NavbarPage to dashboardPage in a Shiny app

shiny
1

The APP below uses navbarPage, however I will need to use it in dashboardPage format. Can anybody help me? I went to try to change, but it gave a lot of errors, so I would kindly ask if anyone can help me tweak this code. I'm inserting the code below.

Thank you very much!

library(shiny)
library(shinythemes)
library(dplyr)
library(tidyr)
library(lubridate)

function.cl<-function(dt){
  df <- structure(
    list(date = c("01-08-2021","01-08-2021","01-08-2021","01-08-2021","01-08-2021",
                  "08-08-2021","08-08-2021","08-08-2021","08-08-2021","08-08-2021","08-08-2021",
                  "13-08-2021","13-08-2021","13-08-2021","13-08-2021","13-08-2021"),
         Week= c("Sunday","Sunday","Sunday","Sunday","Sunday","Sunday","Sunday","Sunday",
                 "Sunday","Sunday","Sunday","Friday","Friday","Friday","Friday","Friday"),
         D1 = c(0,1,0,0,5,0,1,0,0,9,4,3,4,5,6,7), DR01 = c(2,1,0,0,3,0,1,0,1,7,2,3,4,6,7,8),
         DR02 = c(2,0,0,0,4,2,1,0,1,4,2,3,4,5,6,7),  DR03 = c(2,0,0,2,6,2,0,0,1,5,2,2,4,5,7,5),
         DR04 = c(2,0,0,5,6,2,0,0,3,7,2,3,4,5,6,4),  DR05 = c(2,0,0,5,6,2,0,0,7,7,2,3,4,5,6,7),
         DR06 = c(2,0,0,5,7,2,0,0,7,7,1,3,5,6,7,8),  DR07 = c(2,0,0,6,9,2,0,0,7,8,1,3,5,6,4,3)),
    class = "data.frame", row.names = c(NA, -16L))
  
  df$date <- parse_date_time(df$date, c('ymd', 'dmy'))
  
  scatter_date <- function(dt, dta = df) {
    dta %>%
      filter(date == ymd(dt)) %>%
      summarize(across(starts_with("DR"), sum)) %>%
      pivot_longer(everything(), names_pattern = "DR(.+)", values_to = "val") %>%
      mutate(name = as.numeric(name)) %>%
      plot(xlab = "Days", ylab = "Types", xlim = c(0, 7))
  }  
  Plot1<-scatter_date(dt)
  
  return(list(
    "Plot1" = Plot1, 
    date = df$date
  ))
}

ui <- fluidPage(
  
  ui <- shiny::navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
                          br(),
                          
                          tabPanel("",
                                   sidebarLayout(
                                     sidebarPanel(
                                       
                                       uiOutput("date"),
                                       textInput("week", label = h3("Week"), value = ""),
                                       br(),
                                     ),
                                     
                                     mainPanel(
                                       tabsetPanel(
                                         tabPanel("",plotOutput("Graph",width = "95%", height = "600"))),
                                     ))
                          )))


server <- function(input, output,session) {
  data <- reactive(function.cl("2021-08-01"))
  
  output$date <- renderUI({
    all_dates <- seq(as.Date('2021-01-01'), as.Date('2021-01-15'), by = "day")
    disabled <- as.Date(setdiff(all_dates, as.Date(data()$date)), origin = "1970-01-01")
    dateInput(input = "date", 
              label = "Select Date",
              min = min(data()$date),
              max = max(data()$date),
              value = max(data()$date),
              format = "dd-mm-yyyy",
              datesdisabled = disabled)
  })
  
  output$Graph <- renderPlot({
    req(input$date)
    function.cl(input$date)[["Plot1"]]
  })
  
  observeEvent(input$date, {
    updateTextInput(session, 'week', value = weekdays(input$date))
  })
}

shinyApp(ui = ui, server = server)
2

This?

Based on this: Getting started with Shiny Dashboard

library(shiny)
library(shinythemes)
library(dplyr)
library(tidyr)
library(lubridate)
library(shinydashboard)

function.cl<-function(dt){
  df <- structure(
    list(date = c("01-08-2021","01-08-2021","01-08-2021","01-08-2021","01-08-2021",
                  "08-08-2021","08-08-2021","08-08-2021","08-08-2021","08-08-2021","08-08-2021",
                  "13-08-2021","13-08-2021","13-08-2021","13-08-2021","13-08-2021"),
         Week= c("Sunday","Sunday","Sunday","Sunday","Sunday","Sunday","Sunday","Sunday",
                 "Sunday","Sunday","Sunday","Friday","Friday","Friday","Friday","Friday"),
         D1 = c(0,1,0,0,5,0,1,0,0,9,4,3,4,5,6,7), DR01 = c(2,1,0,0,3,0,1,0,1,7,2,3,4,6,7,8),
         DR02 = c(2,0,0,0,4,2,1,0,1,4,2,3,4,5,6,7),  DR03 = c(2,0,0,2,6,2,0,0,1,5,2,2,4,5,7,5),
         DR04 = c(2,0,0,5,6,2,0,0,3,7,2,3,4,5,6,4),  DR05 = c(2,0,0,5,6,2,0,0,7,7,2,3,4,5,6,7),
         DR06 = c(2,0,0,5,7,2,0,0,7,7,1,3,5,6,7,8),  DR07 = c(2,0,0,6,9,2,0,0,7,8,1,3,5,6,4,3)),
    class = "data.frame", row.names = c(NA, -16L))
  
  df$date <- parse_date_time(df$date, c('ymd', 'dmy'))
  
  scatter_date <- function(dt, dta = df) {
    dta %>%
      filter(date == ymd(dt)) %>%
      summarize(across(starts_with("DR"), sum)) %>%
      pivot_longer(everything(), names_pattern = "DR(.+)", values_to = "val") %>%
      mutate(name = as.numeric(name)) %>%
      plot(xlab = "Days", ylab = "Types", xlim = c(0, 7))
  }  
  Plot1<-scatter_date(dt)
  
  return(list(
    "Plot1" = Plot1, 
    date = df$date
  ))
}

