简体   繁体   中英

R Shiny observeEvent triggered multiple times

I'm trying to implement a Shiny text prediction function based on what user has currently input. The ideal scenario is suggested words are displayed as buttons and use can click on one of them and the word will appear on the text input area. However, currently the program seems double triggering the first button so that each time user selects a word, another one (the 1st one) will also pop into the text input area.

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)

I suspect that is because of the input$typingArea has been called within two different reactive functions. But I have no idea how to fix this problem. Appreciate for any suggestion.

With the great cost of using globals and repeat code, you can do this way:

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)

I agree, it is totally unelegant and dirty, but it is the best thing i have been able to come with.

I hope it helps you!

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM