闪亮-不同选项卡中的不同地块

Question

I have what could appear as a very simple problem. I'd like to display different plots in different tabs. For this I have some code already where I use output$Sidebar and output$TABUI for the content of the tabs.

I do wish to use some controls for the plots, but all the controls being identical, I need them just below the different tabs, as I don't want to replicate them across and having them appearing within each tab.

I must miss something in my code because nothing show up in the dashboardbody. The tabs are created just fine (as it seems) so are my controls, just below them. My data is read through (can see this in the console) and I can work with the controls, but nothing appears in the body.

I've tried to modify my code (much longer) to make a minimal example, as follow.

Edit : If both the sidebarmenu and tabitems are in the UI.R, then everything on the ui gets compiled correctly, except that my data, which are being loaded at the beginning of the SERVER.R are not loaded. It seems as if server.R is not even ran. If I define the sidebarmenu and thetabitems from the server.R, then the data are loaded, but only my controls are displayed, sidebarmenu and body are not displayed. I can't understand this behavior either. If I leave tabitems in the UI.R and sidebarmenu from server.R, it does not load the data either. The app just seats there and nothing happens. If someone think they might know why, I'd be glad to have an explanation. Thank you.

ui.R :

library(shiny)
library(shinydashboard)

body <- dashboardBody(
  tags$head(
    tags$link(
      rel = "stylesheet",
      type = "text/css",
      href = "css/custom.css"
    )
  ),
  uiOutput("TABUI")

)

sidebar <- dashboardSidebar(
  width = 350,
  uiOutput("Sidebar")
)

header <- dashboardHeader(
  title = "Dashboard",
  titleWidth = 350,

  tags$li(
    class = "dropdown",
    img(
      src = 'img/General_Logo.png',
      style =  'margin-right:150px; margin-top:21px')
  )
)

dashboardPage(
  header,
  sidebar,
  body
)

Server.R

library(ggplot2)
library(dplyr)
library(RColorBrewer)
library(XLConnect)
library(htmlTable)
library(plotly)

# Loading data  -----------------------------------------------------
raw_data <- read.csv("file.csv")

# Server function ---------------------------------------------------
shinyServer(function(input, output) {

  # Tabs and content

  ntabs <- 4
  tabnames <- paste0("tab ", 1:ntabs)

  output$Sidebar <- renderUI({
    Menus <- vector("list", ntabs + 2)
    for (i in 1:ntabs){
             Menus[[i]] <- menuItem(tabnames[i], tabName = tabnames[i], icon = icon("dashboard"))
    }
    # Controls to appear below tabs
    Menus[[ntabs + 1]] <- selectInput("dpt", "Departments :",
                c("dpt 1" = "DPT1",
                  "dpt 2" = "DPT2",
                  "dpt 3" = "DPT3"),
                multiple = TRUE,
                selectize = TRUE)

    Menus[[ntabs + 2]] <- uiOutput("bottleneck")
    Menus[[ntabs + 3]] <- uiOutput("daterange")
    Menus[[ntabs + 4]] <- submitButton()

    do.call(function(...) sidebarMenu(id = 'sidebarMenu', ...), Menus)
  })

  # content of each tab
  output$TABUI <- renderUI({
    Tabs <- vector("list", ntabs)
    Tabs[[1]] <- tabItem(tabName = tabnames[1],
                         # fluidRow(box(h3("foo.")))
                         fluidRow(
                           box(
                             plotOutput("plot_1")
                           )
                         )
    )
    Tabs[[2]] <- tabItem(tabName = tabnames[2],
                         "Tab 2 Stuff")
    Tabs[[3]] <- tabItem(tabName = tabnames[3],
                         "Tab 3 Stuff")
    Tabs[[4]] <- tabItem(tabName = tabnames[4],
                         "Tab 4 Stuff")
    do.call(tabItems, Tabs)
  })

  formulaText <- reactive({

    if (is.null(data.r())) {
      return("some text")
    }

    paste0(as.character(input$daterange[1]), " to ", as.character(input$daterange[2]), " - blah blah")
  })

  output$bottleneck <- renderUI({
    selectInput('bottleneck', HTML('<font color=\"black\"> Bottlenecks : </font>'), c(Choose = '', raw_data[raw_data$is_bottleneck == 1 & !is.na(raw_data$Sort.field) & raw_data$Cost.Center %in% input$dpt,]$Sort.field %>%  unique() %>% sort()), selectize = TRUE)
  })

  output$daterange <- renderUI({
    dateRangeInput(inputId = 'daterange', 
                   label = HTML('<font color=\"black\"> Select period : </font>'), 
                   min = min(raw_data$Completn.date) , 
                   start = min(raw_data$Completn.date) ,
                   max = max(raw_data$Completn.date), 
                   end = max(raw_data$Completn.date))
  })

  data.r = reactive({

    if (is.null(input$dpt)) {
      return(NULL)
    }  

    ifelse(input$bottleneck == "", a <- raw_data %>% filter(Completn.date >=     input$daterange[1],
                                                                            Completn.date <= input$daterange[2]),
           a <- raw_data %>% filter(Completn.date >= input$daterange[1],
                                    Completn.date <= input$daterange[2],
                                    Sort.field %in% input$bottleneck))

    return(a)
  })

  output$table_ranking <- renderHtmlTableWidget({

    if (is.null(data.r())) {
      return()
    }

    ranking <- read.csv("ranking.csv", header = TRUE)
    htmlTableWidget(ranking)
  })

  output$caption <- renderText({
    formulaText()
  })

  output$plot_1 <- renderPlot({

    if (is.null(data.r())) {
      return()
    }

    current_data <- data.r()

    p0 <- current_data %>% 
      ggplot(aes(x = x1, y = y1)) +
      geom_point()

    p0

  })

  output$plot_2 <- renderPlot({

    if (is.null(data.r())) {
      return()
    }

    current_data <- data.r()

    p0 <- current_data %>% 
      ggplot(aes(x = x2, y = y2)) +
      geom_point()

    p0

  })
})

This is a failed attempt to replicate what was suggested here .

Thanks ahead of time for looking into this.

Answer 1

I finally got to find the answer.

I've had several reactive element duplicated across different tabs. For some reason Shiny does not like this. Once I've created different reactive strings (in my case) then everything was fine (tabitems with renderUI in server.r, as well as sidebarmenu).

Weird but anyway.