当使用多个过滤器从单个数据帧生成单词云时，如何为findAssocs获得有意义的输出

Question

尝试创建一个闪亮的应用程序，根据用户的变量选择生成不同的单词云。到目前为止，我已经能够生成云，但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)

Answer 1

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

下面是一个修正后的闪亮应用程序。注意，dtm必须转换成它自己的反应变量——你在一个范围内定义它，并试图在另一个范围中使用它。dtm是一个根据输入而变化的值，这意味着它是无功的。还要注意，我删除了wordcloud调用周围的isolate()。隔离声明并没有起到任何作用——隔离告诉shine在反应性值变化时不要激发反应性，但在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)