In Edouard-Legoupil/unhcrdatapackage: UNHCR Population Statistics Database with Chart Library and Factsheet Template

library(testthat)

# Load already included functions if relevant
pkgload::load_all(export_all = FALSE)

mod_home

this is a shared module that takes all the parameters to filter the data.. https://stackoverflow.com/questions/69172472/shiny-modules-inside-other-modules/69173076#69173076

#' Landing page UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd 
#' @keywords internal
#' @importFrom shinydashboardPlus carousel carouselItem
#' @importFrom shiny NS tagList 
mod_home_ui <- function(id){
  ns <- NS(id)
  tagList( 

             )
}

                  #, #Doing so, users will: 
                            #  tags$ul(
                            #     tags$li("enhance basic data literacy"), 
                            #     tags$li("further explore data through different filters"), 
                            #     tags$li("be able to create persuasive data stories ") 
                            # )   
                                    # "This app allows Information Managers, Data Analyst and Data Journalist to quickly build data stories on Forced Displacement: Adjust the message in the title, highlight insights in the subtitle, overlay annotation to ease interpretation and filter the data",

                  # for data story telling 

                    # p(HTML("  1. How the different <a href='#shiny-tab-categories'>Categories</a> of Population of concern to UNHCR are evolving over time?")), 
                    # p(HTML("  2. What are the main countries of Origin of Forced Displacement across Borders?")),  
                    # p(HTML("  3. What are the main countries of Destination of Asylum of Forced Displacement across Borders?")),
                    # p(HTML("  4. What are the Demographics profiles of Forcibly Displaced People in relation with the host population?")),
                    # p(HTML("  5. Is the asylum Processing capacity in relation with the demand?")),
                    # p(HTML("  6. What are the trends in terms of Solutions?")),
                    # p(HTML("  7. What is the share of Forcibly Displaced People among total Migrants?")) ,
                  #,
                 # br(),
                  # p ('This app conveniently bring together a series of predefined plots in order to improve data literacy and facilitate the creation of',
                  # tags$a(href="https://edouard-legoupil.github.io/unhcrdatapackage/tuto/tutorial.html", "persuasive data stories") ,
                  # '. Each plot is created through a function that provides a recipe that creates a re-usable chart in line with a',
                  # tags$a(href="https://www.columnfivemedia.com/divisible-content-strategy-gives-brand-less/", "Divisible Content Strategy"),
                  # '. You may',
                  # tags$a(href="https://edouard-legoupil.github.io/unhcrdatapackage/articles/library.html", "enhance the charts story-telling ability"),
                  # ' by adjusting the message in the title, highlighting specific parts of the data or adding annotation to ease interpretation or provide more contextual background.')



#' input Server Functions
#'
#' @noRd 
#' @keywords internal
mod_home_server <- function(id){
  moduleServer( id, function(input, output, session){
    ns <- session$ns
    ## used to get a link to the tabs...



  })
}

## To be copied in the UI
# mod_home_ui("home_1")

## To be copied in the server
# mod_home_server("home_1")

test_that("mod_home works", {




})

Shared Modules

The app includes 2 shared modules -

• One for the selection of countries and year - that will be then passed on to all the plots
• One that takes the global reactive values - and the type of plot (form the library) as a parameter to output a ggplot2 charts

mod_input

this is a shared module that takes all the parameters to filter the data.. https://stackoverflow.com/questions/69172472/shiny-modules-inside-other-modules/69173076#69173076

#' input UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd 
#'
#' @importFrom shiny NS tagList 
mod_input_ui <- function(id){
  ns <- NS(id)
  tagList( 
        # selectInput(inputId = ns("country"),
        #             label = " and filter by country..",
        #             choices = list("Panama" = "PAN",
        #                            "Colombia" = "COL",
        #                            "Ecuador" = "ECU",
        #                            "United States" = "USA",
        #                            "Mexico" = "MEX" ),
        #             selected = "Panama"),
        selectizeInput(inputId = ns("country"),
                       label = " Select Country", 
                      choices = ForcedDisplacementStat::end_year_population_totals |>
              dplyr::arrange(CountryAsylumName) |>
              dplyr::select(CountryAsylumCode) |>
              dplyr::distinct()  |>
              dplyr::pull(CountryAsylumCode) |>
              purrr::set_names(
                               ForcedDisplacementStat::end_year_population_totals |>
                                 dplyr::arrange(CountryAsylumName) |>
                                 dplyr::select(CountryAsylumName) |>
                                 dplyr::distinct()|>
                                 dplyr::pull(CountryAsylumName) ), 
                       selected = "USA", 
                       multiple = FALSE,
                       options = NULL),


        selectInput(inputId = ns("year"),
                    label = "  Select Year",
                    choices = list("2022" = "2022",
                                   "2021" = "2021",
                                   "2020" = "2020",
                                   "2019" = "2019",
                                   "2018" = "2018" ),
                    selected = "2022")
  )
}

#' input Server Functions 
#' @param reactiveParameters  Main app filters defined through mod_input
#'
#' @noRd 
mod_input_server <- function(id, reactiveParameters){
  moduleServer( id, function(input, output, session){
    ns <- session$ns


    observe({
      reactiveParameters$country <- input$country
    })
    observe({
      reactiveParameters$year <- input$year
    })

  })
}

## To be copied in the UI
# mod_input_ui("input_1")

## To be copied in the server
# mod_input_server("input_1")

test_that("mod_input works", {

})

mod_plotviz

This module take as an argument the plot based on the library and the reactive values from the app.

