From 0a22b5fb23aabcdf418d667548b7f826cda3f048 Mon Sep 17 00:00:00 2001 From: Trishang Udhwani Date: Fri, 27 Sep 2024 10:40:01 +0200 Subject: [PATCH] Add navigation panel --- app.R | 26 ++++++++++++--- mod_mainPanel.R | 85 ++++++++++++++++++++++++++++++++++++++++++++++++- mod_sidebar.R | 10 ++++-- 3 files changed, 113 insertions(+), 8 deletions(-) diff --git a/app.R b/app.R index 580cb6a..a46876b 100644 --- a/app.R +++ b/app.R @@ -43,10 +43,26 @@ ui <- fluidPage( )), div( h1('VI Cake Planner'), uiOutput('subtitle') )), - - sidebarLayout(sidebarPanel(# Call sidebar module UI - sidebarUI('sidebar1')), mainPanel(# Call main panel module UI - mainPanelUI('mainpanel1'))) + + sidebarLayout( + sidebarPanel( + sidebarUI('sidebar1') # Call sidebar module UI + ), + mainPanel( + # Add a navigation panel + navset_card_underline( + # Add a title for the panel + title = "When do you want cake? Are you a time traveller (Click Historic then!)?", + # Create 3 panels, today, upcoming and Historic(All) + # All of these panels will call mainpanelUI() module + nav_panel("Today", mainPanelUI('mainpanel2')), + nav_panel("Upcoming", mainPanelUI('mainpanel3')), + nav_panel("Historic (All)", mainPanelUI('mainpanel1')), + + ) + ) + ) + ) # Define server logic @@ -66,6 +82,8 @@ server <- function(input, output, session) { # Call the modules input_data <- sidebarServer('sidebar1', board) # Call sidebar module server mainPanelServer('mainpanel1', board) # Call main panel module server + mainPanelServer_today('mainpanel2', board) # Call main panel module server + mainPanelServer_up('mainpanel3', board) # Call main panel module server } # Run the application diff --git a/mod_mainPanel.R b/mod_mainPanel.R index bfac857..5e22b16 100644 --- a/mod_mainPanel.R +++ b/mod_mainPanel.R @@ -1,11 +1,12 @@ # Main Panel UI Module mainPanelUI <- function(id) { ns <- NS(id) - + # We want to output a datatable tagList(DTOutput(ns('dataTable'))) } # Main Panel Server Module +# This module will display the Historic table mainPanelServer <- function(id, board) { moduleServer(id, function(input, output, session) { output$dataTable <- renderDT({ @@ -42,3 +43,85 @@ mainPanelServer <- function(id, board) { }) }) } + +# This module will display the upcoming table +mainPanelServer_up <- function(id, board) { + moduleServer(id, function(input, output, session) { + output$dataTable <- renderDT({ + # Read the pinned data frame from the pin board + pinned_cakes <- + pin_reactive_read( + board, + name = paste0(Sys.getenv("USER_NAME"), '/cake_user_inputs'), + interval = 1000 + ) + # Hide secret ingredient + pinned_cakes <- pinned_cakes()[,c(1:5,7)] + # Filter all the entries that are occurring after today + pinned_cakes_up <- pinned_cakes |> + dplyr::filter(Date > Sys.Date()) + datatable( + pinned_cakes_up, + # Do not show row names + rownames = FALSE, + # Add filters for each column + filter = "top", + colnames = c( + "Date", + "Hour", + "Room", + "Section", + "Person Name", + "Cake Description" + ), + options = list( + # order table by date and then time + order = list(list(0, 'asc'), list(1, 'asc')), + columnDefs = list( + list(targets = '_all', className = 'dt-center') + )) + ) + }) + }) +} + +# This module will display the today table +mainPanelServer_today <- function(id, board) { + moduleServer(id, function(input, output, session) { + output$dataTable <- renderDT({ + # Read the pinned data frame from the pin board + pinned_cakes <- + pin_reactive_read( + board, + name = paste0(Sys.getenv("USER_NAME"), '/cake_user_inputs'), + interval = 1000 + ) + # Hide secret ingredient + pinned_cakes <- pinned_cakes()[,c(1:5,7)] + # Filter all the entries that are occurring today + pinned_cakes_today <- pinned_cakes |> + dplyr::filter(Date == Sys.Date()) + datatable( + pinned_cakes_today, + # Do not show row names + rownames = FALSE, + # Add filters for each column + filter = "top", + colnames = c( + "Date", + "Hour", + "Room", + "Section", + "Person Name", + "Cake Description" + ), + options = list( + # order table by date and then time + order = list(list(0, 'asc'), list(1, 'asc')), + columnDefs = list( + list(targets = '_all', className = 'dt-center') + )) + ) + }) + }) +} \ No newline at end of file diff --git a/mod_sidebar.R b/mod_sidebar.R index 4fa0f41..b33f8ea 100644 --- a/mod_sidebar.R +++ b/mod_sidebar.R @@ -54,6 +54,7 @@ sidebarUI <- function(id) { "Virologi, immunologi og parasittologi" )), textInput(ns('person'), 'Person Name:'), + textInput(ns('sec_in'), 'Secret Ingredient:'), textAreaInput(ns('cake_desc'), 'Cake Description:', rows = 3), actionButton(ns('submit'), 'Submit') ) @@ -70,8 +71,9 @@ sidebarServer <- function(id, board) { `Hour` = input$hour, `Room` = input$room, `Section` = input$section, - `Person Name` = input$person, - `Cake Description` = input$cake_desc, + `Person.Name` = input$person, + `Secret.Ingredient` = input$sec_in, + `Cake.Description` = input$cake_desc, stringsAsFactors = FALSE ) }) @@ -85,7 +87,8 @@ sidebarServer <- function(id, board) { input$person, input$cake_desc ) - pinned_cakes <- pin_read(board, name = paste0('cake_user_inputs')) + pinned_cakes <- pin_read(board, + name = paste0(Sys.getenv("USER_NAME"), '/cake_user_inputs')) updated_cakes <- rbind(pinned_cakes, input_data()) @@ -103,6 +106,7 @@ sidebarServer <- function(id, board) { updateSelectInput(session, "room", selected = NULL) updateSelectInput(session, "section", selected = NULL) updateTextInput(session, "person", value = "") + updateTextInput(session, "sec_in", value = "") updateTextAreaInput(session, "cake_desc", value = "") })