Question

我正在尝试将DT：datatable中的单元格转换为可单击的按钮，该操作是在闪亮的应用程序上附加一个新标签。

我一直以这篇帖子R Shiny: Handle Action Buttons in Data Table作为参考，但在我的情况下，按钮显示如下：

我的应用有些复杂，但是我将尝试重新创建不起作用的部分

这是我的data.frame的较短版本

mut_genes <- structure(list(acc_num = c("BM0042985", "BM0393251", "BM0673028"), disease = c("Sucrase isomaltase deficiency", "Metachromatic leukodystrophy", "Fatal surfactant deficiency"), gene = c("SI", "ARSA", "ABCA3"), chrom = c("3q25.2-q26.2", "22q13.31-qter", "16p13.3"), genename = c("Sucrase-isomaltase", "arylsulfatase A", "ATP binding cassette subfamily A member 3"), gdbid = c("120377", "119007", "3770735"), omimid = c("609845", "607574", "601615"), amino = c("Leu-Pro", "Glu-Lys", "Met-Ile"), deletion = c(NA_character_, NA_character_, NA_character_), insertion = c(NA_character_, NA_character_, NA_character_), codon = c(341L, 331L, 1L), codonAff = c(341L, 331L, 1L), hgvs = c("1022T>C", "991G>A", "3G>C"), hgvsAll = c("1022TtoC | L341P", "991GtoA | E331K", "3GtoC | M1I"), dbsnp = c("rs267607049", NA, NA), chromosome = c("3", "22", "16"), startCoord = c(165060026L, 50626052L, 2326464L), endCoord = c(165060026L, 50626052L, 2326464L), inheritance = c("AR", "AR", "AR"), gnomad_AC = c(NA_integer_, NA_integer_, NA_integer_), gnomad_AF = c(NA_real_, NA_real_, NA_real_), gnomad_AN = c(NA_integer_, NA_integer_, NA_integer_), mutype = c("missense", "missense", "initiation"), pmid = c("10903344", "12809637", "16641205"), pmidAll = c(NA, NA, "24871971"), base = c("M", "M", "M"), clinvarID = c("1413", NA, NA), clinvar_clnsig = c("Pathogenic", NA, NA), gene_id = c("2073", "190", "10")), row.names = c(NA, -3L), class = c("tbl_df", "tbl", "data.frame"))


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

sidebar <- dashboardSidebar(
selectInput("search", label = "Search Options:", 
            choices = c("General", "Gene", "Mutation", "Reference", "Phenotype"), selected = "Gene"),
sidebarMenu(id="siderbarmenu", sidebarMenuOutput("menu"))
)

header <- dashboardHeader()

body <- dashboardBody(
 tags$style(type="text/css",
  ".shiny-output-error { visibility: hidden; }",
  ".shiny-output-error:before { visibility: hidden; }",
  ".shiny-output-error:after { visibility: hidden; }"),


#ui
shinyjs::useShinyjs(),
tabItems(
 tabItem("search_general", h1("A was done")),
 tabItem(
  tabName = "search_exact_gene",
  tabsetPanel(
    id = "tabs",
    tabPanel(
    title = "Main Dashboard",
    value = "gene1",
      fluidRow(
        column(12,dataTableOutput("tablafilt_paste_genes"))

        )
      )
    )
   )
  )
 )

ui <- dashboardPage(header, sidebar, body)

这是服务器部分