#' plotviz UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#' @param thisPlot identify which plot to output from the library
#'   # 1. Category 
#'    # ## Key Figures
#'    "plot_ctr_keyfig", # year, country_asylum_iso3 
#'    # ## Plot Tree Map of Categories
#'    "plot_ctr_treemap", # year,  country_asylum_iso3c,   pop_type 
#'    # ## Plot Population type per year
#'    "plot_ctr_population_type_per_year", # year,   country_asylum_iso3c, lag,  pop_type  
#'    
#'    # # 2. Origin
#'    # ## Plot Main country of origin  in one specific country - Absolute value
#'    "plot_ctr_population_type_abs", # year , country_asylum_iso3c, top_n_countries,  pop_type = pop_filter, show_diff_label = FALSE   
#'    # ## Plot Main country of origin in one specific country - Percentage
#'    "plot_ctr_population_type_perc", # year , country_asylum_iso3c , top_n_countries, pop_type = "REF"- pop_filter    
#'    # ## Plot Increases and Decreases in Population Groups
#'    "plot_ctr_diff_in_pop_groups", # year,  country_asylum_iso3c,  pop_type  
#'    # ## Plot Origin History
#'    "plot_ctr_origin_history", # year , country_asylum_iso3c ,lag, ,   pop_type , otherprop 
#'   
#'    # # 3. Destination 
#'    # ## Plot Main Destination from  one specific country 
#'    "plot_ctr_destination", # year , country_origin_iso3c, pop_type   
#'    # ## plot recognition rate for a nationality
#'    "plot_ctr_origin_recognition", # year, country_origin_iso3c,  top_n_countries,  measure ,  order_by  
#'     
#'    # # 4. Profile
#'    # ## Plot Age Pyramid
#'    "plot_ctr_pyramid", # year , country_asylum_iso3c , pop_type  
#'    # ## Plot locations within countries
#'    "plot_ctr_location", # year , country_asylum_iso3c, pop_type 
#' 
#'    # # 5. Processing
#'    # ## Plot Refugee Recognition rate in Country
#'    "plot_ctr_recognition", # year,  country_asylum_iso3c, top_n_countries , measure , order_by  
#'    # ## Asylum Applications & Decision over time
#'    "plot_ctr_asylum", # year  country_asylum_iso3c,   lag 
#'    # ## Asylum Processing
#'    "plot_ctr_process", # year,   country_asylum_iso3c ,  otherprop 
#'    # ## Average Asylum Processing Time
#'    "plot_ctr_processing_time", # year =, country_asylum_iso3c ,  country_origin_iso3c ,  procedureType  
#'    
#'    # # 6. Solutions 
#'    # ## Plot Solution Over time 
#'    "plot_ctr_solution", # year , country_asylum_iso3c, pop_type  
#' 
#'    # # 7.Migrant 
#'    # ## Plot Ratio Refugee Migrant 
#'    "plot_ctr_disp_migrant" # year , country_asylum_iso3c ,   top_n_countries,
#'
#' @noRd 
#'
#' @import  shiny  
#' @importFrom shinyjs  useShinyjs
#' @keywords internal
mod_plotviz_ui <- function(id, thisPlot){
  ns <- NS(id)


  tagList(
      # Set up shinyjs
      shinyjs::useShinyjs(),  
      ## Display the plot
        plotOutput(outputId = ns("thisplot"),
                   click= ns("annotate_point"),
                   brush= shiny::brushOpts(id= ns("annotate_box")),
                   height = "500px"),
      ## Display the interface parameters...
       fluidRow(
         shinydashboard::box(
           title = "Tell Your Story!",
           #  status = "primary",
           status = "info",
           solidHeader = FALSE,
           collapsible = TRUE,
           #background = "light-blue",
           width = 12,
           fluidRow(

             ## First column used to storytelling
             column(
               6,
               h4("Interpret"),   
               textInput(
                 inputId = ns("title"),
                 label = "Title - Outline the Message!",
                 value = "",
                 placeholder = "Keep it short!"
               ),
               textInput(
                 inputId = ns("subtitle"),
                 label = "SubTitle - Add Insights!",
                 value = "",
                 placeholder = "Help in reading the chart"
               ), 
               textAreaInput(inputId = ns("annot"),
                 label= "Highlight data points!",
                 placeholder = "Text to overlay as an annotation",
                           width = '100%'),
               tags$i("Apply the following to position the annotation:") ,
               fluidRow(
                       column(   5,
                         shiny::verbatimTextOutput(
                              outputId =  ns("annotinfo"), 
                              placeholder = TRUE )
                         ),
                       column(  5,
                         shiny::verbatimTextOutput(
                              outputId =    ns("annotinfo2"), 
                              placeholder = TRUE )
                       ),
                       column(   2,
                        # shiny::verbatimTextOutput(
                        #       outputId =    ns("annotinfo3"), 
                        #       placeholder = TRUE ),         
                         shiny::actionButton(
                           inputId =  ns("annotgo"),
                           label = "Display",
                           #class = "btn-success" ,
                           icon = shiny::icon("up-down") )
                       ) 
                    ) # end annot...
             ), # end interpret

             ## Second Columns used for chart parameters..
             column(4, 
                h4("Filter"),    
               ## pop_type or pop_filter    
               if (thisPlot %in% c( "plot_ctr_treemap",
                                     "plot_ctr_population_type_per_year",
                                     "plot_ctr_diff_in_pop_groups",
                                     "plot_ctr_origin_history",
                                     "plot_ctr_destination",
                                     "plot_ctr_pyramid")  
                    ){  checkboxGroupInput(  inputId = ns("pop_type"),
                          label = "Population Types to include",
                          choices = c("Refugee" ="REF", 
                                    "Asylum Seeker"= "ASY", 
                                    "Other in Need of International Protection"="OIP" ,
                                    "Other of Concern"= "OOC",
                                    "Stateless"="STA",
                                    "Internally Displaced Persons"=     "IDP" ),
                          selected = c("REF",  "ASY",  "OIP",  "OOC",  "STA",  "IDP" ) )

                    } else if (thisPlot %in% c( "plot_ctr_population_type_abs" ,
                                                  "plot_ctr_population_type_perc") 
                     ){ selectInput(  inputId = ns("pop_type"),
                          label = "Population Type to include",
                          choices = c( "Refugee" ="REF", 
                                     "Asylum Seeker"= "ASY", 
                                     "Other in Need of International Protection"="OIP"  ),
                          selected =   "ASY" )
                    } else {""},

               ## top_n_countries ,  numericInput
               if (thisPlot %in% c( "plot_ctr_population_type_abs",
                                    "plot_ctr_population_type_perc",
                                    "plot_ctr_origin_recognition",
                                    "plot_ctr_recognition",
                                    "plot_ctr_disp_migrant")  
                   ){  sliderInput( inputId =   ns("top_n_countries"), 
                                label = "Top n Countries", 
                                value = 5,  min = 4 , max = 30, step = 1 ,
                                width = '100%') } else {""},

               ## lag  # numericInput
               if (thisPlot %in% c("plot_ctr_population_type_per_year",
                                    "plot_ctr_origin_history",
                                    "plot_ctr_asylum",
                                   "plot_ctr_solution",
                                   "plot_ctr_solution_recognition")  
                   ){  sliderInput( inputId =   ns("lag"), 
                                label = "Lag Period (in years)", 
                                value = 3,  min = 3 , max = 20, step = 1 ,
                                width = '100%') } else {""},

               ## otherprop   ## numeric input
               if (thisPlot %in% c("plot_ctr_origin_history",
                                    "plot_ctr_process")  
                   ){  sliderInput( inputId =   ns("otherprop"), 
                                label = "Percent of records to bind as Other", 
                                value = 0.02 ,  min = 0.01 , max = 0.10, step = 0.01 ,
                                width = '100%') } else {""},

             ## show_diff_label  ## boolean
               if (thisPlot %in% c("plot_ctr_population_type_abs" )  
                   ){  selectInput(  inputId = ns("show_diff_label"),
                          label = "Show Difference to previous Year",
                          choices = c(   "True" =TRUE, 
                                     "False"= FALSE   ),
                          selected =   TRUE) } else {""},

             ## country_origin_iso3c  ## selectise
               if (thisPlot %in% c("ctr_processing_time")  
                   ){   selectizeInput(inputId = ns("country_origin_iso3c"),
                       label = " Filter by orgin...", 
                      choices = ForcedDisplacementStat::end_year_population_totals |>
              dplyr::arrange(CountryAsylumName) |>
              dplyr::select(CountryAsylumCode) |>
              dplyr::distinct()  |>
              dplyr::pull(CountryAsylumCode) |>
              purrr::set_names(
                               ForcedDisplacementStat::end_year_population_totals |>
                                 dplyr::arrange(CountryAsylumName) |>
                                 dplyr::select(CountryAsylumName) |>
                                 dplyr::distinct()|>
                                 dplyr::pull(CountryAsylumName) ), 
                       selected = NULL, 
                       multiple = FALSE,
                       options = NULL)

                 } else {""},
             ## procedureType ## slectone
               if (thisPlot %in% c("plot_ctr_processing_time" )  
                   ){  selectInput(  inputId = ns("procedureType"),
                          label = "Procedure Type",
                          choices = c( "Government"="G",
                                        "Joint"= "J" ,
                                        "UNHCR" = "U"),
                          selected =   "G" )} else {""},
             ##   measure ,  selectOne and 
               if (thisPlot %in% c("plot_ctr_origin_recognition" ,
                                    "plot_ctr_recognition")  
                   ){  selectInput(  inputId = ns("measure"),
                          label = "Measure",
                          choices = c(  
                          "Refugee Recognition Rate" ="RefugeeRecognitionRate", 
                           "Total Recognition Rate"= "TotalRecognitionRate"  ),
                          selected =   "RefugeeRecognitionRate" ) } else {""},
             #order_by  , selectOne
               if (thisPlot %in% c("plot_ctr_origin_recognition" ,
                                    "plot_ctr_recognition")  
                   ){  selectInput(  inputId = ns("order_by"),
                          label = "Order by",
                         choices = c( "Recognized Refugee Status Decisions"= "Recognized", 
                        "Complementary Protection"= "ComplementaryProtection", 
                               "Total Decision (independently of the outcome)"= "TotalDecided" ),
                          selected =   "Recognized" ) } else {""},


              if (thisPlot %in% c( "plot_ctr_solution")  
                    ){  checkboxGroupInput(  inputId = ns("sol_type"),
                          label = "Solution Types to include",
                          choices = c( "Resettlement Arrivals" = "RST",
                                       "Naturalisation" ="NAT",
                                       "Refugee returns, aka Departure"  ="RET", 
                                       "IDP returns" = "RDP"  ),
                          selected = c("NAT", "RST", "RET" ) )} else  {""},

                    ""),

             ## Last column used for the two buttons - download chart and reproducibility
             column(
               2,
               h4("Export"),

             fluidRow(
                 column(
                   4,
                   numericInput(inputId = ns("width"),
                              label ="Image width:", 
                              value = 4,
                              min = 3,
                              max = 12,
                              step = 0.5,
                              width = '60px')),
                 column(
                   4,
                   numericInput(inputId = ns("height"),
                              label = "Image height:", 
                              value = 4,
                              min = 3,
                              max = 8,
                              step = 0.5,
                              width = '60px' )),
                 column(
                   4,
                   numericInput(inputId = ns("size"), 
                              label ="Font Size:", 
                              value = 22,
                              min = 12,
                              max = 32,
                              step = 1,
                              width = '60px' ) )
             ),
             selectInput(  inputId = ns("format"),
                          label = "Format",
                         choices = c( "Image file (png) "= "png", 
                                      "Vector File (svg) for designers"= "svg", 
                                      "Code Snippet (r) for reproducibility"= "r" ),
                          selected =   "png" ) ,

               # always hide the download button
               # conditionalPanel(
               #      "false",
               #      downloadButton(outputId =  ns("dl"))
               #    ),
               hr(),
              ## Depending on the export format - launch either download or modal
               downloadButton(outputId = ns("dl"),
                              label = "Fake",
                              style = "visibility: hidden;"),
               actionButton(inputId = ns("reproducibility"),
                            label = "Fake", 
                            style = "visibility: hidden;"),
               actionButton( inputId =  ns("drop"),
                                 label = "Share your story",
                                 class = "btn-success" ,
                                 icon = shiny::icon("share-from-square")
               ),
               br() #,
              # "A code snippet to inject in your notebook: ", 
               #shiny::tag(br()),
               # actionButton(inputId= ns("reproducibility"), 
               #              label= "Reproducibility",
               #              class = "btn-success",
               #               icon =   icon('gears') )

             )  # End column
           )  # End First Fluid Row...
         ) #, #  shinydashboard::box

       ## Now render the plot... 
       # shinydashboard::box(
       #   width = 12,
       #   plotOutput(ns("thisplot"),
       #               click="annotate_point",
       #               brush= shiny::brushOpts(id="annotate_box"))
       #    ) ## end box


       ) ## End Main fluid row
  )
}

