#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com/
#
citation("textdata")
#>
#> To cite package 'textdata' in publications use:
#>
#> Emil Hvitfeldt (2019). textdata: Download and Load Various Text
#> Datasets. R package version 0.3.0.
#> https://CRAN.R-project.org/package=textdata
#>
#> A BibTeX entry for LaTeX users is
#>
#> @Manual{,
#> title = {textdata: Download and Load Various Text Datasets},
#> author = {Emil Hvitfeldt},
#> year = {2019},
#> note = {R package version 0.3.0},
#> url = {https://CRAN.R-project.org/package=textdata},
#> }
################# LOAD THE LIBRARIES #################
if("shiny" %in% rownames(installed.packages()) == FALSE)
{install.packages("shiny", dependencies=TRUE)}
library(shiny)
if("tidytext" %in% rownames(installed.packages()) == FALSE)
{install.packages("tidytext", dependencies=TRUE)}
library(tidytext)
if("textdata" %in% rownames(installed.packages()) == FALSE)
{install.packages("textdata", dependencies=TRUE)}
library(textdata)
if("stringr" %in% rownames(installed.packages()) == FALSE)
{install.packages("stringr", dependencies=TRUE)}
library(stringr)
if("dplyr" %in% rownames(installed.packages()) == FALSE)
{install.packages("dplyr", dependencies=TRUE)}
library(dplyr)
#>
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#>
#> filter, lag
#> The following objects are masked from 'package:base':
#>
#> intersect, setdiff, setequal, union
if("tidyr" %in% rownames(installed.packages()) == FALSE)
{install.packages("tidyr", dependencies=TRUE)}
library(tidyr)
if("ggplot2" %in% rownames(installed.packages()) == FALSE)
{install.packages("ggplot2", dependencies=TRUE)}
library(ggplot2)
if("ggthemes" %in% rownames(installed.packages()) == FALSE)
{install.packages("ggthemes", dependencies=TRUE)}
library(ggthemes)
if("reshape2" %in% rownames(installed.packages()) == FALSE)
{install.packages("reshape2", dependencies=TRUE)}
library(reshape2)
#>
#> Attaching package: 'reshape2'
#> The following object is masked from 'package:tidyr':
#>
#> smiths
if("wordcloud" %in% rownames(installed.packages()) == FALSE)
{install.packages("wordcloud", dependencies=TRUE)}
library(wordcloud)
#> Loading required package: RColorBrewer
if("igraph" %in% rownames(installed.packages()) == FALSE)
{install.packages("igraph", dependencies=TRUE)}
library(igraph)
#>
#> Attaching package: 'igraph'
#> The following object is masked from 'package:tidyr':
#>
#> crossing
#> The following objects are masked from 'package:dplyr':
#>
#> as_data_frame, groups, union
#> The following objects are masked from 'package:stats':
#>
#> decompose, spectrum
#> The following object is masked from 'package:base':
#>
#> union
if("ggraph" %in% rownames(installed.packages()) == FALSE)
{install.packages("ggraph", dependencies=TRUE)}
library(ggraph)
if("readr" %in% rownames(installed.packages()) == FALSE)
{install.packages("readr", dependencies=TRUE)}
library(readr)
if("textclean" %in% rownames(installed.packages()) == FALSE)
{install.packages("textclean", dependencies=TRUE)}
library(textclean)
if("shinythemes" %in% rownames(installed.packages()) == FALSE)
{install.packages("shinythemes", dependencies=TRUE)}
library(shinythemes)
if("DT" %in% rownames(installed.packages()) == FALSE)
{install.packages("DT", dependencies=TRUE)}
library(DT)
#>
#> Attaching package: 'DT'
#> The following objects are masked from 'package:shiny':
#>
#> dataTableOutput, renderDataTable
################# INITIALISE #################
v_nrc <- reactive({
readRDS("./nrc")
})
v_file_loaded <- reactive({'N'})
# v_lexicon <- reactive({
# "nrc"
# })
v_positive_emotions <- reactive({
c("positive","joy","anticipation","surprise", "trust")
})
v_negative_emotions <- reactive({
c("negative","anger","disgust","fear", "sadness")
})
v_positive_sentiment <- reactive({
# get_sentiments(v_lexicon()) %>%
v_nrc() %>%
filter(sentiment %in% v_positive_emotions())
})
tryCatch(
{
v_text1 <- reactive({
tibble(text = gsub("[^[:alnum:]///' ]", "", read_lines("./Resume.txt"))) # %>%
})
v_text <<- reactive({
drop_empty_row(v_text1())
})
},
error = function(e) {
# return a safeError if a parsing error occurs
stop(safeError(e))
}
)
#
# v_text <- reactive({
# tibble(text = "text") # Global Variable for the Input Text
# })
v_tidy_data1 <- reactive({
v_text() %>%
unnest_tokens(word, text)
})
v_tidy_data <- reactive({
v_tidy_data1() %>%
anti_join(stop_words)
})
v_unique_words <- reactive({
v_tidy_data() %>%
semi_join(v_positive_sentiment()) %>%
count(word, sort = TRUE) %>%
mutate(word = reorder(word, n))
})
emotionCount <- function() {
v_text_sentiment1 <- reactive({
v_tidy_data() %>%
# inner_join(get_sentiments(v_lexicon())) %>%
inner_join(v_nrc()) %>%
count(word,
index = row_number() %/% 80, sentiment) %>%
mutate(v_original_n = n) %>%
mutate(v_positive_negative = ifelse(sentiment %in% v_positive_emotions(),
'positive', 'negative')) %>%
mutate(v_original_sentiment = sentiment) %>%
spread(sentiment, n, fill = 0)
})
v_text_sentiment <- reactive({
v_text_sentiment1() %>%
mutate(positive = ifelse("positive" %in% colnames(v_text_sentiment1()), positive, 0)) %>%
mutate(joy = ifelse("joy" %in% colnames(v_text_sentiment1()), joy, 0)) %>%
mutate(surprise = ifelse("surprise" %in% colnames(v_text_sentiment1()), surprise, 0)) %>%
mutate(trust = ifelse("trust" %in% colnames(v_text_sentiment1()), trust, 0)) %>%
mutate(anticipation = ifelse("anticipation" %in% colnames(v_text_sentiment1()), anticipation, 0)) %>%
mutate(negative = ifelse("negative" %in% colnames(v_text_sentiment1()), negative, 0)) %>%
mutate(anger = ifelse("anger" %in% colnames(v_text_sentiment1()), anger, 0)) %>%
mutate(disgust = ifelse("disgust" %in% colnames(v_text_sentiment1()), disgust, 0)) %>%
mutate(sadness = ifelse("sadness" %in% colnames(v_text_sentiment1()), sadness, 0)) %>%
mutate(fear = ifelse("fear" %in% colnames(v_text_sentiment1()), fear, 0)) %>%
mutate(sentiment = (positive+joy+surprise+trust+anticipation) - (negative+anger+disgust+sadness+fear)) %>%
ungroup()
})
return(v_text_sentiment())
}
extractBiGrams <- function() {
v_text_bigrams <- reactive({
v_text() %>%
unnest_tokens(bigram, text, token = "ngrams", n = 2)
})
return(v_text_bigrams())
}
extractBiGramsToProcess <- function() {
v_bigrams_separated <- reactive({
extractBiGrams() %>%
separate(bigram, c("word1", "word2"), sep = " ")
})
v_bigrams_filtered <- reactive({
v_bigrams_separated() %>%
filter(!word1 %in% stop_words$word) %>%
filter(!word2 %in% stop_words$word)
})
return(v_bigrams_filtered())
}
extractTriGrams <- function() {
v_text_trigrams <- reactive({
v_text() %>%
unnest_tokens(trigram, text, token = "ngrams", n = 3)
})
return(v_text_trigrams())
}
extractTriGramsToProcess <- function() {
v_trigrams_separated <- reactive({
extractTriGrams() %>%
separate(trigram, c("word1", "word2", "word3"), sep = " ")
})
v_trigrams_filtered <- reactive({
v_trigrams_separated() %>%
filter(!word1 %in% stop_words$word) %>%
filter(!word2 %in% stop_words$word) %>%
filter(!word3 %in% stop_words$word)
})
return(v_trigrams_filtered())
}
set.seed(2019)
# Define UI for application that draws a histogram
ui <- fluidPage(theme = shinytheme("united"),
tags$head(
tags$style(
HTML(".shiny-notification {
position:fixed;
top: calc(50%);
left: calc(50%);
font-family:Verdana;
fontSize:xx-large;
}
"
)
)
),
# Application title
fluidRow(
column(width = 3,
img(src="ParthaInPetra.jpg", width=200, height=112)
),
column(width = 6,
h1("ZEUSg", style="color:blue; text-align: center;"),
h3("Emotion Analyser", style="color:darkred; text-align: center;")
),
column(width = 3,
h4("...", style="color:blue; text-align: right;"),
h4("Developed by: Partha Majumdar", style="color:blue; text-align: right;"),
h5("Riyadh (Saudi Arabia), 11-November-2019", style="color:black; text-align: right;")
)
),
fluidRow(
column(width = 3,
wellPanel(
fluidRow(
h3("Select a TEXT file from your Computer to get started to analyse the contents of the file.", style="color:blue; text-align: center;"),
# h4("After selecting the file, please click on the BASIC INFORMATION tab before proceeding to the other tabs. This is a bug in the system.", style="color:darkred; text-align: center;"),
h4("Please select a FILE, before clicking on any TAB. This is a bug in the system.", style="color:darkred; text-align: center;"),
fileInput("v_input_file", h3("Choose Text File"),
multiple = FALSE, placeholder = "No file selected",
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".txt"))
),
fluidRow(
wellPanel(
p("To learn how to use ZEUSg, visit the ",
a("ZEUSg Demonstration Video.",
href = "https://youtu.be/uEyCnHZN0MU",
target="_blank")
)
)
),
fluidRow(
textInput("v_document_title", h3("Enter Document Title"),
value = "Document Title...")
),
fluidRow(
# wellPanel(
downloadButton("report", "Download Report")
# )
)
)
),
column(width = 9,
fluidRow(
tabsetPanel(id = "mainTabset", type = "tabs",
tabPanel("Welcome to ZEUSg",
img(src="CourseLogo.jpg", width=1200, height=900)
),
tabPanel("ANALYSIS",
# conditionalPanel(
# condition = "v_file_loaded == 'Y'))",
# title = "ANALYSIS",
tabsetPanel(id="analysisPanel", type = "tabs",
tabPanel("Basic Information",
fluidRow(
column(width = 6,
h3("Raw Data Extracted"),
dataTableOutput("contents")
),
column(width = 6,
h3("Words Extracted"),
dataTableOutput("words")
)
)
),
tabPanel("Statistics",
# tags$head(tags$style(type = "text/css", "#maxFrequencyWords th {display:none;}")),
fluidRow(
column(width = 2,
wellPanel(
h5("Lines in File", style="color:black; text-align: center;"),
h3(textOutput("totalLines"), style="color:blue; text-align: center;")
)
),
column(width = 2,
wellPanel(
h5("Lines with Text in File", style="color:goldenrod4; text-align: center;"),
h3(textOutput("totalNonEmptyLines"), style="color:darkgreen; text-align: center;")
)
),
column(width = 2,
wellPanel(
h5("Unique Words in File", style="color:goldenrod; text-align: center;"),
h3(textOutput("totalWords"), style="color:blue; text-align: center;")
)
),
column(width = 2,
wellPanel(
h5("Words Processed for Analysis", style="color:darkseagreen4; text-align: center;"),
h3(textOutput("totalProcessedWords"), style="color:darkgreen; text-align: center;")
)
),
column(width = 2,
wellPanel(
h5("Number of Words with Positive Sentiment", style="color:darkmagenta; text-align: center;"),
h3(textOutput("countOfUniqueWords"), style="color:darkgreen; text-align: center;")
)
),
column(width = 2,
wellPanel(
h5("Maximum/Minimum/Median Positive Sentiment Word Count", style="color:brown; text-align: center;"),
fluidRow(
column(width = 4,
h3(textOutput("maxFrequencyWordCount"), style="color:cyan4; text-align: center;")
),
column(width = 4,
h3(textOutput("minFrequencyWordCount"), style="color:darkturquoise; text-align: center;")
),
column(width = 4,
h3(textOutput("medianFrequencyWordCount"), style="color:cyan3; text-align: center;")
)
) )
)
),
fluidRow(
column(width = 4,
fluidRow(
column(width = 12,
wellPanel(
h5("Prevalent Emotion in Text", style="color:darkred; text-align: center;"),
h1(textOutput("sentimentCountTable"), style="color:blueviolet; text-align: center;")
)
)
),
fluidRow(
column(width = 6,
wellPanel(
h5("Total BIGRAMs in Text", style="color:coral3; text-align: center;"),
h1(textOutput("totalBigramCount"), style="color:blue; text-align: center;")
)
),
column(width = 6,
wellPanel(
h5("BIGRAMs processed for Analysis", style="color:coral3; text-align: center;"),
h1(textOutput("processedBigramCount"), style="color:darkgreen; text-align: center;")
)
)
),
fluidRow(
column(width = 6,
wellPanel(
h5("Total TRIGRAMs in Text", style="color:chocolate4; text-align: center;"),
h1(textOutput("totalTrigramCount"), style="color:blue; text-align: center;")
)
),
column(width = 6,
wellPanel(
h5("TRIGRAMs processed for Analysis", style="color:chocolate4; text-align: center;"),
h1(textOutput("processedTrigramCount"), style="color:darkgreen; text-align: center;")
)
)
)
),
column(width = 8,
plotOutput("wordBoxPlot")
)
)
),
tabPanel(
title = "Sentiment Analysis",
fluidRow(
column(width = 6,
h3("This graph indicates the prevalent emotions in the text."),
plotOutput("sentiments")
),
column(width = 6,
h3("This graph indicates the volume of positive and negative sentiments used through different words used in the text. The sentiments are displayed from the begining to the end of the document."),
h4("Higher volume of GREEN colour in the graph indicates positivity in the text.", style="color:darkgreen; text-align: left;"),
h4("Higher volume of RED indicates negativity in the text.", style="color:red; text-align: left;"),
plotOutput("positiveNegativeSentiments")
)
)
),
tabPanel(
"Word Analysis",
tabsetPanel(type = "tabs",
tabPanel(
"Most Words in the Text",
fluidRow(
column(width = 12,
wellPanel(
h3("This section displays the list of most common words used in the text."),
h4("The nature of words used indicates the areas of maximum exposure and areas of expertise of the writer.")
)
)
),
fluidRow(
column(width = 4,
fluidRow(
column(width = 12,
sliderInput("v_number_of_words",
h4("Set Number of Words to Display"),
min = 20, max = 100,
value = 30, step = 5, ticks = TRUE)
) ),
plotOutput("mostWords")
),
column(width = 4,
plotOutput("wordCloud", width = "100%")
),
column(width = 4,
plotOutput("comparisonCloud", width = "100%")
)
)
),
tabPanel(
"Word Contribution to Sentiments",
fluidRow(
column(width = 6,
sliderInput("v_top_n",
h4("Set Top N Words to Include"),
min = 4, max = 200,
value = 10, step = 2, ticks = TRUE),
h4("This section highlights the words which have contributed to the various emotions extracted in the text."),
h4("The emotions extracted is as per the lexicon used. The lexicon assigns a emotion to the words as per generic computation preset in the knowledge base."),
h4("While evaluating this graph, specific context needs to be kept in mind before drawing conclusions."),
plotOutput("wordContributionToSentiments")
),
column(width = 6,
h4("This graph display the different words that have contributed to the different emotions evaluated in the text."),
h3("The same word can contribute to different emotions based on the context it is used in."),
plotOutput("sentimentScore")
)
)
)
)
),
tabPanel(
"Bi-Gram",
fluidRow(
column(width = 6,
sliderInput("v_bigrams_to_include",
h4("Set Number BI-GRAMs to Include"),
min = 10, max = 100,
value = 20, step = 5, ticks = TRUE),
plotOutput("bigramFrequency")
),
column(width = 6,
h3("This section provides an analysis of the BI-GRAMs used in the text."),
h4("BI-GRAMs are combination of 2 continuous words used in the text. BI-GRAMs indicates the common associations made in experience and exposure."),
plotOutput("bigramGraph")
)
)
),
tabPanel(
"Tri-Gram",
fluidRow(
column(width = 6,
sliderInput("v_trigrams_to_include",
h4("Set Number TRI-GRAMs to Include"),
min = 5, max = 100,
value = 10, step = 5, ticks = TRUE),
plotOutput("trigramFrequency")
),
column(width = 6,
wellPanel(
h3("The most frequently used TRI-GRAMs are displayed here.")
),
plotOutput("trigramWordCloud")
)
)
)
)
)
)
)
)
)
)
# Define server logic required
server <- function(input, output, session) {
observeEvent(input$v_input_file, {
updateTabsetPanel(session, "mainTabset",
selected = "Welcome to ZEUSg"
)
})
output$contents <- renderDataTable({
# input$file1 will be NULL initially. After the user selects
# and uploads a file, all rows will be shown.
# cat(paste("Point 1: ***", input$v_input_file, "+++\n", sep = ''), file = stderr())
req(input$v_input_file)
tryCatch(
{
v_text1 <<- reactive({
tibble(text = gsub("[^[:alnum:]///' ]", "",
read_lines(input$v_input_file$datapath)))
})
v_file_loaded <<- reactive({'Y'})
v_text <<- reactive({
drop_empty_row(v_text1())
})
},
error = function(e) {
# return a safeError if a parsing error occurs
stop(safeError(e))
}
)
# Extract WORDS from the Text
v_tidy_data1 <<- reactive({
v_text() %>%
unnest_tokens(word, text)
})
v_tidy_data <<- reactive({
v_tidy_data1() %>%
anti_join(stop_words)
})
DT::datatable(
{ v_text() },
caption = htmltools::tags$caption(
style = 'caption-side: bottom; text-align: center;',
'Table 1: ', htmltools::em('Raw Data.')
),
extensions = 'Buttons',
options = list(
fixedColumns = TRUE,
autoWidth = TRUE,
ordering = TRUE,
dom = 'Bftsp',
buttons = c('copy', 'csv', 'excel')
))
})
output$words <- renderDataTable({
req(input$v_input_file)
DT::datatable(
{ unique(v_tidy_data1()) },
caption = htmltools::tags$caption(
style = 'caption-side: bottom; text-align: center;',
'Table 2: ', htmltools::em('Words in Text.')
),
extensions = 'Buttons',
options = list(
fixedColumns = TRUE,
autoWidth = FALSE,
ordering = TRUE,
dom = 'Bftsp',
buttons = c('copy', 'csv', 'excel')
))
})
output$totalLines <- renderText({
req(input$v_input_file)
return(nrow(v_text1()))
})
output$totalNonEmptyLines <- renderText({
req(input$v_input_file)
return(nrow(v_text()))
})
output$totalWords <- renderText({
req(input$v_input_file)
return(nrow(unique(v_tidy_data1())))
})
output$totalProcessedWords <- renderText({
req(input$v_input_file)
return(nrow(unique(v_tidy_data())))
})
output$countOfUniqueWords <- renderText({
req(input$v_input_file)
return(nrow(v_unique_words()))
})
output$maxFrequencyWordCount <- renderText({
req(input$v_input_file)
return(max(v_unique_words()$n))
})
output$minFrequencyWordCount <- renderText({
req(input$v_input_file)
return(min(v_unique_words()$n))
})
output$medianFrequencyWordCount <- renderText({
req(input$v_input_file)
return(median(v_unique_words()$n))
})
output$wordBoxPlot <- renderPlot({
req(input$v_input_file)
v_word_count <- reactive({
v_tidy_data() %>%
count(word, sort = TRUE)
})
boxplot(v_word_count()$n,
main = "Distribution of Word Count",
xlab = "Count",
ylab = NULL,
col = "orange",
border = "brown",
horizontal = TRUE,
notch = FALSE
)
})
output$totalBigramCount <- renderText({
req(input$v_input_file)
return(nrow(unique(extractBiGrams())))
})
output$processedBigramCount <- renderText({
req(input$v_input_file)
return(nrow(unique(extractBiGramsToProcess())))
})
output$totalTrigramCount <- renderText({
req(input$v_input_file)
return(nrow(unique(extractTriGrams())))
})
output$processedTrigramCount <- renderText({
req(input$v_input_file)
return(nrow(unique(extractTriGramsToProcess())))
})
####### MOST PREVALENT EMOTION
output$sentimentCountTable <- renderText({
req(input$v_input_file)
v_text_nrc <- reactive({
emotionCount() %>%
# mutate(v_pos_neg = ifelse(v_original_sentiment %in% v_positive_emotions(), "positive", "negative")) %>%
mutate(v_original_n = ifelse(v_positive_negative == "negative",
-v_original_n, v_original_n))
})
v_emotions <- reactive({
v_text_nrc() %>%
select(index, anger, anticipation, disgust, fear, joy,
sadness, surprise, trust) %>%
melt(id = "index") %>%
rename(linenumber = index, sentiment_name = variable, value = value)
})
v_emotions_group <- reactive({group_by(v_emotions(), sentiment_name)})
v_by_emotions <- reactive({summarise(v_emotions_group(), values=sum(value))})
v_temp <- reactive({
v_by_emotions() %>%
mutate_if(is.factor, as.character)
})
return(
ifelse(nrow(subset(v_temp(), values == max(values))) == 1,
unname(unlist(subset(v_temp(), values == max(values)))),
"No Prevalent Emotion")
)
})
######## MOST WORDS IN TEXT
output$mostWords <- renderPlot({
req(input$v_input_file)
v_data <- reactive({
v_tidy_data() %>%
count(word, sort = TRUE) %>%
mutate(word = reorder(word, n))
})
v_data() %>%
filter(row_number() <= input$v_number_of_words) %>%
ggplot(aes(word, n)) +
geom_col() +
xlab(NULL) +
coord_flip() +
ggtitle(paste("The Most Common Words in", input$v_document_title, sep = " "))
})
######## WORD CLOUD
output$wordCloud <- renderPlot({
req(input$v_input_file)
v_data <- reactive({
v_tidy_data() %>%
count(word, sort = TRUE) %>%
mutate(word = reorder(word, n))
})
withProgress(message = 'Generating',
detail = 'This may take a while...', value = 0, {
wordcloud(words = v_data()$word, freq = v_data()$n, min.freq = 1,
max.words = input$v_number_of_words,
random.order=FALSE,
# rot.per=0.35,
colors=brewer.pal(8, "Dark2")
)
})
})
########### COMPARISON CLOUD
output$comparisonCloud <- renderPlot({
req(input$v_input_file)
v_data <- reactive({
v_tidy_data() %>%
# inner_join(get_sentiments(v_lexicon())) %>%
inner_join(v_nrc()) %>%
count(word, sentiment, sort = TRUE) %>%
acast(word ~ sentiment, value.var = "n", fill = 0)
})
withProgress(message = 'Generating',
detail = 'This may take a while...', value = 0, {
comparison.cloud(term.matrix = v_data(),
colors = c("red","dark green","blue","grey","magenta","brown","orange","mediumaquamarine","navy"),
max.words = input$v_number_of_words
)
})
})
output$wordContributionToSentiments <- renderPlot({
req(input$v_input_file)
v_data <- reactive({
emotionCount() %>%
filter(row_number() < input$v_top_n) %>%
group_by(v_original_sentiment) %>%
ungroup() %>%
mutate(word = reorder(word, v_original_n))
})
ggplot(aes(word, v_original_n, fill = v_original_sentiment), data = v_data()) +
geom_col(show.legend = FALSE) +
facet_wrap(~v_original_sentiment, scales = "free_y") +
labs(y = "Words Contribution to Individual Sentiments",
x = NULL) +
coord_flip()
})
output$positiveNegativeSentiments <- renderPlot({
req(input$v_input_file)
v_data <- reactive({
emotionCount() %>%
mutate(v_original_n = ifelse(v_positive_negative == "negative",
-v_original_n, v_original_n))
})
ggplot(data = v_data(), aes(x = index, y = v_original_n, fill = v_positive_negative)) +
geom_bar(stat = 'identity', position = position_dodge()) +
theme_minimal() +
ylab("Sentiment") +
ggtitle(paste("Positive and Negative Sentiment in", input$v_document_title, sep = " ")) +
scale_color_manual(values = c("red", "dark green")) +
scale_fill_manual(values = c("red", "dark green"))
})
output$sentiments <- renderPlot({
req(input$v_input_file)
v_emotions <- reactive({
emotionCount() %>%
select(index, anger, anticipation, disgust, fear, joy,
sadness, surprise, trust) %>%
melt(id = "index") %>%
rename(linenumber = index, sentiment_name = variable, value = value)
})
v_emotions_group <- reactive({group_by(v_emotions(), sentiment_name)})
v_by_emotions <- reactive({summarise(v_emotions_group(), values=sum(value))})
ggplot(aes(reorder(x=sentiment_name, values), y=values, fill=sentiment_name), data = v_by_emotions()) +
geom_bar(stat = 'identity') +
ggtitle(paste('Sentiment in ', input$v_document_title, sep = " ")) +
coord_flip() +
theme(legend.position="none")
})
output$sentimentScore <- renderPlot({
req(input$v_input_file)
v_word_count <- reactive({
v_tidy_data() %>%
# inner_join(get_sentiments(v_lexicon())) %>%
inner_join(v_nrc()) %>%
count(word, sentiment, sort = TRUE)
})
v_data <- reactive({
v_word_count() %>%
filter(row_number() < input$v_top_n) %>%
mutate(n = ifelse(sentiment %in% v_negative_emotions(), -n, n)) %>%
mutate(word = reorder(word, n))
})
ggplot(aes(word, n, fill = sentiment), data = v_data()) +
geom_col() +
coord_flip() +
labs(y = "Sentiment Score")
})
output$bigramFrequency <- renderPlot({
req(input$v_input_file)
v_bigrams_united <- reactive({
extractBiGramsToProcess() %>%
unite(bigram, word1, word2, sep = " ")
})
v_bigram_tf_idf <- reactive({
v_bigrams_united() %>%
count(bigram, sort = TRUE)
})
v_bigram_tf_idf() %>%
filter(row_number() < input$v_bigrams_to_include) %>%
ggplot(aes(x = reorder(bigram, n), y=n)) +
geom_bar(stat = 'identity') +
ggtitle(paste("The Most Common Bi-GRAMs in", input$v_document_title, sep = " ")) +
coord_flip()
})
output$bigramGraph <- renderPlot({
req(input$v_input_file)
v_data <- reactive({
extractBiGramsToProcess() %>%
count(word1, word2, sort = TRUE)
})
withProgress(message = 'Generating',
detail = 'This may take a while...', value = 0, {
v_bigram_graph <- reactive({
v_data() %>%
filter(row_number() < input$v_bigrams_to_include) %>%
graph_from_data_frame()
})
ggraph(v_bigram_graph(), layout = "kk") +
geom_edge_link() +
geom_node_point(color = "darkslategray4", size = 3) +
geom_node_text(aes(label = name), vjust = 1.8) +
ggtitle(paste("Most Common Bi-GRAMs in", input$v_document_title, sep = " "))
})
})
output$trigramFrequency <- renderPlot({
req(input$v_input_file)
v_trigrams_united <- reactive({
extractTriGramsToProcess() %>%
unite(trigram, word1, word2, word3, sep = " ")
})
v_trigram_tf_idf <- reactive({
v_trigrams_united() %>%
count(trigram, sort = TRUE)
})
v_trigram_tf_idf() %>%
filter(row_number() < input$v_trigrams_to_include) %>%
ggplot(aes(x = reorder(trigram, n), y=n)) +
geom_bar(stat = 'identity') +
ggtitle(paste("The Most Common Tri-GRAMs in", input$v_document_title, sep = " ")) +
coord_flip()
})
output$trigramWordCloud <- renderPlot({
req(input$v_input_file)
v_trigrams_united <- reactive({
extractTriGramsToProcess() %>%
unite(trigram, word1, word2, word3, sep = " ")
})
v_trigram_tf_idf <- reactive({
v_trigrams_united() %>%
count(trigram, sort = TRUE)
})
withProgress(message = 'Generating',
detail = 'This may take a while...', value = 0, {
wordcloud(words = v_trigram_tf_idf()$trigram, freq = v_trigram_tf_idf()$n, min.freq = 1,
max.words = input$v_trigrams_to_include,
random.order=FALSE,
# rot.per=0.35,
colors=brewer.pal(8, "Dark2"))
})
})
output$report <- downloadHandler(
# For PDF output, change this to "report.pdf"
filename <- "report.pdf",
content <- function(file) {
withProgress(message = 'Generating Report. This takes a minute or two...', value = 0, {
# Set up parameters to pass to Rmd document
params <- list(
p_input_file = input$v_input_file$name,
p_document_title = input$v_document_title,
p_number_of_words = input$v_number_of_words,
p_top_n = input$v_top_n,
p_bigrams_to_include = input$v_bigrams_to_include,
p_trigrams_to_include = input$v_trigrams_to_include,
p_text = v_text(),
p_total_lines = nrow(v_text1())
)
# Knit the document, passing in the `params` list, and eval it in a
# child of the global environment (this isolates the code in the document
# from the code in this app).
rmarkdown::render("EmotionAnalysis.Rmd",
output_file = file,
params = params,
envir = new.env(parent = globalenv())
)
})
# # Copy the report file to a temporary directory before processing it, in
# # case we don't have write permissions to the current working dir (which
# # can happen when deployed).
# # tempReport <- file.path(tempdir(), "EmotionAnalysis.Rmd")
# # file.copy("EmotionAnalysis.Rmd", tempReport, overwrite = TRUE)
#
# # Set up parameters to pass to Rmd document
# params <- list(n = input$v_words_to_include_word_cloud)
#
# # Knit the document, passing in the `params` list, and eval it in a
# # child of the global environment (this isolates the code in the document
# # from the code in this app).
# rmarkdown::render("EmotionAnalysis.Rmd",
# output_file = file,
# params = params,
# envir = new.env(parent = globalenv())
# )
# rmarkdown::render(tempReport, output_file = file,
# params = params,
# envir = new.env(parent = globalenv())
# )
}
)
}
# Run the application
shinyApp(ui = ui, server = server)
#>
#> Listening on http://127.0.0.1:7622ZEUSg – Complete Code
Leave a Comment on ZEUSg – Complete Code
The complete code for ZEUSg - Emotion Analyser.