Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Actionbutton reset needed (or alternative)

I am having some trouble using multiple actionbuttons in shiny. I have constructed a textarea where text can be inserted. This text is manipulated such that three strings are the result. These three string are then made the label of the three actionbuttons. When one of the buttons is clicked it should manipulate the input text.

When I click the actionbutton the text is manipulated correctly, but the action is repeated indefinately. This is because the action button cannot be reset. I have found multiple web pages dealing with this problem and I have tried multiple solutions and workarounds, but nothing seems to work. I have presented the code below:

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")

              )
        )
  )
)
like image 975
Maarten Avatar asked Oct 30 '22 12:10

Maarten


1 Answers

The problem is that in the renderUI you use in the observeEvent have a dependency on input$text_in through the new_word() function and the input$text_in in the second argument. So each time the text changes, the renderUI will be called again which is why the action is repeated indefinitely.

Try using isolate to remove these dependencies, for example:

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]))})
})
like image 143
NicE Avatar answered Nov 11 '22 06:11

NicE