Subseting a dataframe based on single cell selection of DT::datatable returns an empty table

Question

In the shiny app below I display one dataset in the table above and based on the click selection of the cell in owner column I wnat to subset the second dataframe in the datatable below but instead I get an empty table

library(shiny)
library(shinydashboard)
library(DT)
ckall<-structure(list(rowid = c(5704, 10243, 10116), PID = c("170040240", 
                                                             "170039927", "170184811"), county = c("Cheyenne", "Cheyenne", 
                                                                                                   "Cheyenne"), ownerID = c(526, 526, NA), owner = c("RONALD WILLIAM DYKMAN", 
                                                                                                                                                     "GREGORY VATH", "CHERYL L BORGES")), row.names = c(NA, 
                                                                                                                                                                                                                              -3L), class = c("tbl_df", "tbl", "data.frame"))



down<-structure(list(owner = c("GREGORY VATH","RONALD WILLIAM DYKMAN", 
                               "CHERYL L BORGES", "JOSE & BETTY MORALES JTWRS MORALES", "CFP CAPITAL LLC"
), county = c("Cheyenne", "Cheyenne", "Cheyenne", "Cheyenne", 
              "Cheyenne"), acres = c(317.8073664, 5.977516111, 148.2166994, 
                                     10.01189574, 61.81147036)), sf_column = "geometry", agr = structure(c(pid = NA_integer_, 
                                                                                                           rowid = NA_integer_, county = NA_integer_, owner_d = NA_integer_, 
                                                                                                           owner = NA_integer_, address = NA_integer_, city = NA_integer_, 
                                                                                                           state = NA_integer_, zip = NA_integer_, twp_rng = NA_integer_, 
                                                                                                           trs = NA_integer_, legal = NA_integer_, acres = NA_integer_, 
                                                                                                           lst_pdt = NA_integer_, subdivs = NA_integer_, frst_nm = NA_integer_, 
                                                                                                           last_nm = NA_integer_, prprty_ = NA_integer_, sale_dt = NA_integer_, 
                                                                                                           twp = NA_integer_, rng = NA_integer_, section = NA_integer_, 
                                                                                                           landman = NA_integer_, dt_cntc = NA_integer_, dat_nkd = NA_integer_, 
                                                                                                           titlemn = NA_integer_, dt_strt = NA_integer_, date_nd = NA_integer_
                                     ), class = "factor", levels = c("constant", "aggregate", "identity"
                                     )), row.names = c(NA, 5L), class = "data.frame")   

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    dataTableOutput("TABLE"),
    dataTableOutput("TABLE2"),
  )
)
server <- (function(input, output, session) {
  output$TABLE <- renderDataTable({
    server <- TRUE
    datatable(ckall,
              filter = "top", editable = "cell", class = "hover cell-border stripe",
              caption = "Kimball & Cheyenne Counties AOI",
              extensions = "Buttons",
              options = list(
                dom = "Bfrtip", scrollX = T,
                buttons = c("copy", "csv", "excel")
              ),
              selection = list(target = "cell",mode="single"),
    )
  })
  output$TABLE2 <- DT::renderDataTable({
    req(input$TABLE_cells_selected)
    down<-subset(down,down$owner%in%input$TABLE_cells_selected[1])
    
  })
})

shinyApp(ui, server)    

Answer 1

The issue is that input$TABLE_cells_selected[[1]] contains the row number, i.e. with owner %in% input$TABLE_cells_selected[1] you subset your data for owners with a name equal to the row number. Instead you have to use down$owner[input$TABLE_cells_selected[[1]]] which will give the name of the owner of the selected cell.

library(shiny)
library(shinydashboard)
library(DT)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    dataTableOutput("TABLE"),
    dataTableOutput("TABLE2"),
  )
)

server <- (function(input, output, session) {
  output$TABLE <- renderDataTable({
    server <- TRUE
    datatable(ckall,
      filter = "top", editable = "cell", class = "hover cell-border stripe",
      caption = "Kimball & Cheyenne Counties AOI",
      extensions = "Buttons",
      options = list(
        dom = "Bfrtip", scrollX = T,
        buttons = c("copy", "csv", "excel")
      ),
      selection = list(target = "cell", mode = "single"),
    )
  })
  output$TABLE2 <- DT::renderDataTable({
    req(input$TABLE_cells_selected)
    owner_selected <- down$owner[input$TABLE_cells_selected[[1]]]
    down <- subset(down, owner %in% owner_selected)
  })
})

shinyApp(ui, server)