demo/shiny_LDA/server.R

# Define server logic required to draw a histogram
shinyServer(function(input, output, session) {
   # Import des données ########################################################
   dt = eventReactive(input$traitement, {
      read.csv2(input$csvFile.1$datapath, stringsAsFactors = F, encoding = "UTF-8")
   })
   # Viz
   observeEvent(input$traitement, {
      output$print.dat = DT::renderDataTable({
         DT::datatable(dt())
      })
   }, ignoreInit = TRUE)
   # Traitement des données #####################################################
   arg = reactive({ c(input$traitement, input$num) })
   observeEvent(arg(), {
      output$plot = renderPlot(
         dt() %>%
            mutate_at(
               vars(com),
               ~ tolower(.x) %>%
                  str_replace_all("’|“|”", " ") %>%
                  str_replace_all("\\b\\w{1,2}\\b", "") %>%
                  str_remove_all(paste0(
                     "\\b", stopwords("fr"), "\\b", collapse = "|"
                  )) %>%
                  str_remove_all(paste0("\\b", rmw, "\\b", collapse = "|")) %>%
                  removePunctuation() %>%
                  stripWhitespace() %>%
                  trimws()
            ) %>%
            # mutate_at(
            #    vars(positive_score),
            #     ~ scales::rescale(.x, to = c(1, 10)) %>%
            #        round(0)
            # ) %>%
            rownames_to_column("id") %>%
            # (function(x)
            #    tibble(
            #       com = rep(x$com, x$positive_score),
            #       id = rep(x$id, x$positive_score)
            #    )) %>%
            mutate_all(as.character) %>%
            unnest_tokens(word, com) %>%
            count(id, word, sort = TRUE) %>%
            cast_dtm(id, term = word, value = n) %>%
            LDA(k = input$num, control = list(seed = 2811)) %>%
            tidy(matrix = "beta") %>%
            group_by(topic) %>%
            top_n(n = 15, wt = beta) %>%
            spread(1, ncol(.)) %>%
            mutate_all( ~ replace(.x, is.na(.x), 0)) %>%
            column_to_rownames("term") %>%
            PCA(graph = FALSE) %>%
            fviz_pca_biplot(geom.ind = c("text", "point"),
                            geom.var = c("arrow", "text"),
                            col.var = "#2E9FDF",
                            col.ind = "#696969",
                            label.rectangle = TRUE,
                            labelsize = 4,
                            repel = TRUE) +
            labs(x = "", y = "", title = "Analyse à composentes principales") +
            theme_void()
         )
      }, ignoreInit = TRUE)
})
AlexisMayer/toolbox documentation built on Aug. 25, 2020, 3:56 p.m.