library("dplyr")
library("tidyr")
library("purrr")
library("scales")
library("ggplot2")
library("shiny")
library("tidytext")
library("wordcloud")
library("wordcloud2")
library("stringr")
library("reshape2")
library("stopwords")
library("syuzhet")
library("colourpicker")
library("shinyWidgets")
library("RColorBrewer")
library("shinydashboard")
library("shinycustomloader")
library("DT")
library("webshot")
# install phantomjs at first run to enable downloading png wordclouds
# webshot::install_phantomjs()
dataset <- readRDS(file = file.path("qf_data", "tweets_processed", "dataset.rds"))
hashtagsList <- readRDS(file = file.path("qf_data", "tweets_processed", "tweets_hashtags_list.rds"))
trendingHashtags <- readRDS(file = file.path("qf_data", "tweets_processed", "tweets_trending_hashtags_list.rds"))
lang <- readRDS(file = file.path("qf_data", "tweets_processed", "tweets_lang_list.rds"))
EPGroupShort <- readRDS(file = file.path("qf_data", "tweets_processed", "EPGroupShort.rds"))
countries <- readRDS(file = file.path("qf_data", "tweets_processed", "countries.rds"))
palettes <- readRDS(file = file.path("qf_data", "tweets_processed", "palettes.rds"))
langTable <- left_join(x = tibble::tibble(lang = unlist(lang)),
y = readRDS(file.path("qf_data", "tweets_processed", "langCode.rds")) %>%
rename(lang = alpha2), by = "lang") %>%
mutate(English = stringr::str_extract(string = English, pattern = regex("[[:alnum:]]+")))
embed_tweet_js <- function(id, i) {
HTML(paste0('<div id="tweetcontainer', i, '"></div>',
"<script>twttr.widgets.createTweet('", id, "',
document.getElementById('tweetcontainer", i, "'),
{
theme: 'light'
}
); </script>"))
}
embed_profile <- function(screen_name) {
HTML(paste0('<a class="twitter-timeline" data-height="600" href="https://twitter.com/', screen_name, '">Tweets by ', screen_name, '</a> <script async src="https://platform.twitter.com/widgets.js" charset="utf-8"></script>'))
}
pal <- brewer.pal(9,"Blues")
pal <- pal[-(1:5)]
# European formatting of large numbers
point <- scales::format_format(big.mark = ".", decimal.mark = ",", scientific = FALSE)
## function to give wordcloud2 click interactivity
## from https://github.com/Lchiffon/wordcloud2/issues/25
wc2ClickedWord = function(cloudOutputId, inputId) {
shiny::tags$script(shiny::HTML(
sprintf("$(document).on('click', '#%s', function() {", cloudOutputId),
'word = document.getElementById("wcSpan").innerHTML;',
sprintf("Shiny.onInputChange('%s', word);", inputId),
"});"
))
}
# wordcloud2 html output fix from https://github.com/Lchiffon/wordcloud2/issues/20
simpleFixWc2 <- function(inputFile, outputFile){
a = readLines(inputFile)
output = paste(a, collapse = "\n")
output = gsub(">\n\n</div>","></div>",output)
writeLines(output, outputFile)
invisible(NULL)
}
# Enable bookmarking
enableBookmarking(store = "server")
ui = shinydashboard::dashboardPage(
shinydashboard::dashboardHeader(title = "EdjNet QuoteFinder"),
shinydashboard::dashboardSidebar(sidebarMenu(
menuItem("Twitter", tabName = "TwitterMEP", icon = icon("twitter")),
shiny::HTML("<hr><div class='col-sm-12'><p><b>The QuoteFinder lets you explore</b></p></div>"),
infoBox(title = "tweets", value = point(nrow(dataset)), icon = icon("twitter"), width = 12, color = "blue", fill = TRUE),
infoBox(title = "by", value = paste(length(unique(dataset$screen_name)), "MEPs"), icon = icon("users"), width = 12, color = "blue", fill = TRUE)),
infoBox(title = "posted since", value = min(dataset$date), icon = icon("calendar"), width = 12, color = "blue", fill = TRUE),
disable = TRUE
),
dashboardBody(
tags$head(HTML('<script async src="https://platform.twitter.com/widgets.js" charset="utf-8"></script>')),
# wc2ClickedWord(cloudOutputId = "wordcloud2", inputId = "selected_word"),
tabItems(
##### TwitterMEP tab ####
tabItem(tabName = "TwitterMEP",
#### Box 1: Wordcloud ####
tabBox(id = "wordcloud_plot",
tabPanel("Wordcloud",
uiOutput("warning"),
wordcloud2Output("wordcloud2"),
splitLayout(
shiny::sliderInput(inputId = "sizeVarWC2",
label = "Wordcloud size",
min = 0.1,
max = 2,
value = 0.5,
sep = "."
),
shiny::sliderInput(inputId = "MaxWords",
label = "Max number of words",
min = 0L,
max = 1000L,
value = 200L,
sep = ".", width = "95%"
)
),
splitLayout(shiny::uiOutput(outputId = "colourMost_UI"),
shiny::uiOutput(outputId = "colourLeast_UI"),
cellWidths = "50%",
tags$head(tags$style(HTML("
.shiny-split-layout > div {
overflow: visible;
}
")))),
splitLayout(downloadButton("downloadHtml", "Download Html"),
downloadButton("downloadPng", "Download PNG"))
# ,
# HTML("<b>Tip</b>: by clicking on a term in the wordcloud, only tweets including it are shown in the table below.")
),
#### Box1, Tab2: Barcharts #####
tabPanel("Barcharts",
plotOutput('barchartGG'),
shiny::sliderInput(inputId = "MaxWordsInBarchart",
label = "Max number of words",
min = 0L,
max = 30L,
value = 20L,
sep = ".",
width = "95%",
round = TRUE
),
downloadButton("downloadTidyWordCount", "Download as spreadsheet")),
tabPanel("EP group comparison",
plotOutput("barchartComparisonGG"),
radioButtons(inputId = "wcOrBarchartComparison",
label = "How would you like to compare?",
choices = as.list(c("Comparison wordcloud",
"Commonality wordcloud",
"Comparison barchart")))
)
# ,
# tabPanel("Classic wordcloud",
# plotOutput(outputId = "wordcloud"))
),
#### Box 2: Date and language ####
box(
shiny::radioButtons(inputId = "dateRangeRadio",
label = "Select date range",
choices = as.list(c("Last week",
"Last month",
#"Last three months",
"Custom range")),
selected = "Last month", inline = TRUE),
conditionalPanel(
condition = "input.dateRangeRadio == 'Custom range'",
shiny::dateRangeInput(inputId = 'dateRange',
weekstart = 1,
label = "Select date range",
start = min(dataset$date), end = max(dataset$date)
)
)
,
HTML("<b>Filter tweets by language</b>"),
shiny::checkboxInput(inputId = "anyLanguage",
label = "Any language",
value = FALSE),
conditionalPanel("input.anyLanguage == false",
shiny::selectInput(inputId = "language",
label = NULL,
choices = lang,
selected = "en")),
conditionalPanel("input.anyLanguage == true",
shiny::checkboxInput(inputId = "colourLanguage",
label = "A different colour for each language?",
value = TRUE))
,
uiOutput(outputId = "hashtags_UI"),
uiOutput(outputId = "trendingHashtagsTitle"),
uiOutput(outputId = "trendingHashtags"),
conditionalPanel("input.anyLanguage == false",
shiny::radioButtons(inputId = "sentimentL",
label = "Type of wordcloud",
choices = c("Unified",
"Sentiment by tweet",
"Sentiment by word"),
inline = TRUE)
)
),
#### Box 3: Wordcloud filters ####
tabBox(title = "Search and filter",
id = "wordcloud_filters",
tabPanel("By string",
textInput(inputId = 'string', label = NULL)
# splitLayout(textInput(inputId = 'string', label = NULL),
# #actionButton("filter", "Filter", icon = icon("filter", class = "font-awesome")),
# cellWidths = c("75%", "25%"))
)
,
tabPanel("By EP group",
shiny::checkboxGroupInput(inputId = "EPgroup",
label = "Choose group",
choices = EPGroupShort,
inline = TRUE)
#,actionButton("filterByGroup", "Filter", icon = icon("filter", class = "font-awesome"))
),
tabPanel("By MEP", shiny::uiOutput(outputId = "MEPfilter_UI")),
tabPanel("By country", shiny::uiOutput(outputId = "country_filter_UI"))
# ,
# tabPanel("By sentiment", shiny::checkboxGroupInput(inputId = "sentimentFilter",
# label = "Choose sentiment",
# choices = as.list(c("Positive", "Negative", "Neutral")),
# inline = TRUE))
),
box(actionButton(inputId = "reset",
label = "Reset filters",
icon = icon(name = "recycle", lib = "font-awesome")),
bookmarkButton(label = "Get direct link with current settings")
),
#### Box 4: infobox ####
box(title = NULL,
shiny::htmlOutput(outputId = "HeaderInfoBox"),
infoBoxOutput(outputId = "TweetsNr"),
infoBoxOutput(outputId = "MEPsNr"),
infoBoxOutput(outputId = "DaysNr"),width = 12
)
,
#### Box 5: table ####
fluidRow(DT::dataTableOutput(outputId = "table")),
#### Tweet wall ####
fluidRow(uiOutput(outputId = "selected_tweets_wall"))
)
)
)
)
server = function(input, output, session) {
randomString <- stringi::stri_rand_strings(n=1, length=16)
#### Reset ####
observeEvent(input$reset, {
updateTextInput(session = session, inputId = "string", value = "")
updateCheckboxGroupInput(session = session, inputId = "EPgroup", selected = character(0))
updateSelectizeInput(session = session, inputId = "MEPfilter", selected = character(0))
updateSelectizeInput(session = session, inputId = "selectedHashtag", selected = "All tweets")
updateSelectizeInput(session = session, inputId = "countryFilter", selected = character(0))
})
observeEvent(input$wordcloud_plot, {
if (input$wordcloud_plot=="EP group comparison") {
updateTabsetPanel(session = session,
inputId = "wordcloud_filters",
selected = "By EP group")
shiny::updateCheckboxGroupInput(session = session,
inputId = "EPgroup",
selected = c("S&D", "EPP"))
}
})
#### Reactive ####
currentDataset <- reactive({
# filter date
if (input$dateRangeRadio=="Last week") {
dataset <- dataset %>%
filter(date>Sys.Date()-7)
} else if (input$dateRangeRadio=="Last month") {
dataset <- dataset %>%
filter(date>Sys.Date()-31)
} else if (input$dateRangeRadio=="Last three months") {
dataset <- dataset %>%
filter(date>Sys.Date()-91)
} else {
dataset <- dataset %>%
filter(date>=min(as.Date(input$dateRange))&date<=max(as.Date(input$dateRange)))
}
# filter by language
if (input$anyLanguage==FALSE) {
dataset <- dataset %>%
filter(lang==input$language)
}
# filter by country
if (is.null(input$countryFilter)==FALSE) {
dataset <- dataset %>%
filter(stringr::str_detect(string = country, pattern = paste(input$countryFilter, collapse = "|")))
}
#filter hashtag
if(is.null(input$selectedHashtag)){
} else if(input$selectedHashtag=="All tweets") {
} else {
dataset <- dataset %>%
filter(purrr::map_lgl(.x = hashtags, .f = function (x) is.element(el = tolower(input$selectedHashtag), set = tolower(x))))
}
if (input$string!="") {
dataset <- dataset %>%
filter(stringr::str_detect(string = text, pattern = stringr::regex(pattern = input$string, ignore_case = TRUE)))
}
if (is.null(input$EPgroup)==FALSE) {
dataset <- dataset %>%
filter(stringr::str_detect(string = GroupShort, pattern = paste(input$EPgroup, collapse = "|")))
}
if (is.null(input$MEPfilter)==FALSE) {
dataset <- dataset %>%
filter(stringr::str_detect(string = screen_name, pattern = paste(input$MEPfilter, collapse = "|")))
}
dataset
})
currentHashtags <- reactive({
if (input$anyLanguage==FALSE) {
dataset <- dataset %>%
filter(lang==input$language)
}
if (input$dateRangeRadio=="Last week") {
dataset <- dataset %>%
filter(date>Sys.Date()-7)
} else if (input$dateRangeRadio=="Last month") {
dataset <- dataset %>%
filter(date>Sys.Date()-31)
} else if (input$dateRangeRadio=="Last three months") {
dataset <- dataset %>%
filter(date>Sys.Date()-91)
} else {
dataset <- dataset %>%
filter(date>=min(as.Date(input$dateRange))&date<=max(as.Date(input$dateRange)))
}
if (is.null(input$EPgroup)==FALSE) {
dataset <- dataset %>%
filter(stringr::str_detect(string = GroupShort, pattern = paste(input$EPgroup, collapse = "|")))
}
currentHashtagsDF <- dataset %>%
select(screen_name, hashtags) %>%
unnest(cols = c(hashtags)) %>%
na.omit() %>%
group_by(hashtags) %>%
add_count(sort = TRUE) %>%
rename(nTotalOrig = n) %>%
mutate(hashtagsLower = tolower(hashtags)) %>% # ignore case, but keep the case of the most frequently found case combination
group_by(hashtagsLower) %>%
add_tally() %>%
ungroup() %>%
rename(nTotal = n) %>%
group_by(hashtags, nTotal) %>%
distinct(screen_name, .keep_all = TRUE) %>%
add_count() %>%
rename(nMepPerHashtag = n) %>%
select(-screen_name) %>%
arrange(desc(nMepPerHashtag), desc(nTotal)) %>%
ungroup() %>%
distinct(hashtagsLower, .keep_all = TRUE) %>%
mutate(hashtagString = paste0("#", hashtags, " (", nMepPerHashtag, " MEPs, ", nTotal, " tweets)"))
currentHashtagsList <- as.list(currentHashtagsDF$hashtags)
names(currentHashtagsList) <- currentHashtagsDF$hashtagString
currentHashtagsList
})
currentTrendingHashtags <- reactive({
if (input$anyLanguage==TRUE) {
as.character(trendingHashtags$AnyLanguage)
} else {
as.character(unlist(trendingHashtags[names(trendingHashtags)==input$language]))
}
})
currentMEPs <- reactive({
if (input$dateRangeRadio=="Last week") {
dataset <- dataset %>%
filter(date>Sys.Date()-7)
} else if (input$dateRangeRadio=="Last month") {
dataset <- dataset %>%
filter(date>Sys.Date()-31)
} else if (input$dateRangeRadio=="Last three months") {
dataset <- dataset %>%
filter(date>Sys.Date()-91)
} else {
dataset <- dataset %>%
filter(date>=min(as.Date(input$dateRange))&date<=max(as.Date(input$dateRange)))
}
if (is.null(input$EPgroup)==FALSE) {
dataset <- dataset %>%
filter(stringr::str_detect(string = GroupShort, pattern = paste(input$EPgroup, collapse = "|")))
}
# filter language
if (input$anyLanguage==FALSE) {
dataset <- dataset %>%
filter(lang==input$language)
}
#filter hashtag
if(is.null(input$selectedHashtag)){
} else if(input$selectedHashtag=="All tweets") {
} else {
dataset <- dataset %>%
filter(purrr::map_lgl(.x = hashtags, .f = function (x) is.element(el = tolower(input$selectedHashtag), set = tolower(x))))
}
if (input$string!="") {
dataset <- dataset %>%
filter(stringr::str_detect(string = text, pattern = stringr::regex(pattern = input$string, ignore_case = TRUE)))
}
if (is.null(input$EPgroup)==FALSE) {
dataset <- dataset %>%
filter(stringr::str_detect(string = GroupShort, pattern = paste(input$EPgroup, collapse = "|")))
}
temp <- dataset %>% distinct(fullName, screen_name) %>% filter(is.na(fullName)==FALSE) %>% arrange(fullName)
currentMEPsList <- structure(as.list(temp$screen_name), names = as.character(temp$fullName))
currentMEPsList
})
#### UI ####
output$warning <- renderUI({
if (input$sentimentL=="Sentiment by tweet") {
HTML(text = "<b>Warning</b>: sentiment by tweet currently works with English tweets only")
}
})
output$hashtags_UI <- renderUI({
shiny::selectizeInput(inputId = "selectedHashtag",
label = "Select hashtag",
choices = c(list("All tweets"),
currentHashtags()))
})
output$MEPfilter_UI <- renderUI({
shiny::selectizeInput(inputId = "MEPfilter", label = "Filter by MEP",
choices = currentMEPs(),
multiple = TRUE)
})
output$country_filter_UI <- renderUI({
shiny::selectizeInput(inputId = "countryFilter", label = "Filter by country",
choices = as.list(unique(dataset$country) %>% sort()),
multiple = TRUE)
})
output$MaxWords_UI <- renderUI({
shiny::sliderInput(inputId = "MaxWords",
label = "Maximum number of words in the wordcloud",
min = 1,
max = 1000
)
})
output$colourMost_UI <- renderUI({
if (input$sentimentL=="Sentiment by word") {
colourInput(inputId = "colourPositive", label = "Colour for positive terms", value = "#00BFC4", showColour = "both")
} else if (input$anyLanguage==TRUE&input$colourLanguage==TRUE) {
pickerInput(
inputId = "multilingual_palette", label = "Choose a palette:",
choices = palettes$colors_pal, selected = "Set1", width = "200%",
choicesOpt = list(
content = sprintf(
"<div style='width:100%%;padding:5px;border-radius:4px;background:%s;color:%s'>%s</div>",
unname(palettes$background_pals), palettes$colortext_pals, names(palettes$background_pals)
)
)
)
} else {
colourInput(inputId = "colourMost", label = "Colour for most frequent terms", value = "#08306B", showColour = "both")
}
})
output$colourLeast_UI <- renderUI({
if (input$sentimentL=="Sentiment by word") {
colourInput(inputId = "colourNegative", label = "Colour for negative terms", value = "#F8766D", showColour = "both")
} else if (input$anyLanguage==TRUE&input$colourLanguage==TRUE) {
# leave empty
}
else {
colourInput(inputId = "colourLeast", label = "Colour for least frequent terms", value = "#4292C6", showColour = "both")
}
})
observe({
updateActionButton(session = session, inputId = "trendingHashtag_1", label = currentTrendingHashtags()[1])
updateActionButton(session = session, inputId = "trendingHashtag_2", label = currentTrendingHashtags()[2])
updateActionButton(session = session, inputId = "trendingHashtag_3", label = currentTrendingHashtags()[3])
updateActionButton(session = session, inputId = "trendingHashtag_4", label = currentTrendingHashtags()[4])
updateActionButton(session = session, inputId = "trendingHashtag_5", label = currentTrendingHashtags()[5])
updateActionButton(session = session, inputId = "trendingHashtag_6", label = currentTrendingHashtags()[6])
updateActionButton(session = session, inputId = "trendingHashtag_7", label = currentTrendingHashtags()[7])
updateActionButton(session = session, inputId = "trendingHashtag_8", label = currentTrendingHashtags()[8])
})
output$trendingHashtagsTitle <- renderUI({
if (length(currentTrendingHashtags())>0) {
HTML("<b>Trending hashtags</b><br />")
}
})
output$trendingHashtags <- renderUI({
lapply(seq_along(currentTrendingHashtags()[1:8]), function(x){
do.call(actionButton, list(inputId = paste("trendingHashtag", x, sep = "_"), label = currentTrendingHashtags()[x]))
}
)
})
observeEvent(eventExpr = input$trendingHashtag_1, {
updateSelectizeInput(session = session,
inputId = "selectedHashtag",
selected = currentHashtags()[tolower(as.character(unlist(currentHashtags())))==tolower(stringr::str_remove(string = currentTrendingHashtags()[1], pattern = "#"))])
})
observeEvent(eventExpr = input$trendingHashtag_2, {
updateSelectizeInput(session = session,
inputId = "selectedHashtag",
selected = currentHashtags()[tolower(as.character(unlist(currentHashtags())))==tolower(stringr::str_remove(string = currentTrendingHashtags()[2], pattern = "#"))])
})
observeEvent(eventExpr = input$trendingHashtag_3, {
updateSelectizeInput(session = session,
inputId = "selectedHashtag",
selected = currentHashtags()[tolower(as.character(unlist(currentHashtags())))==tolower(stringr::str_remove(string = currentTrendingHashtags()[3], pattern = "#"))])
})
observeEvent(eventExpr = input$trendingHashtag_4, {
updateSelectizeInput(session = session,
inputId = "selectedHashtag",
selected = currentHashtags()[tolower(as.character(unlist(currentHashtags())))==tolower(stringr::str_remove(string = currentTrendingHashtags()[4], pattern = "#"))])
})
observeEvent(eventExpr = input$trendingHashtag_5, {
updateSelectizeInput(session = session,
inputId = "selectedHashtag",
selected = currentHashtags()[tolower(as.character(unlist(currentHashtags())))==tolower(stringr::str_remove(string = currentTrendingHashtags()[5], pattern = "#"))])
})
observeEvent(eventExpr = input$trendingHashtag_6, {
updateSelectizeInput(session = session,
inputId = "selectedHashtag",
selected = currentHashtags()[tolower(as.character(unlist(currentHashtags())))==tolower(stringr::str_remove(string = currentTrendingHashtags()[6], pattern = "#"))])
})
observeEvent(eventExpr = input$trendingHashtag_7, {
updateSelectizeInput(session = session,
inputId = "selectedHashtag",
selected = currentHashtags()[tolower(as.character(unlist(currentHashtags())))==tolower(stringr::str_remove(string = currentTrendingHashtags()[7], pattern = "#"))])
})
observeEvent(eventExpr = input$trendingHashtag_8, {
updateSelectizeInput(session = session,
inputId = "selectedHashtag",
selected = currentHashtags()[tolower(as.character(unlist(currentHashtags())))==tolower(stringr::str_remove(string = currentTrendingHashtags()[8], pattern = "#"))])
})
#### Subset date range ####
observe({
if (input$dateRangeRadio=="Last week") {
startDate <- Sys.Date()-7
} else if (input$dateRangeRadio=="Last month") {
startDate <- Sys.Date()-31
} else if (input$dateRangeRadio=="Last three months") {
startDate <- Sys.Date()-91
}
if (input$dateRangeRadio=="Custom range") {
updateDateRangeInput(session, "dateRange",
start = min(dataset$date),
end = Sys.Date())
}
})
#### Wordcloud ####
output$wordcloud <- renderPlot(expr = {
# reload if dateRange or hashtag is changed
input$dateRange
input$dateRangeRadio
input$selectedHashtag
# If tab is "By hashtag"
if (input$wordcloud_filters=="By hashtag") {
if (is.null(input$selectedHashtag)==FALSE) {
par(mar = rep(0, 4))
if (input$selectedHashtag=="All tweets") {
temp <- dataset %>%
filter(lang==input$language) %>%
select(clean_text) %>%
unnest_tokens(input = clean_text, output = word) %>%
# remove stopwords, if list for the relevant language is available, otherwise do nothing
when(is.element(el = input$language, set = stopwords::stopwords_getlanguages(source = "stopwords-iso")) ~
anti_join(., tibble::tibble(word = stopwords::stopwords(language = input$language, source = "stopwords-iso")), by = "word"),
~ .)
} else {
temp <- dataset %>%
filter(lang==input$language) %>%
filter(purrr::map_lgl(.x = hashtags, .f = function (x) is.element(el = tolower(input$selectedHashtag), set = tolower(x)))) %>%
select(clean_text) %>%
unnest_tokens(input = clean_text, output = word) %>%
# remove stopwords, if list for the relevant language is available, otherwise do nothing
when(is.element(el = input$language, set = stopwords::stopwords_getlanguages(source = "stopwords-iso")) ~
anti_join(., tibble::tibble(word = stopwords::stopwords(language = input$language, source = "stopwords-iso")), by = "word"),
~ .)
}
if (input$sentimentL=="Sentiment by word") {
# for log
message(paste(Sys.time(), "WordcloudSentimentCreated", input$language, sep = "-"))
par(mar = rep(0, 4))
temp %>%
# nrc sentiment, removing words that are both positive and negative
inner_join(y = syuzhet::get_sentiment_dictionary(dictionary = "nrc",
lang = langTable %>% filter(lang=="en") %>% pull(English) %>% tolower()) %>%
dplyr::filter(sentiment=="negative"|sentiment=="positive") %>% add_count(word) %>% filter(n==1) %>% select(-n), by = "word") %>%
count(word, sentiment, sort = TRUE) %>%
acast(word ~ sentiment, value.var = "n", fill = 0) %>%
comparison.cloud(colors = c("#F8766D", "#00BFC4"),
max.words = 100, scale = c(3, 1), family = "Carlito", font = 1)
} else {
# for log
message(paste(Sys.time(), "WordcloudUnifiedCreated", input$language, sep = "-"))
par(mar = rep(0, 4))
temp %>%
count(word) %>%
with(wordcloud(word, n, scale = c(3, 1), max.words = 100, min.freq = 1,
random.order = FALSE, family = "Carlito", font = 1, colors = pal))
}
}
##### By EP Group #####
} else if (input$wordcloud_filters=="By EP group") {
par(mar = rep(0, 4))
temp <- dataset %>%
filter(lang==input$language) %>%
filter(stringr::str_detect(string = GroupShort, pattern = paste(input$EPgroup, collapse = "|"))) %>%
select(clean_text, country, GroupShort) %>%
unnest_tokens(input = clean_text, output = word) %>%
# remove stopwords, if list for the relevant language is available, otherwise do nothing
when(is.element(el = input$language, set = stopwords::stopwords_getlanguages(source = "stopwords-iso")) ~
anti_join(., tibble::tibble(word = stopwords::stopwords(language = input$language, source = "stopwords-iso")), by = "word"),
~ .)
if (length(input$EPgroup)==1) {
} else if (length(input$EPgroup)>1) {
par(mar = rep(0, 4))
temp %>%
count(word, GroupShort, sort = TRUE) %>%
acast(word ~ GroupShort, value.var = "n", fill = 0) %>%
comparison.cloud(
#colors = c("#F8766D", "#00BFC4"),
max.words = 100, scale = c(3, 1), family = "Carlito", font = 1)
}
}
}, execOnResize = TRUE)
#### Wordcloud 2 ####
wc2 <- reactive({
if (is.null(input$colourMost)==FALSE) {
createPalette <- colorRampPalette(colors = c(input$colourMost, input$colourLeast))
} else if(input$anyLanguage==TRUE&input$colourLanguage==TRUE) {
###
} else {
createPalette <- colorRampPalette(colors = c("#08306B", "#4292C6"))
}
if (is.null(input$selectedHashtag)==FALSE) {
##### Wordcloud2 sentiment or unified #####
if (input$sentimentL=="Sentiment by word") {
if (input$language=="en") {
sentimentDictionary <- tidytext::get_sentiments("bing")
} else {
sentimentDictionary <-
syuzhet::get_sentiment_dictionary(dictionary = "nrc",
lang = langTable %>%
filter(lang==input$language) %>%
pull(English) %>%
tolower()) %>%
filter(sentiment=="negative"|sentiment=="positive") %>%
add_count(word) %>%
filter(n==1) %>%
select(word, sentiment)
}
dataset <- currentDataset() %>%
select(clean_text) %>%
unnest_tokens(input = clean_text, output = word) %>%
# remove stopwords, if list for the relevant language is available, otherwise do nothing
when(is.element(el = input$language, set = stopwords::stopwords_getlanguages(source = "snowball")) ~
anti_join(., tibble::tibble(word = stopwords::stopwords(language = input$language, source = "snowball")), by = "word"),
is.element(el = input$language, set = stopwords::stopwords_getlanguages(source = "stopwords-iso")) ~
anti_join(., tibble::tibble(word = stopwords::stopwords(language = input$language, source = "stopwords-iso")), by = "word"),
~ .) %>%
# nrc sentiment, removing words that are both positive and negative
inner_join(y = sentimentDictionary, by = "word") %>%
count(word, sentiment, sort = TRUE) %>%
slice(1:input$MaxWords) %>%
mutate(colour = if_else(condition = sentiment=="negative",
true = if (is.null(input$colourNegative)) "#F8766D" else input$colourNegative,
false = if (is.null(input$colourPositive)) "#00BFC4" else input$colourPositive)) %>%
select(-sentiment)
} else if (input$sentimentL=="Sentiment by tweet") {
dataset <- currentDataset() %>%
select(clean_text) %>%
mutate(sentiment = syuzhet::get_sentiment(char_v = clean_text, language = input$language)) %>%
# remove neutral
filter(sentiment!=0) %>%
mutate(sentiment = if_else(condition = sentiment>0, true = "positive", false = "negative")) %>%
tidytext::unnest_tokens(input = clean_text, output = word) %>%
# remove stopwords, if list for the relevant language is available, otherwise do nothing
when(is.element(el = input$language, set = stopwords::stopwords_getlanguages(source = "snowball")) ~
anti_join(., tibble::tibble(word = stopwords::stopwords(language = input$language, source = "snowball")), by = "word"),
is.element(el = input$language, set = stopwords::stopwords_getlanguages(source = "stopwords-iso")) ~
anti_join(., tibble::tibble(word = stopwords::stopwords(language = input$language, source = "stopwords-iso")), by = "word"),
~ .) %>%
count(word, sentiment, sort = TRUE) %>%
slice(1:input$MaxWords) %>%
mutate(colour = if_else(condition = sentiment=="negative",
true = if (is.null(input$colourNegative)) "#F8766D" else input$colourNegative,
false = if (is.null(input$colourPositive)) "#00BFC4" else input$colourPositive)) %>%
select(-sentiment)
} else {
if (input$anyLanguage==TRUE) {
dataset <- currentDataset() %>%
select(clean_text, lang) %>%
unnest_tokens(input = clean_text, output = word) %>%
mutate(stopword = FALSE)
for (i in stopwords::stopwords_getlanguages(source = "stopwords-iso")) {
if (length(dataset$stopword[dataset$lang==i])!=0) {
dataset$stopword[dataset$lang==i] <- is.element(el = dataset$word[dataset$lang==i], set = c("via", "retweeted", stopwords::stopwords(language = i, source = "stopwords-iso")))
}
}
if (input$colourLanguage==TRUE) {
dataset <- dataset %>%
filter(stopword==FALSE) %>%
group_by(lang) %>%
count(word, sort = TRUE) %>%
add_tally(wt = n) %>%
arrange(desc(n)) %>%
ungroup() %>%
mutate(lang = factor(x = lang, levels = unique(lang)))
dataset$LangRank <- dataset %>% group_indices(., factor(lang, levels = unique(lang)))
if (is.null(input$multilingual_palette)) {
MaxLang <- 9
} else {
MaxLang <- brewer.pal.info$maxcolors[rownames(brewer.pal.info)==input$multilingual_palette]
}
dataset <- dataset %>%
filter(LangRank<(MaxLang+1)) %>%
ungroup() %>%
top_n(n = input$MaxWords, wt = n) %>%
arrange(LangRank) %>%
left_join(tibble::tibble(LangRank = if (is.null(input$multilingual_palette)) 1:9 else if(brewer.pal.info$category[rownames(brewer.pal.info)==input$multilingual_palette]=="seq") MaxLang:1 else 1:MaxLang, colour = brewer.pal(n = MaxLang, name = if (is.null(input$multilingual_palette)) "Set1" else input$multilingual_palette)), by = "LangRank") %>%
select(word, n, colour) %>%
arrange(desc(n))
} else if (input$colourLanguage==FALSE) {
dataset <- dataset %>%
filter(stopword==FALSE) %>%
count(word, sort = TRUE) %>%
slice(1:input$MaxWords) %>%
mutate(colour = createPalette(n()))
}
} else {
dataset <- currentDataset() %>%
select(clean_text) %>%
unnest_tokens(input = clean_text, output = word) %>%
# remove stopwords, if list for the relevant language is available, otherwise do nothing
when(is.element(el = input$language, set = stopwords::stopwords_getlanguages(source = "stopwords-iso")) ~
anti_join(., tibble::tibble(word = c("via", stopwords::stopwords(language = input$language, source = "stopwords-iso"))), by = "word"),
~ .) %>%
count(word, sort = TRUE) %>%
slice(1:input$MaxWords) %>%
mutate(colour = createPalette(n()))
}
}
# add for log
if (input$sentimentL=="Sentiment by word") {
message(paste(Sys.time(), "Wordcloud2SentimentCreated", input$language, sep = "-"))
} else {
message(paste(Sys.time(), "Wordcloud2UnifiedCreated", input$language, sep = "-"))
}
dataset
}
})
output$wordcloud2 <- renderWordcloud2(
if (is.null(wc2())==FALSE) wc2() %>% wordcloud2(size = if (is.null(input$sizeVarWC2)) 0.5 else input$sizeVarWC2,
color = wc2()$colour))
#### Barcharts ####
output$barchartGG <- renderPlot({
currentDataset() %>%
select(clean_text) %>%
unnest_tokens(input = clean_text, output = word) %>%
# remove stopwords, if list for the relevant language is available, otherwise do nothing
when(is.element(el = input$language, set = stopwords::stopwords_getlanguages(source = "stopwords-iso")) ~
anti_join(., tibble::tibble(word = c("via", stopwords::stopwords(language = input$language, source = "stopwords-iso"))), by = "word"),
~ .) %>%
count(word, sort = TRUE) %>%
head(input$MaxWordsInBarchart) %>%
arrange(n) %>%
mutate(word = forcats::as_factor(word)) %>%
ggplot(mapping = aes(x = word, y = n, fill = "singlecolor")) +
geom_col() +
scale_x_discrete("") +
scale_y_continuous("Number of occurrences") +
scale_fill_manual(values = "#08306B") +
coord_flip() +
theme_minimal() +
theme(axis.text=element_text(size=14),
axis.title=element_text(size=14,face="bold")) +
guides(fill=FALSE)
})
#### Comparisons ####
output$barchartComparisonGG <- renderPlot({
if (is.null(input$EPgroup)==FALSE&length(input$EPgroup)<5&length(input$EPgroup)>1) {
tidy_tweets <- currentDataset() %>%
select(clean_text, GroupShort) %>%
filter(stringr::str_detect(string = GroupShort, pattern = paste(input$EPgroup, collapse = "|"))) %>%
unnest_tokens(output = word, input = clean_text) %>%
# remove stopwords, if list for the relevant language is available, otherwise do nothing
when(is.element(el = input$language, set = stopwords::stopwords_getlanguages(source = "stopwords-iso")) ~
anti_join(., tibble::tibble(word = c("via", "retweeted", stopwords::stopwords(language = input$language, source = "stopwords-iso"))), by = "word"),
~ .)
if (input$wcOrBarchartComparison == "Comparison barchart") {
if (is.null(input$EPgroup)==FALSE&length(input$EPgroup)==2) {
temp <- tidy_tweets %>%
count(word, GroupShort) %>%
filter(sum(n) >= 5) %>%
ungroup() %>%
spread(GroupShort, n, fill = 0) %>%
mutate_if(is.numeric, funs((. + 1) / sum(. + 1))) %>%
mutate(logratio = log(.[[2]] / .[[3]])) %>%
arrange(desc(logratio)) %>%
group_by(logratio < 0) %>%
top_n(10, abs(logratio)) %>%
slice(1:10) %>%
ungroup() %>%
mutate(word = reorder(word, logratio))
temp %>%
ggplot(aes(word, logratio, fill = logratio < 0)) +
geom_col() +
coord_flip() +
ylab("Log odds ratio") +
scale_x_discrete("") +
scale_fill_discrete(name = "", labels = colnames(temp)[2:3]) +
theme_minimal() +
theme(axis.text=element_text(size=14),
axis.title=element_text(size=14))
} else {
ggplot() +
labs(title = "Comparison barchart requires two EP groups") +
theme_void() +
theme(plot.title = element_text(colour = "#7F3D17"))
}
} else {
temp <- tidy_tweets %>%
group_by(word, GroupShort) %>%
count() %>%
ungroup() %>%
spread(GroupShort, n, fill = 0)
rownames(temp) <- temp$word
par(mar = rep(0, 4))
temp <- temp %>%
select(-word)
if (input$wcOrBarchartComparison == "Commonality wordcloud") {
temp %>%
commonality.cloud(random.order=FALSE, max.words = 100, scale = c(5, 0.5), family = "Carlito", font = 1)
} else if (input$wcOrBarchartComparison == "Comparison wordcloud") {
temp %>%
comparison.cloud(random.order=FALSE, max.words = 100, scale = c(5, 0.5), family = "Carlito", font = 1)
}
}
} else {
ggplot() +
labs(title = "Minimium 2 and maximum 4 EP groups are allowed") +
theme_void() +
theme(plot.title = element_text(colour = "#7F3D17"))
}
})
#### Download ####
output$downloadTidyWordCount <- downloadHandler(
filename = function() {
paste0("QuoteFinderWordCount", ".csv")
},
content = function(file) {
write_csv(x = currentDataset() %>%
select(clean_text) %>%
unnest_tokens(input = clean_text, output = word) %>%
# remove stopwords, if list for the relevant language is available, otherwise do nothing
when(is.element(el = input$language, set = stopwords::stopwords_getlanguages(source = "stopwords-iso")) ~
anti_join(., tibble::tibble(word = c("via", "retweeted", stopwords::stopwords(language = input$language, source = "stopwords-iso"))), by = "word"),
~ .) %>%
count(word, sort = TRUE),
file)
}
)
output$downloadPng <- downloadHandler(
filename = paste0(randomString, ".png"),
content = function(file) {
owd <- setwd(tempdir())
on.exit(setwd(owd))
saveWidget(widget = wc2() %>% wordcloud2(size = input$sizeVarWC2*2,
color = wc2()$colour), file = paste0(randomString, ".html"), selfcontained = FALSE)
webshot(url = paste0(randomString, ".html"), file = file, delay = if_else(condition = input$MaxWords>500, true = 5, false = 3), vwidth = 1280, vheight = 960)
},
contentType = "image/png")
output$downloadHtml <- downloadHandler(
filename = paste0(randomString, ".html"),
content = function(file) {
owd <- setwd(tempdir())
on.exit(setwd(owd))
saveWidget(widget = wc2() %>% wordcloud2(size = input$sizeVarWC2*2,
color = wc2()$colour), file = file, selfcontained = TRUE)
simpleFixWc2(file, file)
})
#### DataTable ####
output$table <- DT::renderDataTable({
DT::datatable(data = currentDataset() %>%
arrange(desc(time))%>%
select(full_name, screen_name, date, text, Link, GroupShort) %>%
#head(10000) %>%
rename(`Full name` = full_name, `Twitter handle` = screen_name, Date = date, Tweet = text, `EP Group` = "GroupShort"),
escape = FALSE, options = list(pageLength = 4, lengthMenu = c(3, 4, 5, 10, 15, 20)), rownames=FALSE)
})
### InfoBox ####
output$HeaderInfoBox <- renderText({
paste0(paste0("<div class='col-sm-12'><b>Enabled filters</b>: language: <i>", input$language, "</i>;"),
if (is.null(input$selectedHashtag)==TRUE) (" hashtag: <i>All tweets</i>;") else if (input$selectedHashtag=="All tweets") (" hashtag: <i>All tweets</i>;") else paste0(" hashtag: <i>#", input$selectedHashtag, "</i>;"),
if (input$string!="") paste0(" string: <i>", input$string, "</i>;"),
if (is.null(input$EPgroup)==FALSE) paste0(" EP group: <i>", paste(input$EPgroup, collapse = ", "), "</i>;"),
if (is.null(input$countryFilter)==FALSE) paste0(" Country: <i>", paste(input$countryFilter, collapse = ", "), "</i>;"),
#" selected word: <i>", gsub(":.*","",input$selected_word),
"</div>")
})
output$TweetsNr <- renderInfoBox({
infoBox(title = "Tweets",
value = point(nrow(currentDataset())),
icon = icon("twitter"),
color = "blue"
)
})
output$MEPsNr <- renderInfoBox({
infoBox(title = "by",
value = paste(length(unique(currentDataset()$screen_name)), "MEPs"),
icon = icon("users"), color = "blue", fill = FALSE)
})
output$DaysNr <- renderInfoBox({
# reload if dateRange is changed
input$dateRange
input$dateRangeRadio
if (input$dateRangeRadio=="Last week") {
infoBox(title = "posted in", value = paste(7, "days"),
icon = icon("calendar"), color = "blue", fill = FALSE)
} else if (input$dateRangeRadio=="Last month") {
infoBox(title = "posted in", value = paste(31, "days"),
icon = icon("calendar"), color = "blue", fill = FALSE)
} else if (input$dateRangeRadio=="Last three months") {
infoBox(title = "posted in", value = paste(91, "days"),
icon = icon("calendar"), color = "blue", fill = FALSE)
} else {
infoBox(title = "posted in", value = paste(as.Date(input$dateRange[2])-as.Date(input$dateRange[1]), "days"),
icon = icon("calendar"), color = "blue", fill = FALSE)
}
})
output$selected_tweets_wall <- renderUI({
if(nrow(currentDataset()) == 0){
return(NULL)
}
if (is.null(input$table_rows_current)) {
return(NULL)
}
tempTweets <- currentDataset() %>%
slice(input$table_rows_current)
wall <- tagList()
tweet_distribute <- tibble::tibble(status_id = tempTweets$status_id,
column_selector = rep_along(along = tempTweets$status_id, x = 1:4),
div_id = seq_along(along = tempTweets$status_id))
tweet_distribute$tweet_embed <- purrr::map_chr(.x = seq_along(along = tempTweets$status_id),
.f = function(x) embed_tweet_js(id = tweet_distribute$status_id[x],
i = tweet_distribute$div_id[x]))
for (i in 1:4) { #create four columns and distribute tweets
wall[[i]] <- shiny::column(
width = 3,
tweet_distribute %>%
dplyr::filter(column_selector==i) %>%
dplyr::pull(tweet_embed) %>%
paste(collapse = " ") %>%
shiny::HTML()
)
}
fluidRow(wall)
})
}
shinyApp(ui = ui, server = server)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.