#' plotviz Server Functions
#'
#' @param thisPlot reference to the plot  function from the chart library
#' @param reactiveParameters  Main app filters defined through mod_input
#' @noRd 
#' @import ggplot2
#' @import svglite 
#' @importFrom stringr str_wrap
#' @import shiny
#' @importFrom shinyjs click
#' @keywords internal
mod_plotviz_server <- function(id, thisPlot, reactiveParameters){

  moduleServer( id, function(input, output, session){
    ns <- session$ns 
     # Initialize reactive values
     reactLocal <- reactiveValues(
       x = 0, y = 0,
       xmax = 0,  ymax = 0,  xmin = 0,  ymin = 0,
       xbox = 0,   ybox = 0,  arrowcurve = 0.3,  arrowangle = 140,
       annot = "", 
       annotgo = 0,
       xcentroid = 0,  ycentroid = 0,
       thisPlot = "",
       chart =   ggplot2::ggplot() +  
          ggplot2::annotate("text", x = 1, y = 1, size = 11, 
                            label = "There was a schmilblick..." ) +  
          ggplot2::theme_void(), 
       codeinit = "# install.packages(\"pak\") \n # pak::pkg_install(\"edouard-legoupil/unhcrdatapackage\") \n library(\"unhcrdatapackage\")"   
       )

     ## Observe Point
     observeEvent(input$annot,
                  handlerExpr = {
                    reactLocal$annot = input$annot
                    # console
                     cat(
                      file = stderr(),
                      "\n observeEvent Annotation:",
                      "\n ",
                    #  input$annot,
                    #  "\n ",
                      reactLocal$annot, "\n ")
                  })

     ## Get it in UI through verbatim !
     output$annotinfo3 <- shiny::renderText({
       reactLocal$annot
     })
     ## Observe Brush
     observeEvent(input$annotate_point,
                  handlerExpr = {
                    reactLocal$x = input$annotate_point$x
                    reactLocal$y = input$annotate_point$y
                    #reactLocal$annotgo <- FALSE
                    # Get it in the console...
                    cat(file=stderr(),
                      "\n observeEvent annotate_point:",
                      "\n  - x: ",
                     # input$annotate_point$x, "\n",
                      reactLocal$x,"\n",
                      " / y: ",
                     # input$annotate_point$y ,"\n",
                      reactLocal$y,
                      "\n"
                      #    "\n  - xbox: ", reactLocal$xbox,
                      # " / ybox: ", reactLocal$ybox
                    )
                  })
     ## Observer Brush o define the attachment point
     observeEvent(input$annotate_box,
                  handlerExpr = {
                    reactLocal$xmax <- input$annotate_box$xmax
                    reactLocal$xmin <- input$annotate_box$xmin
                    reactLocal$ymax <- input$annotate_box$ymax
                    reactLocal$ymin <- input$annotate_box$ymin

                    ## Position to anchor text box - always aligned on left horizontal
                    reactLocal$xcentroid = reactLocal$xmin
                    #  then centered on the middle vertical
                    reactLocal$ycentroid = reactLocal$ymin + (reactLocal$ymax - reactLocal$ymin) /  2

                    ## Now adjust the point to anchor the box to arrow
                    ## always get  small delta so it si not too cloe
                    ## will be on left if x < xmin -
                    # in the middle if in between
                    # or on right if x > xmax
                    if (reactLocal$x <= reactLocal$xmin) {
                       reactLocal$xbox = reactLocal$xmin -   (reactLocal$xmax - reactLocal$xmin) *  0.1
                       reactLocal$ybox = reactLocal$ycentroid

                    } else  if (reactLocal$x > reactLocal$xmin & reactLocal$x < reactLocal$xmax) {
                      reactLocal$xbox = reactLocal$xmax - reactLocal$xmin
                        # ## and now the y
                        if (reactLocal$y <= reactLocal$ymin) {
                           reactLocal$ybox = reactLocal$ymin -   (reactLocal$ymax - reactLocal$ymin) *  0.1
                        } else  if (reactLocal$y > reactLocal$ymin & reactLocal$y < reactLocal$ymax) {
                          reactLocal$ybox = reactLocal$ymax - reactLocal$ymin
                        } else  if (reactLocal$y >= reactLocal$ymax) {
                          reactLocal$ybox = reactLocal$ymax +   (reactLocal$ymax - reactLocal$ymin) *  0.1
                        }

                    } else  if (reactLocal$x >= reactLocal$xmax) {
                      reactLocal$xbox = reactLocal$xmax +   (reactLocal$xmax - reactLocal$xmin) *  0.1
                      reactLocal$ybox = reactLocal$ycentroid
                    }

                    ## Getting arrow curve and angle ###
                    if (reactLocal$ybox > reactLocal$ycentroid) {
                      reactLocal$arrowcurve = -.3
                    } else {
                      reactLocal$arrowcurve = .3
                    }
                    if (reactLocal$ybox > reactLocal$ycentroid) {
                      reactLocal$arrowangle = 240
                    } else {
                      reactLocal$arrowangle = 140
                    }
                  })


    ## Get it in UI through verbatim !
    output$annotinfo <- shiny::renderText({
       # browser()
        paste0("One first single click on the \n plot to point what you would \n like to highlight:",
               "\n  - x: ", round(reactLocal$x),
               " / y: ", round(reactLocal$y))
     })
    ## Get it in UI through verbatim !
    output$annotinfo2 <- shiny::renderText({
       # browser()
        paste0("A long brush click to draw the \n  box where the annotation \n should be overlaid: ",
               "\n  - xmin: ",  round(reactLocal$xmin),
               " / ymin: ", round(reactLocal$ymin),
               "\n  - xmax: ", round(reactLocal$xmax),
               " / ymax: ", round(reactLocal$ymax) 
             )
     })

    ## Observe title
    observeEvent( input$title,
                 handlerExpr = {
                  reactLocal$title <- input$title #|> 
                             #debounce(1000) 
                  }
    )

    ## Observe title
    observeEvent( input$subtitle,
                 handlerExpr = {
                  reactLocal$subtitle <- input$subtitle #|> 
                             #debounce(1000) 
                  }
    )

    ## Observe add annnotation
    observeEvent( input$annotgo,
                  handlerExpr = {
                    reactLocal$annotgo <- input$annotgo
                  } 
     )

    ### Plot rendering function
    output$thisplot <- renderPlot({
      ## Debugging.. 
        #browser()
       # Get it in the console...
       cat(file=stderr(),
            "renderPlot type", 
            thisPlot, " for year ", 
            reactiveParameters$year,  "\n" 
           )

    # 1. Category 
    # ## Key Figures
      if( thisPlot == "plot_ctr_keyfig"){
        p  <-  plot_ctr_keyfig(
                year = as.numeric(reactiveParameters$year),
                country_asylum_iso3c = reactiveParameters$country)
    # ## Plot Tree Map of Categories
      } else  if( thisPlot == "plot_ctr_treemap"){
        p <-  plot_ctr_treemap(
                year = as.numeric(reactiveParameters$year),
                country_asylum_iso3c = reactiveParameters$country,
                pop_type = input$pop_type)
    # ## Plot Population type per year
      } else if( thisPlot == "plot_ctr_population_type_per_year"){
        p <-  plot_ctr_population_type_per_year(
                year = as.numeric(reactiveParameters$year),
                country_asylum_iso3c = reactiveParameters$country,
                pop_type = input$pop_type,
                lag = input$lag)
    # # 2. Origin
    # ## Plot Main country of origin  in one specific country
        #- Absolute value
      } else if( thisPlot == "plot_ctr_population_type_abs"){
        p <-  plot_ctr_population_type_abs(
                year = as.numeric(reactiveParameters$year),
                country_asylum_iso3c = reactiveParameters$country,
                pop_type = input$pop_type,
                top_n_countries = input$top_n_countries,
                show_diff_label = input$show_diff_label)
    # ## Plot Main country of origin in one specific country 
        #- Percentage
      } else if( thisPlot == "plot_ctr_population_type_perc"){
        p <-  plot_ctr_population_type_perc(
                year = as.numeric(reactiveParameters$year),
                country_asylum_iso3c = reactiveParameters$country,
                pop_type = input$pop_type,
                top_n_countries = input$top_n_countries)
    # ## Plot Increases and Decreases in Population Groups
      } else if( thisPlot == "plot_ctr_diff_in_pop_groups"){
        p <-  plot_ctr_diff_in_pop_groups(
                year = as.numeric(reactiveParameters$year),
                country_asylum_iso3c = reactiveParameters$country,
                pop_type = input$pop_type)
    # ## Plot Origin History
      } else if( thisPlot == "plot_ctr_origin_history"){
        p <-  plot_ctr_origin_history(
                year = as.numeric(reactiveParameters$year),
                country_asylum_iso3c = reactiveParameters$country,
                pop_type = input$pop_type,
                lag = input$lag,
                otherprop = input$otherprop)
    # # 3. Destination 
    # ## Plot Main Destination from  one specific country 
      } else if( thisPlot == "plot_ctr_destination"){
        p  <-  plot_ctr_destination(
                year = as.numeric(reactiveParameters$year),
                country_origin_iso3c = reactiveParameters$country,
                pop_type = input$pop_type )
    # ## plot recognition rate for a nationality
      } else if( thisPlot == "plot_ctr_origin_recognition"){
        p  <-  plot_ctr_origin_recognition(
                year = as.numeric(reactiveParameters$year),
                country_origin_iso3c = reactiveParameters$country,
                top_n_countries = input$top_n_countries,
                measure  = input$measure ,
                order_by = input$order_by)
    # # 4. Profile
    # ## Plot Age Pyramid
      }  else if( thisPlot == "plot_ctr_pyramid"){
        p  <-  plot_ctr_pyramid(
                year = as.numeric(reactiveParameters$year),
                country_asylum_iso3c = reactiveParameters$country,
                pop_type = input$pop_type )
    # ## Plot locations within countries
      } else if( thisPlot == "plot_ctr_location"){
        p  <-  plot_ctr_location(
                year = as.numeric(reactiveParameters$year),
                country_asylum_iso3c = reactiveParameters$country,
                pop_type = input$pop_type,
                mapbackground = "osm")
    # # 5. Processing
    # ## Plot Refugee Recognition rate in Country
      } else if( thisPlot == "plot_ctr_recognition"){
        p  <-  plot_ctr_recognition(
                year = as.numeric(reactiveParameters$year),
                country_asylum_iso3c = reactiveParameters$country,
                top_n_countries = input$top_n_countries,
                measure  = input$measure ,
                order_by = input$order_by)
    # ## Asylum Applications & Decision over time
      } else if( thisPlot == "plot_ctr_asylum"){
        p  <-  plot_ctr_asylum(
                year = as.numeric(reactiveParameters$year),
                country_asylum_iso3c = reactiveParameters$country,
                lag = input$lag)
    # ## Asylum Processing
      } else if( thisPlot == "plot_ctr_process"){
        p  <-  plot_ctr_process(
                year = as.numeric(reactiveParameters$year),
                country_asylum_iso3c = reactiveParameters$country,
                otherprop = input$otherprop)
    # ## Average Asylum Processing Time
      } else if( thisPlot == "plot_ctr_processing_time"){
        p  <-  plot_ctr_processing_time(
                year = as.numeric(reactiveParameters$year),
                country_asylum_iso3c = reactiveParameters$country,
                country_origin_iso3c = NULL,
                #input$country_origin_iso3c,
                procedureType = input$procedureType)
    # # 6. Solutions 
    # ## Plot Solution Over time 
      } else if( thisPlot == "plot_ctr_solution"){
        p  <-  plot_ctr_solution(
                year = as.numeric(reactiveParameters$year),
                country_asylum_iso3c = reactiveParameters$country,
                sol_type = input$sol_type,
                lag = input$lag)

      } else if( thisPlot == "plot_ctr_solution_recognition"){
        p  <-  plot_ctr_solution_recognition(
                year = as.numeric(reactiveParameters$year),
                country_asylum_iso3c = reactiveParameters$country,
                lag = input$lag)
    # # 7.Migrant 
    # ## Plot Ratio Refugee Migrant 
      } else if( thisPlot == "plot_ctr_disp_migrant"){
        p  <-  plot_ctr_disp_migrant(
                year = as.numeric(reactiveParameters$year),
                country_asylum_iso3c = reactiveParameters$country,
                top_n_countries = input$top_n_countries)
        ## Default in case...
      } else {
        p  <- ggplot2::ggplot() +
          ggplot2::annotate("text", x = 1, y = 1, size = 11,
                  label = "A significant problem occured..." ) +
          ggplot2::theme_void()
      }

         ## Now adding title and subtitle...
          if (reactLocal$title != "") { 
            p  <- p +   labs(title = stringr::str_wrap(input$title, 80) )
            }
          if (input$subtitle != "") {   
            p  <- p +     labs(subtitle = stringr::str_wrap(input$subtitle, 1000 ))
          }

            ## Now adding annotation
          if ( reactLocal$annotgo > 0  ) { 
                 p <- p +         
                    ggplot2::annotate(
                      geom = "text",
                      x = reactLocal$xcentroid,
                      y = reactLocal$ycentroid, 
                       #label =  dplyr::last(reactLocal$annot)  ,
                      label = stringr::str_wrap(dplyr::last(reactLocal$annot), 40) ,
                      # hjust and vjust make the reference point 
                      # the lower left corner of your text
                      hjust = 0, vjust = 0.5,
                      color = "grey50",  
                      size = 4, 
                      #fontface = "bold",
                      lineheight = .9) +
                    ## and the connecting Arrow
                    ggplot2::annotate(
                      geom = "curve",
                      x = reactLocal$xbox,
                      y = reactLocal$ybox, 
                      xend = reactLocal$x, 
                      yend = reactLocal$y,
                     # angle = reactLocal$arrowangle,
                      curvature = reactLocal$arrowcurve, 
                      color = "grey50",  
                      arrow = ggplot2::arrow(
                        length = ggplot2::unit(12, "pt"),
                        type = "closed", ends = "last")  )
                  }

        ## Ready to add story telling... 
        reactLocal$chart <- p
       # reactLocal$chart
        p  
      })


    ## Button to manage chart download
    output$dl <- downloadHandler(   

          filename = function() {
              paste(thisPlot,"_",
                    reactiveParameters$year,"_",
                    reactiveParameters$country,"_",
                    format(Sys.time(), "%Y_%m_%d_%H_%M_%S"),  '.',input$format, sep='')  },
            content = function(con) {
              ggsave(filename= con,
                     plot = reactLocal$chart + 
                           ## Increase font size for rendering on phone
                           # theme(text = element_text(size = 22)) , 
                            theme(text = element_text(size = input$size),
                                plot.title=  element_text(size = input$size + 4), 
                                plot.subtitle=  element_text(size = input$size + 2)) , 
                     #device = "svg",
                     device = input$format,
                     ## Square style for insta!
                    # width = 4,
                    # height = 4,
                     width = input$width,
                     height = input$height,
                     units = "in",
                     dpi = "retina" )
            }
          )

    ## get it saved on dropbox 
    # https://stackoverflow.com/questions/75675984/r-shiny-how-to-have-an-action-button-that-automatically-downloads-a-csv-file
    observeEvent(input$drop, {
      #downloadButton(ns("dl"),label = "Fake", style = "visibility: hidden;"),
     # runjs("$('#dl')[0].click();")
      if( input$format %in% c("png", "svg")) {

          ## Launch the download...   
          shinyjs::click("dl")
          plotfile = file.path(tempdir(),  paste( thisPlot,"_",
                        reactiveParameters$year,"_",
                        reactiveParameters$country,"_",
                        format(Sys.time(), "%Y_%m_%d_%H_%M_%S"),
                        '.', input$format,  sep=''))
           ## Save plot in that file
           ggsave( filename= plotfile,
                   plot = reactLocal$chart +
                           ## Increase font size for rendering on phone
                         # theme(text = element_text(size = 22)) ,
                          theme(text = element_text(size = input$size),
                                plot.title=  element_text(size = input$size + 4), 
                                plot.subtitle=  element_text(size = input$size + 2)) ,
                   #device = "png",
                   device = input$format,
                   width = input$width,
                   height = input$height,
                   units = "in",
                   dpi = "retina"  )


      } else {
          shinyjs::click("reproducibility")
      }

      })

     ## Modal displaying chart syntax 
     mod <- function() {
            modalDialog(
              tagList(
                tags$p("Reproducible Script for this chart in R Language: " ),
                tags$code(
                  id = ns("codeinner"),
                  tags$pre(
                   # paste(style_text("reactLocal$code"), collapse = "\n")
                    paste( dplyr::last(reactLocal$code) , collapse = "\n")
                  )
                )
              ),
              footer = tagList(
                actionButton(ns("ok"), "Got it!")
              )
            )
          }
     observeEvent(input$reproducibility, {
       # 1. Category 
    # ## Key Figures
      if( thisPlot == "plot_ctr_keyfig"){
        reactLocal$code <- sprintf(
        " %s  \n   plot_ctr_keyfig( \n  year = as.numeric( %s ), \n  country_asylum_iso3c = \"%s\") \n",
                        reactLocal$codeinit,
                        reactiveParameters$year,
                        reactiveParameters$country)


    # ## Plot Tree Map of Categories
      } else  if( thisPlot == "plot_ctr_treemap"){
        reactLocal$code <- sprintf(
        " %s  \n  plot_ctr_treemap( \n   year = as.numeric( %s ),  \n country_asylum_iso3c = \"%s\" ,  \n pop_type =  c( %s ))",
                        reactLocal$codeinit,
                        reactiveParameters$year,
                        reactiveParameters$country,
                        paste(sprintf('"%s"',input$pop_type), collapse=",")) 

    # ## Plot Population type per year
      } else if( thisPlot == "plot_ctr_population_type_per_year"){ 
        reactLocal$code <- sprintf(
        " %s  \n  plot_ctr_population_type_per_year( \n  year = as.numeric( %s ), \n country_asylum_iso3c = \"%s\" , \n  pop_type =  c( %s )  ,  \n lag =  %s)",
                        reactLocal$codeinit,
                        reactiveParameters$year,
                        reactiveParameters$country,
                        paste(sprintf('"%s"',input$pop_type), collapse=","),
                        input$lag) 
    # # 2. Origin
    # ## Plot Main country of origin  in one specific country
        #- Absolute value
      } else if( thisPlot == "plot_ctr_population_type_abs"){ 
        reactLocal$code <- sprintf(
        " %s  \n  plot_ctr_population_type_abs( \n year = as.numeric( %s ), \n country_asylum_iso3c = \"%s\" ,\n  pop_type =  c( %s ), \n top_n_countries =  %s, \n show_diff_label =  %s)",
                        reactLocal$codeinit,
                        reactiveParameters$year,
                        reactiveParameters$country,
                        paste(sprintf('"%s"',input$pop_type), collapse=","),
                        input$top_n_countries,
                        input$show_diff_label)
    # ## Plot Main country of origin in one specific country 
        #- Percentage
      } else if( thisPlot == "plot_ctr_population_type_perc"){ 
        reactLocal$code <- sprintf(
        " %s  \n plot_ctr_population_type_perc( \n year = as.numeric( %s ), \n country_asylum_iso3c = \"%s\"   ,  \n pop_type =  c( %s ), \n top_n_countries =  %s)",
                        reactLocal$codeinit,
                        reactiveParameters$year,
                        reactiveParameters$country,
                        paste(sprintf('"%s"',input$pop_type), collapse=","),
                        input$top_n_countries)
    # ## Plot Increases and Decreases in Population Groups
      } else if( thisPlot == "plot_ctr_diff_in_pop_groups"){ 
        reactLocal$code <- sprintf(
       " %s  \n  plot_ctr_diff_in_pop_groups( \n year = as.numeric( %s ), \n  country_asylum_iso3c = \"%s\"  ,  \n pop_type =  c( %s ))",
                        reactLocal$codeinit,
                        reactiveParameters$year,
                        reactiveParameters$country,
                        paste(sprintf('"%s"',input$pop_type), collapse=","))
    # ## Plot Origin History
      } else if( thisPlot == "plot_ctr_origin_history"){ 
        reactLocal$code <- sprintf(
        " %s  \n  plot_ctr_origin_history( \n year = as.numeric( %s ), \n country_asylum_iso3c = \"%s\",  \n pop_type =  c( %s ), \n lag =  %s, \n otherprop =  %s)",
                        reactLocal$codeinit,
                        reactiveParameters$year,
                        reactiveParameters$country,
                        paste(sprintf('"%s"',input$pop_type), collapse=","),
                        input$lag,
                        input$otherprop)
    # # 3. Destination 
    # ## Plot Main Destination from  one specific country 
      } else if( thisPlot == "plot_ctr_destination"){ 
        reactLocal$code <- sprintf(
       " %s  \n  plot_ctr_destination( \n year = as.numeric( %s ), \n country_asylum_iso3c = \"%s\",  \n pop_type =  c( %s ))",
                        reactLocal$codeinit,
                        reactiveParameters$year,
                        reactiveParameters$country,
                        paste(sprintf('"%s"',input$pop_type), collapse=",") )
    # ## plot recognition rate for a nationality
      } else if( thisPlot == "plot_ctr_origin_recognition"){ 
        reactLocal$code <- sprintf(
       " %s  \n  plot_ctr_origin_recognition( \n year = as.numeric( %s ), \n country_asylum_iso3c = \"%s\",  \n top_n_countries =  %s, \n measure =  %s, \n order_by =  %s)",
                        reactLocal$codeinit,
                        reactiveParameters$year,
                        reactiveParameters$country,
                        input$top_n_countries,
                        input$measure ,
                        input$order_by)
    # # 4. Profile
    # ## Plot Age Pyramid
      }  else if( thisPlot == "plot_ctr_pyramid"){ 
        reactLocal$code <- sprintf(
        " %s  \n plot_ctr_pyramid( \n  year = as.numeric( %s ), \n country_asylum_iso3c = \"%s\"  ,  \n pop_type =  c( %s ))",
                        reactLocal$codeinit,
                        reactiveParameters$year,
                        reactiveParameters$country,
                        paste(sprintf('"%s"',input$pop_type), collapse=","))
    # ## Plot locations within countries
      } else if( thisPlot == "plot_ctr_location"){ 
        reactLocal$code <- sprintf(
         " %s  \n  plot_ctr_location( \n  year = as.numeric( %s ), \n  country_asylum_iso3c = \"%s\"   ,  \n pop_type =  c( %s ))",
                        reactLocal$codeinit,
                        reactiveParameters$year,
                        reactiveParameters$country,
                        paste(sprintf('"%s"',input$pop_type), collapse=","))
    # # 5. Processing
    # ## Plot Refugee Recognition rate in Country
      } else if( thisPlot == "plot_ctr_recognition"){ 
        reactLocal$code <- sprintf(
        " %s  \n   plot_ctr_recognition( \n  year = as.numeric( %s ), \n country_asylum_iso3c = \"%s\", \n top_n_countries =  %s, \n measure =  %s, \n order_by =  %s)",
                        reactLocal$codeinit,
                        reactiveParameters$year,
                        reactiveParameters$country,
                        input$top_n_countries,
                        input$measure ,
                        input$order_by)
    # ## Asylum Applications & Decision over time
      } else if( thisPlot == "plot_ctr_asylum"){ 
        reactLocal$code <- sprintf(
        " %s  \n  plot_ctr_asylum( \n year = as.numeric( %s ), \n country_asylum_iso3c = \"%s\", \n lag =  %s)",
                        reactLocal$codeinit,
                        reactiveParameters$year,
                        reactiveParameters$country,
                        input$lag)
    # ## Asylum Processing
      } else if( thisPlot == "plot_ctr_process"){ 
        reactLocal$code <- sprintf(
        " %s  \n  plot_ctr_process( \n year = as.numeric( %s ), \n country_asylum_iso3c = \"%s\", \n otherprop =  %s)",
                        reactLocal$codeinit,
                        reactiveParameters$year,
                        reactiveParameters$country,
                        input$otherprop)
    # ## Average Asylum Processing Time
      } else if( thisPlot == "plot_ctr_processing_time"){ 
        reactLocal$code <- sprintf(
        " %s  \n  plot_ctr_processing_time( \n year = as.numeric( %s ), \n country_asylum_iso3c = \"%s\",\n country_origin_iso3c = NULL, \n procedureType =  %s)",
                        reactLocal$codeinit,
                        reactiveParameters$year,
                        reactiveParameters$country,
                        input$procedureType)
    # # 6. Solutions 
    # ## Plot Solution Over time 
      } else if( thisPlot == "plot_ctr_solution"){ 
        reactLocal$code <- sprintf(
        " %s \n plot_ctr_solution( \n year = as.numeric( %s ), \n country_asylum_iso3c = \"%s\",  \n lag =  %s, \n  sol_type =  c( %s ))",
                        reactLocal$codeinit,
                        reactiveParameters$year,
                        reactiveParameters$country,
                        input$lag,
                        paste(sprintf('"%s"',input$sol_type), collapse=","))
      # ## Plot Solution Over recognition 
    } else if( thisPlot == "plot_ctr_solution_recognition"){ 
      reactLocal$code <- sprintf(
        " %s \n plot_ctr_solution_recognition( \n year = as.numeric( %s ), \n country_asylum_iso3c = \"%s\",  \n lag =  %s ) ",
                        reactLocal$codeinit,
                        reactiveParameters$year,
                        reactiveParameters$country,
                        input$lag)
    # # 7.Migrant 
    # ## Plot Ratio Refugee Migrant 
      } else if( thisPlot == "plot_ctr_disp_migrant"){ 
        reactLocal$code <- sprintf(
        "%s  \n plot_ctr_disp_migrant( \n year = as.numeric( %s ), \n country_asylum_iso3c = \"%s\") \n",
                        reactLocal$codeinit,
                        reactiveParameters$year,
                        reactiveParameters$country)

        ## Default in case...
      } else {     }  


     ## Display the syntax in a modal 
     showModal(mod())

          })
     observeEvent(input$ok, {
            removeModal()
          })


  })
}

