-->

Display the selected choice of a dynamically gener

2020-04-23 04:27发布

问题:

I am trying to build a Shiny app that generates rows with multiple selectInput or selectizeInput widgets when a user presses the "+" button, and that removes such rows when he presses the "-" button. The image below show what I have achieved since now:

How my shiny app looks right now: https://imgur.com/uQfdJrv

My problem is that I can't find a way to show the widgets in the new row with the same selected values of the widget in the previous row. In fact, the user may want to change just values of some inputs and don't touch the values of the others.

Referring to the image above, let's suppose that for the first test an user has selected "Amikacin" as antibiotics and "5" as AMR. The second test is always with "Amikacin" but he got the AMR value of 10. The new inputs, right after pressing the "+" button, must display immediately "Amikacin" and "5", and after that the user will just change the "5" of the second row in a "10".

Here is the code I have used:


library(shiny)
library(shinyjs)

###= UI
ui <- fluidPage(

br(),

useShinyjs(),

  fluidRow(
    column(width = 12,
           actionButton(inputId = "add_amr_test",
                        label = icon(name = "plus",
                                     lib = "font-awesome")),
           actionButton(inputId = "remove_amr_test",
                        label = icon(name = "minus",
                                     lib = "font-awesome")),
           div(style = "display: inline-block;
                        padding: 0px 10px;",
               h5("Add or remove an antimicrobial resistance test")),
           tags$div(id = "amr_test_placeholder")
    )
  ),

br()

)

###= SERVER
server <- function(input, output, session) {

  Antibiotics_name <- c("", "Amikacin", "Ampicillin", "Tetracycline")

  observe({

    toggleState(id = "remove_amr_test",
                condition = input$add_amr_test > input$remove_amr_test)

  })

  amr_test_values <- reactiveValues(val = 0)

  ###= Add ui
  observeEvent(input$add_amr_test, {

    amr_test_divId <- length(amr_test_values$val) + 1

    insertUI(
      selector = "#amr_test_placeholder",
      where = "beforeBegin",
      ui = tags$div(
        id = amr_test_divId,
        fluidRow(

          br(),

          column(width = 3,
                 selectizeInput(inputId = paste0("drug_",
                                                 input$add_amr_test - input$remove_amr_test),
                                label = h5(paste0("Antibiotic ",
                                                  input$add_amr_test - input$remove_amr_test)),
                                choices = Antibiotics_name,
                                selected = "")
          ),
          column(width = 1,
                 selectizeInput(inputId = paste0("rescom_",
                                                 input$add_amr_test - input$remove_amr_test),
                                label = h5(paste0("AMR ",
                                                  input$add_amr_test - input$remove_amr_test)),
                                choices = c("",
                                            seq(from = 1,
                                                to = 100,
                                                by = 1)),
                                selected = "")
          )
        )
      )
    )

    amr_test_values$val <- c(amr_test_values$val,
                             amr_test_divId)

  })

  ###= Remove ui
  observeEvent(input$remove_amr_test, {

    removeUI(

      selector = paste0('#', amr_test_values$val[length(amr_test_values$val)])

    )

    amr_test_values$val <- amr_test_values$val[-length(amr_test_values$val)]

  })

}



###= RUN APP
shinyApp(ui = ui, server = server)

Finally, here is an image with the expected results obtained after the user presses the "+" button to generate the second row of widgets.

Example of expected result: https://imgur.com/NIpOZOE

One last question: once every widget from the user has a specific value, which is the best way to store all these values inside a dataframe?

Thanks a lot.

回答1:

Please see below for your first question:

library(shiny)
library(shinyjs)

###= UI
ui <- fluidPage(

br(),

useShinyjs(),

  fluidRow(
    column(width = 12,
           actionButton(inputId = "add_amr_test",
                        label = icon(name = "plus",
                                     lib = "font-awesome")),
           actionButton(inputId = "remove_amr_test",
                        label = icon(name = "minus",
                                     lib = "font-awesome")),
           div(style = "display: inline-block;
                        padding: 0px 10px;",
               h5("Add or remove an antimicrobial resistance test")),
           tags$div(id = "amr_test_placeholder")
    )
  ),

br()

)

###= SERVER
server <- function(input, output, session) {

  Antibiotics_name <- c("", "Amikacin", "Ampicillin", "Tetracycline")

  observe({

    toggleState(id = "remove_amr_test",
                condition = input$add_amr_test > input$remove_amr_test)

  })

  amr_test_values <- reactiveValues(val = 0)

  ###= Add ui
  observeEvent(input$add_amr_test, {

    amr_test_divId <- length(amr_test_values$val) + 1

    # Simplified input_number here and code to obtain previous values if they exist
    input_number <- input$add_amr_test - input$remove_amr_test
    if (!is.null(eval(parse(text = paste0("input$drug_", input_number - 1))))) {
        drug_value = eval(parse(text = paste0("input$drug_", input_number - 1)))
    } else {
        drug_value = ""
    }
    if (!is.null(eval(parse(text = paste0("input$rescom_", input_number - 1))))) {
        rescom_value = eval(parse(text = paste0("input$rescom_", input_number - 1)))
    } else {
        rescom_value = ""
    }

    insertUI(
      selector = "#amr_test_placeholder",
      where = "beforeBegin",
      ui = tags$div(
        id = amr_test_divId,
        fluidRow(

          br(),

          column(width = 3,
                 selectizeInput(inputId = paste0("drug_",
                                                 input_number),
                                label = h5(paste0("Antibiotic ",
                                                  input_number)),
                                choices = Antibiotics_name,
                                selected = drug_value)
          ),
          column(width = 1,
                 selectizeInput(inputId = paste0("rescom_",
                                                 input_number),
                                label = h5(paste0("AMR ",
                                                  input_number)),
                                choices = c("",
                                            seq(from = 1,
                                                to = 100,
                                                by = 1)),
                                selected = rescom_value)
          )
        )
      )
    )

    amr_test_values$val <- c(amr_test_values$val,
                             amr_test_divId)

  })

  ###= Remove ui
  observeEvent(input$remove_amr_test, {

    removeUI(

      selector = paste0('#', amr_test_values$val[length(amr_test_values$val)])

    )

    amr_test_values$val <- amr_test_values$val[-length(amr_test_values$val)]

  })

}



###= RUN APP
shinyApp(ui = ui, server = server)