0

尝试创建一个闪亮的应用程序，该应用程序将根据用户所做的变量选择生成不同的词云。到目前为止，我已经能够产生云，但它是findAssocs()产生问题的部分 - 只有返回$word和numeric(0)。

#> **Warning:** Error in findAssocs: object 'dtm' not found.

我在没有过滤器的情况下尝试了它并获得了有意义的输出findAssocs()。

将非常感谢一些帮助。

这是reprex-

Agegroup <- c("A","B","D","C","E","B","A","B","D","E")
Region <- c("N","S","E","W","W","N","S","E","S","E")
Word <- c("raining cats and dogs", "rabbit out of a hat", "cats with nine lives", "a bear hug", 
            "elephant in the room", "white elephant", "dogs bark, cats meow",
            "a life worth living", "hello", "gold fish")
Word2 <- c("raining cats and dogs", "rabbit out of a hat", "cats with nine lives", "a bear hug", 
            "elephant in the room", "white elephant", "dogs bark, cats meow",
            "a life worth living", "gold fish", "hello")

Data <- data.frame(Agegroup,Region,Word, Word2, stringsAsFactors=FALSE)

ui <- fluidPage(
titlePanel("Big and small pets"),
sidebarLayout(
        sidebarPanel(
            selectInput(
            inputId = "source",
            label = "Select Question",
            choices = c("Why are you satisfied or not satisfied with service?" = "satisfy",
                        "Reasons for recommending or not recommending business" = "recommend")),
            selectInput("region",
                        "Select region:",
                        choices = c("total", "N", "S", "E", "W"),
                        selected = "total"),
            selectInput("group",
                        "Select age group:",
                        choices = c("total", "A","B","C","D","E"),
                        selected = "total"),
    ),
mainPanel(
            wordcloud2Output("cloud"),verbatimTextOutput("heading2")
        )
    )
)

server <- function(input, output) {
    output$cloud <- renderWordcloud2({   
    Data <- Data%>%
            dplyr::select(Region, Word, Word2, Agegroup)
        
    if(input$region == "total"){
    Data <-  Data
    } 
    else if(input$region != "total"){
    Data <-  Data%>%
        subset(Region == input$region)
    }
    if(input$group == "total"){
        Data <-  Data
    } 
    else if(input$group != "total"){
        Data <-  Data%>%
        subset(Agegroup == input$group)
    }   
    if (input$source == "satisfy"){
        text <-  Data%>%
        select(Word)}
    else if (input$source == "recommend"){
        text <-  Data%>%
        select(Word2)}   
    docs <- Corpus(VectorSource(text))
    toSpace <- content_transformer(function (x , pattern ) gsub(pattern, " ", x))
    docs <- tm_map(docs, toSpace, "/")
    docs <- tm_map(docs, toSpace, "@")
    docs <- tm_map(docs, toSpace, "\\|")
    docs <- tm_map(docs, content_transformer(tolower))
    docs <- tm_map(docs, removeNumbers)
    docs <- tm_map(docs, removeWords, stopwords("english"))
    docs <- tm_map(docs, removeWords, c("blabla1", "blabla2")) 
    docs <- tm_map(docs, removePunctuation)
    docs <- tm_map(docs, stripWhitespace)
    docs <- tm_map(docs, stemDocument)
    dtm <- TermDocumentMatrix(docs)
    m <- as.matrix(dtm)
    v <- sort(rowSums(m), decreasing=TRUE)
    d <- data.frame(word = names(v), freq=v)
    set.seed(1234)
    isolate({
        wordcloud2(data = d, size = 0.5, shape = "circle")
    })
    }) 
output$heading2 <- renderPrint({
    findAssocs(dtm, "cat", corlimit = 0.3)
    })
}
shinyApp(ui = ui, server = server)
4

1 回答 1

0

闪亮的代码有几个问题，dplyr 代码也有问题。dplyr 问题是在应该select使用的地方使用。pull