## To be copied in the UI
# mod_plotviz_ui("migrants_1")

## To be copied in the server
# mod_plotviz_server("migrants_1")

# test_that(" mod_plotviz works", {
# 
# })

Interface Componnnent

The interface component allows to navigate within the library from home page - typically each is behind a series of shinydashboard::tabItem

Then each module includes different tabsets for each of the pplotting functions presented

mod_categories

#' categories UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd 
#'
#' @importFrom shiny NS tagList 
#' @importFrom shinydashboard box 
#' @keywords internal
mod_categories_ui <- function(id){
  ns <- NS(id)
  tagList( 
   tabsetPanel(type = "tabs",
         tabPanel(title= "Population Type Over Year",
                  mod_plotviz_ui(ns("categories1"),
                  thisPlot = "plot_ctr_population_type_per_year" ) ),

         tabPanel(title= "Tree Map",
                  mod_plotviz_ui(ns("categories2"),
                  thisPlot = "plot_ctr_treemap" ) ),

         tabPanel(title= "Key Figures",
                  mod_plotviz_ui(ns("categories3"),
                  thisPlot = "plot_ctr_keyfig" ) ) 
      ) ## End Tabset 
    )
}

#' categories Server Functions
#'
#' @param reactiveParameters  Main app filters defined through mod_input
#' @noRd 
#' @importFrom styler style_text
#' @import ggplot2
#' @import shiny
#' @importFrom stringr str_wrap
#' @keywords internal
mod_categories_server <- function(id, reactiveParameters){
  moduleServer( id, function(input, output, session){
    ns <- session$ns
    mod_plotviz_server("categories1", 
                       thisPlot = "plot_ctr_population_type_per_year", 
                       reactiveParameters )
    mod_plotviz_server("categories2", 
                       thisPlot = "plot_ctr_treemap", 
                       reactiveParameters )
    mod_plotviz_server("categories3", 
                       thisPlot = "plot_ctr_keyfig", 
                       reactiveParameters )
  })
}