ui <- dashboardPage(
  dashboardHeader(title = "Basic dashboard"),
  dashboardSidebar(),
  dashboardBody(
    # Boxes need to be put in a row (or column)
    tabPanel("",
             sidebarLayout(
               sidebarPanel(
                 
                 uiOutput("date"),
                 textInput("week", label = h3("Week"), value = ""),
                 br(),
               ),
               
               mainPanel(
                 tabsetPanel(
                   tabPanel("",plotOutput("Graph",width = "95%", height = "600"))),
               ))
    )
  )
)

server <- function(input, output,session) {
  data <- reactive(function.cl("2021-08-01"))
  
  output$date <- renderUI({
    all_dates <- seq(as.Date('2021-01-01'), as.Date('2021-01-15'), by = "day")
    disabled <- as.Date(setdiff(all_dates, as.Date(data()$date)), origin = "1970-01-01")
    dateInput(input = "date", 
              label = "Select Date",
              min = min(data()$date),
              max = max(data()$date),
              value = max(data()$date),
              format = "dd-mm-yyyy",
              datesdisabled = disabled)
  })
  
  output$Graph <- renderPlot({
    req(input$date)
    function.cl(input$date)[["Plot1"]]
  })
  
  observeEvent(input$date, {
    updateTextInput(session, 'week', value = weekdays(input$date))
  })
}

shinyApp(ui = ui, server = server)
3

Thanks @williaml !

It's more or less that. Only I would like the calendar and the Week part on the dark blue side. I would leave the part blank just for the graphic. It is possible?

4

Try this:

library(shiny)
library(shinythemes)
library(dplyr)
library(tidyr)
library(lubridate)
library(shinydashboard)

function.cl<-function(dt){
  df <- structure(
    list(date = c("01-08-2021","01-08-2021","01-08-2021","01-08-2021","01-08-2021",
                  "08-08-2021","08-08-2021","08-08-2021","08-08-2021","08-08-2021","08-08-2021",
                  "13-08-2021","13-08-2021","13-08-2021","13-08-2021","13-08-2021"),
         Week= c("Sunday","Sunday","Sunday","Sunday","Sunday","Sunday","Sunday","Sunday",
                 "Sunday","Sunday","Sunday","Friday","Friday","Friday","Friday","Friday"),
         D1 = c(0,1,0,0,5,0,1,0,0,9,4,3,4,5,6,7), DR01 = c(2,1,0,0,3,0,1,0,1,7,2,3,4,6,7,8),
         DR02 = c(2,0,0,0,4,2,1,0,1,4,2,3,4,5,6,7),  DR03 = c(2,0,0,2,6,2,0,0,1,5,2,2,4,5,7,5),
         DR04 = c(2,0,0,5,6,2,0,0,3,7,2,3,4,5,6,4),  DR05 = c(2,0,0,5,6,2,0,0,7,7,2,3,4,5,6,7),
         DR06 = c(2,0,0,5,7,2,0,0,7,7,1,3,5,6,7,8),  DR07 = c(2,0,0,6,9,2,0,0,7,8,1,3,5,6,4,3)),
    class = "data.frame", row.names = c(NA, -16L))
  
  df$date <- parse_date_time(df$date, c('ymd', 'dmy'))
  
  scatter_date <- function(dt, dta = df) {
    dta %>%
      filter(date == ymd(dt)) %>%
      summarize(across(starts_with("DR"), sum)) %>%
      pivot_longer(everything(), names_pattern = "DR(.+)", values_to = "val") %>%
      mutate(name = as.numeric(name)) %>%
      plot(xlab = "Days", ylab = "Types", xlim = c(0, 7))
  }  
  Plot1<-scatter_date(dt)
  
  return(list(
    "Plot1" = Plot1, 
    date = df$date
  ))
}

ui <- dashboardPage(
  dashboardHeader(title = "Basic dashboard"),
  dashboardSidebar(
    uiOutput("date"),
    textInput("week", label = h3("Week"), value = "")
  ),
  dashboardBody(
    tabsetPanel(
      tabPanel("chart",
               plotOutput("Graph",width = "95%", height = "600"))
      )
  )
)

server <- function(input, output,session) {
  data <- reactive(function.cl("2021-08-01"))
  
  output$date <- renderUI({
    all_dates <- seq(as.Date('2021-01-01'), as.Date('2021-01-15'), by = "day")
    disabled <- as.Date(setdiff(all_dates, as.Date(data()$date)), origin = "1970-01-01")
    dateInput(input = "date", 
              label = "Select Date",
              min = min(data()$date),
              max = max(data()$date),
              value = max(data()$date),
              format = "dd-mm-yyyy",
              datesdisabled = disabled)
  })
  
  output$Graph <- renderPlot({
    req(input$date)
    function.cl(input$date)[["Plot1"]]
  })
  
  observeEvent(input$date, {
    updateTextInput(session, 'week', value = weekdays(input$date))
  })
}

shinyApp(ui = ui, server = server)
1 Like
5

Thank you very much @williaml

1 Like
6

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.