P.G.
P.G.

Reputation: 3

Shiny reactive input add and delete

I'm trying to write a shiny app where I produce a list and add and delete some elements.

I have a module to add somethind to my list.

find_inputUI <- function(id){
  ns <- NS(id)
  tagList(
  sliderInput(ns("first"), "Choose a number:", min=0, max=100, 30),
  radioButtons(ns("second"), "Choose a colour:", choices=c("red", "green", "black")),
  actionButton(ns("press"), "Add to queue"))

}

find_input <- function(input, output, session){
  queue <- list()
 observeEvent(input$press, {
  queue_append <- list(input$first, input$second)
queue <<- append(queue, queue_append )})
 queue_ret <- eventReactive(input$press,{return(list(queue=queue, add=input$press))})

}

Then I call it twice and connect the 2 different inputs. Now I want to choose the elements to delete but this doesn't work.

source('/cloud/project/Queue/find_input.R')
library(shiny)

ui <- fluidPage(
  tagList(tabsetPanel(
    tabPanel("INPUT 1",
             find_inputUI("input1"),
             verbatimTextOutput("test")),
    tabPanel("INPUT 2",
             find_inputUI("input2")
    )
  ),
  actionButton("combine", "Show combined input"),
  verbatimTextOutput("combination"),
  uiOutput("del")
  )
)

# Define server logic required to draw a histogram
server <- function(input, output, session) {

  input_manual1 <- callModule(find_input,"input1")
  input_manual2 <- callModule(find_input, "input2")
  output$test <- renderPrint({input_manual1()$queue})

  appended <- eventReactive(input$combine, {
    return(append(input_manual1()$queue, input_manual2()$queue))
  })

  output$combination <- renderPrint({appended()})

  output$del <- renderUI({
    input$combine
    tagList(checkboxGroupInput("delete", "Choose do delete", seq(1:length(appended()))),
            actionButton("dodelete", "Delete selected"))
  })
  observeEvent(input$dodelete,{
    appended <<- appended()[-input$delete]
  })

}

# Run the application 
shinyApp(ui = ui, server = server)

Maybe anybody can tell me what's wrong so far?

Thanks in advance!

Upvotes: 0

Views: 338

Answers (1)

St&#233;phane Laurent
St&#233;phane Laurent

Reputation: 84659

Below is an app which seems to work but I'm not sure to understand what your app is intended to do.

In general, prefer reactive values (reactiveVal) instaed of using the non-local assignment <<-.

The code appended <<- appended()[-input$delete] is not correct. It does not replace the output of appended() by its originalvalue minus the input$delete index.

library(shiny)

find_inputUI <- function(id){
  ns <- NS(id)
  tagList(
    sliderInput(ns("first"), "Choose a number:", min=0, max=100, 30),
    radioButtons(ns("second"), "Choose a colour:", choices=c("red", "green", "black")),
    actionButton(ns("press"), "Add to queue"))

}

find_input <- function(input, output, session){

  queue <- reactiveVal(list())

  observeEvent(input$press, {
    queue_append <- list(input$first, input$second)
    queue(append(queue(), queue_append))
  })

  queue_ret <- eventReactive(input$press, {
    list(queue=queue(), add=input$press)
  })

}

ui <- fluidPage(
  tagList(tabsetPanel(
    tabPanel("INPUT 1",
             find_inputUI("input1"),
             verbatimTextOutput("test")),
    tabPanel("INPUT 2",
             find_inputUI("input2")
    )
  ),
  actionButton("combine", "Show combined input"),
  verbatimTextOutput("combination"),
  uiOutput("del")
  )
)


server <- function(input, output, session) {

  input_manual1 <- callModule(find_input,"input1")
  input_manual2 <- callModule(find_input, "input2")
  output$test <- renderPrint({input_manual1()$queue})

  appended <- reactiveVal(list())
  observeEvent(input$combine, {
    appended(append(input_manual1()$queue, input_manual2()$queue))
  })

  output$combination <- renderPrint({appended()})

  output$del <- renderUI({
    input$combine
    tagList(checkboxGroupInput("delete", "Choose do delete", seq_along(appended())),
            actionButton("dodelete", "Delete selected"))
  })

  observeEvent(input$dodelete,{
    appended(appended()[-as.integer(input$delete)])
  })

}

# Run the application 
shinyApp(ui = ui, server = server)

Upvotes: 1

Related Questions