rshinyrhandsontable

Is there a way to combine sorting an rhandsontable and removing from an rhandsontable?


I have a Shiny app that is using the mtcars dataset. I am coming up with a way to rank the cars by tiers. So instead of simply just 1-2-3-4 the user can edit the rhandsontable to say 1-1-1-1 if there are four types of cars in the same tier.

Both the Sort Table button and Remove Row From Table button work on their own. However, my issue is that if the user tries to implement tiers (so like 1-1-1-1 again), but then decides to delete a row from the rhandsontable, the entire table re-ranks from 1 to N.

Is there a way to make sure that if the user decides to sort the table, then if they also decide to delete a row then that table will be re-ranked based on what's been sorted and not just a total re-ranking?

Thank you.


library(shiny)
library(rhandsontable)
library(shinyjs)
library(dplyr)

cars_data <- mtcars %>%
  mutate(tiers = row_number()) %>%
  relocate(tiers, .before = mpg)

shinyApp(
  ui = fluidPage(
    useShinyjs(),
    helpText("Edit the table values in the 'Tiers' column to sort the table."),
    actionButton(inputId = "sort_button", label = "Sort Table"),
    actionButton(inputId = "remove_row_button", label = "Remove Row From Table", disabled = ''),
    br(),
    br(),
    rHandsontableOutput("cars_table")
  ),
  
  server = function(input, output, session) {
    
    
    cars_rv <- reactiveValues(
      table = cars_data,
      original_order = 1:nrow(cars_data)
    )
    
    output$cars_table <- renderRHandsontable({
      rhandsontable(data = cars_rv$table,
                    selectCallback = TRUE) %>%
        hot_col("mpg", colWidths = 75, readOnly = T) %>%
        hot_col("cyl", colWidths = 75, readOnly = T) %>%
        hot_col("disp", colWidths = 90, readOnly = T) %>%
        hot_col("hp", colWidths = 90, readOnly = T) %>%
        hot_col("drat", colWidths = 75, readOnly = T) %>%
        hot_col("wt", colWidths = 75, readOnly = T) %>%
        hot_col("qsec", colWidths = 90, readOnly = T) %>%
        hot_col("vs", colWidths = 75, readOnly = T) %>%
        hot_col("am", colWidths = 75, readOnly = T) %>%
        hot_col("gear", colWidths = 75, readOnly = T) %>%
        hot_col("carb", colWidths = 75, readOnly = T)
      
    })
    
    
    observe({
      if (!is.null(input$cars_table_select$select$r)) {
        shinyjs::enable("remove_row_button")
      }
    })
    
    
    observeEvent(input$remove_row_button, {
      selected_rhands_rows <- input$cars_table_select$select$r
      cars_rv$table <- cars_rv$table %>%
        slice(-c(selected_rhands_rows))
      
      cars_rv$table <- cars_rv$table %>%
        mutate(tiers = row_number()) %>%
        arrange(match(tiers, cars_rv$original_order))
      
      output$cars_table <- renderRHandsontable({
        rhandsontable(data = cars_rv$table,
                      selectCallback = TRUE) %>%
        hot_col("mpg", colWidths = 75, readOnly = T) %>%
        hot_col("cyl", colWidths = 75, readOnly = T) %>%
        hot_col("disp", colWidths = 90, readOnly = T) %>%
        hot_col("hp", colWidths = 90, readOnly = T) %>%
        hot_col("drat", colWidths = 75, readOnly = T) %>%
        hot_col("wt", colWidths = 75, readOnly = T) %>%
        hot_col("qsec", colWidths = 90, readOnly = T) %>%
        hot_col("vs", colWidths = 75, readOnly = T) %>%
        hot_col("am", colWidths = 75, readOnly = T) %>%
        hot_col("gear", colWidths = 75, readOnly = T) %>%
        hot_col("carb", colWidths = 75, readOnly = T)
      })
      
      shinyjs::disable("remove_row_button")
      
    })
    
    
    observeEvent(input$sort_button, {
      edited_data <- hot_to_r(input$cars_table)
      edited_data <- edited_data[order(edited_data$tiers), ]
      cars_rv$table <- edited_data
      cars_rv$original_order <- 1:nrow(cars_rv$table)
    })
  }
)

Solution

  • Inside the observeEvent for the remove_row_button, you can replace

    cars_rv$table <- cars_rv$table %>%
            mutate(tiers = row_number()) %>%
            arrange(match(tiers, cars_rv$original_order))
    

    with

    cars_rv$table <- cars_rv$table |> 
                    mutate(tiers = dense_rank(tiers))
    

    This should do the job:

    enter image description here

    Also notice that inside this observeEvent you rather should use

    cars_rv$table <- hot_to_r(input$cars_table) |> 
                    slice(-c(selected_rhands_rows))
    

    such that the re-ranking also works if the user did not click the sort button beforehand.