【问题标题】:Updating Graphs and data with click actions in shiny使用闪亮的点击操作更新图表和数据
【发布时间】:2026-01-28 13:05:01
【问题描述】:

我有一个包含 3 个操作的应用,

  1. 通过点击按钮加载数据(左上角) - 现在应该输出图表

  2. 通过在删除正文中输入一个单词并单击“执行”来删除单词 - 应该更新图表

  3. 替换一个词,购买把要替换的词放在“查找”中,替换在“替换”中点击动作

我面临的问题是只有当我点击“go”然后“act”时才会显示图表,只有在我到达“act”时才会显示图表

library(shiny)
library(plyr)
library(sp)
library(stringr)
library(tidyr)
library(tidyverse)
library(tm)
library(ggplot2)
library("stringi")
library(plyr)
library(dplyr) #Data manipulation (also included in the tidyverse package)


ui <- fluidPage(

  fluidRow( 
    column( 4, titlePanel("Twitter Analytics")),
    column( 3),
    column( 4, 
            textInput("searchstring", 
                      label = "",
                      value = "")),
    column(1, 
           br(),
           actionButton("action", "go"))
  ),
  fluidRow(
    column( 12, tabsetPanel(
      tabPanel("one",
               fluidRow(
                 column(3, textInput("removeString", label = "remove", value = ""), actionButton("remove", "do"),
                        textInput("find", label = "find", value = ""),textInput("rep", label = "replace", value = ""),actionButton("replace", "act"), 
                        checkboxGroupInput("checkGroup", "select plots",
                                           choices <- c("Histogram", "Wordcloud", "network")),
                        sliderInput("topTerms",
                                    label = "top (n) terms", 
                                    min = 0, max = 25, value = 0)  ),
                 column(9,fluidRow(column(12,plotOutput("ttext") )),

                          fluidRow(column(12,wordcloud2Output("wc2"))))
               )
      ),    
      tabPanel("two"),
      tabPanel("three")
    )
    )
  )
)




server <- function(input, output) {
  values <- reactiveValues(go = 0, do = 0, act = 0 )


  observeEvent(input$action, {
    values$go <- 1
    values$do <- 0
    values$act <- 0

  })

  observeEvent(input$remove, {
    values$go <- 0
    values$do <- 1
    values$act <- 0
  })

  observeEvent(input$replace, {
    values$go <- 0
    values$do <- 0
    values$act <- 1
  })

  #tweet <- eventReactive(input$action,{
  cs<- reactiveVal(0)

  tweet <-reactive({

    if(values$go){

    num <- c(1,2,3,4,50)
    text <- c("this is love love something", "this is not hate hate hate something", "@something islove  rethched this not", " Shiny is love confusing me", "this is hate also somthing difficult")
    letter<- c("a", "b", "c", "D", "e")
    tweetdf <- data.frame(num, text, letter)
    tweetdf$text <- tolower(tweetdf$text)
    # tweetdf @UserName
    tweetdf$text <- gsub("@\\w+", "", tweetdf$text)
    #remove punctuation
    tweetdf$text <- gsub("[[:punct:]]", "", tweetdf$text)
    #remove links
    tweetdf$text <- gsub("http\\w+", "", tweetdf$text)
    # Remove tabs
    tweetdf$text <- gsub("[ |\t]{2,}", "", tweetdf$text)
    # Remove blank spaces at the beginning
    tweetdf$text <- gsub("^ ", "", tweetdf$text)
    # Remove blank spaces at the end
    corpus <- iconv(tweetdf$text, to = "ASCII")
    corpus <- Corpus(VectorSource(corpus))
    corpus <- tm_map(corpus, removePunctuation)
    corpus <- tm_map(corpus, removeNumbers)
    cleanset <- tm_map(corpus, removeWords, stopwords('english'))
    cs(cleanset)}

     if(values$do){

      cleanset <- cs()
      cleanset <- tm_map(cleanset, removeWords, input$removeString)
      cs(cleanset)
     }

    if(values$act){

      cleanset <- cs()
      cleanset <- tm_map(cleanset, gsub, 
                         pattern = input$find, 
                         replacement = input$rep)
    cs(cleanset)

    }

    else
      {return()}
  })



    output$ttext <- renderPlot({ 
      if(is.null(tweet())){return()}
      else{
      cleanset <-cs()
      tdm <- TermDocumentMatrix(cleanset)
      tdm <- as.matrix(tdm)
      w <- rowSums(tdm)
        library(RColorBrewer)
        barplot(w)}

    })


    output$wc2 <- renderWordcloud2({
      if(is.null(tweet())){return()}
      else{
      library(wordcloud2)
      cleanset <-cs()
      tdm <- TermDocumentMatrix(cleanset)
      tdm <- as.matrix(tdm)
      w <- rowSums(tdm)
      w <- data.frame(names(w), w)
      colnames(w) <- c('word', 'freq')
      wordcloud2(w,
                 color = 'random-dark',
                 size = 0.7,
                 shape = 'circle',
                 rotateRatio = 0.5,
                 minSize = 1)}
    })
  }

  shinyApp(ui, server)

