带有R-Shiny app的动态标签使用相同的输出函数

时间:2017-02-10 19:49:10

标签: r tabs shiny

目标:我正在从事生物信息学项目。我目前正在尝试实现动态创建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)之后向我的标签添加信息?我是否正确地思考这个问题?

我知道我的代码评论不好,所以我提前道歉。即使您没有解决方案,也请随意在评论中批评我的编码风格。拜托,谢谢!

2 个答案:

答案 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
    ...
 })
} 
像Joe在第一次回复我链接的Github问题时建议的那样。只有在您使用for循环时才需要这样做。 lapply已经将el作为参数,因此您可以获得此动态评估&#34;免费(因缺乏更好的名字)的好处。

为了便于阅读,我将在这里引用Joe的大部分回答:

  

你和我谈过的第二个人在R中被这种行为所困扰。这是因为for循环的所有迭代都与el共享相同的引用。因此,当任何创建的反应式表达式执行时,他们将使用el的最终值。

     

你可以通过1)使用lapply而不是for循环来解决这个问题。因为每次迭代都作为自己的函数调用执行,所以它获得自己对el的引用;或者2)使用for循环但在其中引入局部({...}),并在那里创建一个局部变量,其值被分配给被动的外部的el。