-->

Reactive deletion of dynamically generated widgets

2019-08-17 09:16发布

问题:

My question is related to a previous question that I have already asked here and that has been smartly solved by Eli Berkow. To recap, my UI consists of two buttons to dynamically add and remove (with insertUI and removeUI in the server) selectizeInput widgets one after another inside their respective column. In particular, I wanted the user to be able to add a new widget, fill it with one of the possible choices and then add a new row of inputs with the selected same choice of the previous ones, because there could be some fields that he doesn't want to change in the brand new row of inputs (see image attached).

Now I would like to add a new functionality. In particular, inside the dynamic UI, beyond the widgets, I added some code for the insertion of an action button for each row that, if pressed, should delete the entire row. Below you can find the code for a minimal reproducible example of my app. The code for the action button is already present, but not the one for its functionalities.

library(shiny)
library(shinyjs)

###= UI
ui <- fluidPage(

  br(),

  useShinyjs(),

  br(),

  fluidRow(
    column(width = 3,
           align = "center",
           h5("Animal species")
    ),
    column(width = 3,
           align = "center",
           h5("Sample type")
    )
  ),

br(),

  fluidRow(
    column(width = 12,
           tags$div(id = "amr_test_placeholder")
    )
  ),

  fluidRow(

br(),
  # "+" and "-" buttons
    column(width = 12,
           actionButton(inputId = "add_amr_test",
                        label = icon(name = "plus",
                                     lib = "font-awesome")),
           actionButton(inputId = "remove_amr_test",
                        label = icon(name = "times",
                                     lib = "font-awesome"))
    )
  ),

  br(),
  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)


  ### Defined the input number to count every row
  input_number <- reactive({

    input_number <- input$add_amr_test - input$remove_amr_test

    return(input_number)

  })




  observeEvent(input$add_amr_test, {

    amr_test_divId <- length(amr_test_values$val) + 1

    ###= Animal species
    if (!is.null(eval(parse(text = paste0("input$animal_species_", input_number() - 1))))) {

      animal_species_value = eval(parse(text = paste0("input$animal_species_", input_number() - 1)))

    } else {

      animal_species_value = ""

    }

    ###= Animal sample type
    if (!is.null(eval(parse(text = paste0("input$sample_type_", input_number() - 1))))) {

      sample_type_value = eval(parse(text = paste0("input$sample_type_", input_number() - 1)))

    } else {

      sample_type_value = ""

    }

    ###= Insert dynamic UI
    insertUI(
      selector = "#amr_test_placeholder",
      where = "beforeBegin",
      ui = tags$div(id = amr_test_divId,
                    tags$head(tags$style(HTML(".shiny-split-layout > div {overflow: visible;}"))),

br(),

        fluidRow(
          column(width = 3,
                 splitLayout(cellWidths = c("18%", "14%", "68%"),
                             actionButton(inputId = paste0("delete_row_",
                                                           input_number()),
                                          label = div(icon(name = "times",
                                                           lib = "font-awesome")),
                                          style = "border-radius: 50%; border: 1px solid red; padding: 1px 4px 1px 4px; font-size:55%; margin-top: 11px;"),
                             h5(paste0(input_number(), ". ")),
                             selectizeInput(inputId = paste0("animal_species_",
                                                             input_number()),
                                            label =  NULL,
                                            choices = c("Chicken" = "",
                                                        "Chicken",
                                                        "Pig",
                                                        "Cattle",
                                                        "Sheep",
                                                        "Duck",
                                                        "Buffalo",
                                                        "Horse"),
                                            selected = animal_species_value,
                                            width = "100%",
                                            options = list(create = TRUE))
                 )
          ),
          column(width = 3,
                 selectizeInput(inputId = paste0("sample_type_",
                                                 input_number()),
                                label = NULL,
                                choices = list("Products" = "",
                                               "Living animal" = "living_animal",
                                               "Products" = "products",
                                               "Fecal" = "fecal",
                                               "Slaughtered" = "slaughtered_animal"),
                                selected = sample_type_value,
                                width = "100%")
          )
        )
      )
    )

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

  })

  ###= Remove dynamic 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)]

  })

}




###= Launch App
shinyApp(ui = ui, server = server)

The expected result is illustrated in that image. Basically, every new "x" button should control just what happens in its row, but I don't know how to code that inside my server. I want to keep the functionalities of the two main buttons in the UI, but if I delete one row with is own "x" button the counting number of rows defined should update too (decreasing), while the choices chosen for the next row should not change. Any suggestion on how to proceed?