谁能告诉我我几天前才开始使用 Shiny 出了什么问题?

【问题讨论】:

  • 我明白了,对不起。如果可能的话,您能否多解释一下您的应用程序的每个部分或给出一个更简单的案例?例如,搜索栏对您有多大帮助?
  • 嗨,雷米,这是尽可能简化的,我可以让它做演示目的。实际的应用程序要复杂得多。基本上在服务器中。当按下按钮 go 时,我正在加载 DF,然后应该显示一个图表或单词计数,然后用户应该能够说他们希望删除选定的单词并单击执行,以删除为语料库选择单词,则应更新图表以显示该单词已被删除
  • 谢谢!它更清楚。为什么不只使用 tm_map 函数来清理你的文本?
  • 我是这样做的,因为我正在尝试不同的方法来清理我的数据

标签: r shiny shiny-reactivity shinyapps


【解决方案1】:

问题在于您使用了多个 if。 R 不知道要返回什么。所以你可以使用这个服务器,你不需要用FALSE替换0。

server <- function(input, output) {
  values <- reactiveValues(go = 0, do = 0, act = 0 )

  observeEvent(input$action, {
    values$go <- T
    values$do <- F
    values$act <- F
  })

  observeEvent(input$remove, {
    values$go <- F
    values$do <- T
    values$act <- F
  })

  observeEvent(input$replace, {
    values$go <- F
    values$do <- F
    values$act <- T
  })

  #tweet <- eventReactive(input$action,{
  cs <- reactiveVal(0)

  tweet <- reactive({
    cleanset <- cs()
    if(values$go){
      num <- c(1, 2, 3, 4, 50)
      text <- c("this is love love something", "this is not hate hate hate something",
                "@something islove  rethched this not", " Shiny is love confusing me", "this is hate also somthing difficult")
      letter<- c("a", "b", "c", "D", "e")
      tweetdf <- data.frame(num, text, letter)
      tweetdf$text <- tolower(tweetdf$text)
      # tweetdf @UserName
      tweetdf$text <- gsub("@\\w+", "", tweetdf$text)
      # Remove punctuation
      tweetdf$text <- gsub("[[:punct:]]", "", tweetdf$text)
      # Remove links
      tweetdf$text <- gsub("http\\w+", "", tweetdf$text)
      # Remove tabs
      tweetdf$text <- gsub("[ |\t]{2,}", "", tweetdf$text)
      # Remove blank spaces at the beginning
      tweetdf$text <- gsub("^ ", "", tweetdf$text)
      # Remove blank spaces at the end
      corpus <- iconv(tweetdf$text, to = "ASCII")
      corpus <- Corpus(VectorSource(corpus))
      corpus <- tm_map(corpus, removePunctuation)
      corpus <- tm_map(corpus, removeNumbers)
      cleanset <- tm_map(corpus, removeWords, stopwords('english'))
      return(cs(cleanset))}

    else if(values$do){
      cleanset <- tm_map(cleanset, removeWords, input$removeString)
      return(cs(cleanset))
    }

    else if(values$act){
      cleanset <- tm_map(cleanset, gsub, 
                         pattern = "input$find", 
                         replacement = "input$rep")
      return(cs(cleanset))
    }
    else
    {return()}
  })


  output$ttext <- renderPlot({
    if(is.null(tweet())){
      return()}
    else{
      cleanset <- cs()
      tdm <- TermDocumentMatrix(cleanset)
      tdm <- as.matrix(tdm)
      w <- rowSums(tdm)
      barplot(w)}

  })


  output$wc2 <- renderWordcloud2({
    if(is.null(tweet())){return()}
    else{
      cleanset <-cs()
      tdm <- TermDocumentMatrix(cleanset)
      tdm <- as.matrix(tdm)
      w <- rowSums(tdm)
      w <- data.frame(names(w), w)
      colnames(w) <- c('word', 'freq')
      wordcloud2(w,
                 color = 'random-dark',
                 size = 0.7,
                 shape = 'circle',
                 rotateRatio = 0.5,
                 minSize = 1)}
  })
}

【讨论】:

  • 嗨 Remi,非常感谢,go 按钮按预期工作,但是 act 按钮仍然没有按预期工作,你有什么想法
  • 另一个问题是,一旦单击按钮,该元素就会保持反应状态,有没有办法将其关闭
  • R 中的动作按钮闪亮递增一,所以如果你想这样做,你可以使用复选框输入控件。
  • 在回答您的问题吗?如果是,您可以验证它。谢谢。