[Bug]: checkbox_extra() keeps the values of checked rows if the rows are deleted or a new row is added in source dataset
Opened this issue · 0 comments
Guidelines
- I agree to follow this project's Contributing Guidelines.
Project Version
No response
Platform and OS Version
No response
Existing Issues
No response
What happened?
Thanks for this great package first.
I'm trying to design a player position assignment app to with the following code.
The main idea behind is selecting the players from the player list table which you want, then defining their positions by using checkbox. You are able to assign the positions it once with this app.
However, after some assignments, if removing a player from the list or adding a new one, there will be a bug on the reactable.
For example, on the video I recorded, I assign the positions of the Player1, Player2 and Player3 as Goalkeeper. After that, I decide to remove Player3 from the list and I expect that the checkbox of the Player4 shouldn't have been checked but Player3 still affects the checkbox.
I couldn't find a solution to update checkbox or the reactable? It'd be great if is there a solution for that.
Thanks in advance.
library(shiny)
library(shinyjs)
library(DT)
library(tidyverse)
library(reactable)
library(reactable.extras)
ui <- fluidPage(
useShinyjs(),
reactable_extras_dependency(),
br(),
fluidRow(
column(width = 6,
h4("1. Player List"),
dataTableOutput("selectable_table")),
column(width = 6,
h4("2. Selected Players"),
actionButton("add","Add", style = "background-color:green; color:white"),
actionButton("delete","Delete", style = "background-color:red; color:white"),
dataTableOutput("assignable_table"))
),
hr(),
fluidRow(
column(width = 6,
h4("3. Position Assigning"),
reactableOutput("assign_positions")
),
column(width = 6,
h4("4. Print Assigned Data"),
verbatimTextOutput("print_data")
)
)
)
server <- function(session, input, output){
# Dataframe
data <- data.frame(
Player = paste0("Player", 1:10), Age = sample(c(18:30), 10, replace = T)
)
# Render selectable_table
output$selectable_table <- renderDT({
datatable(
data,
selection = "multiple"
)
})
# Reactive Data
rvData <- reactiveValues(SelectedPlayers = NULL, AssignedPlayers = NULL, GK = NULL)
# Render assignable_table
output$assignable_table <- renderDT({
if(!is.null(rvData$SelectedPlayers)){
hidecols <- which(names(rvData$SelectedPlayers) %in% (rvData$SelectedPlayers %>% select(GK:ST) %>% names()))
datatable(
rvData$SelectedPlayers ,
selection = "multiple",
options=list(columnDefs = list(list(visible=FALSE, targets=c(hidecols))))
)
}
})
# Add Selected Players
observeEvent(input$add, {
if(is.null(rvData$SelectedPlayers)){
rvData$SelectedPlayers <- data[input$selectable_table_rows_selected,] %>%
# Initial values of all positions
mutate(
GK = FALSE,
LCB = FALSE,
CB = FALSE,
RCB = FALSE,
LB = FALSE,
RB = FALSE,
CDM = FALSE,
CM = FALSE,
ACM = FALSE,
LW = FALSE,
RW = FALSE,
ST = FALSE
)
}else{
rvData$SelectedPlayers <- data[input$selectable_table_rows_selected,] %>%
left_join(
rvData$SelectedPlayers %>%
select(Player, GK:ST),
by = "Player") %>%
mutate_at(c("GK", "LCB", "CB", "RCB", "LB", "RB", "CDM", "CM", "ACM", "LW", "RW", "ST"), .funs = function(value){ifelse(is.na(value), FALSE, value)})
}
})
# Remove Selected Players
observeEvent(input$delete, {
rvData$SelectedPlayers <- rvData$SelectedPlayers[-input$assignable_table_rows_selected,]
})
# 3. Position Assigning
output$assign_positions <- renderReactable({
if(!is.null(rvData$SelectedPlayers)){
reactable(
rvData$SelectedPlayers,
columns = list(
GK = colDef(cell = checkbox_extra(id = "check1", class = "checkbox-extra1"), align = "center", header = tooltip_extra("Goalkeeper", theme = "material")),
LCB = colDef(cell = checkbox_extra(id = "check2", class = "checkbox-extra2"), align = "center", header = tooltip_extra("Left Centre Back", theme = "material")),
CB = colDef(cell = checkbox_extra(id = "check3", class = "checkbox-extra2"), align = "center", header = tooltip_extra("Centre Back", theme = "material")),
RCB = colDef(cell = checkbox_extra(id = "check4", class = "checkbox-extra2"), align = "center", header = tooltip_extra("Right Centre Back", theme = "material")),
LB = colDef(cell = checkbox_extra(id = "check5", class = "checkbox-extra3"), align = "center", header = tooltip_extra("Left Back", theme = "material")),
RB = colDef(cell = checkbox_extra(id = "check6", class = "checkbox-extra3"), align = "center", header = tooltip_extra("Right Back", theme = "material")),
CDM = colDef(cell = checkbox_extra(id = "check7", class = "checkbox-extra4"), align = "center", header = tooltip_extra("Defensive Midfield", theme = "material")),
CM = colDef(cell = checkbox_extra(id = "check8", class = "checkbox-extra4"), align = "center", header = tooltip_extra("Central Midfield", theme = "material")),
ACM = colDef(cell = checkbox_extra(id = "check9", class = "checkbox-extra4"), align = "center", header = tooltip_extra("Attacking Midfield", theme = "material")),
LW = colDef(cell = checkbox_extra(id = "check10", class = "checkbox-extra5"), align = "center", header = tooltip_extra("Left Winger", theme = "material")),
RW = colDef(cell = checkbox_extra(id = "check11", class = "checkbox-extra5"), align = "center", header = tooltip_extra("Right Winger", theme = "material")),
ST = colDef(cell = checkbox_extra(id = "check12", class = "checkbox-extra6"), align = "center", header = tooltip_extra("Striker", theme = "material"))
),
pagination = F,filterable = T,showPagination = F, bordered = TRUE, striped = TRUE, highlight = TRUE, compact = TRUE,
sortable = FALSE, showSortable = FALSE, fullWidth = FALSE, style = "z-index: 0; width:100%; font-size:78%;",
defaultColDef = colDef(align = "center",
minWidth = 50,
headerStyle = list(background = "#39a642", color = "black")
),
theme = reactableTheme(
rowSelectedStyle = list(backgroundColor = "#C6E0B4", boxShadow = "inset 2px 0 0 0 #ffa62d")
)
)
}
})
# 4. Print Data
observe({
output$print_data <- renderPrint({
print(rvData$SelectedPlayers)
})
})
# Keep Values & Rewrite on Data
observeEvent(input$check1, {
idname <- "check1"
if(is.null(rvData$GK)){
rvData$GK <- data.frame(Player = rvData$SelectedPlayers[input[[idname]]$row, "Player"], row = input[[idname]]$row, column = input[[idname]]$column, value = input[[idname]]$value)
}else{
rvData$GK <- bind_rows(
rvData$GK,
data.frame(Player = rvData$SelectedPlayers[input[[idname]]$row, "Player"], row = input[[idname]]$row, column = input[[idname]]$column, value = input[[idname]]$value)
) %>%
group_by(row) %>%
do(tail(.,1)) %>%
ungroup()
}
rvData$SelectedPlayers <- rvData$SelectedPlayers %>%
left_join(
(rvData$GK %>% select(-c("row", "column"))),
by = "Player"
) %>%
mutate(GK = ifelse(is.na(value), FALSE, value)) %>%
select(-value)
})
}
shinyApp(ui = ui, server = server)
Steps to reproduce
- In order to create a player list, select players from datatable
- Click "Add" action button with selected players
- Reactable table will be created after clicking "Add" button
- Assign the position of the players (This example is only for GK - Goalkeeper)
- After assignment delete a checked player from selected list
Expected behavior
I was expecting the checkbox on the deleted row to be deleted but it didn't.
Attachments
No response
Screenshots or Videos
Third Row is deleted but checkbox is still staying as checked
Ekran.Kaydi.2024-01-02.15.29.22.mov
Additional Information
No response