R Shiny наблюдать событие срабатывает несколько раз - PullRequest
Новая
       13

R Shiny наблюдать событие срабатывает несколько раз

1 голос
/ 11 марта 2019

Я пытаюсь реализовать функцию прогнозирования блестящего текста на основе того, что пользователь в данный момент вводит.Идеальным сценарием является то, что предлагаемые слова отображаются в виде кнопок, и пользователь может нажать на одну из них, и слово появится в области ввода текста.Однако в настоящее время программа, по-видимому, дважды запускает первую кнопку, так что каждый раз, когда пользователь выбирает слово, другое (1-е) также появляется в области ввода текста. 

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 был вызван в рамках двух разных реактивных функций.Но я понятия не имею, как решить эту проблему.Ценю любое предложение.

1 Ответ

0 голосов
/ 11 марта 2019

С большой стоимостью использования глобалов и повторяющегося кода вы можете сделать это следующим образом: 

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)

Я согласен, это абсолютно нелегко и грязно, но это лучшее, что я смог сделатьПриходите.

Надеюсь, это поможет вам!

...