2017-04-07 109 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)