Subsetting a reactive dataframe in R shiny based on TRUE/FALSE values in one column

I have an editable and scalable data.frame called Dat(), in which users can input text and checkboxes. What I would like is to have any rows in Dat() with marked checkboxes in the Habituation column to be subsetted into another data.frame called habit_Dat(). Then, only certain of those columns are selected for habit_Dat(). The second data.frame exists but is empty, even after checking the Habituation checkbox in any of the rows.

One catch to this situation is the way in which the status of the checkboxes is referred to. Since one feature of this app is to dynamically increase the number of rows in Dat() using a numericInput, the checkboxes had to be added in a more complicated way than usual in Shiny. Therefore, to reference whether the checkboxes are marked, I reference the data.frame Dat() itself, since it gives a logical value.

I'm unsure what I am doing wrong because it seems like what I am trying has been suggested by others on SO. Nonetheless, I'm obviously doing something wrong. Does anyone have ideas that might be helpful?

Thank you!

library(shiny)
library(tidyverse)
library(DT)

#This adds checkboxes for every row, as many rows are in the dataframe
checkboxColumn <- function(len, col, ...) { # `col` is the column index
  inputs <- character(len)
  for(i in seq_len(len)) {
    inputs[i] <- as.character(
      checkboxInput(paste0("checkb_", col, "_", i), label = NULL, ...)
    )
  }
  inputs
}

#This is where the magic for the checkboxes is done
js <- function(dtid, cols, ns = identity) {
  code <- vector("list", length(cols))
  for(i in seq_along(cols)) {
    col <- cols[i]
    code[[i]] <- c(
      sprintf(
        "$('body').on('click', '[id^=checkb_%d_]', function() {",
        col),
      "  var id = this.getAttribute('id');",
      sprintf(
        "  var i = parseInt(/checkb_%d_(\\d+)/.exec(id)[1]);",
        col),
      "  var value = $(this).prop('checked');",
      sprintf(
        "  var info = [{row: i, col: %d, value: value}];",
        col),
      sprintf(
        "  Shiny.setInputValue('%s', info);",
        ns(sprintf("%s_cell_edit:DT.cellInfo", dtid))
      ),
      "});"
    )
  }
  do.call(c, code)
}

ui <- fluidPage(
  
  
  numericInput("num_exps", 
               label = "Enter the number of experimental phases:",
               min = 1,
               max = 96,
               value = 1),
  
  DT::dataTableOutput('phasesTable'),
  
  br(),
  br(),
  
  verbatimTextOutput("reactive_verbatim"),
  br(),
  DT::dataTableOutput('habit_table'),
  br(),
  verbatimTextOutput("habit_verbatim"),
  
  
  
)


server <- function(input, output, session) {
  
  ##### Number output for number of conditions #####
  output$value <- renderPrint({ input$num_exps })
  
  #Putting each phase and its duration into a data frame
  phases_df <- reactive({data.frame(
    'Phase Number' = sapply(1: as.integer(input$num_exps), function(i) { i }),
    'Phase Comparison Groups' = 0,
    'Phase Name' = "",
    Duration = 0
  )
  })
  
  #calculating the start and end times for each phase, and adding them to phases_df as timings
  timings <- reactive({
    req(phases_df()) %>% 
      mutate(Duration = 0) %>%
      mutate(End = cumsum(Duration)) %>%
      mutate(Start = End - Duration) %>%
      relocate(Start, .before = End)
  })
  
  #This adds the columns into which the checkboxes will be added
  dat1 <- reactive({
    cbind(timings(), 
          'Linear Regression' = FALSE, 
          'Habituation' = FALSE, 
          'Freezing Index' = FALSE)
  })
  
  #This uses the checkboxColumn function to add check boxes to the declared
  #columns 
  dat2 <- reactive({cbind(
    timings(),
    'Linear Regression' = checkboxColumn(nrow(phases_df()), 7),
    'Habituation' = checkboxColumn(nrow(phases_df()), 8),
    'Freezing Index' = checkboxColumn(nrow(phases_df()), 9)
  )})
  
  # Convert dat1 reactive to data frame and set to a reactiveVal
  Dat = reactiveVal()
  
  observe({
    d = dat1()
    d = as.data.frame(d)
    Dat(d)
  })
  
  checkboxesColumns_list <- c(0, 1, 5:9)
  
  output[["phasesTable"]] <- renderDT({
    datatable(
      dat2(), 
      escape = FALSE,
      editable = list(
        target = "cell", disable = list(columns = checkboxesColumns_list)
      ),
      options = list(paging = FALSE,
                     ordering = FALSE,
                     scrollx = FALSE,
                     searching = FALSE,
                     stringsAsFactors = FALSE,
                     info = FALSE,
                     columnDefs = list(list(width = '200px', targets = "_all"))),
      selection = "none",
      callback = JS(js("phasesTable", checkboxesColumns_list))
    )
  }, server = FALSE)
  
  observeEvent(input[["phasesTable_cell_edit"]], { 
    info <- input[["phasesTable_cell_edit"]] 
    
    Dat(editData(Dat(), info))
  })
  
  output[["reactive_verbatim"]] <- renderPrint({ 
    str(Dat())
  })
  
  #This creates a subset of the phase data.frame for only the phases that
  #habituation were selected for
  habit_Dat <- reactive({
    req(Dat()) %>%
      subset('Habituation' == TRUE) %>%
      select(c(1:6))
  })
  
  output[['habit_table']] <- renderDT({
    datatable(
      habit_Dat(),
      #escape = FALSE,
      editable = list(
        target = 'cell', disable = list(columns = '0, 1, 5, 6')),
      options = list(paging = FALSE,
                     ordering = FALSE,
                     scrollx = FALSE,
                     searching = FALSE,
                     stringsAsFactors = FALSE,
                     info = FALSE,
                     columnDefs = list(list(width = '200px', targets = "_all"))),
      selection = 'none')
  })
  
  output[["habit_verbatim"]] <- renderPrint({ 
    str(habit_Dat())
  })
  
}
shinyApp(ui, server)

The main issue is you're passing in a string not the actual variable name in subset. So the logical expression, "Habituation" == TRUE will always return FALSE thus returning an empty table. To correct it, just remove the quotes.

With that said, I'd recommend using filter instead of subset. If you're trying to be more dplyr-centric.

  habit_Dat <- reactive({
req(Dat()) %>%
subset(Habituation == TRUE) %>%
select(1:6)
})