R/app_server.R

Defines functions app_server

#' @import shiny
  app_server <- function(input, output,session) {
  output$letters <- renderText(paste(head(tweets$screen_name), collapse = ", "))

  ##### Wordcloud app ########
  
  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 = "#6B2A8C", 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 = "#8F5CA8",
                  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())
    }
  })
  
  
  #### UI textual datasets ####
  

  
  
  #### 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) {
      readr::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 ####
  
  marker_table <- marker::marker$new("#table")
  
  observeEvent(input$table_rows_current, {
    if (input$selectedHashtag=="All tweets") {
      current_hashtag <- ""
    } else {
      current_hashtag <- paste0("#", input$selectedHashtag)
    }
    
    marker_table$
      unmark(className = "green")$
      mark(c(input$string, current_hashtag), className = "green")
    
  }, priority = -1)
  
  output$table <- DT::renderDT({
    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,
                  filter = "top",
                  options = list(dom = "lipt", 
                    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)
  })
  
  
  ###### end of wordcloud app ##########
  
  #### castarter section #########
  tsGG <- shiny::reactive(x = {

    terms <- as.character(tolower(trimws(stringr::str_split(string = input$term, pattern = ",", simplify = TRUE))))
    if (input$freq=="Number of mentions per day") {
      df <- castarter::ShowAbsoluteTS(terms = terms,
                                      dataset = castarter_dataset %>% 
                                        dplyr::filter(is.element(website, input$website_selector)),
                                      type = "data.frame",
                                      rollingDays = input$rollingDays,
                                      rollingType = tolower(input$rollingType), 
                                      startDate = input$dateRange_castarter[1],
                                      endDate = input$dateRange_castarter[2])

      graph <- df %>%
        tidyr::gather(word, nRoll, 2:sum(length(terms),1)) %>%
        ggplot2::ggplot(mapping = ggplot2::aes(x = Date, y = nRoll, color = word)) +
        ggplot2::geom_line(size = 1.5) +
        ggplot2::scale_y_continuous(name = "", breaks = scales::pretty_breaks(n = 5), labels = function(n){format(n, scientific = FALSE)}) +
        ggplot2::scale_x_date(name = "", breaks = scales::pretty_breaks(n = 10)) +
        ggplot2::expand_limits(y = 0) +
        ggplot2::theme_minimal() +
        ggplot2::theme(legend.title=ggplot2::element_blank(),
                       legend.text = element_text(size = 16, family = "Roboto Condensed"),
                       axis.text = element_text(size = 16, family = "Roboto Condensed"),
                       text = element_text(size = 16, family = "Roboto Condensed")) +
        ggplot2::scale_colour_viridis_d() +
        ggplot2::labs(title = stringr::str_wrap(paste("Number of occurrences per day of", knitr::combine_words(terms, before = '`'), "on the website of ", knitr::combine_words(input$website_selector, before = "the ", after = ""))),
                      caption = paste0("Calculated on a ", input$rollingDays, "-days rolling ", tolower(input$rollingType)))
      
    } else if (input$freq=="Relative frequency") {
      df <- castarter::ShowRelativeTS(terms = as.character(tolower(trimws(stringr::str_split(string = input$term, pattern = ",", simplify = TRUE)))),
                                dataset = castarter_dataset %>% 
                                  dplyr::filter(is.element(website, input$website_selector)),
                                type = "data.frame",
                                rollingType = tolower(input$rollingType),
                                rollingDays = input$rollingDays,
                                startDate = input$dateRange_castarter[1],
                                endDate = input$dateRange_castarter[2])
      
      graph <- df %>%
        tidyr::gather(word, nRoll, 2:sum(length(terms),1)) %>%
        ggplot2::ggplot(mapping = ggplot2::aes(x = Date, y = nRoll, color = word)) +
        ggplot2::geom_line(size = 1.5) +
        ggplot2::scale_y_continuous(name = "", breaks = scales::pretty_breaks(n = 5), labels = function(n){paste(format(n*100, scientific = FALSE), "%")}) +
        ggplot2::scale_x_date(name = "", breaks = scales::pretty_breaks(n = 10)) +
        ggplot2::expand_limits(y = 0) +
        ggplot2::theme_minimal() +
        ggplot2::theme(legend.title=ggplot2::element_blank(),
                       legend.text = element_text(size = 16, family = "Roboto Condensed"),
                       axis.text = element_text(size = 16, family = "Roboto Condensed"),
                       text = element_text(size = 16, family = "Roboto Condensed")) +
        ggplot2::scale_colour_viridis_d() +
        ggplot2::labs(title = stringr::str_wrap(paste("Frequency of", knitr::combine_words(terms, before = '`'), "on the website of", knitr::combine_words(input$website_selector, before = "the ", after = ""))),
                      caption = paste0("Calculated on a ", input$rollingDays, "-days rolling ", input$rollingType))
    }
    graph
  })
  
  output$freqPlot <- shiny::renderPlot({
    # if (input$go==0) {
    #   
    # } else {
      tsGG()
    # }
  })
  
  kwic_react <- shiny::reactive(x = {
    
    if (length(input$website_selector)>0&is.null(input$dateRange_castarter[2])==FALSE&is.null(input$dateRange_castarter[1])==FALSE) {
      castarter_dataset %>%
        dplyr::filter(is.element(website, input$website_selector)) %>% 
        dplyr::filter(date>=input$dateRange_castarter[1], date<=input$dateRange_castarter[2]) %>%
        dplyr::filter(stringr::str_detect(string = sentence,
                                          pattern = stringr::regex(ignore_case = TRUE,
                                                                   pattern = paste(as.character(tolower(trimws(stringr::str_split(string = input$term, pattern = ",", simplify = TRUE)))), collapse = "|")))) %>%
        dplyr::mutate(Title = paste0("<a target='_blank' href='", link, "'>", title, "</a><br />")) %>%
        dplyr::rename(Sentence = sentence, Date = date, Source = website) %>%
        dplyr::select(Date, Source, Title, Sentence) %>%
        dplyr::arrange(desc(Date))
    }
  })
  
  # Renders table at the bottom of the main tab
  
  output$kwic <- DT::renderDT(expr = kwic_react(),
                                     server = TRUE,
                  options = list(dom = "lipt",
                                 pageLength = 5,
                                 lengthMenu = c(3, 5, 10, 15, 20)),
                  escape = FALSE,
                  rownames = FALSE,
                  filter = "top")
  
  # highlight terms in table
  
  marker_kwic <- marker::marker$new("#kwic")
  
  observeEvent(input$kwic_rows_current, {
    marker_kwic$
      unmark(className = "green")$ 
      mark(trimws(as.character(stringr::str_split(input$term, pattern = ",",simplify = TRUE))), className = "green")
  }, priority = -1)
  
  
  # output$dateRangeInput__castarter_UI <- renderUI({shiny::dateRangeInput(inputId = "dateRange_castarter",
  #                                                                        label = "Date range",
  #                                                                        start = min(castarter_dataset$date),
  #                                                                        end = max(castarter_dataset$date),
  #                                                                        weekstart = 1)})
  
  wc2_eu_castarter <- reactive({
    message(paste(Sys.time(), "WordcloudCastarter_eu", input$language, sep = "-"))
    castarter_dataset %>% 
      tidytext::unnest_tokens(output = "word", input = "sentence") %>% 
      dplyr::count(word, sort = TRUE) %>% 
      dplyr::anti_join(y = tidytext::stop_words, by = "word") %>% 
      dplyr::anti_join(y = tibble::tibble(word = c("de", trimws(as.character(stringr::str_split(input$wordcloud_eu_castarter_custom_stopwords, pattern = ",",simplify = TRUE))))), by = "word") %>% 
      head(input$MaxWords_castarter_eu)
    })
    
  
  output$wordcloud2_eu_castarter <- renderWordcloud2(
    if (is.null(wc2())==FALSE) wc2_eu_castarter() %>%
      wordcloud2(size = if (is.null(input$sizeVarWC2_castarter_eu)) 0.5 else input$sizeVarWC2_castarter_eu,
                 fontFamily = "Roboto",
                 color = "#6b2a8c"))
  
  
  #### end of castarter section #########
  
  
  ###### tab_trending_news #########
  
  entity_reactValue <- reactiveValues(select=1)
  
  emm_df_current_language <- reactive(x = ({
    if (is.null(input$emm_language_selector)) {
      return(NULL)
    }
    emm_df %>%
      dplyr::filter(is.element(language, input$emm_language_selector)) 
  }))
  
  top_entities_react <- reactive(x = ({
    
    emm_df_current_language() %>% 
      dplyr::group_by(id, name) %>%
      dplyr::count(sort = TRUE) %>%
      dplyr::ungroup()
  }))
  
  
  selected_entities_id_react <- reactive(x = ({
    top_entities_react() %>% 
      dplyr::slice(input$top_entities_dt_rows_selected) %>% 
      dplyr::pull(id)
  }))
  
  selected_entities_name_react <- reactive(x = ({
    if (is.null(input$top_entities_dt_rows_selected)) {
      return(NULL)
    }
    top_entities_react() %>% 
      dplyr::slice(input$top_entities_dt_rows_selected) %>% 
      dplyr::pull(name)
  }))
  
  emm_selected_news_react <- reactive(x = ({
    
    if (is.null(input$top_entities_dt_rows_selected)) {
      return(NULL)
    }
    if (is.null(input$emm_language_selector)) {
      return(NULL)
    }
    
    emm_df_current_language() %>%  
      dplyr::mutate(check = is.element(id, selected_entities_id_react())) %>% 
      dplyr::group_by(link) %>% 
      dplyr::filter(dplyr::if_else(sum(check)>0, TRUE, FALSE)) %>%
      dplyr::group_by(link) %>% 
      dplyr::mutate(Entity = paste(name, collapse = ", ")) %>%
      dplyr::ungroup() %>% 
      dplyr::distinct(link, .keep_all = TRUE) %>% 
      dplyr::transmute(Date = as.Date(pubDate), 
                       Source = domain,
                       Title = paste0("<a target='_blank' href='", link, "'>",
                                      stringr::str_trunc(string = title, width = 240),"</a>"),
                       `Entities mentioned` = Entity, 
                       Language = language) %>% 
      dplyr::arrange(dplyr::desc(Date))
    
  }))
  
  
  emm_selected_other_languages_react <- reactive(x = ({
    
    if (is.null(input$top_entities_dt_rows_selected)) {
      return(NULL)
    }
    if (is.null(input$emm_language_selector)) {
      return(NULL)
    }
    
    emm_df %>%
      dplyr::filter(is.element(id, selected_entities_id_react())) %>% 
      dplyr::group_by(language) %>% 
      dplyr::count(sort = TRUE) %>% 
      dplyr::ungroup() %>% 
      dplyr::rename(Language = language)
  }))
  
  output$emm_selected_other_languages_bb <- billboarder::renderBillboarder({
    if (is.null(emm_selected_other_languages_react())) {
      return(NULL)
    }
    billboarder::billboarder(data = emm_selected_other_languages_react()) %>% 
      billboarder::bb_aes(x = Language, y = n) %>% 
      billboarder::bb_barchart() %>% 
      billboarder::bb_title(text = paste("News about", base::sQuote(selected_entities_name_react()), "by language. Click on the barchart to see news in a given language"),
                            position = "left") %>% 
      billboarder::bb_colors_manual(n = "#6b2a8c") %>% 
      billboarder::bb_legend(show = FALSE)
  })
  
  output$top_entities_dt <- DT::renderDataTable(expr = ({
    if (is.null(top_entities_react())) {
      return(NULL)
    }
    top_entities_react() %>% 
      dplyr::select(-id) %>% 
      rename(entity = name)
  }), options = list(dom = "ftip",
                     pageLength = 10),
  escape = TRUE,
  rownames = FALSE,
  server = TRUE,
  selection = list(mode = 'single',
                   selected = entity_reactValue$select))
  
  #top_entities_dt_proxy <- DT::dataTableProxy("top_entities_dt")
  
  output$emm_table <- DT::renderDataTable(expr = ({
    
    emm_selected_news_react()
    
  }),
  options = list(dom = "fipt",
                 pageLength = 5,
                 autoWidth = TRUE,
                 columnDefs = (list(list(width = '5%', targets =c(0, 4)),
                                    list(width = '10%', targets =c(1)),
                                    list(width = '45%', targets =c(2)),
                                    list(width = '35%', targets =c(3))
                 ))),
  escape = FALSE,
  rownames = FALSE,
  server = TRUE,
  filter = "top", 
  )
  
  observeEvent(input$emm_selected_other_languages_bb_click, {
    
    entity_reactValue$previous_id <- selected_entities_id_react()
    
    shinyWidgets::updatePickerInput(
      session = session,
      inputId = "emm_language_selector",
      selected = input$emm_selected_other_languages_bb_click
    )
    
    
  })
  
  ###### end of tab_trending_news #########
  
  # waiter::hide_waiter()
}
giocomai/edjnetquotefinder documentation built on Feb. 11, 2022, 12:51 p.m.