Shiny app: delete UI objects with action buttons

后端 未结 1 1131
难免孤独
难免孤独 2021-02-11 10:24

With the following code, it is possible to create UI objects in Shiny.

library(shiny)


LHSchoices <- c(\"X1\", \"X2\", \"X3\", \"X4\")


#-------------------         


        
1条回答
  •  -上瘾入骨i
    2021-02-11 10:57

    There should be multiple ways to do this. One is suggested in the docu of removeUI(): To wrap your affffded ui part in a div with an id.

    Then your selector would be fairly easy to add:

    removeUI(
            selector = paste0("#var", btn)
    )
    

    , where # is the identifier for ids in jquery´s selectors.

    Next, you would have to add multiple observe events. It might be surprising, but that this can actually be done from within other reactive contexts. So it might be the easiest way to add this listener when you create the new ui. So within observeEvent(input$insertBtn, {...}) you can add:

    observeEvent(input[[paste0("var", btn,"-rmvv")]], {
      removeUI(
        selector = paste0("#var", btn)
      )
    })
    

    Then you have as many listeners as you have (newly added) ui components.

    Potential enhancements:

    • The initially added ui.

    Since you added one row manually, the corresponding listener would have to be added manually as well. In order to keep the code not too long i didnt add this part, but i am happy to edit.

    • Counting the amount of rows

    For now you count the amount of uis with btn <- sum(input$insertBtn, 1). Therefore, the rows are numbered by the amount of units ever being added, not the amount of visible rows. So if a user adds 2 rows, deletes them and adds another one, there will be row 1 and row 4.

    In case this is not desired one could attempt placing the counting mechanism in a global reactive variable.

    • Removing the inputs on server side

    For now you cleaned up the ui side. But the inputs will still be available on the server side. In case this should be cleaned up as well, there is an example on how to do so here: https://www.r-bloggers.com/shiny-add-removing-modules-dynamically/.

    Reproducible example:

    library(shiny)
    
    
    LHSchoices <- c("X1", "X2", "X3", "X4")
    
    LHSchoices2 <- c("S1", "S2", "S3", "S4")
    
    #------------------------------------------------------------------------------#
    
    # MODULE UI ----
    variablesUI <- function(id, number) {
    
      ns <- NS(id)
    
      tagList(
        div(id = id,
          fluidRow(
            column(6,
                   selectInput(ns("variable"),
                               paste0("Select Variable ", number),
                               choices = c("Choose" = "", LHSchoices)
                   )
            ),
    
            column(3,
                   numericInput(ns("value.variable"),
                                label = paste0("Value ", number),
                                value = 0, min = 0
                   )
            ),
            column(3,
                   actionButton(ns("rmvv"),"Remove UI")
            ),
          )
        )
      )
    
    }
    
    #------------------------------------------------------------------------------#
    
    # MODULE SERVER ----
    
    variables <- function(input, output, session, variable.number){
      reactive({
    
        req(input$variable, input$value.variable)
    
        # Create Pair: variable and its value
        df <- data.frame(
          "variable.number" = variable.number,
          "variable" = input$variable,
          "value" = input$value.variable,
          stringsAsFactors = FALSE
        )
    
        return(df)
    
      })
    }
    
    #------------------------------------------------------------------------------#
    
    # Shiny UI ----
    
    ui <- fixedPage(
      tabsetPanel(type = "tabs",id="tabs",
                  tabPanel("t1",value="t1"),
                  tabPanel("t2",value="t2")),
    
      variablesUI("var1", 1),
      h5(""),
      actionButton("insertBtn", "Add another line"),
    
      verbatimTextOutput("test1"),
      tableOutput("test2"),
    
      actionButton("rmv", "Remove UI"),
      textInput("txt", "This is no longer useful")
    )
    
    # Shiny Server ----
    
    server <- function(input, output,session) {
    
      # this remove button works, from https://shiny.rstudio.com/reference/shiny/latest/removeUI.html
      observeEvent(input$rmv, {
        removeUI(
          selector = "div:has(> #txt)"
        )
      })
    
      add.variable <- reactiveValues()
    
      add.variable$df <- data.frame("variable.number" = numeric(0),
                                    "variable" = character(0),
                                    "value" = numeric(0),
                                    stringsAsFactors = FALSE)
    
      var1 <- callModule(variables, paste0("var", 1), 1)
    
      observe(add.variable$df[1, ] <- var1())
    
      observeEvent(input$insertBtn, {
    
        btn <- sum(input$insertBtn, 1)
    
        insertUI(
          selector = "h5",
          where = "beforeEnd",
          ui = tagList(
            variablesUI(paste0("var", btn), btn)
          )
        )
    
        newline <- callModule(variables, paste0("var", btn), btn)
    
        observeEvent(newline(), {
          add.variable$df[btn, ] <- newline()
        })
    
        observeEvent(input[[paste0("var", btn,"-rmvv")]], {
          removeUI(
            selector = paste0("#var", btn)
          )
        })
    
    
      })
    
      output$test1 <- renderPrint({
        print(add.variable$df)
      })
    
      output$test2 <- renderTable({
        add.variable$df
      })
    
    }
    
    #------------------------------------------------------------------------------#
    
    shinyApp(ui, server)
    

    0 讨论(0)
提交回复
热议问题