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

24 Views Asked by At

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)
    })
  }
)
1

There are 1 best solutions below

0
Jan On BEST ANSWER

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.