Skip to content

Commit

Permalink
Benefit function element and buttons added
Browse files Browse the repository at this point in the history
  • Loading branch information
@Martin-Jung
Martin-Jung committed Nov 14, 2023
1 parent c7c262e commit b9371c8
Show file tree
Hide file tree
Showing 9 changed files with 216 additions and 54 deletions.
41 changes: 33 additions & 8 deletions R/app_server.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -16,19 +16,44 @@ app_server <- function(input, output, session) {
# to modify a global variable use <<- instead of <- or =
results <- shiny::reactiveValues()

# title page --------------------------------------------------------------
# Bottom page buttons -------------------------------------------------------
shiny::observeEvent(input$start_new_protocol, {
bs4Dash::updateTabItems(session,
inputId = "sidebarmenu", selected = "Overview")
})

# Final observer events for continue buttons
shiny::observeEvent(input$go_home, {
bs4Dash::updateTabItems(session, inputId = "sidebarmenu", selected = "Home")
})
shiny::observeEvent(input$go_overview, {
bs4Dash::updateTabItems(session, inputId = "sidebarmenu", selected = "Overview")
})
shiny::observeEvent(input$go_design, {
bs4Dash::updateTabItems(session, inputId = "sidebarmenu", selected = "Design")
})
shiny::observeEvent(input$go_specification, {
bs4Dash::updateTabItems(session, inputId = "sidebarmenu", selected = "Specification")
})
shiny::observeEvent(input$go_context, {
bs4Dash::updateTabItems(session, inputId = "sidebarmenu", selected = "Context")
})
shiny::observeEvent(input$go_prioritization, {
bs4Dash::updateTabItems(session, inputId = "sidebarmenu", selected = "Prioritization")
})
shiny::observeEvent(input$go_export, {
bs4Dash::updateTabItems(session, inputId = "sidebarmenu", selected = "Export")
})
# ---------------------------------------------------------------------------

# title page ----------------------------------------------------------------
# Adding module server code
mod_Home_server("Home_1", results)
mod_Overview_server("Overview_1", results)
mod_Design_server("Design_1", results)
mod_Specification_server("Specification_1", results)
mod_Context_server("Context_1", results)
mod_Prioritization_server("Prioritization_1", results)
mod_Home_server("Home_1", results, session)
mod_Overview_server("Overview_1", results, session)
mod_Design_server("Design_1", results, session)
mod_Specification_server("Specification_1", results, session)
mod_Context_server("Context_1", results, session)
mod_Prioritization_server("Prioritization_1", results, session)

# News
mod_News_server("News_1")
Expand All @@ -37,6 +62,6 @@ app_server <- function(input, output, session) {
mod_Export_server("Export_1", results)

# Automatically stop a Shiny app when closing the browser tab
session$onSessionEnded(stopApp)
# session$onSessionEnded(stopApp)
}

6 changes: 3 additions & 3 deletions R/app_ui.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,7 @@ app_ui <- function(request) {
bs4Dash::dashboardPage(
# Preloader using waiter
preloader = list(html = shiny::tagList(
waiter::spin_1(), "Loading ..."), color = "#3c8dbc"),
waiter::spin_balance(), "Loading ..."), color = "#3c8dbc"),
# freshTheme = odpscp_theme(), # Theme designed with fresh
# Other options
dark = FALSE,
Expand Down Expand Up @@ -73,7 +73,7 @@ app_ui <- function(request) {
id = "sidebarmenu",
bs4Dash::menuItem(
"Home",
tabName = "Home",
tabName = "Home",selected = TRUE,
icon = shiny::icon("home")
),
bs4Dash::menuItem(
Expand Down Expand Up @@ -115,7 +115,7 @@ app_ui <- function(request) {
bs4Dash::menuItem(
"Export protocol",
tabName = "Export",
icon = shiny::icon("download")
icon = shiny::icon("file-export")
),
bs4Dash::sidebarHeader("Info"),
bs4Dash::menuItem(
Expand Down
30 changes: 28 additions & 2 deletions R/mod_Context.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -228,7 +228,33 @@ mod_Context_ui <- function(id){
)
)
)
)
),
# End of page button row
shiny::fluidRow(
shiny::column(width = 2),
shiny::column(width = 8,
# Add backward button
shinyWidgets::actionBttn(
inputId = "go_specification",
label = "Back to specification",
style = "simple",
color = "primary",
size = "sm",
block = FALSE,
icon = shiny::icon("arrow-left")
),
# Add forward button
shinyWidgets::actionBttn(
inputId = "go_prioritization",
label = "Continue with prioritization",
style = "simple",
color = "primary",
size = "sm",
block = FALSE,
icon = shiny::icon("arrow-right")
)
)
) # End button box
) # End Fluid row
) # End Fluidpage
)
Expand All @@ -238,7 +264,7 @@ mod_Context_ui <- function(id){
#'
#' @importFrom shiny observe
#' @noRd
mod_Context_server <- function(id, results){
mod_Context_server <- function(id, results, parentsession){
shiny::moduleServer( id, function(input, output, session){
ns <- session$ns

Expand Down
29 changes: 28 additions & 1 deletion R/mod_Design.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -287,6 +287,33 @@ mod_Design_ui <- function(id){
)
) # Box engagement
)
),

# End of page button row
shiny::fluidRow(
shiny::column(width = 2),
shiny::column(width = 8,
# Add backward button
shinyWidgets::actionBttn(
inputId = "go_overview",
label = "Back to Overview",
style = "simple",
color = "primary",
size = "sm",
block = FALSE,
icon = shiny::icon("arrow-left")
),
# Add forward button
shinyWidgets::actionBttn(
inputId = "go_specification",
label = "Continue with specification",
style = "simple",
color = "primary",
size = "sm",
block = FALSE,
icon = shiny::icon("arrow-right")
)
)
)
) # FluidPage
) # TabItem
Expand All @@ -296,7 +323,7 @@ mod_Design_ui <- function(id){
#'
#' @importFrom shiny observe
#' @noRd
mod_Design_server <- function(id, results){
mod_Design_server <- function(id, results, parentsession){
shiny::moduleServer( id, function(input, output, session){
ns <- session$ns

Expand Down
2 changes: 1 addition & 1 deletion R/mod_Home.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -90,7 +90,7 @@ mod_Home_ui <- function(id){
#' Home Server Functions
#'
#' @noRd
mod_Home_server <- function(id, results){
mod_Home_server <- function(id, results, parentsession){
shiny::moduleServer( id, function(input, output, session){
ns <- session$ns

Expand Down
69 changes: 37 additions & 32 deletions R/mod_Overview.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -274,36 +274,46 @@ mod_Overview_ui <- function(id){
)
) # End of column
) # End of fluid row
)
),

# uiOutput("Overview_UI")

# End of page button row
# fluidRow(
# column(width = 3),
# column(width = 8,
# # Add reset button
# shinyWidgets::actionBttn(
# inputId = ns("reset"),
# label = "Clear all fields?",
# style = "simple",
# color = "danger",
# size = "md",
# block = FALSE,
# icon = icon("broom")
# ),
# # Add forward button
# shinyWidgets::actionBttn(
# inputId = ns("next_design"),
# label = "Continue with the design",
# style = "simple",
# color = "royal",
# size = "md",
# block = FALSE,
# icon = icon("arrow-right")
# )
# )
# ) # End of fluid row for buttons
shiny::fluidRow(
shiny::column(width = 2),
shiny::column(width = 8,
# # Add reset button
# shinyWidgets::actionBttn(
# inputId = ns("reset"),
# label = "Clear all fields?",
# style = "simple",
# color = "danger",
# size = "md",
# block = FALSE,
# icon = icon("broom")
# ),
# Add backward button
shinyWidgets::actionBttn(
inputId = "go_home",
label = "Back to start",
style = "simple",
color = "primary",
size = "sm",
block = FALSE,
icon = shiny::icon("arrow-left")
),
# Add forward button
shinyWidgets::actionBttn(
inputId = "go_design",
label = "Continue with the design",
style = "simple",
color = "primary",
size = "sm",
block = FALSE,
icon = shiny::icon("arrow-right")
)
)
) # End of fluid row for buttons
) # End of fluid page
) # End of tab

Expand All @@ -313,7 +323,7 @@ mod_Overview_ui <- function(id){
#'
#' @importFrom shiny observe observeEvent
#' @noRd
mod_Overview_server <- function(id, results){
mod_Overview_server <- function(id, results, parentsession){
shiny::moduleServer( id, function(input, output, session){
ns <- session$ns

Expand Down Expand Up @@ -383,11 +393,6 @@ mod_Overview_server <- function(id, results){
})
# ----- #

# Bottom page buttons --------------------------------------------------------------
# Final observe event to continue
shiny::observeEvent(input$next_design, {
bs4Dash::updateTabItems(session, inputId = ns("sidebarmenu"), selected = "Design")
})

# Clear all
shiny::observeEvent(input$reset, {
Expand Down
47 changes: 45 additions & 2 deletions R/mod_Prioritization.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -77,6 +77,22 @@ mod_Prioritization_ui <- function(id){
placeholder = 'Enter a version nr for the used algorithm',
height = "45px", width = "100%", resize = "none")
),
# Objective functions
shiny::br(),
bs4Dash::box(
title = "Benefit functions",
closable = FALSE,
width = 12,
solidHeader = TRUE,
status = "secondary",
collapsible = FALSE,
shiny::p("In many optimizations benefits can accrue in varying ways, for example
through maximizing the targets achieved. If known or specific to the study,
provide information on benefit function used."),
shiny::textAreaInput(inputId = ns("benefitfunctions"), label = "What is being optimized and how?",
placeholder = 'If known, please provide further detail.',
height = "60px", width = "100%", resize = "vertical")
),
shiny::br(),
bs4Dash::box(
title = "Key parameters",
Expand Down Expand Up @@ -158,7 +174,34 @@ mod_Prioritization_ui <- function(id){
)
)
) # Column end
) # Fluid row
), # Fluid row

# End of page button row
shiny::fluidRow(
shiny::column(width = 2),
shiny::column(width = 8,
# Add backward button
shinyWidgets::actionBttn(
inputId = "go_context",
label = "Back to Context",
style = "simple",
color = "primary",
size = "sm",
block = FALSE,
icon = shiny::icon("arrow-left")
),
# Add forward button
shinyWidgets::actionBttn(
inputId = "go_export",
label = "Export the protocol",
style = "simple",
color = "success",
size = "sm",
block = FALSE,
icon = shiny::icon("file-export")
)
)
) # Fluidrow button end
) # Fluidpage
)
}
Expand All @@ -167,7 +210,7 @@ mod_Prioritization_ui <- function(id){
#'
#' @importFrom shiny observe observeEvent
#' @noRd
mod_Prioritization_server <- function(id, results){
mod_Prioritization_server <- function(id, results, parentsession){
shiny::moduleServer( id, function(input, output, session){
ns <- session$ns

Expand Down
33 changes: 30 additions & 3 deletions R/mod_Specification.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -331,16 +331,43 @@ mod_Specification_ui <- function(id){
)
)
) # Fluid column end
) # Fluidrow end
)
), # Fluidrow end

# End of page button row
shiny::fluidRow(
shiny::column(width = 2),
shiny::column(width = 8,
# Add backward button
shinyWidgets::actionBttn(
inputId = "go_design",
label = "Back to Design",
style = "simple",
color = "primary",
size = "sm",
block = FALSE,
icon = shiny::icon("arrow-left")
),
# Add forward button
shinyWidgets::actionBttn(
inputId = "go_context",
label = "Continue to context",
style = "simple",
color = "primary",
size = "sm",
block = FALSE,
icon = shiny::icon("arrow-right")
)
)
)
) # Fluidpage end
) # End tab
}

#' Specification Server Functions
#'
#' @importFrom shiny observe observeEvent
#' @noRd
mod_Specification_server <- function(id, results){
mod_Specification_server <- function(id, results, parentsession){
shiny::moduleServer( id, function(input, output, session){
ns <- session$ns

Expand Down
Loading

0 comments on commit b9371c8

Please sign in to comment.