Необходим сброс кнопки действия (или альтернатива)

У меня возникли проблемы с использованием нескольких кнопок действий в блестящей. Я создал текстовую область, в которую можно вставить текст. Этот текст обрабатывается так, что три строки являются результатом. Эти три строки затем становятся метками для трех кнопок действий. При нажатии на одну из кнопок она должна манипулировать вводимым текстом.

Когда я нажимаю кнопку действия, текст корректно обрабатывается, но действие повторяется бесконечно. Это потому, что кнопка действия не может быть сброшена. Я нашел несколько веб-страниц, посвященных этой проблеме, и я пробовал несколько решений и обходных путей, но, похоже, ничего не работает. Я представил код ниже:

server.R

library(shiny)
library(stringi)

new_word_f <- function(x) {
      x <- substr(x, nchar(x), nchar(x)) == " " 
}

modify_text_input <- function(new_word, input_text, word_to_remove, answer) {
      if (new_word == TRUE) {
            paste(input_text, answer, " ")
      } else {
             paste(stri_replace_last_regex(input_text, word_to_remove,     answer), " ")
      }
}


start_input_text <- "Testing the lines "
ngram_input <- "lines"
answer <- c("a", "b", "c")

## Start shiny app
shinyServer(function(input, output) {

  ## New word or current mid-word
  new_word <- reactive({new_word_f(input$text_in)})

  output$input_textarea <- renderUI({tags$textarea(id="text_in", rows=3, cols=40, start_input_text)})
  output$text1 <- renderText({input$text_in})
  output$text2 <- renderText({new_word()})

  output$but1 <- renderUI({actionButton("action1", label = answer[1])})
  output$but2 <- renderUI({actionButton("action2", label = answer[2])})
  output$but3 <- renderUI({actionButton("action3", label = answer[3])})


  ## On button press
  observeEvent(input$action1, {output$input_textarea <- renderUI({tags$textarea(id="text_in", rows=3, cols=40, modify_text_input(new_word(), input$text_in, ngram_input, answer[1]))})})
  observeEvent(input$action2, {output$input_textarea <- renderUI({tags$textarea(id="text_in", rows=3, cols=40, modify_text_input(new_word(), input$text_in, ngram_input, answer[2]))})})
  observeEvent(input$action3, {output$input_textarea <- renderUI({tags$textarea(id="text_in", rows=3, cols=40, modify_text_input(new_word(), input$text_in, ngram_input, answer[3]))})})


})

ui.R

library(shiny)
library(stringi)

shinyUI(
  fluidPage(
        titlePanel("Word prediction"),

        sidebarLayout(
              sidebarPanel(
                    uiOutput("input_textarea"),
                    uiOutput("but1"),
                    uiOutput("but2"),
                    uiOutput("but3")

              ),

              mainPanel(
                    textOutput("text1"),
                    textOutput("text2")

              )
        )
  )
)

1 ответ

Решение

Проблема в том, что в renderUI вы используете в observeEvent зависеть от input$text_in сквозь new_word() функция и input$text_in во втором аргументе. Таким образом, каждый раз, когда изменяется текст, renderUI будет вызываться снова, поэтому действие повторяется бесконечно.

Попробуйте использовать isolate для удаления этих зависимостей, например:

observeEvent(input$action1, {output$input_textarea <- renderUI({
tags$textarea(id="text_in", rows=3, cols=40, modify_text_input(isolate(new_word()),isolate(input$text_in),ngram_input,answer[1]))})
})
Другие вопросы по тегам