下面有一个闪亮的应用程序，我在其中创建了一个wordcloud。这个wordcloud基于侧边栏中闪亮的小部件。selectInput()用label对其进行子集设置，Maximum Number of Words:表示将在单词云中显示的最大单词数，Minimun Frequency表示单词需要显示的最小频率。这些小部件是反应式的，基于df()函数，该函数创建wordcloud所需的数据帧。问题是，当我使用input$freq进行子集时，数据帧的行数也少于使用input$max进行子集所需的行数，因此不会显示任何内容。
## app.R ##
library(shiny)
library(shinydashboard)
library(dplyr)
library(tm)
library(wordcloud)
library(memoise)
library(janeaustenr)
library(tidyverse)
library(tidytext)
library(wordcloud2)
library(tidyr)
spam_or_not_spam2<-structure(list(email = c("' date wed NUMBER aug NUMBER NUMBER NUMBER NUMBER NUMBER from chris garrigues cwg dated NUMBER NUMBERfaNUMBERd deepeddy com message id NUMBER NUMBER tmda deepeddy vircio com i can t reproduce this error for me it is very repeatable like every time without fail this is the debug log of the pick happening NUMBER NUMBER NUMBER pick_it exec pick inbox list lbrace lbrace subject ftp rbrace rbrace NUMBER NUMBER sequence mercury NUMBER NUMBER NUMBER exec pick inbox list lbrace lbrace subject ftp rbrace rbrace NUMBER NUMBER sequence mercury NUMBER NUMBER NUMBER ftoc_pickmsgs NUMBER hit NUMBER NUMBER NUMBER marking NUMBER hits NUMBER NUMBER NUMBER tkerror syntax error in expression int note if i run the pick command by hand delta pick inbox list lbrace lbrace subject ftp rbrace rbrace NUMBER NUMBER sequence mercury NUMBER hit that s where the NUMBER hit comes from obviously the version of nmh i m using is delta pick version pick nmh NUMBER NUMBER NUMBER compiled on URL at sun mar NUMBER NUMBER NUMBER NUMBER ict NUMBER and the relevant part of my mh_profile delta mhparam pick seq sel list since the pick command works the sequence actually both of them the one that s explicit on the command line from the search popup and the one that comes from mh_profile do get created kre ps this is still using the version of the code form a day ago i haven t been able to reach the cvs repository today local routing issue i think _______________________________________________ exmh workers mailing list exmh workers URL URL '",
"'martin a posted tassos papadopoulos the greek sculptor behind the plan judged that the limestone of mount kerdylio NUMBER miles east of salonika and not far from the mount athos monastic community was ideal for the patriotic sculpture as well as alexander s granite features NUMBER ft high and NUMBER ft wide a museum a restored amphitheatre and car park for admiring crowds are planned so is this mountain limestone or granite if it s limestone it ll weather pretty fast yahoo groups sponsor NUMBER dvds free s p join now URL to unsubscribe from this group send an email to forteana unsubscribe URL your use of yahoo groups is subject to URL '"
), label = c("spam", "ham")), row.names = c(NA, -2L), class = c("tbl_df",
"tbl", "data.frame"))
ui <- dashboardPage(
dashboardHeader(title = "Text Classification"),
dashboardSidebar(
uiOutput("spamham"),
uiOutput("frequency"),
uiOutput("maximum")
),
dashboardBody(
tabsetPanel(
id="tabs",
tabPanel("Wordcloud",wordcloud2Output("word",width="100%",height="850px"))
)
)
)
server <- function(input, output) {
output$spamham<-renderUI({
selectInput("selection", "Choose spam or ham:",
choices = unique(spam_or_not_spam2$label),
selected = unique(spam_or_not_spam2$label),
multiple = T
)
})
smoh<-reactive({
spam_or_not_spam2 <-subset( spam_or_not_spam2, spam_or_not_spam2$label %in% input$selection)
spam_or_not_spam2
})
df<-reactive({
#Create a vector containing only the text
#spam_or_not_spam2 <-subset( spam_or_not_spam2, spam_or_not_spam2$label %in% input$selection)
dt<-smoh()
text <- dt$email
# Create a corpus
docs <- Corpus(VectorSource(text))
docs <- docs %>%
tm_map(removeNumbers) %>%
tm_map(removePunctuation) %>%
tm_map(stripWhitespace)
docs <- tm_map(docs, content_transformer(tolower))
docs <- tm_map(docs, removeWords, stopwords("english"))
dtm <- TermDocumentMatrix(docs)
matrix <- as.matrix(dtm)
words <- sort(rowSums(matrix),decreasing=TRUE)
df <- data.frame(word = names(words),freq=words)
})
output$maximum<-renderUI({
sliderInput("max",
"Maximum Number of Words:",
min = 1, max = nrow(df()), value =nrow(df()),step=1 )
})
output$frequency<-renderUI({
sliderInput("freq",
"Minimum Frequency:",
min = 1, max =max(df()$freq), value = 1,step=1)
})
output$word<-renderWordcloud2({
subs<-subset( df()
,df()$freq >=input$freq )
#subs<-subs[1:input$max,]
wordcloud2(subs[1:input$max,],size = 4)
#wordcloud(words = df()$word, freq = df()$freq, min.freq = input$freq,max.words=input$max, random.order=FALSE, rot.per=0.35, colors=brewer.pal(8, "Dark2"))
})
}
shinyApp(ui, server)
我不完全确定，但既然你说
当应用程序启动时，不会显示任何
它可能与此错误有关。
我创建了这个解决方案。
这看起来很复杂，但事实并非如此。只需定义以下函数(wordcloud2a()(，然后在通常使用wordcloud2()的地方使用它。
wordcloud2a <- function (data, size = 1, minSize = 0, gridSize = 0, fontFamily = "Segoe UI",
fontWeight = "bold", color = "random-dark", backgroundColor = "white",
minRotation = -pi/4, maxRotation = pi/4, shuffle = TRUE,
rotateRatio = 0.4, shape = "circle", ellipticity = 0.65,
widgetsize = NULL, figPath = NULL, hoverFunction = NULL)
{
if ("table" %in% class(data)) {
dataOut = data.frame(name = names(data), freq = as.vector(data))
}
else {
data = as.data.frame(data)
dataOut = data[, 1:2]
names(dataOut) = c("name", "freq")
}
if (!is.null(figPath)) {
if (!file.exists(figPath)) {
stop("cannot find fig in the figPath")
}
spPath = strsplit(figPath, "\.")[[1]]
len = length(spPath)
figClass = spPath[len]
if (!figClass %in% c("jpeg", "jpg", "png", "bmp", "gif")) {
stop("file should be a jpeg, jpg, png, bmp or gif file!")
}
base64 = base64enc::base64encode(figPath)
base64 = paste0("data:image/", figClass, ";base64,",
base64)
}
else {
base64 = NULL
}
weightFactor = size * 180/max(dataOut$freq)
settings <- list(word = dataOut$name, freq = dataOut$freq,
fontFamily = fontFamily, fontWeight = fontWeight, color = color,
minSize = minSize, weightFactor = weightFactor, backgroundColor = backgroundColor,
gridSize = gridSize, minRotation = minRotation, maxRotation = maxRotation,
shuffle = shuffle, rotateRatio = rotateRatio, shape = shape,
ellipticity = ellipticity, figBase64 = base64, hover = htmlwidgets::JS(hoverFunction))
chart = htmlwidgets::createWidget("wordcloud2", settings,
width = widgetsize[1], height = widgetsize[2], sizingPolicy = htmlwidgets::sizingPolicy(viewer.padding = 0,
browser.padding = 0, browser.fill = TRUE))
chart
}
也就是说，定义上面的函数，然后在代码中替换这一行
wordcloud2(subs[1:input$max,],size = 4)
用这个
wordcloud2a(subs[1:input$max,],size = 4)
我调整了input$max
## app.R ##
library(shiny)
library(shinydashboard)
library(dplyr)
library(tm)
library(wordcloud)
library(memoise)
library(janeaustenr)
library(tidyverse)
library(tidytext)
library(wordcloud2)
library(tidyr)
spam_or_not_spam2<-structure(list(email = c("' date wed NUMBER aug NUMBER NUMBER NUMBER NUMBER NUMBER from chris garrigues cwg dated NUMBER NUMBERfaNUMBERd deepeddy com message id NUMBER NUMBER tmda deepeddy vircio com i can t reproduce this error for me it is very repeatable like every time without fail this is the debug log of the pick happening NUMBER NUMBER NUMBER pick_it exec pick inbox list lbrace lbrace subject ftp rbrace rbrace NUMBER NUMBER sequence mercury NUMBER NUMBER NUMBER exec pick inbox list lbrace lbrace subject ftp rbrace rbrace NUMBER NUMBER sequence mercury NUMBER NUMBER NUMBER ftoc_pickmsgs NUMBER hit NUMBER NUMBER NUMBER marking NUMBER hits NUMBER NUMBER NUMBER tkerror syntax error in expression int note if i run the pick command by hand delta pick inbox list lbrace lbrace subject ftp rbrace rbrace NUMBER NUMBER sequence mercury NUMBER hit that s where the NUMBER hit comes from obviously the version of nmh i m using is delta pick version pick nmh NUMBER NUMBER NUMBER compiled on URL at sun mar NUMBER NUMBER NUMBER NUMBER ict NUMBER and the relevant part of my mh_profile delta mhparam pick seq sel list since the pick command works the sequence actually both of them the one that s explicit on the command line from the search popup and the one that comes from mh_profile do get created kre ps this is still using the version of the code form a day ago i haven t been able to reach the cvs repository today local routing issue i think _______________________________________________ exmh workers mailing list exmh workers URL URL '",
"'martin a posted tassos papadopoulos the greek sculptor behind the plan judged that the limestone of mount kerdylio NUMBER miles east of salonika and not far from the mount athos monastic community was ideal for the patriotic sculpture as well as alexander s granite features NUMBER ft high and NUMBER ft wide a museum a restored amphitheatre and car park for admiring crowds are planned so is this mountain limestone or granite if it s limestone it ll weather pretty fast yahoo groups sponsor NUMBER dvds free s p join now URL to unsubscribe from this group send an email to forteana unsubscribe URL your use of yahoo groups is subject to URL '"
), label = c("spam", "ham")), row.names = c(NA, -2L), class = c("tbl_df",
"tbl", "data.frame"))
ui <- dashboardPage(
dashboardHeader(title = "Text Classification"),
dashboardSidebar(
uiOutput("spamham"),
uiOutput("frequency"),
uiOutput("maximum")
),
dashboardBody(
tabsetPanel(
id="tabs",
tabPanel("Wordcloud",wordcloud2Output("word",width="100%",height="850px"))
)
)
)
server <- function(input, output) {
output$spamham<-renderUI({
selectInput("selection", "Choose spam or ham:",
choices = unique(spam_or_not_spam2$label),
selected = unique(spam_or_not_spam2$label),
multiple = T
)
})
smoh<-reactive({
spam_or_not_spam2 <-subset( spam_or_not_spam2, spam_or_not_spam2$label %in% input$selection)
spam_or_not_spam2
})
df<-reactive({
#Create a vector containing only the text
#spam_or_not_spam2 <-subset( spam_or_not_spam2, spam_or_not_spam2$label %in% input$selection)
dt<-smoh()
text <- dt$email
# Create a corpus
docs <- Corpus(VectorSource(text))
docs <- docs %>%
tm_map(removeNumbers) %>%
tm_map(removePunctuation) %>%
tm_map(stripWhitespace)
docs <- tm_map(docs, content_transformer(tolower))
docs <- tm_map(docs, removeWords, stopwords("english"))
dtm <- TermDocumentMatrix(docs)
matrix <- as.matrix(dtm)
words <- sort(rowSums(matrix),decreasing=TRUE)
df <- data.frame(word = names(words),freq=words)
})
output$maximum<-renderUI({
subs<-subset( df()
,df()$freq >=input$freq )
sliderInput("max",
"Maximum Number of Words:",
min = 1, max = nrow(subs), value =nrow(subs),step=1 )
})
output$frequency<-renderUI({
sliderInput("freq",
"Minimum Frequency:",
min = 1, max =max(df()$freq), value = 1,step=1)
})
output$word<-renderWordcloud2({
subs<-subset( df()
,df()$freq >=input$freq )
#subs<-subs[1:input$max,]
wordcloud2(subs[1:input$max,],size = 4)
#wordcloud(words = df()$word, freq = df()$freq, min.freq = input$freq,max.words=input$max, random.order=FALSE, rot.per=0.35, colors=brewer.pal(8, "Dark2"))
})
}
shinyApp(ui, server)