delete one or more rows in output table in Shiny - r

Question

I can show the output table in my Shiny app but I also wanted to have a 'delete' button next to each row in the output table so I can delete certain row and do some recalculation
I have the basic template of my Shiny app but need to add the 'delete' buttons next to each row in the output table and I have no idea... Is there a way in Shiny?
Any recommendation welcome and thanks in advance!
library(shiny)
library(data.table)
​
# Define list of products
products <- c("207STX",
"208STX",
"209ABC",
"210ABC")
​
# Create function to process shopping cart and create model input
process_cart <- function(cart_df) {
​
# Do some data processing
df <- copy(cart_df)
# Check if product has SmartStax
df[, STX := grepl("STX", Product)]
​
# Collapse into a single observation
obs_df <- data.table(total_quantity = sum(df$Quantity),
qty_stx = sum(df$Quanity[df$STX]))
​
return(obs_df)
​
}
​
# Run model on observation
predict_discount <- function(obs_df) {
# This is a fake model for demonstration purposes only
discount <- obs_df[, 20 * log(total_quantity) +
1.3 * qty_stx]
discount <- max(discount, 0)
return(discount)
}
​
# Define UI for application
ui <- fluidPage(
​
# Application title
titlePanel("Shopping Cart Example"),
​
# Sidebar
sidebarLayout(
sidebarPanel(
selectInput(inputId = "product_name",
label = "Product Name",
choices = products),
​
numericInput(inputId = "product_quantity",
label = "Quantity",
value = 0,
min = 0),
​
actionButton(inputId = "add_to_cart",
label = "Add to Cart"),
​
actionButton(inputId = "clear_cart",
label = "Clear Cart")
),
​
​
mainPanel(
h2("Shopping Cart"),
tableOutput(outputId = "cart_df"),
h2("Total Discount"),
textOutput(outputId = "discount_amt")
)
)
)
​
​
server <- function(input, output, session) {
​
# Definie initial empty table
cart_df <- data.table()
​
add_to_cart <- observeEvent(input$add_to_cart, {
# Update cart
new_row <- data.frame(Product = input$product_name,
Quantity = input$product_quantity)
new_df <- rbind(cart_df, new_row)
cart_df <<- new_df[, .(Quantity = sum(Quantity)), by = Product]
output$cart_df <- renderTable(cart_df)
​
# Create observation for prediction
obs_df <- process_cart(cart_df)
​
# Run model to predict discount
discount <- predict_discount(obs_df)
output$discount_amt <- renderText(sprintf("$%.2f", discount))
​
# Reset input
updateNumericInput(session, "product_quantity", value = 0)
})
​
clear_cart <- observeEvent(input$clear_cart, {
cart_df <<- data.table()
output$cart_df <- renderTable(cart_df)
})
​
}
​
# Run the application
shinyApp(ui = ui, server = server)

Answer 1

Here is a working demo:
library(shiny)
library(formattable)
library(glue)
initial_table <- cbind(
iris[1:10,],
data.frame(
delete = glue(
"<button rowid='{1:10}'
onclick='Shiny.setInputValue(\"removeRow\",this.getAttribute(\"rowid\"))'>Delete</button>"),
rowid = 1:10
)
)
colnames(initial_table)[ncol(initial_table)-1] <- " "
ui <- fluidPage(
dataTableOutput("deletable")
)
server <- function(input, output, session) {
mytable <- reactiveVal(initial_table)
output$deletable <- renderDataTable(
datatable(
mytable(),
escape = FALSE,
selection = "none",
options = list(
columnDefs = list(list(targets = ncol(initial_table),visible = FALSE))
)
)
)
observeEvent(input$removeRow,{
removeRow <- as.integer(input$removeRow)
tblRowRemoved <- mytable()[-which(mytable()$rowid == removeRow),]
mytable(tblRowRemoved)
})
}
shinyApp(ui, server)