Как я могу связать menuSubItem с tabPanel - PullRequest
1 голос
/ 04 июня 2019

У меня есть это приложение

   library(shinydashboard)
library(dplyr)
library(shiny)

mtcars$cyl <- as.factor(mtcars$cyl)

ui <- dashboardPage(
  dashboardHeader(title = "Simple Dashboard"),
  ## Sidebar content
  dashboardSidebar(sidebarMenu(
    menuItem("Widgets", tabName = "widgets", icon = icon("th")),
    menuSubItem("Sub-menu1", icon = icon("dashboard")),
    menuSubItem("Sub-menu2", icon = icon("dashboard"))
  )),
  ## Body content
  dashboardBody(tabItems(
    # First tab content
    tabItem(tabName = "widgets",
            fluidRow(DT::dataTableOutput('items_dt')))
  ))
)

server <- function(input, output) {
  set.seed(122)
  histdata <- rnorm(500)

  output$plot1 <- renderPlot({
    data <- histdata[seq_len(input$slider)]
    hist(data)
  })

  output$items_dt = DT::renderDataTable(
    Patient_005,
    filter = 'bottom',
    options = list(scrollX = TRUE)
  )
}

shinyApp(ui, server)

У меня также есть две таблицы данных, подобные этой

Patient_005=as.data.frame(read.table(text = "   Driver  SNV_Tumour_005  SNV_Organoid_005    INDEL_Tumour_005    INDEL_Organoid_005  Deletion_Organoid_005
                                     ABCB1   *   *   *   -   -   -
                                     ACVR1B  *   *   -   -   -   -
                                     ACVR2A  *   -   -   -   -   -

                                     "))

Patient_013=as.data.frame(read.table(text = "   Driver  SNV_Tumour_013  SNV_Organoid_013    INDEL_Tumour_013    INDEL_Organoid_013  Deletion_Tumour_013 Deletion_Organoid_013
                                     ABCB1   *   -   *   -   -   -   -
                                     ACVR1B  *   -   -   -   -   -   -
                                     ACVR2A  *   -   -   -   -   -   -

                                     "))

Я хочу, чтобы Patient_005 в Sub-menu1 и Patient_013 в Sub-menu2 но только Patient_005 отображается везде, в то время как мне нужны разные пациенты в разных подменю

Любая помощь, пожалуйста?

Большое спасибо за любую помощь заранее

1 Ответ

1 голос
/ 10 июня 2019
library(shinydashboard)
library(rAmCharts)
library(plyr)
library(rAmCharts)
library(DT)
library(shiny)
library(shinyBS)
library(highcharter)
library(nycflights13)
library(htmltools)
library(purrr)
library(dbplyr)
library(dplyr)
library(nycflights13)
library(ggplot2)
library(pool)
library(DBI)
library(BBmisc)
library(colourpicker)
library(UpSetR)
library(plyr)
library(gridExtra)
library(d3heatmap)
library(corrplot)
library(Vennerable)
library(wordcloud)
library(nycflights13)
library(shinyHeatmaply)
library(heatmaply)


ui <- dashboardPage(skin = 'yellow',
                    dashboardHeader(
                                    tags$li(a(href = 'https://www.southampton.ac.uk/medicine/about/staff/tju.page#_ga=2.14695670.1710730763.1560178233-40818463.1486652937',
                                              icon("list-alt"),
                                              title = "Back to Apps Home"),
                                            class = "dropdown"),
                                    tags$li(a(href = 'https://www.southampton.ac.uk/cruk',
                                              img(src = 'https://tse3.mm.bing.net/th?id=OIP.oQOheFA4xY7SFZ5lyJi1nQHaD4&pid=Api&P=0&w=342&h=180',height = 100, width = 100,
                                                  title = "Home", height = "30px"),
                                              style = "padding-top:10px; padding-bottom:10px;"),
                                            class = "dropdown")), 
  dashboardSidebar(
    sidebarMenu( img(src = "https://reliawire.com/wp-content/uploads/2018/09/esophogeal-organoid-CinChild.jpg", height = 240, width = 230),
      menuItem("Dashboard", tabName = "dashboard", icon = icon("bar-chart-o")),
      menuItem("OAC", icon = icon("database"), tabName = "rdb", startExpanded = TRUE,
               menuSubItem("005", icon = icon("exclamation-triangle"), tabName = "005"),
               menuSubItem("013", icon = icon("exclamation-triangle"), tabName = "013"),
               menuSubItem("036", icon = icon("exclamation-triangle"), tabName = "036"),
               menuSubItem("121", icon = icon("exclamation-triangle"), tabName = "121")
      ), menuItem("COAD", icon = icon("database"), tabName = "rdb", startExpanded = TRUE,
                  menuSubItem("005", icon = icon("exclamation-triangle"), tabName = "005"),
                  menuSubItem("013", icon = icon("exclamation-triangle"), tabName = "013"),
                  menuSubItem("036", icon = icon("exclamation-triangle"), tabName = "036"),
                  menuSubItem("121", icon = icon("exclamation-triangle"), tabName = "121")
      )
    )
  ),
  dashboardBody(

    tabItems(
      tabItem("dashboard",  fluidRow(
        box(
          tags$head(tags$link(rel="shortcut icon", href="favicon.ico")),
          img(src = 'https://www.cancerresearchuk.org/sites/default/files/styles/cruk_no_style/public/large-icon_alcohol_darkblue_rgb.jpg?itok=q5L2YLuM',height = 500, width = 500),

          title = "OAC modeling by Organoid culture", width = 12, status = "primary",  tags$li(a(href = 'https://github.com/beginner984/OESO-modelling-by-organoid-culture',
                                                                                icon("list-alt"),
                                                                                title = "github"),
                                                                              class = "dropdown")
        ),
        fluidRow(
          box(
            title = "Interactive heatmap of deriver genes", width = 4, status = "warning",
            p(""),
            #p("Using battle option one can generate up-to 9 sets."),
            tags$li(a(href = 'https://fi1d18.shinyapps.io/new_folderr/',
                      icon("list-alt"),
                      title = "Interactive heatmap"),
                    class = "dropdown")

          ),
          box(
            title = "Jaccard index", width = 4,status = "warning",
            p(""),
            tags$li(a(href = 'https://fi1d18.shinyapps.io/new_folderrr/',
                      icon("list-alt"),
                      title = "Jaccard heatmap"),
                    class = "dropdown")
          )
        ),fluidRow(
          box(
            title = "Citation", width = 12, status = "success",
            h4("If you use this app, please cite this:"),
            HTML("<h5>Underwood T, et al. <a href='' target='_blank'>Shiny app for exploring organoids</a>. </h5>")
          )
        )
      )),
      tabItem("005", DT::dataTableOutput("items_dt")),
      tabItem("013", DT::dataTableOutput("items_dt1")),
      tabItem("036",      fluidRow(
        tabBox(width = 12, height = NULL,

               tabPanel("Organoid 036",  fluidRow(
                 box(
                   title = "Mutational signature", width = 4, status = "warning",
                   p(""),
                   #p("Using battle option one can generate up-to 9 sets."),
                   img(src='https://github.com/beginner984/OESO-modelling-by-organoid-culture/blob/master/Organoid-image-for-English-banner-stand.png?raw=true', align = "center", height = 350, width = 600)

                 ),
                 box(
                   tags$li(a(href = 'https://www.dropbox.com/s/z2j52o9twr9hkzj/036.xlsx?dl=0',
                             icon("list-alt"),
                             title = "Patient details"),
                           class = "dropdown")
                 )
               )
               ),


               tabPanel("Data", value=2,

                        fluidRow(

                          valueBoxOutput("vbox1", width = 2),
                          valueBoxOutput("vbox2", width = 2),
                          valueBoxOutput("vbox3", width = 2),
                          valueBoxOutput("vbox4", width = 8),
                          valueBoxOutput("vbox5", width = 2),
                          valueBoxOutput("vbox6", width = 2),
                          valueBoxOutput("vbox7", width = 2),
                          valueBoxOutput("vbox8", width = 2)


                        ),

                        fluidRow(

                          column(width = 4,  tags$li(a(href = 'https://fi1d18.shinyapps.io/new_folder/',
                                                       icon("question"),
                                                       title = "Interactive heatmap"),
                                                     class = "dropdown"), box(title = "76 deriver genes from Frankel paper", width = NULL, solidHeader = FALSE, dataTableOutput("dat1"))),
                          column(width = 4,  box(title = "Annotated SNVs and INDELS", width = NULL, solidHeader = FALSE, dataTableOutput("dat2"))),
                          column(width = 4,  box(title = "Structural variants", width = NULL, solidHeader = FALSE, dataTableOutput("dat3")))),

                        fluidRow(


                          column(width = 4,  box(tags$li(a(href = 'https://github.com/beginner984/OESO-modelling-by-organoid-culture/blob/master/example.png?raw=true',
                                                           icon("image"),
                                                           title = "Structural variants"),
                                                         class = "dropdown") ),  img(src='https://github.com/beginner984/OESO-modelling-by-organoid-culture/blob/master/example.png?raw=true', align = "center", height = 100, width = 100), p("Structural variants")),
                          column(width = 4,  box(tags$li(a(href = 'https://github.com/beginner984/OESO-modelling-by-organoid-culture/blob/master/Untitled.png?raw=true',
                                                           icon("image"),
                                                           title = "Structural variants"),
                                                         class = "dropdown") ),  img(src='https://github.com/beginner984/OESO-modelling-by-organoid-culture/blob/master/Untitled.png?raw=true', align = "center", height = 100, width = 100), p("Total and minor copy number (purple/blue respectively)")),
                          column(width = 4,  box(tags$li(a(href = 'https://github.com/beginner984/OESO-modelling-by-organoid-culture/blob/master/1.png?raw=true',
                                                           icon("image"),
                                                           title = "Structural variants"),
                                                         class = "dropdown") ),  img(src='https://github.com/beginner984/OESO-modelling-by-organoid-culture/blob/master/1.png?raw=true', align = "center", height = 100, width = 100), p("Major and minor copy number (red/green respectively)")),
                          column(width = 4,  box(tags$li(a(href = 'https://github.com/beginner984/OESO-modelling-by-organoid-culture/blob/master/2.png?raw=true',
                                                            icon("image"),
                                                            title = "Mutational consequences"),
                                                          class = "dropdown") ),  img(src='https://github.com/beginner984/OESO-modelling-by-organoid-culture/blob/master/2.png?raw=true', align = "center", height = 100, width = 100), p("Mutational consequences"))


                        )

               )
        )
      )),tabItem("121", DT::dataTableOutput("items_dt2"))
    )
  )
)


server <- function(input, output) {


  output$items_dt = DT::renderDataTable(
    Patient_005,
    filter = 'bottom',
    options = list(scrollX = TRUE)
  )
  output$items_dt1 = DT::renderDataTable(
    Patient_013,
    filter = 'bottom',
    options = list(scrollX = TRUE)
  )

  output$dat1 <- renderDataTable(derivers,
                                 filter = 'bottom',
                                 options = list(scrollX = TRUE))
  output$dat2 <- renderDataTable({datatable(annotated_snv_indel,extensions = 'Responsive' )})
  output$dat3 <- renderDataTable(structural_variants,
                                 filter = 'bottom',
                                 options = list(scrollX = TRUE))
  output$items_dt2 = DT::renderDataTable(
    Patient_021,
    filter = 'bottom',
    options = list(scrollX = TRUE)
  )



}



shinyApp(ui, server)
...