闪亮的反应式输入添加和删除

Question

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!

Answer 1

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)