闪亮的DT :: renderdt（）多表格

Question

我无法让renderdt（）显示我脚本创建的多个数据表。下面的代码。读取输入表有效，进度指示器通过每行进行进展，但是HG38和HG19选项卡在显示屏中是空的。 如果我将hg38 renderdt（）移至my_data＆lt; - eactive（它将显示HG38表，但我会在HG19选项卡中获得以下错误，但没有任何内容

      ```Warning: Error in $: object of type 'closure' is not subsettable```

        ```105: <Anonymous>```

如果我在my_data＆lt; - eactive（我什么都没有得到的renderdt（） 。

library(shiny)
library(DT)
library("dplyr")
library(GenomeInfoDb)
library(BSgenome)
library("MafDb.gnomAD.r2.1.hs37d5")
library("MafH5.gnomAD.v3.1.2.GRCh38")
library(BSgenome.Hsapiens.UCSC.hg19)
library(BSgenome.Hsapiens.UCSC.hg38)
mafdb_hg19 <- MafDb.gnomAD.r2.1.hs37d5
mafdb_hg38 <- MafH5.gnomAD.v3.1.2.GRCh38
hg19 <- BSgenome.Hsapiens.UCSC.hg19
hg38 <- BSgenome.Hsapiens.UCSC.hg38

ui <- fluidPage(
    sidebarLayout(
        sidebarPanel(
            fileInput("file1", "Choose CSV File", accept = ".csv"),
            #checkboxInput("header", "Header", TRUE),
            width = 2
        ),
        mainPanel(
            tabsetPanel(
                tabPanel("Primers(input)", DT::dataTableOutput("primers")),
                tabPanel("SNPs(hg38)", DT::dataTableOutput("hg38")),
                tabPanel("SNPs(hg19)", DT::dataTableOutput("hg19"))
            )
        )
    )
)