## To be copied in the UI
# mod_categories_ui("categories_1")

## To be copied in the server
# mod_categories_server("categories_1")

testServer(
  mod_categories_server,
  # Add here your module params
  args = list()
  , {
    ns <- session$ns
    expect_true(
      inherits(ns, "function")
    )
    expect_true(
      grepl(id, ns(""))
    )
    expect_true(
      grepl("test", ns("test"))
    )
    # Here are some examples of tests you can
    # run on your module
    # - Testing the setting of inputs
    # session$setInputs(x = 1)
    # expect_true(input$x == 1)
    # - If ever your input updates a reactiveValues
    # - Note that this reactiveValues must be passed
    # - to the testServer function via args = list()
    # expect_true(r$x == 1)
    # - Testing output
    # expect_true(inherits(output$tbl$html, "html"))
})

test_that("module categories works", {
  ui <- mod_categories_ui(id = "test")
  golem::expect_shinytaglist(ui)
  # Check that formals have not been removed
  fmls <- formals(mod_categories_ui)
  for (i in c("id")){
    expect_true(i %in% names(fmls))
  }
})

mod_origin

#' origin UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd 
#'
#' @importFrom shiny NS tagList 
#' @keywords internal
mod_origin_ui <- function(id){
  ns <- NS(id)
  tagList(

   tabsetPanel(type = "tabs",
         tabPanel(title= "Main Country of Origin",
                  mod_plotviz_ui(ns("origin1"),
                  thisPlot = "plot_ctr_population_type_abs" ) ),

         tabPanel(title= "Main Country of Origin as %",
                  mod_plotviz_ui(ns("origin2"),
                  thisPlot = "plot_ctr_population_type_perc" ) ),

         tabPanel(title= "Increases and Decreases ",
                  mod_plotviz_ui(ns("origin3"),
                  thisPlot = "plot_ctr_diff_in_pop_groups" ) ),

         tabPanel(title= "Origin History",
                  mod_plotviz_ui(ns("origin4"), 
                  thisPlot = "plot_ctr_origin_history" ) ) 
      ) ## End Tabset 
  )
}

