Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

[Bug]: checkbox_extra() keeps the values of checked rows if the rows are deleted or a new row is added in source dataset #54

Open
1 task done
EkremBayar opened this issue Jan 2, 2024 · 0 comments
Labels
bug Something isn't working

Comments

@EkremBayar
Copy link

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

  1. In order to create a player list, select players from datatable
  2. Click "Add" action button with selected players
  3. Reactable table will be created after clicking "Add" button
  4. Assign the position of the players (This example is only for GK - Goalkeeper)
  5. 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

@EkremBayar EkremBayar added the bug Something isn't working label Jan 2, 2024
@EkremBayar EkremBayar changed the title [Bug]: checkbox_extra() keeps the values of checked rows if the rows are deleted or a new row added in source dataset [Bug]: checkbox_extra() keeps the values of checked rows if the rows are deleted or a new row is added in source dataset Jan 2, 2024
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
bug Something isn't working
Projects
None yet
Development

No branches or pull requests

1 participant