目标：我正在从事生物信息学项目。我目前正在尝试实现动态创建tabPanel的R代码（除数据输出外，它们基本上都是碳副本）。
实施：在做了一些研究后，我实施了this解决方案。它的工作方式（我创建的“复制”面板），但无法显示我需要的数据。
问题：我确定我显示数据的方式很好。问题是我无法使用相同的输出函数来显示数据here。那么让我来看看代码......
ui.R
library(shiny)
library(shinythemes)
library(dict)
library(DT)
...# Irrelevant functions removed #...
geneinfo <- read.table(file = "~/App/final_gene_info.csv",
header = TRUE,
sep = ",",
na.strings = "N/A",
as.is = c(1,2,3,4,5,6,7))
ui <- navbarPage(inverse = TRUE, "GENE PROJECT",
theme = shinytheme("cerulean"),
tabPanel("Home",
#shinythemes::themeSelector(),
fluidPage(
includeHTML("home.html")
)),
tabPanel("Gene Info",
h2('Detailed Gene Information'),
DT::dataTableOutput('table')),
tabPanel("File Viewer",
sidebarLayout(
sidebarPanel(
selectizeInput(inputId = "gene", label = "Choose a Gene", choice = genes, multiple = TRUE),
selectInput(inputId = "organism", label = "Choose an Organism", choice = orgs),
selectInput(inputId = "attribute", label = "Choose an Other", choice = attributes),
width = 2),
mainPanel(
uiOutput('change_tabs'),
width = 10))),
tabPanel("Alignment")
)
我正在使用uiOutput在服务器端动态生成标签....
server.R
server <- function (input, output, session) {
# Generate proper files from user input
fetch_files <- function(){
python <- p('LIB', 'shinylookup.py', python=TRUE)
system(sprintf('%s %s %s', python, toString(genie), input$organism), wait = TRUE)
print('Done with Python file generation.')
# Fetch a temporary file for data output
fetch_temp <- function(){
if(input$attribute != 'Features'){
if(input$attribute != 'Annotations'){
chosen <- toString(attribute_dict[[input$attribute]])
}
else{
chosen <- toString(input$sel)
extension <<- '.anno'
}
}
else{
chosen <- toString(input$sel)
extension <<- '.feat'
}
count = 0
oneline = ''
f <- paste(toString(genie), toString(input$organism), sep = '_')
f <- paste(f, extension, sep = '')
# Writes a temporary file to display output to the UI
target <- p('_DATA', f)
d <- dict_fetch(target)
temp_file <- tempfile("temp_file", p('_DATA', ''), fileext = '.txt')
write('', file=temp_file)
vectorofchar <- strsplit(toString(d[[chosen]]), '')[[1]]
for (item in vectorofchar){
count = count + 1
oneline = paste(oneline, item, sep = '')
# Only 60 characters per line (Find a better solution)
if (count == 60){
write(toString(oneline), file=temp_file, append=TRUE)
oneline = ''
count = 0
}
}
write(toString(oneline), file=temp_file, append=TRUE)
return(temp_file)
}
# Get the tabs based on the number of genes selected in the UI
fetch_tabs <- function(Tabs, OId, s = NULL){
count = 0
# Add a select input or nothing at all based on user input
if(is.null(s)==FALSE){
selection <- select(s)
x <- selectInput(inputId = 'sel', label = "Choose an Annotation:", choices = selection$keys())
}
else
x <- ''
for(gene in input$gene){
if(count==0){myTabs = character()}
count = count + 1
genie <<- gene
fetch_files()
file_tab <- lapply(sprintf('File for %s', gene), tabPanel
fluidRow(
titlePanel(sprintf("File for %s:", gene)),
column(5,
pre(textOutput(outputId = "file")),offset = 0))
)
addTabs <- c(file_tab, lapply(sprintf('%s for %s',paste('Specific', Tabs), gene), tabPanel,
fluidRow(
x,
titlePanel(sprintf("Attribute for %s:", gene)),
column(5,
pre(textOutput(outputId = OId), offset = 0)))
))
# Append additional tabs every iteration
myTabs <- c(myTabs, addTabs)
}
return(myTabs)
}
# Select the proper file and return a dictionary for selectInput
select <- function(ext, fil=FALSE){
f <- paste(toString(genie), toString(input$organism), sep = '_')
f <- paste(f, ext, sep = '')
f <- p('_DATA', f)
if(fil==FALSE){
return(dict_fetch(f))
}
else if(fil==TRUE){
return(toString(f))
}
}
# Output gene info table
output$table <- DT::renderDataTable(
geneinfo,
filter = 'top',
escape = FALSE,
options = list(autoWidth = TRUE,
options = list(pageLength = 10),
columnDefs = list(list(width = '600px', targets = c(6))))
)
observe({
x <- geneinfo[input$table_rows_all, 2]
if (is.null(x))
x <- genes
updateSelectizeInput(session, 'gene', choices = x)
})
# Output for the File tab
output$file <- renderText({
extension <<- '.gbk'
f <- select(extension, f=TRUE)
includeText(f)
})
# Output for attributes with ony one property
output$attributes <- renderText({
extension <<- '.kv'
f <- fetch_temp()
includeText(f)
})
# Output for attributes with multiple properties (features, annotations)
output$sub <- renderText({
f <- fetch_temp()
includeText(f)
})
# Input that creates tabs and selectors for more input
output$change_tabs <- renderUI({
# Fetch all the appropriate files for output
Tabs = input$attribute
if(input$attribute == 'Annotations'){
extension <<- '.anno'
OId = 'sub'
s <- extension
}
else if(input$attribute == 'Features'){
extension <<- '.feat'
OId = 'sub'
s <- extension
}
else{
OId = 'attributes'
s <- NULL
}
myTabs <- fetch_tabs(Tabs, OId, s = s)
do.call(tabsetPanel, myTabs)
})
}
)
说明：现在我知道这里有很多东西要看..但我的问题存在于输出$ change_tabs （这是最后一个函数），调用 fetch_tabs（）。获取选项卡使用 input $ gene （基因列表通过 selectizeInput（multiple = TRUE））动态创建一组由用户选择的每个基因的2个选项卡。 / p>
发生了什么：因此，如果用户选择2个基因，则会创建4个选项卡。有5个基因，10个标签被创建......依此类推......除了数据之外，每个标签都是完全相同的。
包版广告但是...对于每个标签我正在尝试使用相同的输出ID（因为它们完全相同）用于我想要显示的数据（ textOutput （outputId =“file”））。正如上面在第二个链接中所解释的那样，这根本不起作用，因为HTML。
问题：我已尝试研究多种解决方案，但我宁愿不必实施this解决方案。我不想重写这么多代码。有什么方法可以添加一个可以包装或修复我的输出$ file 函数的被动或观察者函数吗？或者有没有办法在 do.call（tabsetPanel，myTabs）之后向我的标签添加信息？我是否正确地思考这个问题？
我知道我的代码评论不好，所以我提前道歉。即使您没有解决方案，也请随意在评论中批评我的编码风格。拜托，谢谢！
答案 0 :(得分：0)
我已经提出了一个非常非常粗略的答案，现在可以使用......
以下是answer from @BigDataScientist
BigDataScientist的问题答案：
我无法动态地将数据传递到输出。输出函数在需要之前不会被解释...所以如果我想将你创建的for循环迭代器（iter）传递给动态创建的输出，那么我就无法做到这一点。它只能采用静态数据
我的解决方案：
我最终利用sys.calls（）解决方案找到了here，以便将函数的名称作为字符串。函数的名称包含我需要的信息（在这种情况下是一个数字）。
library(shiny)
library(shinythemes)
myTabs <<- list()
conv <- function(v1) {
deparse(substitute(v1))
}
ui <- navbarPage(inverse = TRUE, "GENE PROJECT",
theme = shinytheme("cerulean"),
tabPanel("Gene Info",
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 5,
value = 3)
),
# Show a plot of the generated distribution
mainPanel(
uiOutput('changeTab')
)
)
)
)
server <- function(input, output) {
observe({
b <<- input$bins
myTabs <<- list()
# Dynamically Create output functions
# Dynamically Create formatted tabs
# Dynamically Render the tabs with renderUI
for(iter in 1:b){
x <<- iter
output[[sprintf("tab%s", iter)]] <- renderText({
temp <- deparse(sys.calls()[[sys.nframe()-3]])
x <- gsub('\\D','',temp)
x <- as.numeric(x)
f <- sprintf('file%s.txt', x)
includeText(f)
})
addTabs <<- lapply(sprintf('Tab %s', iter), tabPanel,
fluidRow(
titlePanel(sprintf("Tabble %s:", iter)),
column(5,
pre(textOutput(outputId = sprintf('%s%s','tab', iter))))))
myTabs <<- c(myTabs, addTabs)
}
myTabs <<- c(myTabs, selected = sprintf('Tab %s', x))
output$changeTab <- renderUI({
do.call(tabsetPanel, myTabs)
})
})
}
# Run the application
shinyApp(ui = ui, server = server)
答案 1 :(得分：0)
我认为你是this behavior的受害者。试试：
for (el in whatever) {
local({
thisEl <- el
...
})
}
lapply已经将el作为参数，因此您可以获得此动态评估＆＃34;免费（因缺乏更好的名字）的好处。
为了便于阅读，我将在这里引用Joe的大部分回答：
你和我谈过的第二个人在R中被这种行为所困扰。这是因为for循环的所有迭代都与el共享相同的引用。因此，当任何创建的反应式表达式执行时，他们将使用el的最终值。
你可以通过1）使用lapply而不是for循环来解决这个问题。因为每次迭代都作为自己的函数调用执行，所以它获得自己对el的引用;或者2）使用for循环但在其中引入局部（{...}），并在那里创建一个局部变量，其值被分配给被动的外部的el。