#' origin Server Functions
#'
#' @param reactiveParameters  Main app filters defined through mod_input
#' @noRd 
#' @import ggplot2
#' @import shiny
#' @keywords internal
mod_origin_server <- function(id, reactiveParameters){
  moduleServer( id, function(input, output, session){
    ns <- session$ns
    mod_plotviz_server("origin1", 
                       thisPlot = "plot_ctr_population_type_abs", 
                       reactiveParameters )
    mod_plotviz_server("origin2", 
                       thisPlot = "plot_ctr_population_type_perc", 
                       reactiveParameters )
    mod_plotviz_server("origin3", 
                       thisPlot = "plot_ctr_diff_in_pop_groups", 
                       reactiveParameters )
    mod_plotviz_server("origin4",
                       thisPlot = "plot_ctr_origin_history", 
                       reactiveParameters )

  })
}

## To be copied in the UI
# mod_origin_ui("origin_1")

## To be copied in the server
# mod_origin_server("origin_1")

testServer(
  mod_origin_server,
  # Add here your module params
  args = list()
  , {
    ns <- session$ns
    expect_true(
      inherits(ns, "function")
    )
    expect_true(
      grepl(id, ns(""))
    )
    expect_true(
      grepl("test", ns("test"))
    )
    # Here are some examples of tests you can
    # run on your module
    # - Testing the setting of inputs
    # session$setInputs(x = 1)
    # expect_true(input$x == 1)
    # - If ever your input updates a reactiveValues
    # - Note that this reactiveValues must be passed
    # - to the testServer function via args = list()
    # expect_true(r$x == 1)
    # - Testing output
    # expect_true(inherits(output$tbl$html, "html"))
})

