Question

我正在尝试用反应性词云构建一个闪亮的应用程序。截至目前，它只生成一个静态词云，当我选择不同的输入时，它不会改变。

这些是我正在使用的包：

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"))
  })
}

我的数据基本上是两列，其中包含代理商名称，另一列包含不同合同的描述。

Answer 1

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

首先加载数据和包：

 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)

输出Wordcloud不会在Shiny

1 个答案: