R shiny - как получить доступ к подмножеству таблицы данных, отфильтрованной на основе строк, выбранных в другой таблице данных - PullRequest
Новая
       110

R shiny - как получить доступ к подмножеству таблицы данных, отфильтрованной на основе строк, выбранных в другой таблице данных

0 голосов
/ 17 июня 2020

Я пытаюсь разработать приложение, в котором подмножество dataframe_2 отображается на отдельной вкладке на основе строк, выбранных в dataframe_1. Эта часть работает у меня нормально, но я не могу получить отфильтрованное подмножество dataframe_2. Мне он нужен в качестве входных данных для добавления следующих функций в приложение: - i) включение загрузки отфильтрованного подмножества dataframe_2, ii) динамическое создание графика на основе выбора одной строки в подмножестве dataframe_2, и iii) отображение всплывающих меток для имен столбцов из отфильтрованного кадра данных_2 Я пробовал много разных решений для извлечения отфильтрованного кадра данных_2, но пока ничего не работало, вероятно, из-за дополнительной сложности, т.е. кадр данных_2 отображается на основе выбора строки в кадре данных_1. Вот небольшая воспроизводимая версия кода для моего приложения: 

    library(tidyverse)
    library(shiny)
    library(DT)

    dataframe_1 <- data.frame(
      "key"=c("ABC_24e:id1","DEF_xe5:id2","GHI_ge2:id3","JKL_58d:id4","MNO_m24:id5"),
      "ID"=c("id1","id2","id3","id4","id5"),
      "owner_id"=c("yz1","yz1","xz3","xz3","zx2"),
      "sample_code"=c("D2","A1","A4","B5","B7"),
      "replicates"=c("N/A","N/A","N/A","N/A","N/A"),
      "QC"=c("pass","pass","pass","fail","pass"),
      "short_key"=c("ABC_24e","DEF_xe5","GHI_ge2","JKL_58d","MNO_m24")
    )
    dataframe_2 <- data.frame(
      "target"=c("A1BG","A1CF","A2M","AAACS"),
      "drug1aaa:ABC_24e:id1"=c(0.5,1.5,-2.1,-4),
      "drug2aaa:DEF_xe5:id2"=c(-0.6,1.6,3.5,1),
      "drug3aaa:GHI_ge2:id3"=c(-0.7,1.1,2.3,-3.4),
      "noneaaa:ABC_24e"=c(2,-1.8,0.7,1)
    )
    ui <- fluidPage(
      sidebarLayout(
        sidebarPanel(
          conditionalPanel(
            'input.dataset == "dataframe_1',
             checkboxGroupInput("show_vars", "select columns to show:",
                       names(dataframe_1), selected = names(dataframe_1))
           )
         ),
         mainPanel(
           tabsetPanel(
             id = "mydata",
             tabPanel("lookup table",DT::dataTableOutput("dataframe_1_tbl")),
           tabPanel("scores",DT::dataTableOutput("dataframe_2_tbl")),
             fluidRow(
               downloadButton("downloadScores", "Download filtered scores")
             ),
           plotlyOutput("row_dotplot")
       ))))
     # code for server logic
     server <- function(input, output) {

       #display lookup table
       output$dataframe_1_tbl  <- DT::renderDataTable({
         DT::datatable(dataframe_1[, input$show_vars,drop=FALSE])
       })

       #display dataframe_2 filtered on dataframe_1 row selection
       output$dataframe_2_tbl <- DT::renderDataTable({
         sel <- input$dataframe_1_tbl_rows_all
         dataframe_1_subset <- dataframe_1[sel,c("key","ID","owner_id","sample_code","replicates","QC")]
        columns_to_show <- dataframe_1[sel,"short_key"]
        columns_to_show <- as.character(columns_to_show)
        DT::datatable(select(dataframe_2,contains(c("target",columns_to_show))))
     })

     #download dataframe_2 - not working as this downloads unfiltered table but I need filtered table to be downloaded instead
     output$downloadScores <- downloadHandler(
       filename = function() {
         paste('filtered_scores-', Sys.time(), '.csv', sep = '')
       },
       content = function(file){
         write.csv(dataframe_2[input[["dataframe_2_tbl_rows_all"]], ], file)
       }
     )

     #generate ggplotly dotplot for single selected row from filtered subset of dataframe_2
     #output$row_dotplot <- renderPlotly({
       #row <- input$dataframe_2_tbl_rows_selected # this doesn't select filtered      dataframe_2
       #scorez <- dataframe_2[row,]
       ##
       ##code for geom_dotplot to be added##
       ##
    #})
   }
 shinyApp(ui, server)
...