test_that("module origin works", {
  ui <- mod_origin_ui(id = "test")
  golem::expect_shinytaglist(ui)
  # Check that formals have not been removed
  fmls <- formals(mod_origin_ui)
  for (i in c("id")){
    expect_true(i %in% names(fmls))
  }
})

mod_destination

#' destination UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd 
#'
#' @importFrom shiny NS tagList 
#' @keywords internal
mod_destination_ui <- function(id){
  ns <- NS(id)
  tagList(
   tabsetPanel(type = "tabs",
         tabPanel(title= "Main Destination",
                  mod_plotviz_ui(ns("destination1"),
                  thisPlot = "plot_ctr_destination" ) ),

         tabPanel(title= "Recognition by Origin",
                  mod_plotviz_ui(ns("destination2"),
                  thisPlot = "plot_ctr_origin_recognition" ) )
      ) ## End Tabset 
  )
}

#' destination Server Functions
#'
#' @param reactiveParameters  Main app filters defined through mod_input
#' @noRd 
#' @import ggplot2
#' @import shiny
#' @keywords internal
mod_destination_server <- function(id, reactiveParameters){
  moduleServer( id, function(input, output, session){
    ns <- session$ns
      mod_plotviz_server("destination1", 
                         thisPlot = "plot_ctr_destination",
                         reactiveParameters )
       mod_plotviz_server("destination2", 
                          thisPlot = "plot_ctr_origin_recognition",
                          reactiveParameters )

  })
}

