selectInput for every row in shiny app using reactable

Question

I am trying to create a dynamic table in shiny using reactable where any time "Sell" is selected in a given row in the transaction column, the corresponding row in the quantity column changes to zero.

I am able to generate a selectInput in any row, but I am having trouble changing the value in the quantity column after the fact. I assume I can do this with some combination of observe/observeEvent and updateReactable but have not been able to solve it myself. Here is what I have tried:

library(shiny)
library(tidyverse)
library(reactable)

df <- tibble(
  rowId = 1:5,
  fruit = c("apple", "banana", "orange", "kiwi", "grape"),
  quantity = c(10, 20, 15, 5, 12)) %>%
  group_by(rowId) %>%
  mutate(transaction = as.character(selectInput(inputId = rowId,
                                                label = NULL,
                                                choices = c("Keep", "Sell")))) %>%
  ungroup()


ui <- fluidPage(
  titlePanel("Fruit Table"),
  mainPanel(
    reactableOutput("table")
  )
)


# Server----
server = function(input, output, session) {
  
  # Team Budget Table----
  fruit_table <- reactive({
    
    df_reactable <- reactable(
      df,
      defaultColDef = colDef(
        align = "center",
        width = 100,
        headerStyle = list(background = "#ededed", fontSize = 11),
        style = function(value) {
          list(fontSize = 11,
               height = 25)
        }
      ),
      columns = list(
        transaction = colDef(
          html = T
        )
      ),
      bordered = T,
      highlight = T,
      fullWidth = F,
      pagination = F
    )
    df_reactable
    
  })
  
  output$table <- renderReactable(fruit_table())

  observeEvent(input$rowId, {
    df[input$rowId, "quantity"] <- ifelse(input[[input$rowId]] == "Sell", 0, df[input$rowId, "quantity"])
  })
  
}

EDIT:

With some help from YBS, I was able to get this sort of working. When I select "Sell" in a given row, the table changes the quantity column in that row to 0. However, the issue I still have is that when a new row is set to "Sell", the original row (which was set to "Sell") reverts back to its original quantity rather than staying at zero. The documentation on updateReactable says "When updating data, the selected rows, expanded rows, and current page will reset unless explicitly specified." So it does seem to be possible.

Updated code:

library(shiny)
library(tidyverse)
library(reactable)

js <- "
$(document).on('shiny:value', function(e) {
  if(e.name === 'table'){
    setTimeout(function(){Shiny.bindAll(document.getElementById('table'))}, 0);
  }
});
"

df <- tibble(
  rowId = 1:5,
  fruit = c("apple", "banana", "orange", "kiwi", "grape"),
  quantity = c(10, 20, 15, 5, 12)) %>%
  group_by(rowId) %>%
  mutate(transaction = as.character(selectInput(inputId = rowId,
                                                label = NULL,
                                                choices = c("Keep", "Sell")))) %>%
  ungroup()


ui <- fluidPage(
  tags$head(tags$script(js)),
  titlePanel("Fruit Table"),
  mainPanel(
    reactableOutput("table"),
    textOutput("selection")
  )
)


# Server----
server = function(input, output, session) {
  
  # Create the reactive table
  df_reactable <- reactive({
    reactable(
      df,
      defaultColDef = colDef(
        align = "center",
        width = 100,
        headerStyle = list(background = "#ededed", fontSize = 11),
        style = function(value) {
          list(fontSize = 11,
               height = 25)
        }
      ),
      columns = list(
        transaction = colDef(html = TRUE)
      ),
      bordered = TRUE,
      highlight = TRUE,
      fullWidth = FALSE,
      pagination = FALSE
    )
  })
  
  # Render the table
  output$table <- renderReactable(df_reactable())
  
  
  lapply(1:nrow(df), function(i) {
  
    observe({
   
      print(i)
  
      filtered <- if (length(input[[paste0(i)]]) > 0) {
        df <- df %>%
          mutate(quantity = ifelse(input[[paste0(i)]] == "Sell" & 
                                     row_number() == paste0(i),
                                   0, quantity))
      } else {
        df
      }
      updateReactable(outputId = "table", 
                      data = filtered)
      
    })
  })

}




