2017-02-10 6 views
0

ゴール:私はバイオインフォマティクスプロジェクトに取り組んでいます。私は現在、tabPanelsを動的に作成するRコードを実装しようとしています(データ出力以外は本質的にカーボンコピーです)。同じ出力機能を使用するR-Shinyアプリのダイナミックタブ

実装:いくつかの調査を行った後、thisソリューションを実装しました。それは(私は "カーボンコピー"が作成されているパネル)の方法で動作しますが、私が必要とするデータを表示することはできません。

問題:私は自分のデータを表示する方法は問題ないと確信しています。問題は、同じ出力機能を使用して、hereと表示されているデータを表示できないことです。だから私は、サーバー側で動的にタブを生成するuiOutputを使用しています....

サーバー

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

ui.R

...私はコードを取得してみましょう。 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) 
    }) 
} 
) 

説明:今、私はthaの承知していますしかし、私の問題はの出力$ change_tabs(最後の機能です)にあります。fetch_tabs()を呼び出しています。フェッチタブは入力$遺伝子(遺伝子番号selectizeInput(multiple = TRUE))を使用して、ユーザーが選択した遺伝子ごとに2つのタブのセットを動的に作成します。

何が起こっているのですか:したがって、ユーザーが2つの遺伝子を選択すると、4つのタブが作成されます。 5つの遺伝子で10個のタブが作成されています...等々...各タブはデータを除いて全く同じです。

道路障害物:各タブのしかし...私は表示するデータのために(彼らはまったく同じなので)同じ出力IDを使用しようとしている(textOutput(outputId =「ファイル」 ))。上の2番目のリンクで説明したように、これはHTMLのため動作しません。

質問:私はいくつかのソリューションの調査を試みましたが、むしろthisソリューションを実装する必要はありません。あまりにも多くのコードを書き直す必要はありません。 出力$ファイルの機能をラップまたは修正できるリアクティブまたはオブザーバ機能を追加する方法はありますか?または、do.call(tabsetPanel、myTabs)の後に、自分のタブに情報を追加する方法がありますか?私はこれについて正しい考え方をしていますか?

私のコードにはコメントがありませんので、事前にお詫び申し上げます。あなたが解決策を持っていなくても、私のコーディングスタイルをコメントで批評してください。お願いしてありがとう!

答えて

0

私は非常にお答えしましたVERY今のところうまくいくでしょう...私は動的に出力にデータを渡すことはできません

:ここ

はBigDataScientistの回答とanswer from @BigDataScientist

私の問題です。出力関数は必要になるまで解釈されません。したがって、作成したforループ反復子(iter)を動的に作成された出力に渡したい場合、それを行うことはできません。これは、静的なデータのみを取ることができ

マイソリューション:
私は()ソリューション私は、文字列としての機能の名前を取得するためにhereを見つけ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) 
0

私はあなたの犠牲者はthis behaviorだと思います。試してみてください:

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

ジョーのように私がリンクしているGithubの問題への最初の返信で示唆しています。これは、forループを使用している場合にのみ必要です。 lapplyはすでにelを引数にとりますので、この「動的評価」の利点(より良い名前がないため)は無料です。読みやすさのために

、私はここでジョーの答えのほとんどを引用するつもりです:

あなたは、私がそれに話をしたユーザーの二人はR.でこの動作にかまれたなら、すべてのためですforループの反復はelと同じ参照を共有します。したがって、作成された反応式が実行されると、elの最終値が何であれ使用しています。

これは、1)forループの代わりにlapplyを使用して解決できます。各反復は独自の関数呼び出しとして実行されるため、elへの独自の参照を取得します。または2)forループを使用するが、その内部にローカル({...})を導入し、その値がリアクティブの外部のelに割り当てられるローカル変数を作成する。

+0

これはまさに私に起こったことです。私のタブを生成するためにelの最終的な値だけが使用されていました。私もこれを実装し、何が起こるか見る必要があります。昨日から私の解決策は非常に醜いので、私たちは間違いなくこれから恩恵を受けるでしょう。知らせます! –

+0

私はこの解決策を試しました。私が必要とするものに対しては機能しません。私が抱えている問題は確かに反応式ですが、動的出力関数を追加すると問題が複雑になります。それは理にかなっていますか? –

関連する問題