Thanks a lot!

回答1:

Partial Answer - needs work

Here is an answer that removes the correct row but needs work keeping track of the previous values and numbering.

library(shiny)
library(shinyjs)

###= UI
ui <- fluidPage(

  br(),

  useShinyjs(),

  br(),

  fluidRow(
    column(width = 3,
           align = "center",
           h5("Animal species")
    ),
    column(width = 3,
           align = "center",
           h5("Sample type")
    )
  ),

  br(),

  fluidRow(
    column(width = 12,
           tags$div(id = "amr_test_placeholder")
    )
  ),

  fluidRow(

    br(),
    # "+" and "-" buttons
    column(width = 12,
           actionButton(inputId = "add_amr_test",
                        label = icon(name = "plus",
                                     lib = "font-awesome")),
           actionButton(inputId = "remove_amr_test",
                        label = icon(name = "times",
                                     lib = "font-awesome"))
    )
  ),

  br(),
  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,
                                    ignore = 0)


  ### Defined the input number to count every row
  input_number <- reactive({

    input_number <- input$add_amr_test - input$remove_amr_test

    return(input_number)

  })




  observeEvent(input$add_amr_test, {

    amr_test_divId <- max(amr_test_values$val) + 1

    ###= Animal species
    if (!is.null(eval(parse(text = paste0("input$animal_species_", input_number() - 1))))) {

      animal_species_value = eval(parse(text = paste0("input$animal_species_", input_number() - 1)))

    } else {

      animal_species_value = ""

    }

    ###= Animal sample type
    if (!is.null(eval(parse(text = paste0("input$sample_type_", input_number() - 1))))) {

      sample_type_value = eval(parse(text = paste0("input$sample_type_", input_number() - 1)))

    } else {

      sample_type_value = ""

    }

    ###= Insert dynamic UI
    insertUI(
      selector = "#amr_test_placeholder",
      where = "beforeBegin",
      ui = tags$div(id = amr_test_divId,
                    tags$head(tags$style(HTML(".shiny-split-layout > div {overflow: visible;}"))),

                    br(),

                    fluidRow(
                      column(width = 3,
                             splitLayout(cellWidths = c("18%", "14%", "68%"),
                                         actionButton(inputId = paste0("delete_row_",
                                                                       input_number()),
                                                      label = div(icon(name = "times",
                                                                       lib = "font-awesome")),
                                                      style = "border-radius: 50%; border: 1px solid red; padding: 1px 4px 1px 4px; font-size:55%; margin-top: 11px;"),
                                         h5(paste0(input_number(), ". ")),
                                         selectizeInput(inputId = paste0("animal_species_",
                                                                         input_number()),
                                                        label =  NULL,
                                                        choices = c("Chicken" = "",
                                                                    "Chicken",
                                                                    "Pig",
                                                                    "Cattle",
                                                                    "Sheep",
                                                                    "Duck",
                                                                    "Buffalo",
                                                                    "Horse"),
                                                        selected = animal_species_value,
                                                        width = "100%",
                                                        options = list(create = TRUE))
                             )
                      ),
                      column(width = 3,
                             selectizeInput(inputId = paste0("sample_type_",
                                                             input_number()),
                                            label = NULL,
                                            choices = list("Products" = "",
                                                           "Living animal" = "living_animal",
                                                           "Products" = "products",
                                                           "Fecal" = "fecal",
                                                           "Slaughtered" = "slaughtered_animal"),
                                            selected = sample_type_value,
                                            width = "100%")
                      )
                    )
      )
    )

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

  })

  ###= Remove dynamic UI
  observeEvent(input$remove_amr_test, {

    removeUI(

      selector = paste0('#', max(amr_test_values$val))

    )

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

  })

  observeEvent(lapply(paste0("delete_row_", amr_test_values$val), function(x) input[[x]]), {
    value <- grep(1, lapply(paste0("delete_row_", amr_test_values$val), function(x) input[[x]]))
    value <- value[!value%in%amr_test_values$ignore]

    if (length(value) != 0) {
      removeUI(

        selector = paste0('#', value-1)

      )

      amr_test_values$ignore <- c(amr_test_values$ignore,
                                  value)
    }

  })

}




###= Launch App
shinyApp(ui = ui, server = server)