问题
I have this app
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)
I also have two data tables like this
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 * - - - - - -
"))
I want to have Patient_005 in Sub-menu1 and Patient_013 in Sub-menu2
but only Patient_005 being displayed everywhere generally while I need different patients in different sub menus
Any help please?
Thanks a lot for any help in advance
回答1:
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)
来源：https://stackoverflow.com/questions/56446516/how-i-can-related-menusubitem-to-tabpanel