R-Shiny應用程序的動態選項卡使用相同的輸出功能

Question

目標：我正在從事生物信息學項目。 我目前正在嘗試實現可動態創建tabPanels的R代碼（除數據輸出外，它們實質上是復本）。

實施：經過研究后，我實施了該解決方案。 它以某種方式工作（創建了我正在“抄寫”的面板），但是無法顯示我需要的數據。

問題：我確定顯示數據的方式很好。 問題是，我不能使用相同的輸出功能看到顯示的數據在這里 。 所以讓我來看看代碼...

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)
  })
}
)

說明：現在我知道這里有很多需要注意的地方。但是我的問題存在於output $ change_tabs （這是最后一個函數）中，該函數調用fetch_tabs（） 。 提取選項卡使用input $ gene （通過selectizeInput（multiple = TRUE）列出的基因）來動態創建用戶選擇的每個基因2個選項卡的集合。

發生了什么：因此，如果用戶選擇2個基因，則會創建4個標簽。 利用5個基因，創建了10個標簽...依此類推，等等...除了數據之外，每個標簽都是一樣的。

障礙：但是...對於每個選項卡，我都試圖為我要顯示的數據使用相同的輸出ID（因為它們完全相同）（ textOutput（outputId =“ file”） ）。 如上面在第二個鏈接中所述，這根本就行不通，因為HTML。

問題：我曾嘗試研究幾種解決方案，但我寧願不必實施此解決方案。 我不想重寫太多的代碼。 有什么辦法可以添加可包裝或修復我的output $ file函數的反應或觀察器函數？ 還是有一種方法可以在do.call（tabsetPanel，myTabs）之后向我的標簽添加信息？ 我在考慮正確的方法嗎？

我知道我的代碼注釋不佳，所以我事先表示歉意。 即使您沒有解決方案，也請隨時在評論中批評我的編碼風格。 謝謝，麻煩您了！

Answer 1

我已經提出了一個非常非常粗略的答案，該答案現在可以使用...

這是@BigDataScientist的答案

我的BigDataScientist問題解答：

我無法將數據動態傳遞到輸出。 在需要輸出函數之前，它們不會被解釋...因此，如果我想將您創建的for循環迭代器（iter）傳遞到動態創建的輸出中，那么我將無法做到這一點。 它只能獲取靜態數據

我的解決方案：
最后，我利用了在這里找到的sys.calls（）解決方案，以便以字符串形式獲取函數的名稱。 函數的名稱包含我需要的信息（在這種情況下為數字）。

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)

Answer 2

我認為您是這種行為的受害者。 嘗試：

for (el in whatever) {
  local({
    thisEl <- el
    ...
 })
} 

就像喬在我鏈接到的Github問題的第一個回復中所建議的那樣。 僅在使用for循環時才需要。 lapply已經將el作為參數，因此您可以免費獲得此“動態評估”好處（由於缺少更好的名稱）。

為了提高可讀性，我將在此處引用Joe的大部分答案：

您是在useR上與我交談過的第二個人，這是R中的這種行為所困擾。這是因為for循環的所有迭代都共享對el的相同引用。 因此，當執行任何創建的反應式表達式時，它們都會使用el的最終值。

您可以通過以下方法解決此問題：1）使用lapply而不是for循環； 由於每個迭代都作為其自己的函數調用執行，因此它獲得對el的引用。 或2）使用for循環，但在其中引入local（{...}），並在其中創建一個局部變量，其值分配給React之外的el。