R shiny - настраиваемый контейнер таблицы для отображения текста заголовка столбца при наведении курсора мыши не работает

Question

Я разрабатываю блестящее приложение R, которое отображает подмножество таблицы данных (dataframe_2) на основе выбранных пользователем строк в другой таблице данных (dataframe_1). Я пытаюсь добавить текст при наведении курсора мыши для заголовков столбцов отфильтрованной таблицы данных (dataframe_2), используя подход «Пользовательский контейнер таблицы». Я сослался на блестящий текст R при наведении курсора мыши для столбцов таблицы и другие подобные сообщения, а также на документацию (https://rstudio.github.io/DT/) по этому поводу. Проблема в том, что когда я запускаю код, отфильтрованные данные вообще не отображаются. Ошибок нет, но появляется сообщение: «Нет совпадающих записей» (это не так, поскольку в остальном приложение работает нормально). Я раньше не использовал контейнеры и был бы признателен за любую помощь, чтобы заставить это работать (или если бы кто-нибудь мог предложить лучший способ сделать это). Вот короткая воспроизводимая версия кода для моего приложения:

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

    #dataframe_1 is the table displayed in tab1 of the app
    dataframe_1 <- data.frame(
      "key"=c("ABC_24e:id1","DEF_xe5:id2","GHI_ge2:id3","JKL_58d:id4","MNO_m24:id5"),
      "ID"=c("id1","id2","id3","id4","id5"),
      "owner_id"=c("yz1","yz1","xz3","xz3","zx2"),
      "sample_code"=c("D2","A1","A4","B5","B7"),
      "replicates"=c("N/A","N/A","N/A","N/A","N/A"),
      "QC"=c("pass","pass","pass","fail","pass"),
      "short_key"=c("ABC_24e","DEF_xe5","GHI_ge2","JKL_58d","MNO_m24")
    )
    #a subset of dataframe_2 is displayed in tab2 of the app based on user selected rows of dataframe_1 (in tab1).
    dataframe_2 <- data.frame(
      "target"=c("A1BG","A1CF","A2M","AAACS"),
      "drug1aaa:ABC_24e:id1"=c(0.5,1.5,-2.1,-4),
      "drug2aaa:DEF_xe5:id2"=c(-0.6,1.6,3.5,1),
      "drug3aaa:GHI_ge2:id3"=c(-0.7,1.1,2.3,-3.4),
      "noneaaa:ABC_24e:id4"=c(2,-1.8,0.7,1)
    )
    #code for UI
    ui <- fluidPage(
      sidebarLayout(
        sidebarPanel(
          conditionalPanel(
            'input.dataset == "dataframe_1',
            checkboxGroupInput("show_vars", "select columns to show:",
                       names(dataframe_1), selected = names(dataframe_1))
          )
        ),
        mainPanel(
          tabsetPanel(
            id = "mydata",
            tabPanel("lookup table",DT::dataTableOutput("dataframe_1_tbl")),
            tabPanel("scores",DT::dataTableOutput("dataframe_2_tbl"))
          )
        )
      )
    )

    # code for server logic
    server <- function(input, output) {

      #display lookup table
      output$dataframe_1_tbl  <- DT::renderDataTable({
        DT::datatable(dataframe_1[, input$show_vars,drop=FALSE])
      })

      #display dataframe_2 filtered on dataframe_1 row selection
      output$dataframe_2_tbl <- DT::renderDataTable({
        columnLabels <- NULL
        sel <- input$dataframe_1_tbl_rows_all
        dataframe_1_subset <- dataframe_1[sel,c("key","ID","owner_id","sample_code","replicates","QC")]
        columns_to_show <- dataframe_1[sel,"short_key"]
        columns_to_show <- as.character(columns_to_show)

        #generate labels/text for column headings
        filtered_dataframe_2 <- select(dataframe_2,contains(c("target",columns_to_show)))
        columns_to_label <- colnames(filtered_dataframe_2)
        drug_columns <- columns_to_label[!grepl(c("^target"), columns_to_label)]
        j=NULL
        for(j in 1:ncol(filtered_dataframe_2)){
          if(colnames(filtered_dataframe_2)[j] == "target"){
            col_label = "Gene symbol"
           } 
          if(str_contains(colnames(filtered_dataframe_2)[j], drug_columns, logic = "or")){
            short_drug_col <- sub(".*:","",colnames(filtered_dataframe_2)[j])
            df_1_row <- which(dataframe_1$arm_ID == short_drug_col)
            col_label = paste0("sample code - ",dataframe_1$sample_code[df_1_row],"; replicates - ",dataframe_1$replicates[df_1_row],"; QC - ",dataframe_1$QC[df_1_row],"; Owner ID - ",dataframe_1$owner_id[df_1_row])
          }
          columnLabels <- rbind(columnLabels,col_label)
          columnLabels <- as.vector(columnLabels)
        }
        rownames(columnLabels) <- NULL

        sketch = htmltools::withTags(table(
          class = 'display',
          thead(
            tr(apply(data.frame(colnames=columns_to_label, labels=columnLabels), 1,
                     function(x) th(title="column info:")))
          )
        ))
        DT::datatable(dataframe_2[,columns_to_label], container=sketch)
      })
    }
    shinyApp(ui, server)