闪亮 DT::renderDT() 多个表
shiny DT::renderDT() multiple tables
我无法让 renderDT() 显示我的脚本创建的多个数据 table。下面的代码。读取输入 table 有效，进度指示器逐行显示，但显示的 hg38 和 hg19 选项卡为空。
如果我将 hg38 renderDT() 移到 my_data <- reactive( 内，它将显示 hg38 table，但我收到以下错误并且 hg19 选项卡中没有任何内容
```Warning: Error in $: object of type 'closure' is not subsettable```
```105: <Anonymous>```
如果我将 renderDT() 都移到 my_data <- reactive( 中，我在这两个选项卡中什么也得不到。我显然误解了什么，但我不确定是什么。
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)
以后请考虑发帖 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)
我无法让 renderDT() 显示我的脚本创建的多个数据 table。下面的代码。读取输入 table 有效，进度指示器逐行显示，但显示的 hg38 和 hg19 选项卡为空。
如果我将 hg38 renderDT() 移到 my_data <- reactive( 内，它将显示 hg38 table，但我收到以下错误并且 hg19 选项卡中没有任何内容
```Warning: Error in $: object of type 'closure' is not subsettable```
```105: <Anonymous>```
如果我将 renderDT() 都移到 my_data <- reactive( 中，我在这两个选项卡中什么也得不到。我显然误解了什么，但我不确定是什么。
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)
以后请考虑发帖 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)