server <- function(input, output, session) {


output$menu <- renderMenu({

  my_general = list(
    menuItem("Búsqueda general", tabName="search_general"),
      conditionalPanel("input.siderbarmenu == 'search_general'",
      textInput(inputId = "search_terms", label = "Search terms"),
      selectInput("search_fields", label="Search choices",  choices=c("All Fields", "Gene symbol", 
        "Gene description", "Chromosomal location", "HGNC/OMIM/GDB/Entrez ID", "RefSeq transcript", 
        "Disease/phenotype", "Gene Ontology"), selected = "Gene symbol"),
      actionButton("submit", "Submit query")
    )
  )

   my_gene = list(
    menuItem("Búsqueda por gene", tabName="search_exact_gene"),
      textInput(inputId = "search_exact_symbol", label = "Exact gene symbol only"),
      actionButton("submit3", "Submit query")
  )


 if(input$search=="General"){
  menu = my_general
 } else if (input$search=="Gene"){
  menu = my_gene
 } 

 sidebarMenu(menu)

 })

 filtrado <- reactive({
  dataset <- input$submit3
   glist <- isolate(input$search_exact_symbol)

   datos <- filter(mut_genes, gene %in% glist) 

  shinyInput <- function(FUN, len, id, ...) {
  inputs <- character(len)
  for (i in seq_len(len)) {
    inputs[i] <- as.character(FUN(paste0(id, i), ...))
   }
   inputs
  }

  datos <- mutate(datos, Mutacion=shinyInput(
   FUN = actionButton,
   len = nrow(datos),
   id = 'button_',
   label = "Mutacion",
   onclick = 'Shiny.onInputChange(\"select_button\",  this.id)')
   )

   return(datos)

  })

output$tablafilt_paste_genes <- DT::renderDataTable({
if(is.null(filtrado()))
  return()
datos <- filtrado()

DT::datatable(datos, escape = FALSE,
  rownames = FALSE,
  style = 'bootstrap', 
  class = 'compact cell-border stripe hover', 
  filter = list(position = 'top', clear = FALSE), 
  extensions = c('Buttons', "FixedHeader", "Scroller"),
  options = list(
    stateSave = FALSE,
    ordering = FALSE,
    autoWidth = TRUE,
    search = list(regex = TRUE, caseInsensitive = TRUE),
    columnDefs = list(
      list(
        className = 'dt-center',
        targets = 1:ncol(datos)-1L,
        render = JS("function(data, type, row, meta) {",
                    "return type === 'display' && typeof data === 'string' && data.length > 10 ?",
                    "'<span title=\"' + data + '\">' + data.substr(0,  10) + '...</span>' : data;",
                    "}") 
        )

     ),
    initComplete = JS(
      "function(settings, json) {",
      "$(this.api().table().header()).css({'font-size': '12px'});",
      "}"),
    sDom = '<"top">Brtp<"bottom">i', # remove search general box and  keep the top filters
    scrollX = TRUE,
    deferRender=TRUE,
    buttons = list('colvis'),                  
    FixedHeader = TRUE,
    pageLength = 25,
    lengthMenu = list(c(25, 50, 100, -1), list('25', '50', '100', 'All'))
   ), 
   callback = JS('table.page(3).draw(false); "setTimeout(function() { table.draw(true); }, 300);"')) %>% 
formatStyle(columns = colnames(.$x$data), `font-size` = "15px") 
   })
 }

 runApp(shinyApp(ui, server))

我的理想情况是重新创建acc_num列，使其成为可点击的按钮，但是当我尝试使用

时

   shinyInput <- function(FUN, len, id, label,...) {
  inputs <- character(len)
  for (i in seq_len(len)) {
    label <- datos$acc_num[i]
    inputs[i] <- as.character(FUN(paste0(id, i), label=label, ...))
  }
  inputs
}

发生相同的情况，即使将数据表选项<button id =>设置为escape，我仍然看到false

Answer 1

那是因为引号。您的render函数会生成<span title="<button id = "xxx" ......，这会导致问题。

您不想将span应用于按钮，因此在以下条件下添加正则表达式测试!(/button/).test(data)：

render = JS("function(data, type, row, meta) {",
            "return type === 'display' && typeof data === 'string' && data.length > 10 && !(/button/).test(data) ? ",
            "'<span title=\"' + data + '\">' + data.substr(0,  10) + '...</span>' : data;",
            "}")

里面的按钮。 DT :: datatable无法正确呈现

1 个答案: