I'm trying to create a column that has a button on each row to delete it. The problem is that when I run it it only performs the expected action once.
Below is a reproducible example with dummy data. The generation of the data.frame is done in a reactive way because in my case (with the original data) that data.frame also depends on other inputs. I also saw this topic that seems to be related but is not clear to me.
What am I doing wrong?
Thanks in advance.
library(shiny)
# Server
server <- function(input, output) {
# Auxiliary function
shinyInput <- function(FUN, len, id, ...) {
inputs <- character(len)
for (i in seq_len(len)) {
inputs[i] <- as.character(FUN(paste0(id, i), ...))
}
inputs
}
# Reactive
getListUnder <- reactive({
df <- mtcars
df$Delete <- shinyInput(actionButton, nrow(df),'delete_',label = "Delete",icon=icon("trash"),
style = "color: red;background-color: white",
onclick = paste0('Shiny.onInputChange( \"delete_button\" , this.id, {priority: \"event\"})'))
df
})
# Assign reactive data.frame to reactiveValues
values <- reactiveValues(df = NULL)
values$df <- isolate({getListUnder()})
# When press delete_button, remove row
observeEvent( input$delete_button, {
selectedRow <- as.numeric(strsplit(input$delete_button, "_")[[1]][2])
values$df <<- values$df[-selectedRow,]
})
# Render data.table
output$print_mtcars <- renderDataTable({
final_df <- values$df
table <- final_df %>%
DT::datatable(filter = "none", rownames = F
,extensions = 'FixedColumns'
,options = list(pageLength = 10,scrollX = TRUE,
fixedColumns = list(leftColumns = 2)),
escape=F)
})
}
# UI
ui <- fluidPage(
titlePanel("Delete rows"),
mainPanel(
DT::dataTableOutput("print_mtcars")
)
)
# Run the application
shinyApp(ui = ui, server = server)
noveld
September 24, 2020, 2:44pm
2
I think the problem is that the shiny input only reacts on an input change. You now input this.id which will always be the same. If you change this.id with for instance Math.random():
paste0('Shiny.onInputChange( "delete_button" , Math.random(), {priority: "event"})'))
Does that work?
If I run your expression (slightly modified to make it works) it drops all rows
'Shiny.onInputChange( \"delete_button\", Math.random().toString(), {priority: \"event\"})'
noveld
September 24, 2020, 4:24pm
4
I think I found the real problem. You delete by row number and those are not updated in your original df. What you could do is add a column with the row numbers in your original df and delete based on those:
library(shiny)
# Server
server <- function(input, output) {
# Auxiliary function
shinyInput <- function(FUN, len, id, ...) {
inputs <- character(len)
for (i in seq_len(len)) {
inputs[i] <- as.character(FUN(paste0(id, i), ...))
}
inputs
}
# Reactive
getListUnder <- reactive({
df <- mtcars
df$Delete <- shinyInput(actionButton, nrow(df),'delete_',label = "Delete",icon=icon("trash"),
style = "color: red;background-color: white",
onclick = paste0('Shiny.onInputChange( \"delete_button\" , this.id, {priority: \"event\"})'))
df$ID <- seq.int(nrow(df))
return(df)
})
# Assign reactive data.frame to reactiveValues
values <- reactiveValues(df = NULL)
values$df <- isolate({getListUnder()})
# When press delete_button, remove row
observeEvent( input$delete_button, {
selectedRow <- as.numeric(strsplit(input$delete_button, "_")[[1]][2])
values$df <<- subset(values$df, ID!=selectedRow)
})
# Render data.table
output$print_mtcars <- renderDataTable({
final_df <- values$df
table <- final_df %>%
DT::datatable(filter = "none", rownames = F
,extensions = 'FixedColumns'
,options = list(pageLength = 10,scrollX = TRUE,
fixedColumns = list(leftColumns = 2)),
escape=F)
})
}
# UI
ui <- fluidPage(
titlePanel("Delete rows"),
mainPanel(
DT::dataTableOutput("print_mtcars")
)
)
# Run the application
shinyApp(ui = ui, server = server)
It works like a charm.
Thank you so much for your answer!
system
Closed
October 1, 2020, 7:33pm
6
This topic was automatically closed 7 days after the last reply. New replies are no longer allowed. If you have a query related to it or one of the replies, start a new topic and refer back with a link.