Shiny app: Writing function that works like datatable( ..., selection = list(target = 'row+column')), but has the selection indices of target = 'cell'

[cjy8s]

I have a data.frame, labeled selected_df, that saves the indices of cells from a data table that are selected using input$id_cells_selected. What I want to do is basically combine the concepts from selection = list(mode = 'multiple', target = 'row+column') with selection = list(mode = 'multiple', target = 'cell') because I want the selected_df to list the indices of the individual cells of all the rows or columns that I select. Just using row+column doesn't allow me to store the indices of the individual cells that are selected, it just allows me to store the index of the selected row or column itself.

Here is the way that I wanted to do this:

1. Click on individual cells within the table, and the selected_df stores the index of the individual cell.
2. Click on the row headers of the table to select a row, or any cell in the last row to select a column, and a number of rows equal to the number of cells in the tables row/column, and the indices of all the cells in that row/column, will be added to the selected_df.

Right now, I can launch the app and it loads the table, but then crashes when I click on a cell. I'm wondering if there is some problem with how I am referencing selected_df in my function. If I take out the problematic function, then selected_df populates and reacts to changes in selection perfectly.

This is the error message that I'm getting:

Warning: Error in [[.data.frame: argument "..1" is missing, with no default

This makes me wonder if the issue is from this part of the code when I tried to refer to one of the columns in the selected_df in my problematic function. Is this not right?:

if (selected_df()[[,2]] == 0) { 

Here is my current MRE:

library(shiny)
library(glue)
library(dplyr)
library(DT)
library(shinyWidgets)
library(tibble)

####Create the matrix and organization for the 96 well plate####
plate96 <- function(id) {
  div(
    style = "position: relative; height: 500px",
    tags$style(HTML('
          
        .wells {
            transform: translateX(50%);
        }

        .wells table.dataTable tr:nth-child(9) td { /*for the row 9, need to make it not look like a row*/
            border-bottom: unset;
        }

        .wells tbody tr td:not(:first-of-type) {
            border: 1px solid black;
            height: 15px;
            width: 15px;
            padding: 15px;
            font-size: 0;
        }
    ')),
    div(
      style = "position: absolute; left: 50%; transform: translateX(-100%);",
      div(
        class = "wells",
        DTOutput(id, width = "90%", height= "100%")
      )
    )
  )
}

renderPlate96 = function(id, colors = rep("white", 108)) {
  stopifnot(is.character(colors) && length(colors) == 108)
  
  plate <- matrix(1:108, 
                  nrow = 9, 
                  ncol = 12, 
                  byrow = TRUE, 
                  dimnames = list(LETTERS[1:9], 1:12))
  
  colnames (plate) = stringr::str_pad(colnames(plate), 2, "left", "0")
  
  return(plate_return1 <-
           datatable(
             plate,
             options = list(dom = 't', ordering = F),
             selection = list(mode = 'multiple', 
                              target = "cell"),
             class = 'cell-border compact'
           ) %>%
           formatStyle(
             1:12,
             cursor = 'pointer',
             backgroundColor = styleEqual(1:108, colors, default = NULL)
           )
  )
}

ui <- fluidPage(
  tags$style(type="text/css",
             ".shiny-output-error { visibility: hidden; }",
             ".shiny-output-error:before { visibility: hidden; }"
  ),
  
  br(),
  
  plate96("plate"),
  tags$b("Wells Selected:"),
  verbatimTextOutput("plateWells_selected"),
  
  DT::dataTableOutput("selected_table"),
  
)

server <- function(input, output, session){
  
  ####Create the 96 well plate image####
  output$plate <- renderDT({
    renderPlate96()
  })
  
  output$plateWells_selected <- renderPrint({
    input$plate_cells_selected
  })
  
  ####Create a DT that stores the values of the cells selected in the plate####
  selected_df <- reactive(data.frame(rows = input$plate_cells_selected[,1],
                                     columns = input$plate_cells_selected[,2]
                                     )
                          )

  output$selected_table <- renderDataTable(
    selected_df(),
    options = list(paging = FALSE, 
                   ordering = FALSE, 
                   scrollx = FALSE,
                   searching = FALSE,
                   lengthChange = FALSE
    )
  )
  
  ####function to select entire row if the row letters are selected, or col if col 9 is selected####
  observeEvent(req(input$plate_cells_selected),
    lapply(selected_df(), {
      #For selecting all cells in a row if the letters are selected
        if (selected_df()[[,2]] == 0) { 
          lapply(seq(12), function (x) {
            new_row <- c(selected_df()[[,1]], x)
            selected_df()[nrow(selected_df())+ 1,] <- rbind(selected_df(), new_row)
          })
        }
      
      #For selecting all the cells in a column if the 9th cell is selected
        else if (selected_df()[[,1]] == 9) {
          lapply(seq(8), function (i) {
            new_col <- c(i, selected_df()[[,2]])
            selected_df()[nrow(selected_df())+ 1,] <- rbind(selected_df(), new_col)
          })
        }
    })
  )
}

shinyApp(ui = ui, server = server)