inst/example_app/app.R

In data-atelier/newsExploreR: Extracting information from newsapi.org

load_packages(c("shiny",
                "shinymaterial",
                "sweetalertR",
                "ggplot2",
                "plotly",
                "wordcloud2",
                "dplyr",
                "magrittr",
                "reshape",
                "tidytext",
                "lsa",
                "tm"))

source("www/Theme_DataAtelier.R")

ui <- material_page(
  # navbar
  title = "NewsExploreR",
  nav_bar_fixed = TRUE,
  nav_bar_color = "deep-purple",  #https://materializecss.com/color.html
  # slider
  material_side_nav(
    image_source = "LOGO_DateAtelier.svg",
    tags$br(),
    tags$br(),
    material_row(
      material_column(
        width = 10,
        offset = 1,
        HTML("<a href='https://github.com/data-atelier' target='_blank'> GitHub <i class='material-icons'>open_in_new</i></a>")
      )
    ),
    material_row(
      material_column(
        width = 10,
        offset = 1,
        HTML("<a href='https://dataatelier.de/' target='_blank'> Homepage <i class='material-icons'>open_in_new</i></a>")
      )
    )
  ), # Ende slide_nav

  # tabs als navbar Ersatz
  material_tabs(
    tabs = c("Get News" = "first_tab",
             "Sentiments" = "second_tab",
             "Wordcloud" = "third_tab"),
    color = "blue-grey"
  ),
  # tab 1 ----

  # Layout ändern!
  material_tab_content(
    tab_id = "first_tab", # get news
    tags$br(),
    material_row(
      material_column(width=1),
      material_column(width=3, material_text_box("apikey",
                                                 label = "Enter your API key",
                                                 color = "#607d8b")),
      # sources durch material_dropdown zerstört irgendwie die plots....
      material_column(width=2),
      material_column(width=5,
                      helpText("News API indexes articles from over 30,000
                               worldwide sources. This application only lists a few but by
                               using the get_headline() function one can access all the sources
                               easily. To see all sources go to"), HTML("<a href='https://newsapi.org/sources' target='_blank'>
                                                                          https://newsapi.org/sources</a>"), br(),
                      helpText("You need an API key which is free for development,
                               open-source, and non-commercial uses. Just type your API key in the
                               input box and get your data. By checking to box you can also save the
                               data to an csv file. Then, you can switch to the other tabs to see
                               sentiments and visual analysss of the news data. Otherwise, you see
                               the analyses only for a sample data set."))
    ),
    tags$br(),
    material_row(
      material_column(width=1),
      material_column(width=2, material_checkbox("check_csv", "Save as csv file?",color = "#607d8b")),
      material_column(width=2, material_button("get_news","Get news", depth=3, color = "blue-grey"),
                      sweetalert(selector = "#getN", text = "is beeing collected", title = "Data"))
    )
),
material_tab_content(
  tab_id = "second_tab", # get news
  tags$br(),
  material_row(
    material_column(width=1),
    material_column(width=5,
                    material_card(depth = 3,
                                  plotOutput("plot2")
                    )
    ),
    material_column(width=5,
                    material_card(depth = 3,
                                  plotlyOutput("plot3")
                    )
    )
  )
  ),

# tab 3 ----
material_tab_content(
  tab_id = "third_tab", # wordcloud
  tags$br(),
  material_row(
    material_column(width=1),
    material_column(width=2,
      material_row(material_dropdown(
        input_id = "shapepicker",
        label = "Choose shape",
        choices = c("circle" = "circle",
                    "diamond" = "diamond",
                    "triangle" = "triangle",
                    "pentagon" = "pentagon",
                    "star" = "star"
        ),
        selected = "circle",
        color = "#607d8b" # blue-grey
      )),
      material_row(
        material_slider(
          input_id = "size",
          label = "Choose plot size",
          min_value = 1,
          max_value = 40,
          initial_value = 20,
          color = "#607d8b"
        )
      ),
      material_row(
        material_slider(
          input_id = "counter",
          label = "Choose the minimum number of occurrences",
          min_value = 1,
          max_value = 5,
          initial_value = 1,
          color = "#607d8b"
        )
      )
    ),
    material_column(
      width = 8,
      material_card(
        depth = 3,
        wordcloud2Output("wordOut2", width = "90%")))
  )

)

) # ende ui

server <- function(input, output, session) {

  dta_news <- read.csv("news_data.csv")
  # Stoppwörter
  data("stopwords_de")
  stopwordsLsa <- stopwords_de
  stopwordsTm <- stopwords("german")
  # eigene Stopwörter
  ownStopwords <- c("sowie",
                    "z.b",
                    "zudem")
  wordsNoUse <- data_frame(words = unique(c(stopwordsLsa, stopwordsTm, ownStopwords)))
  names(wordsNoUse)<-"word"

  # Sentiments
  sent <- c(
    # positive Wörter
    readLines(paste0("www/SentiWS/SentiWS_v1.8c_Positive.txt"),
              encoding = "UTF-8"),
    # negative Wörter
    readLines(paste0("www/SentiWS/SentiWS_v1.8c_Negative.txt"),
              encoding = "UTF-8")
  ) %>% lapply(function(x) {
    # Extrahieren der einzelnen Spalten
    res <- strsplit(x, "\t", fixed = TRUE)[[1]]
    return(data.frame(word = res[1], value = res[2],
                      stringsAsFactors = FALSE))
  }) %>%
    bind_rows %>%
    mutate(word = gsub("\\|.*", "", word) %>% tolower,
           value = as.numeric(value)) %>%
    # manche Wörter kommen doppelt vor, hier nehmen wir den mittleren Wert
    group_by(word) %>% summarise(value = mean(value)) %>% ungroup

  temp <- dta_news
  # Kommas, Punkte etc. entfernen
  temp$articles.title <- gsub("[[:punct:]]", "", temp$articles.title)
  # nur kleine Buchstaben
  temp$articles.title <- tolower(temp$articles.title)
  # lösche unbenötigte Spalten
  temp <- temp[,c(-1,-2,-4,-5,-7:-10)]
  # bilde tokens
  senti_data <- temp %>% unnest_tokens(word, articles.title)

  # reactive ----
  sentiment_data <- reactive({
    temp <- dta_news
    # Kommas, Punkte etc. entfernen
    temp$articles.title <- gsub("[[:punct:]]", "", temp$articles.title)
    # nur kleine Buchstaben
    temp$articles.title <- tolower(temp$articles.title)
    # lösche unbenötigte Spalten
    temp <- temp[,c(-1,-2,-4,-5,-7:-10)]
    # bilde tokens
    senti_data <- temp %>% unnest_tokens(word, articles.title)
    senti_data
  })

  a <- seq(1:5)
  b <- c("a", "b", "c", "d", "e")
  dta_n <- as.data.frame(a)
  dta_n$b <- b

  output$plot1 <- renderPlot({
    ggplot(data = dta_n, aes(x=b, y=a)) +
      geom_bar(stat="identity") +
      theme_DataAtelier
  })

  output$plot2 <- renderPlot({
    temp <- sentiment_data() %>% anti_join(wordsNoUse, by = "word") %>% filter(nchar(word, type = "chars") > 1)
    sentTxt <- left_join(temp, sent, by = "word") %>%
      mutate(value = as.numeric(value)) %>%
      filter(!is.na(value))
    senti_temp <- as.data.frame(sentTxt %>%
                                  group_by(source) %>%
                                  summarize(meanSent = mean(value)))

    ggplot(data = senti_temp, aes(x=source, y=meanSent)) +
      geom_bar(stat = "identity", fill="slategray2") +
      theme_DataAtelier +
      ylab("mean of sentiment score")
  })

  output$plot3 <- renderPlotly({
    temp <- senti_data %>% anti_join(wordsNoUse, by = "word") %>% filter(nchar(word, type = "chars") > 1)
    sentTxt <- left_join(temp, sent, by = "word") %>%
      mutate(value = as.numeric(value)) %>%
      filter(!is.na(value))
    senti_temp <- as.data.frame(sentTxt %>%
                                  group_by(source) %>%
                                  summarize(meanSent = mean(value)))
    ggplotly(
    ggplot(data = senti_temp, aes(x=source, y=meanSent)) +
      geom_bar(stat = "identity", fill="slategray2") +
      theme_DataAtelier +
      ylab("mean of sentiment score")
    )
  })

  output$wordOut <- renderWordcloud2({
    n <- 1
    temp <- sentiment_data() %>% anti_join(wordsNoUse, by = "word") %>% filter(nchar(word, type = "chars") > 1)
    words<- temp$word
    words <- unlist(words)
    words.freq<-table(words)
    words.freq <- as.data.frame(words.freq)
    words.freq <- words.freq %>% filter(Freq >= n)
    #wordcloud
    wordcloud2(words.freq, size = 0.5, shape = "circle", color = "random-dark")})

  output$wordOut2 <- renderWordcloud2({
    n <- input$counter
    #temp <- get_news_data()
    temp <- sentiment_data() %>% anti_join(wordsNoUse, by = "word") %>% filter(nchar(word, type = "chars") > 1)
    words<- temp$word
    words <- unlist(words)
    words.freq<-table(words)
    words.freq <- as.data.frame(words.freq)
    words.freq <- words.freq %>% filter(Freq >= n)
    #wordcloud
    wordcloud2(words.freq, size = (input$size/20), shape = input$shapepicker, color = "random-dark")})

}

shinyApp(ui = ui, server = server)