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)
})
}
)
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:
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.