Question

我正在尝试根据用户当前输入的内容实现Shiny文本预测功能。理想的情况是建议将单词显示为按钮，使用时可以单击其中之一，并且该单词将出现在文本输入区域中。但是，当前该程序似乎是双重触发了第一个按钮，因此每次用户选择一个单词时，另一个（第一个）单词也会弹出到文本输入区域。

library(shiny)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      textAreaInput("typingArea", NULL)
    ),
    mainPanel(
      uiOutput("UI")
    )
  )
)

server = function(input, output, session){
  wordlist <- data.frame("word"=sample(LETTERS, 5), stringsAsFactors = F)

  Gibberish <- reactive({
    input$typingArea
    return(sample(letters, 5))
  })

  output$UI = renderUI({
    res <- Gibberish()
    obsList <- list()
    lapply(
      1:5,
      function(i) {
        btnID <- paste0("btn", i)
        if (is.null(obsList[[btnID]])) {
          obsList[[btnID]] <<- observeEvent(input[[btnID]], {
            mytext <- paste0(input$typingArea, res[i], " ")
            updateTextAreaInput(session, "typingArea", value=mytext)
          })
        }
        fluidRow(
          actionButton(btnID, res[i]), br(), br()
        )
      }
    )
  })
}

shinyApp(ui,server)

我怀疑是因为在两个不同的反应函数中调用了input$typingArea。但是我不知道如何解决这个问题。感谢任何建议。

Answer 1

使用全局变量和重复代码的成本很高，您可以采用以下方式：

library(shiny)
res <<-(sample(letters, 5))
mytext <<- NULL
ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      textAreaInput("typingArea", NULL)
    ),
    mainPanel(

      fluidRow(
        actionButton("btn1", res[1]),
      actionButton("btn2", res[2]),
    actionButton("btn3", res[3]), 
  actionButton("btn4", res[4]), 
actionButton("btn5", res[5])
      )
    )
  )
)

server = function(input, output, session){  
  wordlist <- data.frame("word"=sample(LETTERS, 5), stringsAsFactors = F)

  Gibberish <- reactive({
  input$typingArea
  mytext <<- paste0(mytext,input$typingArea, " ")
  return(sample(letters, 5))

  })
  observeEvent(input$btn1, {
    mytext<<-paste0(mytext,res[1], " ")
    updateTextAreaInput(session, "typingArea", value=mytext)
    res <<-  sample(letters, 5)
    print(res)
  })
  observeEvent(input$btn2, {
       mytext<<-paste0(mytext,res[2], " ")
       updateTextAreaInput(session, "typingArea", value=mytext)
       res<<-  sample(letters, 5)
  })
  observeEvent(input$btn3, {
    mytext<<-paste0(mytext,res[3], " ")
    updateTextAreaInput(session, "typingArea", value=mytext)
    res <<-  sample(letters, 5)
  })
  observeEvent(input$btn4, {
    mytext<<-paste0(mytext,res[4], " ")
    updateTextAreaInput(session, "typingArea", value=mytext)
    res <<-  sample(letters, 5)
  })
  observeEvent(input$btn5, {
    mytext<<-paste0(mytext,res[5], " ")
    updateTextAreaInput(session, "typingArea", value=mytext)
    res <<-  sample(letters, 5)
  })
  observeEvent({input$btn1 },{
  updateActionButton(session,"btn1", res[1])
    updateActionButton(session,"btn2", res[2])
    updateActionButton(session,"btn3", res[3])
    updateActionButton(session,"btn4", res[4])
    updateActionButton(session,"btn5", res[5])

    })
  observeEvent({input$btn2 },{
    updateActionButton(session,"btn1", res[1])
    updateActionButton(session,"btn2", res[2])
    updateActionButton(session,"btn3", res[3])
    updateActionButton(session,"btn4", res[4])
    updateActionButton(session,"btn5", res[5])

  })
  observeEvent({input$btn3 },{
    updateActionButton(session,"btn1", res[1])
    updateActionButton(session,"btn2", res[2])
    updateActionButton(session,"btn3", res[3])
    updateActionButton(session,"btn4", res[4])
    updateActionButton(session,"btn5", res[5])

  })
  observeEvent({input$btn4 },{
    updateActionButton(session,"btn1", res[1])
    updateActionButton(session,"btn2", res[2])
    updateActionButton(session,"btn3", res[3])
    updateActionButton(session,"btn4", res[4])
    updateActionButton(session,"btn5", res[5])

  })
  observeEvent({input$btn5 },{
    updateActionButton(session,"btn1", res[1])
    updateActionButton(session,"btn2", res[2])
    updateActionButton(session,"btn3", res[3])
    updateActionButton(session,"btn4", res[4])
    updateActionButton(session,"btn5", res[5])

  })
}


shinyApp(ui,server)

我同意，这完全没有意义而且肮脏，但这是我能够做到的最好的事情。

希望对您有帮助！

R闪亮的watchEvent多次触发

1 个答案: