From 03e978a704ebf31133ee37915a031f5c45222565 Mon Sep 17 00:00:00 2001 From: "Marius D. PASCARIU" Date: Tue, 6 Dec 2022 10:30:10 +0100 Subject: [PATCH 1/2] test --- dev/test_prepare_functions.R | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/dev/test_prepare_functions.R b/dev/test_prepare_functions.R index cf14f11..4d403ec 100644 --- a/dev/test_prepare_functions.R +++ b/dev/test_prepare_functions.R @@ -5,6 +5,7 @@ remove(list = ls()) library(tidyverse) library(dttest) +library(lemur) region1 = "ROMANIA" @@ -45,9 +46,10 @@ prepare_data_mode_cntr( ) prepare_data_mode_sex( + cod = cod, + lt = lt, region1 = region1, - cod_change = M, - year = 2000 + cod_change = M ) prepare_data_mode_sdg( @@ -62,6 +64,6 @@ prepare_data_mode_sdg( sdg_7 = -10 ) - +lemur::run_app() From df8a5e504b4820a8b68838e06159d86b52f0551c Mon Sep 17 00:00:00 2001 From: "Marius D. PASCARIU" Date: Tue, 17 Oct 2023 22:55:51 +0200 Subject: [PATCH 2/2] v0.14.0 - Fix bug related to lack of maternal mortality selection and reduction --- .gitignore | 3 + DESCRIPTION | 5 +- NAMESPACE | 4 + NEWS | 170 ++++--- R/app_server.R | 31 +- R/app_ui.R | 244 ++++----- R/app_ui_dashboard.R | 1012 ++++++++++++++++++------------------- R/lemur-package.R | 208 ++++---- R/setSliderColor.R | 85 ++++ R/useShinydashboard.R | 113 +++++ dev/rapid_load.R | 1 - man/setSliderColor_.Rd | 61 +++ man/useShinydashboard_.Rd | 103 ++++ 13 files changed, 1209 insertions(+), 831 deletions(-) create mode 100644 R/setSliderColor.R create mode 100644 R/useShinydashboard.R create mode 100644 man/setSliderColor_.Rd create mode 100644 man/useShinydashboard_.Rd diff --git a/.gitignore b/.gitignore index 1b05554..d78ff5b 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,6 @@ +.DS_Store +/dev/* + *.env /deploy/*.tar /deploy/*.csv diff --git a/DESCRIPTION b/DESCRIPTION index c37f80b..0c29f85 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: lemur Title: Life expectancy monitor upscaled in R -Version: 0.13.0 +Version: 0.14.0 Authors@R: c( person("Marius D.", "Pascariu", role = c("aut", "cre", "cph"), email = "rpascariu@outlook.com", comment = c(ORCID = "0000-0002-2568-6489")), person("Jose Manuel", "Aburto", role = "aut", comment = c(ORCID = "0000-0002-2926-6879")), @@ -42,9 +42,8 @@ Imports: RPostgres Encoding: UTF-8 LazyData: true -RoxygenNote: 7.1.2 +RoxygenNote: 7.2.3 Suggests: testthat (>= 3.0.0) Depends: R (>= 2.10) - diff --git a/NAMESPACE b/NAMESPACE index 590bf5c..0410856 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -18,10 +18,12 @@ export(prepare_data_mode_cntr) export(prepare_data_mode_cod) export(prepare_data_mode_sex) export(run_app) +export(setSliderColor_) export(tab_md) export(ui_dashbord) export(ui_datatab) export(ui_tabs) +export(useShinydashboard_) import(data.table) import(ggplot2) import(golem) @@ -54,6 +56,8 @@ importFrom(dplyr,summarise) importFrom(dplyr,ungroup) importFrom(glue,glue_data) importFrom(htmltools,HTML) +importFrom(htmltools,attachDependencies) +importFrom(htmltools,findDependencies) importFrom(htmltools,tagAppendAttributes) importFrom(htmltools,tagList) importFrom(htmltools,tags) diff --git a/NEWS b/NEWS index 8d24f87..823104b 100644 --- a/NEWS +++ b/NEWS @@ -1,83 +1,87 @@ -version 0.13.0 -- Include the maternal and neonatal mortality in the SDG section; - -version 0.12.2 -- Add the servedMode argument in the run_app() function that would allow the user -to select the datasource at the launch of the application. - -version 0.10.0 -- Create datatab corresponding to dashboard figures (lifetables, cod distributions and decomposition values) - -version 0.9.0 -- Update database by adding macro-regions - -version 0.8.2 -- remove home page tab - -version 0.8.1 -- bug fixes. Minor but important. - -version 0.8.0 -- rebrand the developing R package from MortalityCauses to lemur - -version 0.7.0 -- add data.table filtering - major update - -version 0.6.0 -- make the figures plotly. - -version 0.5.5 -- sdg mode working. Not with refrence to 2015 values, but working without errors. - -version 0.5.4 -- bug fixes; -- sdg mode still not working. - -version 0.5.3 -- update datasets processing; -- make the sdg mode functional.Now we only need to make it work correctly and -will all the inputs. - -version 0.5.2 -- include tooltips to save dashboard real-estate; -- now shiny app is operational except the SDG mode. - -version 0.5.1 -- specify glue and purrr dependencies, remove some more warnings. - -version 0.5.0 -- Add yearly COD data and also a SDG classification. -- Re-run the data preprocessing scripts. -- No tests have been performed on the shiny app, so probably contains fatal bugs. To be verified in the next version. - -version 0.4.5 -- Fix bug issues in map; - -version 0.4.5 -- Add dynamic map and start the SDG mode; - -version 0.3.0 -- Start dashboard development; - -version 0.2.0 -- Include the function to compute life expectancy decomposition by age and cod; - -version 0.1.0 -- add function to compute cause modified life tables; - -version 0.0.6 -- Create function for performing decomposition of age-specific mortality -contributions in life expectancy: decompose_ex_by_age(). - -version 0.0.5 -- Add GBD life tables consistent with the COD data over the 204 regions. Also, include hierarchical maps of the data. - -version 0.0.3 -- Add GBD data; - -version 0.0.2 -- Add WPP data; - -version 0.0.1 -- Start with a {golem} skeleton; -- Added a `NEWS` file to track changes to the package. +version 0.14.0 +- Fix bug related to lack of maternal mortality data when male population is selected; +- Fix bug in the under 5 mortality reduction method; + +version 0.13.0 +- Include the maternal and neonatal mortality in the SDG section; + +version 0.12.2 +- Add the servedMode argument in the run_app() function that would allow the user +to select the datasource at the launch of the application. + +version 0.10.0 +- Create datatab corresponding to dashboard figures (lifetables, cod distributions and decomposition values) + +version 0.9.0 +- Update database by adding macro-regions + +version 0.8.2 +- remove home page tab + +version 0.8.1 +- bug fixes. Minor but important. + +version 0.8.0 +- rebrand the developing R package from MortalityCauses to lemur + +version 0.7.0 +- add data.table filtering - major update + +version 0.6.0 +- make the figures plotly. + +version 0.5.5 +- sdg mode working. Not with refrence to 2015 values, but working without errors. + +version 0.5.4 +- bug fixes; +- sdg mode still not working. + +version 0.5.3 +- update datasets processing; +- make the sdg mode functional.Now we only need to make it work correctly and +will all the inputs. + +version 0.5.2 +- include tooltips to save dashboard real-estate; +- now shiny app is operational except the SDG mode. + +version 0.5.1 +- specify glue and purrr dependencies, remove some more warnings. + +version 0.5.0 +- Add yearly COD data and also a SDG classification. +- Re-run the data preprocessing scripts. +- No tests have been performed on the shiny app, so probably contains fatal bugs. To be verified in the next version. + +version 0.4.5 +- Fix bug issues in map; + +version 0.4.5 +- Add dynamic map and start the SDG mode; + +version 0.3.0 +- Start dashboard development; + +version 0.2.0 +- Include the function to compute life expectancy decomposition by age and cod; + +version 0.1.0 +- add function to compute cause modified life tables; + +version 0.0.6 +- Create function for performing decomposition of age-specific mortality +contributions in life expectancy: decompose_ex_by_age(). + +version 0.0.5 +- Add GBD life tables consistent with the COD data over the 204 regions. Also, include hierarchical maps of the data. + +version 0.0.3 +- Add GBD data; + +version 0.0.2 +- Add WPP data; + +version 0.0.1 +- Start with a {golem} skeleton; +- Added a `NEWS` file to track changes to the package. diff --git a/R/app_server.R b/R/app_server.R index e8bbeec..f3a5bc4 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -1,7 +1,7 @@ -# --------------------------------------------------- # +# -------------------------------------------------------------- # # Author: Marius D. PASCARIU -# Last update: Thu Jun 02 15:45:46 2022 -# --------------------------------------------------- # +# Last Update: Tue Oct 17 22:30:57 2023 +# -------------------------------------------------------------- # #' The application server-side #' @@ -48,7 +48,7 @@ app_server <- function(input, output, session) { dataSource <- if (serverMode()) "sdg" else lemur::data_gbd2019_sdg - eval( + dt <- eval( call( name = queryFunction(), data = dataSource, @@ -58,11 +58,12 @@ app_server <- function(input, output, session) { gender = input$sex, year = input$time_slider ) - ) %>% + ) %>% mutate( cause_name = factor(cause_name, levels = lemur::data_app_input$cause_name_sdg)) } + dt }) # 3) life tables data @@ -96,8 +97,9 @@ app_server <- function(input, output, session) { # Reduction matrix ----------------------------- data_cod_change <- reactive({ - + if (input$mode == "mode_sdg") { + M <- build_reduction_matrix( data = data_sdg(), select_cod = as.character(unique(data_sdg()$cause_name)), @@ -120,28 +122,30 @@ app_server <- function(input, output, session) { S6 = "Transport Injuries" S7 = "Exposure to Forces of Nature" - M[ , S2a] <- input$sdg_2a + if (input$sex != 'male') { + # For now males are not exposed to maternal disorders :) + M[ , S2a] <- input$sdg_2a + } M[ , S2b] <- input$sdg_2b M[ , S3] <- input$sdg_3 M[ , S4] <- input$sdg_4 M[ , S5] <- input$sdg_5 M[ , S6] <- input$sdg_6 M[ , S7] <- input$sdg_7 - + # when under 5 mortality is reduced across all COD we have to deal with # interactions, or successive reduction inputs. E.g. One may reduce # neonatal mortality (50%) and under-five mortality (10%) resulting a 55% - # total reduction. This is what we try to in the next 5 lines. - + # total reduction. This is what we try to do in the next 5 lines. + if (input$sdg_1 != 0) { if (sum(M[S1, ]) != 0) { - M[S1, ] <- input$sdg_1 + M[S1, ] * abs(input$sdg_1)/100 + M[S1, ] <- ((1 + input$sdg_1/100) * ((M[S1, ] + 100)/100) - 1) * 100 } else { M[S1, ] <- input$sdg_1 } } - } else { M <- build_reduction_matrix( data = data_cod(), @@ -194,6 +198,7 @@ app_server <- function(input, output, session) { # Decompose the difference in life expectancy at birth data_decomp <- reactive({ + # print(data_fig()) decompose_by_cod( data_fig()$lt_initial, data_fig()$lt_final, @@ -528,7 +533,7 @@ dt_filter_local <- function(data, mode, region1, region2, gender, year) { dt <- as.data.table(data) dt <- dt[period == year] dt <- dt[region %in% c(region1, region2)] - + if (mode != "mode_sex") { dt <- dt[sex == gender] } diff --git a/R/app_ui.R b/R/app_ui.R index 83e41ea..4f06331 100644 --- a/R/app_ui.R +++ b/R/app_ui.R @@ -1,122 +1,122 @@ -# --------------------------------------------------- # -# Author: Marius D. PASCARIU -# Last update: Thu Feb 10 13:49:34 2022 -# --------------------------------------------------- # - -#' The application User-Interface -#' -#' @keywords internal -#' @export -app_ui <- function() { - - tagList( - # Leave this function for adding external resources - golem_add_external_resources(), - ui_tabs() - ) -} - - -#' UI - List the first level UI elements here -#' @keywords internal -#' @export -ui_tabs <- function() { - tagList( - navbarPage( - title = tagList("Life Expectancy Monitor"), - windowTitle = "Life Expectancy Monitor", - position = "fixed-top", - collapsible = TRUE, - - # The 5 main tabs defined in 5 separate modules - - tabPanel( # Dashboard - title = icon("globe-africa"), - ui_dashbord() - ), - - tabPanel( # Dashboard - title = icon("database"), - ui_datatab() - ), - - tab_md( # "Methods Protocol" - title = icon("calculator"), - file = 'app/www/doc_methods.md' - ), - - tab_md( # sources - title = icon("book"), - file = 'app/www/doc_sources.md' - ), - - tab_md( # About - title = icon("info-circle"), - file = 'app/www/doc_about.md' - ), - - tab_md( # Contact - title = icon("address-book"), - file = 'app/www/doc_contact.md' - ) - ) - ) -} - -#' UI - markdown pages -#' @keywords internal -#' @export -tab_md <- function(title, file) { - - tabPanel( - title = title, - column( - width = 10, - offset = 1, - includeMarkdown( - system.file(file, package = 'lemur') - ) - ) - ) -} - - - -#' Add external Resources to the Application -#' -#' This function is internally used to add external -#' resources inside the Shiny application. -#' -#' @keywords internal -#' @export -golem_add_external_resources <- function(){ - - addResourcePath( - 'www', system.file('app/www', package = 'lemur') - ) - - tags$head( - # metathis::meta() %>% - # metathis::meta_social( - # title = "lemur Dashboard", - # description = "Developed by Pascariu et al.", - # url = "https://github.com/mpascariu", # to be updated - # # image = "", - # image_alt = "lemur", - # twitter_card_type = "summary_large_image" - # ), - - golem::activate_js(), - tags$link( - href = "https://fonts.googleapis.com/css?family=Roboto+Condensed:400,700&display=swap", - rel = "stylesheet"), - shinyjs::useShinyjs(), - tags$link( - rel="stylesheet", - type="text/css", - href="www/styles.css"), - tags$script(src="www/addNavLink.js"), - shinyWidgets::useShinydashboard() - ) -} - +# --------------------------------------------------- # +# Author: Marius D. PASCARIU +# Last update: Thu Feb 10 13:49:34 2022 +# --------------------------------------------------- # + +#' The application User-Interface +#' +#' @keywords internal +#' @export +app_ui <- function() { + + tagList( + # Leave this function for adding external resources + golem_add_external_resources(), + ui_tabs() + ) +} + + +#' UI - List the first level UI elements here +#' @keywords internal +#' @export +ui_tabs <- function() { + tagList( + navbarPage( + title = tagList("Life Expectancy Monitor"), + windowTitle = "Life Expectancy Monitor", + position = "fixed-top", + collapsible = TRUE, + + # The 5 main tabs defined in 5 separate modules + + tabPanel( # Dashboard + title = icon("globe-africa"), + ui_dashbord() + ), + + tabPanel( # Dashboard + title = icon("database"), + ui_datatab() + ), + + tab_md( # "Methods Protocol" + title = icon("calculator"), + file = 'app/www/doc_methods.md' + ), + + tab_md( # sources + title = icon("book"), + file = 'app/www/doc_sources.md' + ), + + tab_md( # About + title = icon("info-circle"), + file = 'app/www/doc_about.md' + ), + + tab_md( # Contact + title = icon("address-book"), + file = 'app/www/doc_contact.md' + ) + ) + ) +} + +#' UI - markdown pages +#' @keywords internal +#' @export +tab_md <- function(title, file) { + + tabPanel( + title = title, + column( + width = 10, + offset = 1, + includeMarkdown( + system.file(file, package = 'lemur') + ) + ) + ) +} + + + +#' Add external Resources to the Application +#' +#' This function is internally used to add external +#' resources inside the Shiny application. +#' +#' @keywords internal +#' @export +golem_add_external_resources <- function(){ + + addResourcePath( + 'www', system.file('app/www', package = 'lemur') + ) + + tags$head( + # metathis::meta() %>% + # metathis::meta_social( + # title = "lemur Dashboard", + # description = "Developed by Pascariu et al.", + # url = "https://github.com/mpascariu", # to be updated + # # image = "", + # image_alt = "lemur", + # twitter_card_type = "summary_large_image" + # ), + + golem::activate_js(), + tags$link( + href = "https://fonts.googleapis.com/css?family=Roboto+Condensed:400,700&display=swap", + rel = "stylesheet"), + shinyjs::useShinyjs(), + tags$link( + rel="stylesheet", + type="text/css", + href="www/styles.css"), + tags$script(src="www/addNavLink.js"), + useShinydashboard_() + ) +} + diff --git a/R/app_ui_dashboard.R b/R/app_ui_dashboard.R index 5662046..b701d44 100644 --- a/R/app_ui_dashboard.R +++ b/R/app_ui_dashboard.R @@ -1,506 +1,506 @@ -# --------------------------------------------------- # -# Author: Marius D. PASCARIU -# Last update: Thu Jun 02 14:17:10 2022 -# --------------------------------------------------- # - -#' UI - dashboard page -#' @keywords internal -#' @export -ui_dashbord <- function() { - - tagList( - - # # Disable the vertical scroll bar in shiny dashboard - # tags$head( - # tags$style( - # "body {overflow-y: hidden;}" - # ) - # ), - - tagList( - column( - width = 2, - side_panel() - ), - - column( - width = 10, - top_panel(), - main_panel() - ) - ) - ) -} - - -#' TOP PANEL -#' @keywords internal -top_panel <- function() { - fluidRow( - - column( - width = 3, - - conditionalPanel( - condition = "input.mode != 'mode_sex'", - shinyWidgets::radioGroupButtons( - inputId = "sex", - label = "Sex", - choices = c( - "Female" = "female", - "Male" = "male", - "Both" = "both"), - selected = "both", - justified = TRUE, - size = "sm", - checkIcon = list(yes = icon("ok", lib = "glyphicon")) - ), - ), - - conditionalPanel( - condition = "input.mode == 'mode_sex'", - shinyWidgets::checkboxGroupButtons( - inputId = "sex", - label = "Sex", - choices = c( - "Female" = "female", - "Male" = "male", - "Both" = "both"), - selected = c("female", "male"), - justified = TRUE, - size = "sm", - checkIcon = list(yes = icon("ok", lib = "glyphicon")) - ), - ), - shinyBS::bsTooltip( - id = "sex", - title = paste( - "Select the female, male or entire population", - "for which to display statistics."), - ), - ), - - column( - width = 4, - shinyWidgets::radioGroupButtons( - inputId = "mode", - label = "Life Expectancy Comparisons", - choices = c( - "WITHIN REGION" = "mode_cod", - "BETWEEN REGIONS" = "mode_cntr", - "SEX-GAP" = "mode_sex", - "SDG" = "mode_sdg"), - selected = "mode_cod", - justified = TRUE, - size = "sm", - checkIcon = list(yes = icon("ok", lib = "glyphicon")) - ), - shinyBS::bsTooltip( - id = "mode", - title = "Select the mode in which the dashboard to operate.", - placement = "bottom" - ) - ), - - column( - width = 1, - style = 'padding-right:0px; margin-right: 0px;', - - tags$div( - style = "padding: 25px 0px 0px 0px; margin-right: 0px;" - ), - switchInput( - inputId = "perc", - value = FALSE, - onStatus = "success", - offStatus = "danger", - label = icon("percent"), - size = "small" - ) - ), - - column( - width = 4, - style = 'padding-right:0px; margin-right: 0px;', - tags$div( - style = "padding: 25px 0px 0px 0px; margin-right: 0px;" - ), - bookmarkButton(), - actionButton( - inputId = "reset", - icon = icon("recycle"), - label = "Reset Selection" - ), - ), - ) -} - - -#' SIDE PANEL -#' @keywords internal -side_panel <- function() { - tagList( - - fluidRow( - column( - width = 12, - selectInput( - inputId = "region1", - label = "Region", - choices = list(Regions = lemur::data_app_input$regions, - Countries = lemur::data_app_input$countries), - selected = "GLOBAL", - width = "100%" - ) - ), - conditionalPanel( - condition = "input.mode == 'mode_cntr'", - column( - width = 12, - selectInput( - inputId = "region2", - label = "Region 2", - choices = list(Regions = lemur::data_app_input$regions, - Countries = lemur::data_app_input$countries), - selected = "EUROPE", - width = "100%", - ) - ) - ) - ), - - sliderTextInput( - inputId = "time_slider", - label = "Year", - choices = lemur::data_app_input$period, - selected = 2019, - grid = TRUE - ), - shinyBS::bsTooltip( - id = "time_slider", - title = "Select the year for which the data to correspond to", - ), - - chooseSliderSkin("Flat"), - setSliderColor(rep("black", 20), c(1:20)), - - conditionalPanel( - condition = "input.mode != 'mode_sdg'", - sliderInput( - inputId = "cod_change", - label = "Modify the cause-specific risk of dying:", - post = "%", - value = -10, - min = -100, - max = 100, - step = 5 - ), - shinyBS::bsTooltip( - id = "cod_change", - title = paste( - "Apply a percentage increase or decrease (%)", - " of the risk selected below"), - ), - - sliderTextInput( - inputId = "age_change", - label = "Age range:", - choices = lemur::data_app_input$x, - selected = c(0, 110), - grid = TRUE - ), - shinyBS::bsTooltip( - id = "age_change", - title = paste( - "On which age interval to change the risks? ", - "The ages outside the selected interval will not be affected."), - ), - - fluidRow( - column( - width = 10, - prettyCheckboxGroup( - inputId = "cod_target", - label = "Cause of death:", - choices = as.character(lemur::data_app_input$cause_name), - selected = lemur::data_app_input$cause_name, - icon = icon("check"), - status = "success", - animation = "rotate", - outline = TRUE, - inline = FALSE - ), - shinyBS::bsTooltip( - id = "cod_target", - title = paste( - "Which causes of death to be affected? ", - "The unchecked causes of death will maintain", - "their absolute mortality impact."), - placement = "top", - ), - ), - - column( - width = 2, - style = 'padding:0px;', - br(), - actionButton( - inputId = "cod_target_all", - label = "ALL", - style = "width:100%;" - ), - actionButton( - inputId = "cod_target_none", - label = "NONE", - style = "width:100%;" - ) - ) - ) - ), - - # Side panel for sdg mode - conditionalPanel( - condition = "input.mode == 'mode_sdg'", - - sliderInput(# End Epidemics. Goal: -100% relative to 2015 level - inputId = "sdg_3", - label = "AIDS epidemic, tuberculosis, malaria and neglected tropical diseases:", - post = "%", - value = 0, - min = -100, - max = 100, - step = 5 - ), - - sliderInput( #Goal: - 33.3% relative to 2015 level - inputId = "sdg_4", - label = "Mortality rate attributed to cardiovascular disease, cancer, diabetes or chronic respiratory disease:", - post = "%", - value = 0, - min = -100, - max = 100, - step = 5 - ), - - sliderInput( - inputId = "sdg_1", - label = "Under-five mortality rate:", - # post = " per 1000 live births", - post = "%", - value = 0, - min = -100, - max = 100, - step = 5 - ), - - sliderInput( - inputId = "sdg_2a", - label = "Maternal mortality ratio:", - # post = " per 100k", - post = "%", - value = 0, - min = -100, - max = 100, - step = 5 - ), - - sliderInput( # goal 25 - inputId = "sdg_2b", - label = "Neonatal mortality rate:", - # post = " per 1000 live births", - post = "%", - value = 0, - min = -100, - max = 100, - step = 5 - ), - - sliderInput( # Goal: -50% relative to 2015 level - inputId = "sdg_5", - label = "Suicide mortality rate:", - post = "%", - value = 0, - min = -100, - max = 100, - step = 5 - ), - - sliderInput( # Goal: -50% relative to 2015 level - inputId = "sdg_6", - label = "Death rate due to road traffic injuries:", - post = " %", - value = 0, - min = -100, - max = 100, - step = 5 - ), - - sliderInput( # substantially reduce the number of deaths from pollution - inputId = "sdg_7", - label = "Mortality due to natural disasters:", - post = "%", - value = 0, - min = -100, - max = 100, - step = 5 - ), - ) - ) -} - - -#' @keywords internal -main_panel <- function() { - tagList( - fluidRow( - column( - width = 7, - style = 'padding:0px 0px 0px 18px;', - - boxFrame( - style = 'padding:0px', - title = tagList( - tags$div( - "World Map", - style = "display: inline-block; font-weight: bold; padding:0px;" - ) - ), - - leafletOutput( - outputId = "figure1", - height = 381*0.93 - ) - ) - ), - - column( - width = 5, - style = 'padding:0px;', - - boxFrame( - title = boxTitleInput( - title = "Difference in Life Expectancy at various ages", - db_style = "padding: 0px 0px 0px 340px;", - selectInput( - inputId = "fig2_x", - label = "Ages to be displayed", - choices = lemur::data_app_input$x, - selected = seq(0, 110, 10), - multiple = TRUE - ) - ), - - plotlyOutput( - outputId = "figure2", - height = 350*0.955 - ) - ) - ) - ), - - fluidRow( - column( - width = 6, - style = 'padding-right:0px; padding-top:0px; padding-bottom:0px', - - boxFrame( - title = boxTitleInput( - title = "Cause of Death Distribution", - db_style = "padding: 0px 0px 0px 450px;", - radioGroupButtons( - inputId = "fig3_chart_type", - label = "View by:", - choices = c("Bar-plot" = "barplot"), - justified = TRUE, - checkIcon = list( - yes = tags$i(class = "fa fa-circle", - style = "color: black"), - no = tags$i(class = "fa fa-circle-o")), - direction = "vertical" - ) - ), - - plotlyOutput( - outputId = "figure3", - height = 330 - ) - ) - ), - - column( - width = 6, - style = 'padding:0px;', - - boxFrame( - title = boxTitleInput( - title = "Cause of Death / Age Decomposition of the Change in Life Expectancy at Birth", - db_style = "padding: 0px 0px 0px 410px;", - radioGroupButtons( - inputId = "fig4_dim", - label = "View by:", - choices = c("Age-and-COD" = "both", - "Age" = "age", - "COD" = "cod"), - justified = TRUE, - checkIcon = list( - yes = tags$i(class = "fa fa-circle", - style = "color: black"), - no = tags$i(class = "fa fa-circle-o")), - direction = "vertical" - ) - ), - - plotlyOutput( - outputId = "figure4", - height = 330 - ) - ) - ) - ) - ) -} - - -#' @keywords internal -boxFrame <- function(..., - width = NULL, - solidHeader = TRUE, - style = NULL) { - box( - width = width, - solidHeader = solidHeader, - style = style, - ... - ) -} - - -#' @keywords internal -boxTitleInput <- function(title, db_style, ...) { - - tagList( - tags$div( - title, - style = "display: inline-block; font-weight: bold; padding:0px; margin: -20px 0px 0px 5px;", - shinyWidgets::dropdownButton( - size = "xs", - label = "", - right = TRUE, - icon = icon("sliders-h"), - inline = TRUE, - width = "50px", - circle = FALSE, - ... - ) - ), - - tags$div( - # "subtitle....", - style = "display: padding:0px; margin: 0px 0px -20px 5px; font-size: 12px;" - ), - ) -} - - - - +# -------------------------------------------------------------- # +# Author: Marius D. PASCARIU +# Last Update: Tue Oct 17 22:41:44 2023 +# -------------------------------------------------------------- # + +#' UI - dashboard page +#' @keywords internal +#' @export +ui_dashbord <- function() { + + tagList( + + # # Disable the vertical scroll bar in shiny dashboard + # tags$head( + # tags$style( + # "body {overflow-y: hidden;}" + # ) + # ), + + tagList( + column( + width = 2, + side_panel() + ), + + column( + width = 10, + top_panel(), + main_panel() + ) + ) + ) +} + + +#' TOP PANEL +#' @keywords internal +top_panel <- function() { + fluidRow( + + column( + width = 3, + + conditionalPanel( + condition = "input.mode != 'mode_sex'", + shinyWidgets::radioGroupButtons( + inputId = "sex", + label = "Sex", + choices = c( + "Female" = "female", + "Male" = "male", + "Both" = "both"), + selected = "both", + justified = TRUE, + size = "sm", + checkIcon = list(yes = icon("ok", lib = "glyphicon")) + ), + ), + + conditionalPanel( + condition = "input.mode == 'mode_sex'", + shinyWidgets::checkboxGroupButtons( + inputId = "sex", + label = "Sex", + choices = c( + "Female" = "female", + "Male" = "male", + "Both" = "both"), + selected = c("female", "male"), + justified = TRUE, + size = "sm", + checkIcon = list(yes = icon("ok", lib = "glyphicon")) + ), + ), + shinyBS::bsTooltip( + id = "sex", + title = paste( + "Select the female, male or entire population", + "for which to display statistics."), + ), + ), + + column( + width = 4, + shinyWidgets::radioGroupButtons( + inputId = "mode", + label = "Life Expectancy Comparisons", + choices = c( + "WITHIN REGION" = "mode_cod", + "BETWEEN REGIONS" = "mode_cntr", + "SEX-GAP" = "mode_sex", + "SDG" = "mode_sdg"), + selected = "mode_cod", + justified = TRUE, + size = "sm", + checkIcon = list(yes = icon("ok", lib = "glyphicon")) + ), + shinyBS::bsTooltip( + id = "mode", + title = "Select the mode in which the dashboard to operate.", + placement = "bottom" + ) + ), + + column( + width = 1, + style = 'padding-right:0px; margin-right: 0px;', + + tags$div( + style = "padding: 25px 0px 0px 0px; margin-right: 0px;" + ), + switchInput( + inputId = "perc", + value = FALSE, + onStatus = "success", + offStatus = "danger", + label = icon("percent"), + size = "small" + ) + ), + + column( + width = 4, + style = 'padding-right:0px; margin-right: 0px;', + tags$div( + style = "padding: 25px 0px 0px 0px; margin-right: 0px;" + ), + bookmarkButton(), + actionButton( + inputId = "reset", + icon = icon("recycle"), + label = "Reset Selection" + ), + ), + ) +} + + +#' SIDE PANEL +#' @keywords internal +side_panel <- function() { + tagList( + + fluidRow( + column( + width = 12, + selectInput( + inputId = "region1", + label = "Region", + choices = list(Regions = lemur::data_app_input$regions, + Countries = lemur::data_app_input$countries), + selected = "GLOBAL", + width = "100%" + ) + ), + conditionalPanel( + condition = "input.mode == 'mode_cntr'", + column( + width = 12, + selectInput( + inputId = "region2", + label = "Region 2", + choices = list(Regions = lemur::data_app_input$regions, + Countries = lemur::data_app_input$countries), + selected = "EUROPE", + width = "100%", + ) + ) + ) + ), + + sliderTextInput( + inputId = "time_slider", + label = "Year", + choices = lemur::data_app_input$period, + selected = 2019, + grid = TRUE + ), + shinyBS::bsTooltip( + id = "time_slider", + title = "Select the year for which the data to correspond to", + ), + + chooseSliderSkin("Flat"), + setSliderColor_(rep("black", 20), c(1:20)), + + conditionalPanel( + condition = "input.mode != 'mode_sdg'", + sliderInput( + inputId = "cod_change", + label = "Modify the cause-specific risk of dying:", + post = "%", + value = -10, + min = -100, + max = 100, + step = 5 + ), + shinyBS::bsTooltip( + id = "cod_change", + title = paste( + "Apply a percentage increase or decrease (%)", + " of the risk selected below"), + ), + + sliderTextInput( + inputId = "age_change", + label = "Age range:", + choices = lemur::data_app_input$x, + selected = c(0, 110), + grid = TRUE + ), + shinyBS::bsTooltip( + id = "age_change", + title = paste( + "On which age interval to change the risks? ", + "The ages outside the selected interval will not be affected."), + ), + + fluidRow( + column( + width = 10, + prettyCheckboxGroup( + inputId = "cod_target", + label = "Cause of death:", + choices = as.character(lemur::data_app_input$cause_name), + selected = lemur::data_app_input$cause_name, + icon = icon("check"), + status = "success", + animation = "rotate", + outline = TRUE, + inline = FALSE + ), + shinyBS::bsTooltip( + id = "cod_target", + title = paste( + "Which causes of death to be affected? ", + "The unchecked causes of death will maintain", + "their absolute mortality impact."), + placement = "top", + ), + ), + + column( + width = 2, + style = 'padding:0px;', + br(), + actionButton( + inputId = "cod_target_all", + label = "ALL", + style = "width:100%;" + ), + actionButton( + inputId = "cod_target_none", + label = "NONE", + style = "width:100%;" + ) + ) + ) + ), + + # Side panel for sdg mode + conditionalPanel( + condition = "input.mode == 'mode_sdg'", + + sliderInput(# End Epidemics. Goal: -100% relative to 2015 level + inputId = "sdg_3", + label = "AIDS epidemic, tuberculosis, malaria and neglected tropical diseases:", + post = "%", + value = 0, + min = -100, + max = 100, + step = 5 + ), + + sliderInput( #Goal: - 33.3% relative to 2015 level + inputId = "sdg_4", + label = "Mortality rate attributed to cardiovascular disease, cancer, diabetes or chronic respiratory disease:", + post = "%", + value = 0, + min = -100, + max = 100, + step = 5 + ), + + sliderInput( + inputId = "sdg_1", + label = "Under-five mortality rate:", + # post = " per 1000 live births", + post = "%", + value = 0, + min = -100, + max = 100, + step = 5 + ), + + sliderInput( + inputId = "sdg_2a", + label = "Maternal mortality ratio:", + # post = " per 100k", + post = "%", + value = 0, + min = -100, + max = 100, + step = 5 + ), + + sliderInput( # goal 25 + inputId = "sdg_2b", + label = "Neonatal mortality rate:", + # post = " per 1000 live births", + post = "%", + value = 0, + min = -100, + max = 100, + step = 5 + ), + + sliderInput( # Goal: -50% relative to 2015 level + inputId = "sdg_5", + label = "Suicide mortality rate:", + post = "%", + value = 0, + min = -100, + max = 100, + step = 5 + ), + + sliderInput( # Goal: -50% relative to 2015 level + inputId = "sdg_6", + label = "Death rate due to road traffic injuries:", + post = " %", + value = 0, + min = -100, + max = 100, + step = 5 + ), + + sliderInput( # substantially reduce the number of deaths from pollution + inputId = "sdg_7", + label = "Mortality due to natural disasters:", + post = "%", + value = 0, + min = -100, + max = 100, + step = 5 + ), + ) + ) +} + + +#' @keywords internal +main_panel <- function() { + tagList( + fluidRow( + column( + width = 7, + style = 'padding:0px 0px 0px 18px;', + + boxFrame( + style = 'padding:0px', + title = tagList( + tags$div( + "World Map", + style = "display: inline-block; font-weight: bold; padding:0px;" + ) + ), + + leafletOutput( + outputId = "figure1", + height = 381*0.93 + ) + ) + ), + + column( + width = 5, + style = 'padding:0px;', + + boxFrame( + title = boxTitleInput( + title = "Difference in Life Expectancy at various ages", + db_style = "padding: 0px 0px 0px 340px;", + selectInput( + inputId = "fig2_x", + label = "Ages to be displayed", + choices = lemur::data_app_input$x, + selected = seq(0, 110, 10), + multiple = TRUE + ) + ), + + plotlyOutput( + outputId = "figure2", + height = 350*0.955 + ) + ) + ) + ), + + fluidRow( + column( + width = 6, + style = 'padding-right:0px; padding-top:0px; padding-bottom:0px', + + boxFrame( + title = boxTitleInput( + title = "Cause of Death Distribution", + db_style = "padding: 0px 0px 0px 450px;", + radioGroupButtons( + inputId = "fig3_chart_type", + label = "View by:", + choices = c("Bar-plot" = "barplot"), + justified = TRUE, + checkIcon = list( + yes = tags$i(class = "fa fa-circle", + style = "color: black"), + no = tags$i(class = "fa fa-circle-o")), + direction = "vertical" + ) + ), + + plotlyOutput( + outputId = "figure3", + height = 330 + ) + ) + ), + + column( + width = 6, + style = 'padding:0px;', + + boxFrame( + title = boxTitleInput( + title = "Cause of Death / Age Decomposition of the Change in Life Expectancy at Birth", + db_style = "padding: 0px 0px 0px 410px;", + radioGroupButtons( + inputId = "fig4_dim", + label = "View by:", + choices = c("Age-and-COD" = "both", + "Age" = "age", + "COD" = "cod"), + justified = TRUE, + checkIcon = list( + yes = tags$i(class = "fa fa-circle", + style = "color: black"), + no = tags$i(class = "fa fa-circle-o")), + direction = "vertical" + ) + ), + + plotlyOutput( + outputId = "figure4", + height = 330 + ) + ) + ) + ) + ) +} + + +#' @keywords internal +boxFrame <- function(..., + width = NULL, + solidHeader = TRUE, + style = NULL) { + box( + width = width, + solidHeader = solidHeader, + style = style, + ... + ) +} + + +#' @keywords internal +boxTitleInput <- function(title, db_style, ...) { + + tagList( + tags$div( + title, + style = "display: inline-block; font-weight: bold; padding:0px; margin: -20px 0px 0px 5px;", + shinyWidgets::dropdownButton( + size = "xs", + label = "", + right = TRUE, + icon = icon("sliders-h"), + inline = TRUE, + width = "50px", + circle = FALSE, + ... + ) + ), + + tags$div( + # "subtitle....", + style = "display: padding:0px; margin: 0px 0px -20px 5px; font-size: 12px;" + ), + ) +} + + + + diff --git a/R/lemur-package.R b/R/lemur-package.R index 2894b76..6fb2138 100644 --- a/R/lemur-package.R +++ b/R/lemur-package.R @@ -1,103 +1,105 @@ -# --------------------------------------------------- # -# Author: Marius D. PASCARIU -# Last update: Tue Apr 26 16:26:21 2022 -# --------------------------------------------------- # - -# lemur Package - -#' @details -#' To learn more about the package, start with the vignettes: -#' \code{browseVignettes(package = "lemur")} -#' -#' @import shinyBS -#' @import shinyWidgets -#' @import golem -#' @import ggplot2 -#' @import data.table -#' @import sf -#' @import shinydashboard -#' -#' @importFrom shiny -#' actionButton -#' addResourcePath -#' bookmarkButton -#' br -#' column -#' conditionalPanel -#' div -#' fluidPage -#' fluidRow -#' h3 -#' icon -#' includeMarkdown -#' navbarPage -#' observeEvent -#' reactive -#' selectInput -#' shinyApp -#' sliderInput -#' shinyOptions -#' showNotification -#' getShinyOption -#' tabPanel -#' tabsetPanel -#' updateSelectInput -#' updateSliderInput -#' validateCssUnit -#' -#' @importFrom DBI dbConnect dbSendQuery dbFetch dbDisconnect -#' @importFrom RPostgres Postgres -#' @importFrom DT dataTableOutput renderDataTable -#' @importFrom shinyjs useShinyjs -#' @importFrom MortalityLaws LifeTable -#' @importFrom glue glue_data -#' @importFrom purrr map -#' -#' @importFrom htmltools -#' tags -#' tagList -#' tagAppendAttributes -#' HTML -#' -#' @importFrom tibble -#' column_to_rownames -#' rownames_to_column -#' new_tibble -#' as_tibble -#' -#' @importFrom tidyr -#' pivot_wider -#' pivot_longer -#' replace_na -#' -#' @importFrom dplyr -#' all_of -#' arrange -#' bind_rows -#' bind_cols -#' group_by -#' left_join -#' filter -#' mutate -#' mutate_all -#' rename -#' summarise -#' select -#' ungroup -#' %>% -#' -#' @importFrom plotly -#' ggplotly -#' layout -#' renderPlotly -#' plotlyOutput -#' -#' @import leaflet -#' @importFrom leaflet.extras -#' addFullscreenControl -#' addResetMapButton -#' -#' @name MortalityCauses -#' @docType package -"_PACKAGE" - +# -------------------------------------------------------------- # +# Author: Marius D. PASCARIU +# Last Update: Tue Oct 17 22:36:36 2023 +# -------------------------------------------------------------- # + +# lemur Package + +#' @details +#' To learn more about the package, start with the vignettes: +#' \code{browseVignettes(package = "lemur")} +#' +#' @import shinyBS +#' @import shinyWidgets +#' @import golem +#' @import ggplot2 +#' @import data.table +#' @import sf +#' @import shinydashboard +#' +#' @importFrom shiny +#' actionButton +#' addResourcePath +#' bookmarkButton +#' br +#' column +#' conditionalPanel +#' div +#' fluidPage +#' fluidRow +#' h3 +#' icon +#' includeMarkdown +#' navbarPage +#' observeEvent +#' reactive +#' selectInput +#' shinyApp +#' sliderInput +#' shinyOptions +#' showNotification +#' getShinyOption +#' tabPanel +#' tabsetPanel +#' updateSelectInput +#' updateSliderInput +#' validateCssUnit +#' +#' @importFrom DBI dbConnect dbSendQuery dbFetch dbDisconnect +#' @importFrom RPostgres Postgres +#' @importFrom DT dataTableOutput renderDataTable +#' @importFrom shinyjs useShinyjs +#' @importFrom MortalityLaws LifeTable +#' @importFrom glue glue_data +#' @importFrom purrr map +#' +#' @importFrom htmltools +#' tags +#' tagList +#' tagAppendAttributes +#' HTML +#' findDependencies +#' attachDependencies +#' +#' @importFrom tibble +#' column_to_rownames +#' rownames_to_column +#' new_tibble +#' as_tibble +#' +#' @importFrom tidyr +#' pivot_wider +#' pivot_longer +#' replace_na +#' +#' @importFrom dplyr +#' all_of +#' arrange +#' bind_rows +#' bind_cols +#' group_by +#' left_join +#' filter +#' mutate +#' mutate_all +#' rename +#' summarise +#' select +#' ungroup +#' %>% +#' +#' @importFrom plotly +#' ggplotly +#' layout +#' renderPlotly +#' plotlyOutput +#' +#' @import leaflet +#' @importFrom leaflet.extras +#' addFullscreenControl +#' addResetMapButton +#' +#' @name MortalityCauses +#' @docType package +"_PACKAGE" + diff --git a/R/setSliderColor.R b/R/setSliderColor.R new file mode 100644 index 0000000..daa2839 --- /dev/null +++ b/R/setSliderColor.R @@ -0,0 +1,85 @@ +#' @title Color editor for sliderInput +#' +#' @description Edit the color of the original shiny's sliderInputs +#' +#' @param color The \code{color} to apply. This can also be a vector of colors if you want to customize more than 1 slider. Either +#' pass the name of the color such as 'Chartreuse ' and 'Chocolate 'or the HEX notation such as \code{'#7FFF00'} and \code{'#D2691E'}. +#' @param sliderId The \code{id} of the customized slider(s). This can be a vector like \code{c(1, 2)}, if you want to modify the 2 first sliders. +#' However, if you only want to modify the second slider, just use the value 2. +#' +#' @note See also \url{https://www.w3schools.com/colors/colors_names.asp} to have an overview of all colors. +#' +#' @seealso See \code{\link{chooseSliderSkin}} to update the global skin of your sliders. +#' +#' @export +#' +#' +#' @examples +#' if (interactive()) { +#' +#' library(shiny) +#' library(shinyWidgets) +#' +#' ui <- fluidPage( +#' +#' # only customize the 2 first sliders and the last one +#' # the color of the third one is empty +#' setSliderColor(c("DeepPink ", "#FF4500", "", "Teal"), c(1, 2, 4)), +#' sliderInput("obs", "My pink slider:", +#' min = 0, max = 100, value = 50 +#' ), +#' sliderInput("obs2", "My orange slider:", +#' min = 0, max = 100, value = 50 +#' ), +#' sliderInput("obs3", "My basic slider:", +#' min = 0, max = 100, value = 50 +#' ), +#' sliderInput("obs3", "My teal slider:", +#' min = 0, max = 100, value = 50 +#' ), +#' plotOutput("distPlot") +#' ) +#' +#' server <- function(input, output) { +#' +#' output$distPlot <- renderPlot({ +#' hist(rnorm(input$obs)) +#' }) +#' } +#' +#' shinyApp(ui, server) +#' +#' } +setSliderColor_ <- function(color, sliderId) { + + # some tests to control inputs + stopifnot(!is.null(color)) + stopifnot(is.character(color)) + stopifnot(is.numeric(sliderId)) + stopifnot(!is.null(sliderId)) + + # the css class for ionrangeslider starts from 0 + # therefore need to remove 1 from sliderId + sliderId <- sliderId - 1 + + # create custom css background for each slider + # selected by the user + sliderCol <- lapply(sliderId, FUN = function(i) { + paste0( + ".js-irs-", i, " .irs-single,", + " .js-irs-", i, " .irs-from,", + " .js-irs-", i, " .irs-to,", + " .js-irs-", i, " .irs-bar-edge,", + " .js-irs-", i, + " .irs-bar{ border-color: transparent;background: ", color[i+1], + "; border-top: 1px solid ", color[i+1], + "; border-bottom: 1px solid ", color[i+1], + ";}" + ) + }) + + # insert this custom css code in the head + # of the shiy app + custom_head <- tags$head(tags$style(HTML(as.character(sliderCol)))) + return(custom_head) +} diff --git a/R/useShinydashboard.R b/R/useShinydashboard.R new file mode 100644 index 0000000..2d09719 --- /dev/null +++ b/R/useShinydashboard.R @@ -0,0 +1,113 @@ +#' Use 'shinydashboard' in 'shiny' +#' +#' Allow to use functions from 'shinydashboard' into a classic 'shiny' app, +#' specifically \code{valueBox}, \code{infoBox} and \code{box}. +#' +#' @export +#' +#' @importFrom htmltools findDependencies attachDependencies +#' +#' @examples +#' if (interactive()) { +#' +#' library(shiny) +#' library(shinydashboard) +#' library(shinyWidgets) +#' +#' # example taken from ?box +#' +#' ui <- fluidPage( +#' tags$h2("Classic shiny"), +#' +#' # use this in non shinydashboard app +#' setBackgroundColor(color = "ghostwhite"), +#' useShinydashboard(), +#' # ----------------- +#' +#' # infoBoxes +#' fluidRow( +#' infoBox( +#' "Orders", uiOutput("orderNum2"), "Subtitle", icon = icon("credit-card") +#' ), +#' infoBox( +#' "Approval Rating", "60%", icon = icon("chart-line"), color = "green", +#' fill = TRUE +#' ), +#' infoBox( +#' "Progress", uiOutput("progress2"), icon = icon("users"), color = "purple" +#' ) +#' ), +#' +#' # valueBoxes +#' fluidRow( +#' valueBox( +#' uiOutput("orderNum"), "New Orders", icon = icon("credit-card"), +#' href = "http://google.com" +#' ), +#' valueBox( +#' tagList("60", tags$sup(style="font-size: 20px", "%")), +#' "Approval Rating", icon = icon("chart-line"), color = "green" +#' ), +#' valueBox( +#' htmlOutput("progress"), "Progress", icon = icon("users"), color = "purple" +#' ) +#' ), +#' +#' # Boxes +#' fluidRow( +#' box(status = "primary", +#' sliderInput("orders", "Orders", min = 1, max = 2000, value = 650), +#' selectInput("progress", "Progress", +#' choices = c("0%" = 0, "20%" = 20, "40%" = 40, "60%" = 60, "80%" = 80, +#' "100%" = 100) +#' ) +#' ), +#' box(title = "Histogram box title", +#' status = "warning", solidHeader = TRUE, collapsible = TRUE, +#' plotOutput("plot", height = 250) +#' ) +#' ) +#' ) +#' +#' server <- function(input, output, session) { +#' +#' output$orderNum <- renderText({ +#' prettyNum(input$orders, big.mark=",") +#' }) +#' +#' output$orderNum2 <- renderText({ +#' prettyNum(input$orders, big.mark=",") +#' }) +#' +#' output$progress <- renderUI({ +#' tagList(input$progress, tags$sup(style="font-size: 20px", "%")) +#' }) +#' +#' output$progress2 <- renderUI({ +#' paste0(input$progress, "%") +#' }) +#' +#' +#' output$plot <- renderPlot({ +#' hist(rnorm(input$orders)) +#' }) +#' +#' } +#' +#' shinyApp(ui, server) +#' +#' } +useShinydashboard_ <- function() { + if (!requireNamespace(package = "shinydashboard")) + message("Package 'shinydashboard' is required to run this function") + deps <- htmltools::findDependencies(shinydashboard::dashboardPage( + header = shinydashboard::dashboardHeader(), + sidebar = shinydashboard::dashboardSidebar(), + body = shinydashboard::dashboardBody() + )) + htmltools::attachDependencies(tags$div( + class = "main-sidebar", + style = "display: none;"), + value = deps) +} + diff --git a/dev/rapid_load.R b/dev/rapid_load.R index 572231f..3b029fe 100644 --- a/dev/rapid_load.R +++ b/dev/rapid_load.R @@ -6,7 +6,6 @@ run_app() - library(lemur) run_app() plot_map("US") diff --git a/man/setSliderColor_.Rd b/man/setSliderColor_.Rd new file mode 100644 index 0000000..edb9a1a --- /dev/null +++ b/man/setSliderColor_.Rd @@ -0,0 +1,61 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/setSliderColor.R +\name{setSliderColor_} +\alias{setSliderColor_} +\title{Color editor for sliderInput} +\usage{ +setSliderColor_(color, sliderId) +} +\arguments{ +\item{color}{The \code{color} to apply. This can also be a vector of colors if you want to customize more than 1 slider. Either +pass the name of the color such as 'Chartreuse ' and 'Chocolate 'or the HEX notation such as \code{'#7FFF00'} and \code{'#D2691E'}.} + +\item{sliderId}{The \code{id} of the customized slider(s). This can be a vector like \code{c(1, 2)}, if you want to modify the 2 first sliders. +However, if you only want to modify the second slider, just use the value 2.} +} +\description{ +Edit the color of the original shiny's sliderInputs +} +\note{ +See also \url{https://www.w3schools.com/colors/colors_names.asp} to have an overview of all colors. +} +\examples{ +if (interactive()) { + +library(shiny) +library(shinyWidgets) + +ui <- fluidPage( + + # only customize the 2 first sliders and the last one + # the color of the third one is empty + setSliderColor(c("DeepPink ", "#FF4500", "", "Teal"), c(1, 2, 4)), + sliderInput("obs", "My pink slider:", + min = 0, max = 100, value = 50 + ), + sliderInput("obs2", "My orange slider:", + min = 0, max = 100, value = 50 + ), + sliderInput("obs3", "My basic slider:", + min = 0, max = 100, value = 50 + ), + sliderInput("obs3", "My teal slider:", + min = 0, max = 100, value = 50 + ), + plotOutput("distPlot") +) + +server <- function(input, output) { + + output$distPlot <- renderPlot({ + hist(rnorm(input$obs)) + }) +} + +shinyApp(ui, server) + +} +} +\seealso{ +See \code{\link{chooseSliderSkin}} to update the global skin of your sliders. +} diff --git a/man/useShinydashboard_.Rd b/man/useShinydashboard_.Rd new file mode 100644 index 0000000..0f4de6b --- /dev/null +++ b/man/useShinydashboard_.Rd @@ -0,0 +1,103 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/useShinydashboard.R +\name{useShinydashboard_} +\alias{useShinydashboard_} +\title{Use 'shinydashboard' in 'shiny'} +\usage{ +useShinydashboard_() +} +\description{ +Allow to use functions from 'shinydashboard' into a classic 'shiny' app, +specifically \code{valueBox}, \code{infoBox} and \code{box}. +} +\examples{ +if (interactive()) { + +library(shiny) +library(shinydashboard) +library(shinyWidgets) + +# example taken from ?box + +ui <- fluidPage( + tags$h2("Classic shiny"), + + # use this in non shinydashboard app + setBackgroundColor(color = "ghostwhite"), + useShinydashboard(), + # ----------------- + + # infoBoxes + fluidRow( + infoBox( + "Orders", uiOutput("orderNum2"), "Subtitle", icon = icon("credit-card") + ), + infoBox( + "Approval Rating", "60\%", icon = icon("chart-line"), color = "green", + fill = TRUE + ), + infoBox( + "Progress", uiOutput("progress2"), icon = icon("users"), color = "purple" + ) + ), + + # valueBoxes + fluidRow( + valueBox( + uiOutput("orderNum"), "New Orders", icon = icon("credit-card"), + href = "http://google.com" + ), + valueBox( + tagList("60", tags$sup(style="font-size: 20px", "\%")), + "Approval Rating", icon = icon("chart-line"), color = "green" + ), + valueBox( + htmlOutput("progress"), "Progress", icon = icon("users"), color = "purple" + ) + ), + + # Boxes + fluidRow( + box(status = "primary", + sliderInput("orders", "Orders", min = 1, max = 2000, value = 650), + selectInput("progress", "Progress", + choices = c("0\%" = 0, "20\%" = 20, "40\%" = 40, "60\%" = 60, "80\%" = 80, + "100\%" = 100) + ) + ), + box(title = "Histogram box title", + status = "warning", solidHeader = TRUE, collapsible = TRUE, + plotOutput("plot", height = 250) + ) + ) +) + +server <- function(input, output, session) { + + output$orderNum <- renderText({ + prettyNum(input$orders, big.mark=",") + }) + + output$orderNum2 <- renderText({ + prettyNum(input$orders, big.mark=",") + }) + + output$progress <- renderUI({ + tagList(input$progress, tags$sup(style="font-size: 20px", "\%")) + }) + + output$progress2 <- renderUI({ + paste0(input$progress, "\%") + }) + + + output$plot <- renderPlot({ + hist(rnorm(input$orders)) + }) + +} + +shinyApp(ui, server) + +} +}