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
observeEventfor theremove_row_button, you can replacewith
This should do the job:
Also notice that inside this
observeEventyou rather should usesuch that the re-ranking also works if the user did not click the sort button beforehand.