## To be copied in the UI
# mod_destination_ui("destination_1")

## To be copied in the server
# mod_destination_server("destination_1")

test_that("mod_destination works", {

})

mod_demographics

#' demographics UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd 
#'
#' @importFrom shiny NS tagList 
#' @keywords internal
mod_demographics_ui <- function(id){
  ns <- NS(id)
  tagList( 
   tabsetPanel(type = "tabs",
         tabPanel(title= "Age and Gender",
                  mod_plotviz_ui(ns("demographics1"),
                  thisPlot = "plot_ctr_pyramid" ) ) #,

         # tabPanel(title= "Location",
         #          mod_plotviz_ui(ns("demographics2"), 
         #          thisPlot = "plot_ctr_location" ) )
      ) ## End Tabset 
  )
}

#' demographics Server Functions
#'
#' @noRd 
#' @import ggplot2
#' @import shiny
#' @keywords internal
mod_demographics_server <- function(id, reactiveParameters){
  moduleServer( id, function(input, output, session){
    ns <- session$ns 
   mod_plotviz_server("demographics1", 
                      thisPlot = "plot_ctr_pyramid", 
                      reactiveParameters ) 
   # mod_plotviz_server("demographics2", 
   #                    thisPlot = "plot_ctr_location", 
   #                    reactiveParameters ) 

  })
}

## To be copied in the UI
# mod_demographics_ui("demographics_1")

## To be copied in the server
# mod_demographics_server("demographics_1")

test_that("mod_demographics works", {

})

mod_processing

#' processing UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd 
#'
#' @importFrom shiny NS tagList 
#' @keywords internal
mod_processing_ui <- function(id){
  ns <- NS(id)
  tagList(
   tabsetPanel(type = "tabs",
         tabPanel(title= "Decision Flow",
                  mod_plotviz_ui(ns("processing1"),
                  thisPlot = "plot_ctr_process" ) ),

         tabPanel(title= "Recognition",
                  mod_plotviz_ui(ns("processing2"), 
                  thisPlot = "plot_ctr_recognition" ) ),

         tabPanel(title= "Applications & Decision",
                  mod_plotviz_ui(ns("processing3"), 
                  thisPlot = "plot_ctr_asylum" ) ),

         tabPanel(title= "Processing Time",
                  mod_plotviz_ui(ns("processing4"), 
                  thisPlot = "plot_ctr_processing_time" ) )
      ) ## End Tabset
  )
}

#' processing Server Functions
#' @param reactiveParameters  Main app filters defined through mod_input
#'
#' @noRd 
#' @import ggplot2
#' @import shiny
#' @keywords internal
mod_processing_server <- function(id, reactiveParameters){
  moduleServer( id, function(input, output, session){
    ns <- session$ns
       mod_plotviz_server("processing1", 
                          thisPlot = "plot_ctr_process", 
                          reactiveParameters )
       mod_plotviz_server("processing2", 
                          thisPlot = "plot_ctr_recognition",
                          reactiveParameters )
       mod_plotviz_server("processing3", 
                          thisPlot = "plot_ctr_asylum", 
                          reactiveParameters )
       mod_plotviz_server("processing4",
                          thisPlot = "plot_ctr_processing_time", 
                          reactiveParameters )

  })
}

## To be copied in the UI
# mod_processing_ui("processing_1")

## To be copied in the server
# mod_processing_server("processing_1")

test_that("mod_processing works", {

})

mod_solution

#' solution UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd 
#'
#' @importFrom shiny NS tagList 
#' @keywords internal
mod_solution_ui <- function(id){
  ns <- NS(id)
  tagList(
   tabsetPanel(type = "tabs",
         tabPanel(title= "Solutions Trend",
                  mod_plotviz_ui(ns("solution1"),
                  thisPlot = "plot_ctr_solution" ) ),

         tabPanel(title= "Solutions vs Recognition",
                  mod_plotviz_ui(ns("solution2"),
                  thisPlot = "plot_ctr_solution_recognition" ) )


      ) ## End Tabset
  )
}

#' solution Server Functions
#' @param reactiveParameters  Main app filters defined through mod_input
#'
#' @noRd 
#' @import ggplot2
#' @import shiny
#' @keywords internal
mod_solution_server <- function(id, reactiveParameters){
  moduleServer( id, function(input, output, session){
    ns <- session$ns
   mod_plotviz_server("solution1", 
                      thisPlot = "plot_ctr_solution", 
                      reactiveParameters ) 
   mod_plotviz_server("solution2", 
                      thisPlot = "plot_ctr_solution_recognition", 
                      reactiveParameters ) 

  })
}

## To be copied in the UI
# mod_solution_ui("solution_1")

## To be copied in the server
# mod_solution_server("solution_1")

test_that("mod_solution works", {

})

mod_migrants

#' migrants UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd 
#'
#' @importFrom shiny NS tagList 
#' @keywords internal
mod_migrants_ui <- function(id){
  ns <- NS(id)
  tagList(
   tabsetPanel(type = "tabs",
         tabPanel(title= "Migration and Displacement",
                  mod_plotviz_ui(ns("migrants1"),
                  thisPlot = "plot_ctr_disp_migrant" ) ) 
      ) ## End Tabset
  )

}

#' migrants Server Functions
#' @param reactiveParameters  Main app filters defined through mod_input
#'
#' @noRd 
#' @import ggplot2
#' @import shiny
#' @keywords internal
mod_migrants_server <- function(id, reactiveParameters){
  moduleServer( id, function(input, output, session){
    ns <- session$ns 
       mod_plotviz_server("migrants1", 
                          thisPlot = "plot_ctr_disp_migrant",
                          reactiveParameters ) 
  })
}

## To be copied in the UI
# mod_migrants_ui("migrants_1")

## To be copied in the server
# mod_migrants_server("migrants_1")

# test_that("mod_migrants works", {
# 
# })

# Run but keep eval=FALSE to avoid infinite loop
# Execute in the console directly
fusen::inflate(flat_file = "dev/dev_golem_module.Rmd", check = FALSE, document = TRUE,  overwrite = TRUE,vignette_name = "Golem Modules for ShinyApp")

Edouard-Legoupil/unhcrdatapackage documentation built on Nov. 6, 2023, 6:10 p.m.