SideBar不在Dashboard Body上呈现任何内容:R Shiny Dashboard

时间:2017-07-19 06:23:27

标签: r rendering shiny shinydashboard

我正在创建一个闪亮的仪表板,侧栏中有两个标签。 Tab1 用于导入csv, Tab2 用于显示所选变量的图。

Tab2有1个选择输入选项,用于选择绘图的变量

问题:点击侧边栏标签后,我的信息中心主体无法更改。它总是向我显示Tab1内容​​,即csv导入结果。 因此,尽管单击侧栏中的Tab2,但没有任何反应

以下是我的剧本

library(shinydashboard)
library(shiny)
library(DT)
#UI

sidebar=dashboardSidebar(width=200,
                     sidebarMenu( id="sidebar",
                                  menuItem("Data UpLoad", tabName = "dashboard", icon = icon("table"), 
                                           fileInput('file1','Choose CSV File',
                                                    accept=c('text/csv','text/comma-separated-values,text/plain', '.csv'))),

                                  menuItem("Uni Variate", tabName = "Uni", icon = icon("line-chart"),
                                           fluidRow(
                                          selectInput("options",label=h5("Select Column"),"")))))


body= dashboardBody(
 tabItems(
tabItem(tabName="dashboard",class='active',
        fluidRow(
          box(
            title="Data",solidHeader = TRUE, collapsible = TRUE,
            div(style='overflow-x: scroll',tableOutput("table1"))))),

tabItem(tabName = "Uni",
        fluidRow(box(title="Plot",solidHeader = TRUE,plotOutput("plot1"))),
        h2("tab content"))))

dashboardPage(
dashboardHeader(title= "test"),sidebar,body)

#Server
server <- function(input, output,session) {
data_set <- reactive({
req(input$file1)
inFile <- input$file1
data_set1<-read.csv(inFile$datapath)
list(data=data_set1)
 })
 # updating select input of second tab in shiny side bar
observe({
 updateSelectInput(
  session,
  "options",
  choices = names(data_set()$data))})

# tab1
output$table1= renderTable({
de=as.data.frame(data_set()$data[1:7,])})

#tab2
output$plot1 <- renderPlot({ggplot(data_set$data,aes(y=input$options,x=Prediction))+geom_histogram(binwidth=0.50, fill="blue") })
}

每一个帮助都很重要!

1 个答案:

答案 0 :(得分:2)

似乎问题与将小部件放在侧边栏上有关,它将它们作为子菜单。下面是一些可能的解决方案,可以在侧边栏上显示小部件,具体取决于您是否要在不活动时隐藏它们。

选项1-小部件始终可见

 
library(shinydashboard)
library(shiny)

sidebar <- dashboardSidebar(width=200,
  sidebarMenu( id="sidebar",
    menuItem("Data UpLoad", icon = icon("table"), tabName = "dashboard"),
    div(
        fileInput('file1','Choose CSV File',
        accept=c('text/csv','text/comma-separated-values,text/plain', '.csv'))
    ),
    menuItem("Uni Variate", icon = icon("line-chart"), tabName = "Uni"),
    div(
      selectInput("options",label=h5("Select Column"),"")
    )
  )
)

body <- dashboardBody(
  tabItems(
    tabItem(tabName="dashboard", class='active',
      box( title="Data",solidHeader = TRUE, collapsible = TRUE,
        div(style='overflow-x: scroll', p("table1"))
      )
    ),
    tabItem(tabName = "Uni",
      box(title="Plot", solidHeader = TRUE, p("plot1"))
    )
  )
)

server <- function(input, output,session) {}

shinyApp(dashboardPage(dashboardHeader(title= "test"), sidebar, body), server = server)

选项2-小部件仅在标签处于活动状态时可见

请注意,要在正文上显示正确的标签,用户必须单击子项。

library(shinydashboard)
library(shiny)

sidebar <- dashboardSidebar(width=200,
  sidebarMenu( id="sidebar",
      menuItem("data", icon = icon("table"), tabName = "dashboard",  
        menuSubItem(tabName = "dashboard",
          fileInput('file1','Choose CSV File',
          accept=c('text/csv','text/comma-separated-values,text/plain', '.csv'))
      )),
      menuItem("Uni Variate", icon = icon("line-chart"), tabName = "Uni", 
        menuSubItem( tabName = "Uni", 
          selectInput("options",label=h5("Select Column"),"")
      ))
  )
)

body <- dashboardBody(
  tabItems(
    tabItem(tabName="dashboard", class='active',
      box( title="Data",solidHeader = TRUE, collapsible = TRUE,
        div(style='overflow-x: scroll', p("table1"))
      )
    ),
    tabItem(tabName = "Uni",
      box(title="Plot", solidHeader = TRUE, p("plot1"))
    )
  )
)

server <- function(input, output,session) {}

shinyApp(dashboardPage(dashboardHeader(title= "test"), sidebar, body), server = server)