问题
With the following code, it is possible to create UI objects in Shiny.
library(shiny)
LHSchoices <- c("X1", "X2", "X3", "X4")
#------------------------------------------------------------------------------#
# MODULE UI ----
variablesUI <- function(id, number) {
ns <- NS(id)
tagList(
fluidRow(
column(6,
selectInput(ns("variable"),
paste0("Select Variable ", number),
choices = c("Choose" = "", LHSchoices)
)
),
column(6,
numericInput(ns("value.variable"),
label = paste0("Value ", number),
value = 0, min = 0
)
)
)
)
}
#------------------------------------------------------------------------------#
# 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(
verbatimTextOutput("test1"),
tableOutput("test2"),
variablesUI("var1", 1),
h5(""),
actionButton("insertBtn", "Add another line")
)
# Shiny Server ----
server <- function(input, output) {
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()
})
})
output$test1 <- renderPrint({
print(add.variable$df)
})
output$test2 <- renderTable({
add.variable$df
})
}
#------------------------------------------------------------------------------#
shinyApp(ui, server)
Now, I would like to add a button for each row to delete it if we click on it.
First I don't quite understand how the variables function works: inside the function, we can see that input$variable is used, but how does it know which selectInput is used? I think that I don't understand how ns("variable") works.
So now, it is difficult to create remove buttons. I am trying: I used this link to create a remove button, but I don't know how to make each button work.
library(shiny)
LHSchoices <- c("X1", "X2", "X3", "X4")
LHSchoices2 <- c("S1", "S2", "S3", "S4")
#------------------------------------------------------------------------------#
# MODULE UI ----
variablesUI <- function(id, number) {
ns <- NS(id)
tagList(
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)"
)
})
# trying to make the following work
observeEvent(input$rmvv, {
removeUI(
selector = "h5"
)
})
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()
})
})
output$test1 <- renderPrint({
print(add.variable$df)
})
output$test2 <- renderTable({
add.variable$df
})
}
#------------------------------------------------------------------------------#
shinyApp(ui, server)
回答1:
There should be multiple ways to do this. One is suggested in the docu of removeUI(): To wrap your addded 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)
来源：https://stackoverflow.com/questions/62161796/shiny-app-delete-ui-objects-with-action-buttons