R Shiny updateSelectInput无法正常工作 - 与wordcloud组件有关吗?

时间:2018-06-16 09:49:38

标签: r shiny reactive

我已经在updateSelectInput上阅读了很多问题/答案和网页,但在我的情况下它不起作用,我真的找不到原因。

这可能是我使用的wordcloud2额外小部件的错误,但也许有人会遗憾地错过 (愚蠢)的原因。

很抱歉,我的代码需要您在gihub上找到的包harrypotter。也许您只需查看代码即可获得解决方案。

library(wordcloud2)
library(harrypotter)
library(tm)

books <- list(philosophers_stone, chamber_of_secrets, prisoner_of_azkaban,
              goblet_of_fire, order_of_the_phoenix, half_blood_prince,
              deathly_hallows)
books_title <- c(' Harry Potter and the Philosophers Stone (1997)'=1
              ,' Harry Potter and the Chamber of Secrets (1998)'=2
              ,' Harry Potter and the Prisoner of Azkaban (1999)'=3
              ,' Harry Potter and the Goblet of Fire (2000)'=4
              ,' Harry Potter and the Order of the Phoenix (2003)'=5
              ,' Harry Potter and the Half-Blood Prince (2005)'=6
              ,' Harry Potter and the Deathly Hallows (2007)'=7)

# 
create_wordcloud <- function(data, num_words = 20, background = "white") {
  # If text is provided, convert it to a dataframe of word frequencies
  if (is.character(data)) {
    corpus <- Corpus(VectorSource(data))
    corpus <- tm_map(corpus, tolower)
    corpus <- tm_map(corpus, removePunctuation)
    corpus <- tm_map(corpus, removeNumbers)
    corpus <- tm_map(corpus, removeWords, stopwords("english"))
    tdm <- as.matrix(TermDocumentMatrix(corpus))
    data <- sort(rowSums(tdm), decreasing = TRUE)
    data <- data.frame(word = names(data), freq = as.numeric(data))
  }

  # Make sure a proper num_words is provided
  if (!is.numeric(num_words) || num_words < 3) {
    num_words <- 3
  }

  # Grab the top n most common words
  data <- head(data, n = num_words)
  if (nrow(data) == 0) {
    return(NULL)
  }

  wordcloud2(data, backgroundColor = background)
}

# Define UI for the application
ui <- fluidPage(
  h1("Word Cloud")
  # Add input of book
  , selectInput("book","Chose one Harry Potter book",choices=books_title)
  # Add input of chapter
  , selectInput("bchapter",label="Select a chapter", choices=1:length(philosophers_stone),selected=1, multiple=FALSE)
  # Add the word cloud output placeholder to the UI
  ,wordcloud2Output(outputId = "cloud")
)

# Define the server logic
server <- function(input, output,session) {
  # Render the word cloud and assign it to the output list
  #<HERE MANAGE OUTPUT> 
  # you will have to use create_wordcloud
  output$cloud <- renderWordcloud2({
    # Create a word cloud object
    text <- reac_book_text()
    create_wordcloud(text)
  })

  reac_book <- reactive({
    books[[as.numeric(input$book)]]
  })
  reac_book_text <- reactive({
    reac_book()[ as.numeric(input$bchapter)]
  })
  observe({
    nchapters <- length(reac_book())
    print(nchapters)
    updateSelectInput(session=session, inputId="bchapter",label="Select a chapter", choices=1:nchapters,selected=1)
    cat("Done.")
  })
}



# Run the application 
shinyApp(ui = ui, server = server)

有什么想法吗?

0 个答案:

没有答案