server <- function(input, output){
  
  
  primer_file <- reactive(
  {
    file <- input$file1
    ext <- tools::file_ext(file$datapath)
    req(file)
    validate(need(ext == "csv", "Please upload a csv file"))
    primer_file <- as.data.frame(read.csv(file$datapath, header = TRUE))
    return(primer_file)
  })
  output$primers <- DT::renderDT(primer_file())
  
  my_data <- reactive(
  {
     primers_hg38 <- data.frame(primer_id=character(),
                                        seq=character(),
                                        chr=character(),
                                        hg38_pos=integer(),
                                        AF_allpopmax_hg38=integer(),
                                        stringsAsFactors=FALSE)
  
     primers_hg19 <- data.frame(primer_id=character(),
                                        seq=character(),
                                        chr=character(),
                                        hg19_pos=integer(),
                                        AF_afr=integer(),AF_amr=integer(), AF_asj=integer(), AF_eas=integer(), AF_fin=integer(), AF_nfe=integer(), AF_oth=integer(),
                                        stringsAsFactors=FALSE)
             
    progress <- shiny::Progress$new()
       # Make sure it closes when we exit this reactive, even if there's an error
    on.exit(progress$close())
    progress$set(message = "Calculating", value = 0)
               
    lastrow <- nrow(primer_file())
    firstrow=1
    for (no in (firstrow:lastrow))
    {
       row = primer_file()[no,]
       temp_chr <- row$chr
       temp_FP <- row$FP
       temp_RP <- row$RP
       
       progress$inc(1/lastrow, detail = paste("line ", no))
         
         ###################lets do hg38 first######################
         
         subject_hg38 <- hg38[[temp_chr]]
         products_hg38 <- matchProbePair(temp_FP,temp_RP,subject_hg38)
         amp_start_hg38 = (start(products_hg38))
         fp_end_hg38 = (start(products_hg38) + as.integer(nchar(row$FP)) - 1)
         rp_start_hg38 = ( (start(products_hg38) + width(products_hg38)) - as.integer(nchar(row$RP)) )
         amp_end_hg38 = (start(products_hg38) + width(products_hg38) - 1)
         
         fp_range_hg38 <- GRanges(seqnames=temp_chr, IRanges(start=amp_start_hg38:fp_end_hg38, width=1))
         fp_scores_hg38 <- gscores(mafdb_hg38,fp_range_hg38,pop="AF_allpopmax")
         fp_scores_hg38 <- as.data.frame(fp_scores_hg38)
         
         rp_range_hg38 <- GRanges(seqnames=temp_chr, IRanges(start=rp_start_hg38:amp_end_hg38, width=1))
         rp_scores_hg38 <- gscores(mafdb_hg38,rp_range_hg38,pop="AF_allpopmax")
         rp_scores_hg38 <- as.data.frame(rp_scores_hg38)
         
         #primers_hg38 <- data.frame(primer_id=character(),
         #          seq=character(),
         #          chr=character(),
         #          hg38_pos=integer(),
         #          AF_allpopmax_hg38=integer(),
         #          stringsAsFactors=FALSE)
         primers_hg38 <- bind_rows(primers_hg38,setNames(data.frame(primer_id <- paste0(row$ID,"_F"),
                                                                    seq <- temp_FP,
                                                                    chr <- fp_scores_hg38$seqnames,
                                                                    hg38_pos <- fp_scores_hg38$start,
                                                                    AF_allpopmax_hg38 <- fp_scores_hg38$AF_allpopmax, stringsAsFactors=FALSE),c("primer_id", "seq", "chr","hg38_pos","AF_allpopmax_hg38")))
         #names(primers_hg38) <- c("primer_id","seq","chr","hg38_pos","AF_allpopmax_hg38")
         primers_hg38 <- bind_rows(primers_hg38,setNames(data.frame(primer_id <- paste0(row$ID,"_R"),
                                                                    seq <- temp_RP,
                                                                    chr <- rp_scores_hg38$seqnames,
                                                                    hg38_pos <- rp_scores_hg38$start,
                                                                    AF_allpopmax_hg38 <- rp_scores_hg38$AF_allpopmax,stringsAsFactors=FALSE),c("primer_id", "seq", "chr","hg38_pos","AF_allpopmax_hg38")))
        
         
         ##########################now hg19######################################
         
          #names(primers_hg38) <- c("primer_id","seq","chr","hg38_pos","AF_allpopmax_hg38")
         subject_hg19 <- hg19[[temp_chr]]
         products_hg19 <- matchProbePair(temp_FP,temp_RP,subject_hg19)
         amp_start_hg19 = start(products_hg19)
         fp_end_hg19 = ( start(products_hg19) + as.integer(nchar(row$FP)) - 1)
         rp_start_hg19 = ( (start(products_hg19) + width(products_hg19)) - as.integer(nchar(row$RP)) )
         amp_end_hg19 = (start(products_hg19) + width(products_hg19) - 1)
         
         
         fp_range_hg19 <- GRanges(seqnames=temp_chr, IRanges(start=amp_start_hg19:fp_end_hg19, width=1))
         fp_scores_hg19 <- gscores(mafdb_hg19,fp_range_hg19,pop=c("AF_afr","AF_amr","AF_asj","AF_eas","AF_fin","AF_nfe","AF_oth"))
         fp_scores_hg19 <- as.data.frame(fp_scores_hg19)
         
         rp_range_hg19 <- GRanges(seqnames=temp_chr, IRanges(start=rp_start_hg19:amp_end_hg19, width=1))
         rp_scores_hg19 <- gscores(mafdb_hg19,rp_range_hg19,pop=c("AF_afr","AF_amr","AF_asj","AF_eas","AF_fin","AF_nfe","AF_oth"))
         rp_scores_hg19 <- as.data.frame(rp_scores_hg19)
         
         primers_hg19 <- bind_rows(primers_hg19,setNames(data.frame(primer_id <- paste0(row$ID,"_F"),
                                                                    seq <- temp_FP,
                                                                    chr <- fp_scores_hg19$seqnames,
                                                                    hg19_pos <- fp_scores_hg19$start,
                                                                    AF_afr <- fp_scores_hg19$AF_afr,
                                                                    AF_amr <- fp_scores_hg19$AF_amr,
                                                                    AF_asj <- fp_scores_hg19$AF_asj,
                                                                    AF_eas <- fp_scores_hg19$AF_eas,
                                                                    AF_fin <- fp_scores_hg19$AF_fin,
                                                                    AF_nfe<- fp_scores_hg19$AF_nfe,
                                                                    AF_oth<- fp_scores_hg19$AF_oth,
                                                                    stringsAsFactors=FALSE),
                                                         c("primer_id", "seq", "chr","hg19_pos","AF_afr","AF_amr","AF_asj","AF_eas","AF_fin","AF_nfe","AF_oth")))
         primers_hg19 <- bind_rows(primers_hg19,setNames(data.frame(primer_id <- paste0(row$ID,"_R"),
                                                                    seq <- temp_RP,
                                                                    chr <- rp_scores_hg19$seqnames,
                                                                    hg19_pos <- rp_scores_hg19$start,
                                                                    AF_afr <- rp_scores_hg19$AF_afr,
                                                                    AF_amr <- rp_scores_hg19$AF_amr,
                                                                    AF_asj <- rp_scores_hg19$AF_asj,
                                                                    AF_eas <- rp_scores_hg19$AF_eas,
                                                                    AF_fin <- rp_scores_hg19$AF_fin,
                                                                    AF_nfe<- rp_scores_hg19$AF_nfe,
                                                                    AF_oth<- rp_scores_hg19$AF_oth,
                                                                    stringsAsFactors=FALSE),
                                                         c("primer_id", "seq", "chr","hg19_pos","AF_afr","AF_amr","AF_asj","AF_eas","AF_fin","AF_nfe","AF_oth")))
         
         
     }    
    return(list(as.data.frame(primers_hg38), as.data.frame(primers_hg19)))
  })
     output$hg38 <- DT::renderDT(my_data()$primers_hg38)
     #,  options = list(paging = F, info = F, search = list(), 
    #                                                         dom = "Brtip", fixedColumns = T, fixedHeader = T,
     #                                                        buttons = c("copy", "excel")),
      #                                     fillContainer = TRUE)
     
     output$hg19 <- DT::renderDT(my_data()$primers_hg19,  options = list(paging = F, info = F, search = list(), 
                                                             dom = "Brtip", fixedColumns = T, fixedHeader = T,
                                                             buttons = c("copy", "excel")),
                                         fillContainer = TRUE)


   
   
   

}

shinyApp(ui, server)

Answer 1

请考虑发布 mre 将来。如果您以my_data（）[[1]]访问数据，则应起作用。但是，如果定义命名列表，则您的方法有效。看看下面的MRE。

library(DT)
ui <- fluidPage(
  DTOutput("t1"), DTOutput("t2")
)

server <- function(input, output) {
  myd <- reactive(list(iris,mtcars))
  myd2 <- reactive(list(ab=rock,cd=pressure))
  
  output$t1 <- renderDT(head(myd()[[2]]))      ### works
  # output$t1 <- renderDT(myd()$mtcars)  ### does not work
  
  output$t2 <- renderDT(head(myd2()$ab))  ### works as a named list
}
shinyApp(ui = ui, server = server)