下面是一个更正的闪亮应用程序。请注意，dtm必须将其转换为自己的反应变量 - 您在一个范围内定义它并尝试在另一个范围内使用它。dtm是一个根据输入而变化的值，因此这意味着它是反应性的。另请注意，我删除isolate()了 wordcloud 调用周围的内容。该隔离语句没有做任何事情 - 隔离告诉闪亮不要在反应值更改时触发反应，但在该行wordcloud2(data = d, size = 0.5, shape = "circle")中没有任何反应。

library(shiny)
library(wordcloud2)
library(tm)
library(dplyr)

Agegroup <- c("A","B","D","C","E","B","A","B","D","E")
Region <- c("N","S","E","W","W","N","S","E","S","E")
Word <- c("raining cats and dogs", "rabbit out of a hat", "cats with nine lives", "a bear hug", 
          "elephant in the room", "white elephant", "dogs bark, cats meow",
          "a life worth living", "hello", "gold fish")
Word2 <- c("raining cats and dogs", "rabbit out of a hat", "cats with nine lives", "a bear hug", 
           "elephant in the room", "white elephant", "dogs bark, cats meow",
           "a life worth living", "gold fish", "hello")

Data <- data.frame(Agegroup,Region,Word, Word2, stringsAsFactors=FALSE)

ui <- fluidPage(
  titlePanel("Big and small pets"),
  sidebarLayout(
    sidebarPanel(
      selectInput(
        inputId = "source",
        label = "Select Question",
        choices = c("Why are you satisfied or not satisfied with service?" = "satisfy",
                    "Reasons for recommending or not recommending business" = "recommend")),
      selectInput("region",
                  "Select region:",
                  choices = c("total", "N", "S", "E", "W"),
                  selected = "total"),
      selectInput("group",
                  "Select age group:",
                  choices = c("total", "A","B","C","D","E"),
                  selected = "total"),
    ),
    mainPanel(
      wordcloud2Output("cloud"),verbatimTextOutput("heading2")
    )
  )
)


server <- function(input, output) {
  dtm <- reactive({
    Data <- Data%>%
      dplyr::select(Region, Word, Word2, Agegroup)
    
    if(input$region == "total"){
      Data <-  Data
    } 
    else if(input$region != "total"){
      Data <-  Data%>%
        subset(Region == input$region)
    }
    if(input$group == "total"){
      Data <-  Data
    } 
    else if(input$group != "total"){
      Data <-  Data%>%
        subset(Agegroup == input$group)
    }   
    if (input$source == "satisfy"){
      text <-  Data%>%
        pull(Word)}
    else if (input$source == "recommend"){
      text <-  Data%>%
        pull(Word2)}   
    docs <- Corpus(VectorSource(text))
    toSpace <- content_transformer(function (x , pattern ) gsub(pattern, " ", x))
    docs <- tm_map(docs, toSpace, "/")
    docs <- tm_map(docs, toSpace, "@")
    docs <- tm_map(docs, toSpace, "\\|")
    docs <- tm_map(docs, content_transformer(tolower))
    docs <- tm_map(docs, removeNumbers)
    docs <- tm_map(docs, removeWords, stopwords("english"))
    docs <- tm_map(docs, removeWords, c("blabla1", "blabla2")) 
    docs <- tm_map(docs, removePunctuation)
    docs <- tm_map(docs, stripWhitespace)
    docs <- tm_map(docs, stemDocument)
    TermDocumentMatrix(docs)
  })
  
  output$cloud <- renderWordcloud2({   
    m <- as.matrix(dtm())
    v <- sort(rowSums(m), decreasing=TRUE)
    d <- data.frame(word = names(v), freq=v)
    set.seed(1234)
    wordcloud2(data = d, size = 0.5, shape = "circle")
  }) 
  output$heading2 <- renderPrint({
    findAssocs(dtm(), "cat", corlimit = 0.3)
  })
}
shinyApp(ui = ui, server = server)
于 2020-08-28T05:37:10.597 回答