2017-04-07 112 views
0

我正试图用反应词云构建一个Shiny应用程序。截至目前,它只产生一个静态词云,当我选择不同的输入时不会改变。输出Wordcloud不会更新闪亮

这是我使用的软件包:

library(shiny) 
library(tm) 
library(wordcloud) 
library(SnowballC) 
library(memoise) 

ui.R

ui <- fluidPage(

# Application title 
titlePanel("Word Cloud"), sidebarLayout(

# Sidebar with a slider and selection inputs 
sidebarPanel(
selectInput("selection", "Choose an agency:", choices = Agencies), 
actionButton("update", "Change"), 
hr(), 
sliderInput("freq", 
"Minimum Frequency:", 
min = 1, max = 50, value = 15), 
sliderInput("max", "Maximum Number of Words:", min = 1, max = 300, value = 100)), 

# Show Word Cloud 
mainPanel(
plotOutput("plot")))) 

server.R

server <- function(input, output) { 
    # Define a reactive expression for the document term matrix 
    terms <- reactive({ 
    input$update 
    # ...but not for anything else 

    Agencies <<- list("NASA" = "NASA", "DOD" = "DOD") 

    getTermMatrix <- function(Agency) { 
     if(!(Agency %in% Agencies)) 
     stop("Unknown Agency") 

     PropCorpus <- Corpus(VectorSource(x$Proposal.Title)) 
     PropCorpus <- tm_map(PropCorpus, PlainTextDocument) 
     myCorpus = Corpus(VectorSource(PropCorpus)) 
     myCorpus = tm_map(myCorpus, content_transformer(tolower)) 
     myCorpus = tm_map(myCorpus, removePunctuation) 
     myCorpus = tm_map(myCorpus, removeNumbers) 
     myDTM = TermDocumentMatrix(myCorpus, control = list(minWordLength = 1)) 
     m = as.matrix(myDTM) 
     sort(rowSums(m), decreasing = TRUE) 
    } 

     getTermMatrix(input$selection) 
    }) 

    # Make the wordcloud drawing predictable during a session 
    wordcloud_rep <- repeatable(wordcloud) 

    output$plot <- renderPlot({ 
    v <- terms() 
    wordcloud_rep(names(v), v, scale=c(4,0.5), 
        min.freq = input$freq, max.words=input$max, 
        colors=brewer.pal(8, "Dark2")) 
    }) 
} 

我的数据基本上是两列一个与该机构的名称和一个描述不同的合同。

+0

我认为你缺少一些代码在这里。在“getTermMatrix”中,您引用了在此处未定义的变量“x”和“PlainTextDocument”。我怀疑他们是由你本地定义的。基本上,你在制作词云的信息在这里没有定义。你可能会在本地定义它们,这就是为什么当你运行你的闪亮程序时事物并没有改变。 –

+0

或者也许还有另一个块,你没有告诉我们... –

+0

我看不到输入$选择用于实际获得TDM。你的函数只在你的if语句中调用变量,但对语料库创建保持沉默。所以我认为它只是创建一个没有任何输入规范的语料库。 –

回答

0

谢谢你的帮助!我终于明白了,所以我想分享我的最终代码。

首先加载数据和包:

contract_data_df <- read.csv(file.choose(), header = TRUE, stringsAsFactors = FALSE) 
contract_data_df$Agency <- as.factor(contract_data_df$Agency) 
attach(contract_data_df) 
library(shiny) 
library(tm) 
library(wordcloud) 
library(SnowballC) 
library(memoise) 

在我的数据集,我有两个栏目:局(因素)和Proposal.Title(串)。这个词云的目的是想象在与多个联邦机构相关的提案标题中最突出的单词。

设置的用户界面(UI):

ui <- fluidPage(
    titlePanel("Word Cloud"), 
    sidebarLayout(
    sidebarPanel(
     #selectInput("selection", "Choose an agency:", choices = list("DOD"="DOD", "NASA"="NASA")), 
     selectInput("selection", "Choose an agency:", choices = Agency, selected = 1), 
     actionButton("update", "Change"), 
     hr(), 
     sliderInput("freq", 
        "Minimum Frequency:", 
        min = 1, max = 50, value = 15), 
     sliderInput("max", "Maximum Number of Words:", min = 1, max = 300, value = 100)), 

    mainPanel(
     plotOutput("plot")))) 

设置服务器:

server <- function(input, output) { 

terms <- reactive({ 
input$update 
agencies <<- list("DOD"="DOD", "NASA"="NASA") 
getCorpusMatrix <- function(agency){ 
text <- subset(contract_data_df, contract_data_df$Agency == input$selection) 
contract_corpus <- Corpus(VectorSource(text$Proposal.Title)) 
contract_corpus <- tm_map(contract_corpus, content_transformer(tolower)) 
contract_corpus <- tm_map(contract_corpus, removePunctuation) 
contract_corpus <- tm_map(contract_corpus, removeWords, stopwords("english")) 
contract_corpus <- tm_map(contract_corpus, stripWhitespace) 
contract_corpus <- tm_map(contract_corpus, stemDocument) 


contract_dtm <- TermDocumentMatrix(contract_corpus) 
contract_dtm_df <- data.frame(as.matrix(contract_dtm)) 
sort(rowSums(contract_dtm_df), decreasing = TRUE) 
} 

getCorpusMatrix(input$update) 
}) 

wordcloud_rep <- repeatable(wordcloud) 
output$plot <- renderPlot({ 
v <- terms() 
wordcloud_rep(names(v), v, scale=c(4,0.5), 
min.freq = input$freq, max.words=input$max, 
colors=brewer.pal(8, "Dark2")) 
}) 
} 

最后,启动应用程序:

shinyApp(ui = ui, server = server)