shinyApp(ui = ui, server = server)

Answer [here](https://stackoverflow.com/questions/59304843/selectinput-value-not-updating-in-reactable-shiny-trouble-binding-unbiding) might be useful. — YBS, Mar 11 '23 at 20:14
This is indeed useful for getting a single input to work, thank you. However, when trying to iterate across the entire data frame, I get the following error message: "Error in checkName: Must use single string to index into reactivevalues." — James, Mar 13 '23 at 15:08
To update the reactable, you need to render the table again. When you do that you are using the same inputIDs. That is the reason it will not work in your situation unless you make the IDs update each time you re-render. Then it will get complicated to access the input values. — YBS, Mar 13 '23 at 15:48
See update. I was able to get it sort of working, but not exactly how I want. — James, Mar 14 '23 at 19:28
Answer [here](https://stackoverflow.com/questions/51065090/complex-r-shiny-input-binding-issue-with-datatable) might be useful to define unique IDs each time you render the reactable. — YBS, Mar 14 '23 at 23:54
@YBS How do i save the updated dataframe after changing the transaction column. Let's say I have a submit button and on click of that the new dataframe should be saved for future use. — Narendra Sahu, Jun 16 '23 at 02:31

Marcus · Answer 1 · 2023-06-16T15:12:45.457

Make the quantity a reactive output. Define a default value list and change your df definition.

ogQty <- c(10, 20, 15, 5, 12)

df <- tibble(
  rowId = 1:5,
  fruit = c("apple", "banana", "orange", "kiwi", "grape")
) %>%
  group_by(rowId) %>%
  mutate(
    quantity = as.character(textOutput(paste0("val_", rowId))),
    transaction = as.character(
      selectInput(inputId = rowId, label = NULL, choices = c("Keep", "Sell"))
    )
  ) %>%
  ungroup()

Then instead of using an observer for the transaction selector, set all the quantity outputs to be dependent on the transaction input.

lapply(1:nrow(df), function(i) {
    
    output[[paste0("val_", i)]] <- renderText({
      if(input[[paste0(i)]] == "Sell") 0 else ogQty[i]
    })
    
    # observe({
    #   
    #   print(i)
    #   
    #   filtered <- if (length(input[[paste0(i)]]) > 0) {
    #     df <- df %>%
    #       mutate(quantity = ifelse(input[[paste0(i)]] == "Sell" & 
    #                                  row_number() == paste0(i),
    #                                0, quantity))
    #   } else {
    #     df
    #   }
    #   updateReactable(outputId = "table", 
    #                   data = filtered)
    #   
    # })
  })

sorry. my question was: How do i save the updated dataframe after changing the transaction column. Let's say I have a submit button and on click of that the new dataframe should be saved for future use — Narendra Sahu, Jun 16 '23 at 16:31

score 0 · Answer 2 · answered Jun 16 '23 at 16:06

Alternatively, you could use JavaScript and attach event handlers directly to the select inputs. This can be faster because it doesn't require communication with the server, but might be less intuitive if you're only familiar with Shiny.

When you're defining the table, again take advantage of HTML. Because the selectInput is actually a collection of HTML elements, you need to wrap it in a span and add the event handler there. You still need to make the quantity column HTML elements with IDs in order for the JS to be able to target them.

onChangeJS <- "
  if(this.querySelector('select').value === 'Sell'){
    qty = document.getElementById('val_' + this.id)
    qty.innerText = '0'
  } 
"

ogQty <- c(10, 20, 15, 5, 12)

df <- tibble(
  rowId = 1:5,
  fruit = c("apple", "banana", "orange", "kiwi", "grape"),
  quantity = imap_chr(
      ogQty, \(qty, i) as.character(span(qty, id = paste0("val_", i)))
    )
) %>%
  group_by(rowId) %>%
  mutate(
    transaction = as.character(
      span(
        id = rowId,
        selectInput(inputId = paste0("sel_", rowId), label = NULL, choices = c("Keep", "Sell")), 
        onchange = onChangeJS
      )
    )
  ) %>%
  ungroup()

You can then drop the entire lapply call in server

selectInput for every row in shiny app using reactable

2 Answers2