delete one or more rows in output table in Shiny

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)