Skip to contents

Implementing cs9 requires a number of functions to be called in the correct order. To make this as simple as possible, we have provided a skeleton implementation at https://github.com/csids/cs9example/

We suggest that you clone this GitHub repo to your server, and then do a global find/replace on cs9example with the name you want for your R package.

Descriptions of the required files/functions are detailed below.

00_env_and_namespace.R

https://github.com/csids/cs9example/blob/main/R/00_env_and_namespace.R

https://github.com/csids/cs9example/blob/main/R/00_env_and_namespace.R

 1 | # ******************************************************************************
 2 | # ******************************************************************************
 3 | #
 4 | # 00_env_and_namespace.R
 5 | #
 6 | # PURPOSE 1:
 7 | #   Use roxygen2 to import ggplot2, data.table, %>%, and %<>% into the namespace,
 8 | #   because these are the most commonly used packages/functions.
 9 | #
10 | # PURPOSE 2:
11 | #   Declaration of environments that can be used globally.
12 | #
13 | # PURPOSE 3:
14 | #   Fix issues/integration with other packages.
15 | #
16 | #   Most notably is the issue with rmarkdown, where an error is thrown when
17 | #   rendering multiple rmarkdown documents in parallel.
18 | #
19 | # ******************************************************************************
20 | # ******************************************************************************
21 | 
22 | #' @import ggplot2
23 | #' @import data.table
24 | #' @importFrom magrittr %>% %<>%
25 | 1
26 | 
27 | #' Declaration of environments that can be used globally
28 | #' @export global
29 | global <- new.env()
30 | 
31 | # https://github.com/rstudio/rmarkdown/issues/1632
32 | # An error is thrown when rendering multiple rmarkdown documents in parallel.
33 | clean_tmpfiles_mod <- function() {
34 |   # message("Calling clean_tmpfiles_mod()")
35 | }

01_definitions.R

https://github.com/csids/cs9example/blob/main/R/01_definitions.R

https://github.com/csids/cs9example/blob/main/R/01_definitions.R

 1 | # ******************************************************************************
 2 | # ******************************************************************************
 3 | #
 4 | # 01_definitions.R
 5 | #
 6 | # PURPOSE 1:
 7 | #   Set global definitions that are used throughout the package, and further
 8 | #   (e.g. in shiny/plumber creations).
 9 | #
10 | #   Examples of global definitions are:
11 | #     - Border years
12 | #     - Age definitions
13 | #     - Diagnosis mappings (e.g. "R80" = "Influenza")
14 | #
15 | # ******************************************************************************
16 | # ******************************************************************************
17 | 
18 | #' Set global definitions
19 | set_definitions <- function() {
20 | 
21 |   # Norway's last redistricting occurred 2024-01-01
22 |   global$border <- 2024
23 | 
24 |   csdata::set_config(
25 |     border_nor = global$border
26 |   )
27 | }

02_surveillance_systems.R

https://github.com/csids/cs9example/blob/main/R/02_surveillance_systems.R

https://github.com/csids/cs9example/blob/main/R/02_surveillance_systems.R

 1 | # ******************************************************************************
 2 | # ******************************************************************************
 3 | #
 4 | # 02_surveillance_systems.R
 5 | #
 6 | # PURPOSE 1:
 7 | #   Initialize surveillance systems
 8 | #
 9 | # ******************************************************************************
10 | # ******************************************************************************
11 | 
12 | set_surveillance_systems <- function() {
13 |   global$ss <- cs9::SurveillanceSystem_v9$new()
14 | }

03_tables.R

https://github.com/csids/cs9example/blob/main/R/03_tables.R

https://github.com/csids/cs9example/blob/main/R/03_tables.R

  1 | # ******************************************************************************
  2 | # ******************************************************************************
  3 | #
  4 | # 03_db_tables.R
  5 | #
  6 | # PURPOSE 1:
  7 | #   Set db tables that are used throughout the package.
  8 | #
  9 | # ******************************************************************************
 10 | # ******************************************************************************
 11 | 
 12 | set_db_tables <- function() {
 13 |   # __________ ----
 14 |   # Covid-19  ----
 15 |   ## > anon_covid19_data ----
 16 |   global$ss$add_table(
 17 |     name_access = c("anon"),
 18 |     name_grouping = "covid19",
 19 |     name_variant = "data",
 20 |     field_types =  c(
 21 |       "granularity_time" = "TEXT",
 22 |       "granularity_geo" = "TEXT",
 23 |       "country_iso3" = "TEXT",
 24 |       "location_code" = "TEXT",
 25 |       "border" = "INTEGER",
 26 |       "age" = "TEXT",
 27 |       "sex" = "TEXT",
 28 | 
 29 |       "isoyear" = "INTEGER",
 30 |       "isoweek" = "INTEGER",
 31 |       "isoyearweek" = "TEXT",
 32 |       "season" = "TEXT",
 33 |       "seasonweek" = "DOUBLE",
 34 | 
 35 |       "calyear" = "INTEGER",
 36 |       "calmonth" = "INTEGER",
 37 |       "calyearmonth" = "TEXT",
 38 | 
 39 |       "date" = "DATE",
 40 | 
 41 |       "covid19_cases_testdate_n" = "INTEGER",
 42 |       "covid19_cases_testdate_pr100000" = "DOUBLE"
 43 |     ),
 44 |     keys = c(
 45 |       "granularity_time",
 46 |       "location_code",
 47 |       "date",
 48 |       "age",
 49 |       "sex"
 50 |     ),
 51 |     indexes = list(
 52 |       "ind1" = c("granularity_time", "granularity_geo", "country_iso3", "location_code", "border", "age", "sex", "date", "isoyear", "isoweek", "isoyearweek")
 53 |     ),
 54 |     validator_field_types = csdb::validator_field_types_blank,
 55 |     validator_field_contents = csdb::validator_field_contents_blank
 56 |   )
 57 | 
 58 |   # __________ ----
 59 |   # Weather  ----
 60 |   ## > anon_example_weather_rawdata ----
 61 |   global$ss$add_table(
 62 |     name_access = c("anon"),
 63 |     name_grouping = "example_weather",
 64 |     name_variant = "rawdata",
 65 |     field_types =  c(
 66 |       "granularity_time" = "TEXT",
 67 |       "granularity_geo" = "TEXT",
 68 |       "country_iso3" = "TEXT",
 69 |       "location_code" = "TEXT",
 70 |       "border" = "INTEGER",
 71 |       "age" = "TEXT",
 72 |       "sex" = "TEXT",
 73 | 
 74 |       "isoyear" = "INTEGER",
 75 |       "isoweek" = "INTEGER",
 76 |       "isoyearweek" = "TEXT",
 77 |       "season" = "TEXT",
 78 |       "seasonweek" = "DOUBLE",
 79 | 
 80 |       "calyear" = "INTEGER",
 81 |       "calmonth" = "INTEGER",
 82 |       "calyearmonth" = "TEXT",
 83 | 
 84 |       "date" = "DATE",
 85 | 
 86 |       "temp_max" = "DOUBLE",
 87 |       "temp_min" = "DOUBLE",
 88 |       "precip" = "DOUBLE"
 89 |     ),
 90 |     keys = c(
 91 |       "granularity_time",
 92 |       "location_code",
 93 |       "date",
 94 |       "age",
 95 |       "sex"
 96 |     ),
 97 |     validator_field_types = csdb::validator_field_types_csfmt_rts_data_v1,
 98 |     validator_field_contents = csdb::validator_field_contents_csfmt_rts_data_v1
 99 |   )
100 | 
101 |   ## > anon_example_weather_data ----
102 |   global$ss$add_table(
103 |     name_access = c("anon"),
104 |     name_grouping = "example_weather",
105 |     name_variant = "data",
106 |     field_types =  c(
107 |       "granularity_time" = "TEXT",
108 |       "granularity_geo" = "TEXT",
109 |       "country_iso3" = "TEXT",
110 |       "location_code" = "TEXT",
111 |       "border" = "INTEGER",
112 |       "age" = "TEXT",
113 |       "sex" = "TEXT",
114 | 
115 |       "isoyear" = "INTEGER",
116 |       "isoweek" = "INTEGER",
117 |       "isoyearweek" = "TEXT",
118 |       "season" = "TEXT",
119 |       "seasonweek" = "DOUBLE",
120 | 
121 |       "calyear" = "INTEGER",
122 |       "calmonth" = "INTEGER",
123 |       "calyearmonth" = "TEXT",
124 | 
125 |       "date" = "DATE",
126 | 
127 |       "temp_max" = "DOUBLE",
128 |       "temp_min" = "DOUBLE",
129 |       "precip" = "DOUBLE"
130 |     ),
131 |     keys = c(
132 |       "granularity_time",
133 |       "location_code",
134 |       "date",
135 |       "age",
136 |       "sex"
137 |     ),
138 |     validator_field_types = csdb::validator_field_types_csfmt_rts_data_v1,
139 |     validator_field_contents = csdb::validator_field_contents_csfmt_rts_data_v1
140 |   )
141 | 
142 |   ## > anon_example_income ----
143 |   global$ss$add_table(
144 |     name_access = c("anon"),
145 |     name_grouping = "example_income",
146 |     name_variant = NULL,
147 |     field_types =  c(
148 |       "granularity_time" = "TEXT",
149 |       "granularity_geo" = "TEXT",
150 |       "country_iso3" = "TEXT",
151 |       "location_code" = "TEXT",
152 |       "border" = "INTEGER",
153 |       "age" = "TEXT",
154 |       "sex" = "TEXT",
155 | 
156 |       "isoyear" = "INTEGER",
157 |       "isoweek" = "INTEGER",
158 |       "isoyearweek" = "TEXT",
159 |       "season" = "TEXT",
160 |       "seasonweek" = "DOUBLE",
161 | 
162 |       "calyear" = "INTEGER",
163 |       "calmonth" = "INTEGER",
164 |       "calyearmonth" = "TEXT",
165 | 
166 |       "date" = "DATE",
167 | 
168 |       "household_income_median_all_households_nok" = "DOUBLE",
169 |       "household_income_median_singles_nok" = "DOUBLE",
170 |       "household_income_median_couples_without_children_nok" = "DOUBLE",
171 |       "household_income_median_couples_with_children_nok" = "DOUBLE",
172 |       "household_income_median_single_with_children_nok" = "DOUBLE"
173 |     ),
174 |     keys = c(
175 |       "granularity_time",
176 |       "location_code",
177 |       "date",
178 |       "age",
179 |       "sex"
180 |     ),
181 |     validator_field_types = csdb::validator_field_types_csfmt_rts_data_v1,
182 |     validator_field_contents = csdb::validator_field_contents_csfmt_rts_data_v1
183 |   )
184 | }

04_tasks.R

https://github.com/csids/cs9example/blob/main/R/04_tasks.R

https://github.com/csids/cs9example/blob/main/R/04_tasks.R

  1 | # ******************************************************************************
  2 | # ******************************************************************************
  3 | #
  4 | # 04_tasks.R
  5 | #
  6 | # PURPOSE 1:
  7 | #   Set all the tasks that are run by the package.
  8 | #
  9 | #   These are basically all of the "things" that you want to do.
 10 | #   E.g. Downloading data, cleaning data, importing data, analyzing data,
 11 | #   making Excel files, making docx/pdf reports, sending emails, etc.
 12 | #
 13 | # ******************************************************************************
 14 | # ******************************************************************************
 15 | 
 16 | set_tasks <- function() {
 17 |   # __________ ----
 18 |   # Covid-19  ----
 19 |   ## > covid19_import_data ----
 20 |   # tm_run_task("covid19_import_data")
 21 |   global$ss$add_task(
 22 |     name_grouping = "covid19",
 23 |     name_action = "import_data",
 24 |     name_variant = NULL,
 25 |     cores = 1,
 26 |     plan_analysis_fn_name = NULL,
 27 |     for_each_plan = plnr::expand_list(
 28 |       x = 1
 29 |     ),
 30 |     for_each_analysis = NULL,
 31 |     universal_argset = NULL,
 32 |     upsert_at_end_of_each_plan = FALSE,
 33 |     insert_at_end_of_each_plan = FALSE,
 34 |     action_fn_name = "cs9example::covid19_import_data_action",
 35 |     data_selector_fn_name = "cs9example::covid19_import_data_data_selector",
 36 |     tables = list(
 37 |       # input
 38 | 
 39 |       # output
 40 |       "anon_covid19_data" = global$ss$tables$anon_covid19_data
 41 |     )
 42 |   )
 43 | 
 44 |   # __________ ----
 45 |   # Weather  ----
 46 |   ## > weather_download_and_import_rawdata ----
 47 |   # tm_run_task("weather_download_and_import_rawdata")
 48 |   global$ss$add_task(
 49 |     name_grouping = "weather",
 50 |     name_action = "download_and_import_rawdata",
 51 |     name_variant = NULL,
 52 |     cores = 1,
 53 |     plan_analysis_fn_name = NULL,
 54 |     for_each_plan = plnr::expand_list(
 55 |       location_code = fhidata::norway_locations_names()[granularity_geo %in% c("municip")]$location_code
 56 |     ),
 57 |     for_each_analysis = NULL,
 58 |     universal_argset = NULL,
 59 |     upsert_at_end_of_each_plan = FALSE,
 60 |     insert_at_end_of_each_plan = FALSE,
 61 |     action_fn_name = "cs9example::weather_download_and_import_rawdata_action",
 62 |     data_selector_fn_name = "cs9example::weather_download_and_import_rawdata_data_selector",
 63 |     tables = list(
 64 |       # input
 65 | 
 66 |       # output
 67 |       "anon_example_weather_rawdata" = global$ss$tables$anon_example_weather_rawdata
 68 |     )
 69 |   )
 70 | 
 71 |   ## > weather_clean_data ----
 72 |   # tm_run_task("weather_clean_data")
 73 |   global$ss$add_task(
 74 |     name_grouping = "weather",
 75 |     name_action = "clean_data",
 76 |     name_variant = NULL,
 77 |     cores = 1,
 78 |     plan_analysis_fn_name = NULL,
 79 |     for_each_plan = plnr::expand_list(
 80 |       x = 1
 81 |     ),
 82 |     for_each_analysis = NULL,
 83 |     universal_argset = NULL,
 84 |     upsert_at_end_of_each_plan = FALSE,
 85 |     insert_at_end_of_each_plan = FALSE,
 86 |     action_fn_name = "cs9example::weather_clean_data_action",
 87 |     data_selector_fn_name = "cs9example::weather_clean_data_data_selector",
 88 |     tables = list(
 89 |       # input
 90 |       "anon_example_weather_rawdata" = global$ss$tables$anon_example_weather_rawdata,
 91 | 
 92 |       # output
 93 |       "anon_example_weather_data" = global$ss$tables$anon_example_weather_data
 94 |     )
 95 |   )
 96 | 
 97 |   ## > weather_clean_data ----
 98 |   # tm_run_task("weather_export_plots")
 99 |   global$ss$add_task(
100 |     name_grouping = "weather",
101 |     name_action = "export_plots",
102 |     name_variant = NULL,
103 |     cores = 1,
104 |     plan_analysis_fn_name = NULL,
105 |     for_each_plan = plnr::expand_list(
106 |       location_code = fhidata::norway_locations_names()[granularity_geo %in% c("county")]$location_code
107 |     ),
108 |     for_each_analysis = NULL,
109 |     universal_argset = list(
110 |       output_dir = tempdir(),
111 |       output_filename = "weather_{argset$location_code}.png",
112 |       output_absolute_path = fs::path("{argset$output_dir}", "{argset$output_filename}")
113 |     ),
114 |     upsert_at_end_of_each_plan = FALSE,
115 |     insert_at_end_of_each_plan = FALSE,
116 |     action_fn_name = "cs9example::weather_export_plots_action",
117 |     data_selector_fn_name = "cs9example::weather_export_plots_data_selector",
118 |     tables = list(
119 |       # input
120 |       "anon_example_weather_data" = global$ss$tables$anon_example_weather_data
121 | 
122 |       # output
123 |     )
124 |   )
125 | }

05_deliverables.R

https://github.com/csids/cs9example/blob/main/R/05_deliverables.R

https://github.com/csids/cs9example/blob/main/R/05_deliverables.R

 1 | # ******************************************************************************
 2 | # ******************************************************************************
 3 | #
 4 | # 05_deliverables.R
 5 | #
 6 | # PURPOSE 1:
 7 | #   Set all the deliverables that team members are supposed to manually do/check
 8 | #   every day/week/month.
 9 | #
10 | # ******************************************************************************
11 | # ******************************************************************************
12 | 
13 | set_deliverables <- function() {
14 | 
15 | }

10_onLoad.R

https://github.com/csids/cs9example/blob/main/R/10_onLoad.R

https://github.com/csids/cs9example/blob/main/R/10_onLoad.R

 1 | # ******************************************************************************
 2 | # ******************************************************************************
 3 | #
 4 | # 10_onLoad.R
 5 | #
 6 | # PURPOSE 1:
 7 | #   Initializing everything that happens when the package is loaded.
 8 | #
 9 | #   E.g. Calling bash scripts that authenticate against Kerebros, setting the
10 | #   configs.
11 | #
12 | # ******************************************************************************
13 | # ******************************************************************************
14 | 
15 | .onLoad <- function(libname, pkgname) {
16 |   # Mechanism to authenticate as necessary (e.g. Kerebros)
17 |   if (file.exists("/bin/authenticate.sh")) {
18 |     try(system2("/bin/authenticate.sh", stdout = NULL), TRUE)
19 |   }
20 | 
21 |   # 01_definitions.R
22 |   set_definitions()
23 | 
24 |   # 02_surveillance_systems.R
25 |   set_surveillance_systems()
26 | 
27 |   # 03_db_schemas.R
28 |   set_db_tables()
29 | 
30 |   # 04_tasks.R
31 |   set_tasks()
32 | 
33 |   # 05_deliverables.R
34 |   # set_deliverables()
35 | 
36 |   # Formatting for progress bars.
37 |   progressr::handlers(progressr::handler_progress(
38 |     format = "[:bar] :current/:total (:percent) in :elapsedfull, eta: :eta",
39 |     clear = FALSE
40 |   ))
41 | 
42 |   # https://github.com/rstudio/rmarkdown/issues/1632
43 |   assignInNamespace("clean_tmpfiles", clean_tmpfiles_mod, ns = "rmarkdown")
44 | 
45 |   invisible()
46 | }

11_onAttach.R

https://github.com/csids/cs9example/blob/main/R/11_onAttach.R

https://github.com/csids/cs9example/blob/main/R/11_onAttach.R

 1 | # ******************************************************************************
 2 | # ******************************************************************************
 3 | #
 4 | # 11_onAttach.R
 5 | #
 6 | # PURPOSE 1:
 7 | #   What you want to happen when someone types library(yourpackage)
 8 | #
 9 | # ******************************************************************************
10 | # ******************************************************************************
11 | 
12 | .onAttach <- function(libname, pkgname) {
13 |   version <- tryCatch(
14 |     utils::packageDescription("cs9example", fields = "Version"),
15 |     warning = function(w){
16 |       1
17 |     }
18 |   )
19 | 
20 |   packageStartupMessage(paste0("cs9example ",version))
21 |   packageStartupMessage(paste0("cs9 ",utils::packageDescription("cs9", fields = "Version")))
22 | }

Task files

Task files are placed in .R files under their own names.

weather_download_and_import_rawdata.R

https://github.com/csids/cs9example/blob/main/R/weather_download_and_import_rawdata.R

https://github.com/csids/cs9example/blob/main/R/weather_download_and_import_rawdata.R

  1 | # **** action **** ----
  2 | #' weather_download_and_import_rawdata (action)
  3 | #' @param data Data
  4 | #' @param argset Argset
  5 | #' @param tables DB tables
  6 | #' @export
  7 | weather_download_and_import_rawdata_action <- function(data, argset, tables) {
  8 |   # cs9::run_task_sequentially_as_rstudio_job_using_load_all("weather_download_and_import_rawdata")
  9 |   # To be run outside of rstudio: cs9example::global$ss$run_task("weather_download_and_import_rawdata")
 10 | 
 11 |   if (plnr::is_run_directly()) {
 12 |     # global$ss$shortcut_get_plans_argsets_as_dt("weather_download_and_import_rawdata")
 13 | 
 14 |     index_plan <- 1
 15 |     index_analysis <- 1
 16 | 
 17 |     data <- global$ss$shortcut_get_data("weather_download_and_import_rawdata", index_plan = index_plan)
 18 |     argset <- global$ss$shortcut_get_argset("weather_download_and_import_rawdata", index_plan = index_plan, index_analysis = index_analysis)
 19 |     tables <- global$ss$shortcut_get_tables("weather_download_and_import_rawdata")
 20 |   }
 21 | 
 22 |   # special case that runs before everything
 23 |   if (argset$first_analysis == TRUE) {
 24 | 
 25 |   }
 26 | 
 27 |   a <- data$data$properties$timeseries
 28 |   res <- vector("list", length=length(a) - 1)
 29 |   for(i in seq_along(res)){
 30 |     # i = 1
 31 |     time_from <- a[[i]]$time
 32 |     if("next_1_hours" %in% names(a[[i]]$data)){
 33 |       time_var <- "next_1_hours"
 34 |     } else {
 35 |       time_var <- "next_6_hours"
 36 |     }
 37 |     temp <- a[[i]]$data[["instant"]]$details$air_temperature
 38 |     precip <- a[[i]]$data[[time_var]]$details$precipitation_amount
 39 | 
 40 |     res[[i]] <- data.frame(
 41 |       time_from = as.character(time_from),
 42 |       temp = as.numeric(temp),
 43 |       precip = as.numeric(precip)
 44 |     )
 45 |   }
 46 | 
 47 |   res <- rbindlist(res)
 48 |   res <- res[stringr::str_sub(time_from, 12, 13) %in% c("00", "06", "12", "18")]
 49 |   res[, date := as.Date(stringr::str_sub(time_from, 1, 10))]
 50 |   res <- res[
 51 |     ,
 52 |     .(
 53 |       temp_max = max(temp),
 54 |       temp_min = min(temp),
 55 |       precip = sum(precip)
 56 |     ),
 57 |     keyby = .(date)
 58 |   ]
 59 | 
 60 |   # we look at the downloaded data
 61 |   # res
 62 | 
 63 |   # we now need to format it
 64 |   res[, granularity_time := "day"]
 65 |   res[, sex := "total"]
 66 |   res[, age := "total"]
 67 |   res[, location_code := argset$location_code]
 68 |   res[, border := global$border]
 69 | 
 70 |   # fill in missing structural variables
 71 |   cstidy::set_csfmt_rts_data_v1(res)
 72 | 
 73 |   # we look at the downloaded data
 74 |   # res
 75 | 
 76 |   # put data in db table
 77 |   tables$anon_example_weather_rawdata$upsert_data(res)
 78 | 
 79 |   # special case that runs after everything
 80 |   if (argset$last_analysis == TRUE) {
 81 | 
 82 |   }
 83 | }
 84 | 
 85 | # **** data_selector **** ----
 86 | #' weather_download_and_import_rawdata (data selector)
 87 | #' @param argset Argset
 88 | #' @param tables DB tables
 89 | #' @export
 90 | weather_download_and_import_rawdata_data_selector <- function(argset, tables) {
 91 |   if (plnr::is_run_directly()) {
 92 |     # sc::tm_get_plans_argsets_as_dt("weather_download_and_import_rawdata")
 93 | 
 94 |     index_plan <- 1
 95 | 
 96 |     argset <- global$ss$shortcut_get_argset("weather_download_and_import_rawdata", index_plan = index_plan)
 97 |     tables <- global$ss$shortcut_get_tables("weather_download_and_import_rawdata")
 98 |   }
 99 | 
100 |   # find the mid lat/long for the specified location_code
101 |   gps <- fhimaps::norway_lau2_map_b2020_default_dt[location_code == argset$location_code,.(
102 |     lat = mean(lat),
103 |     long = mean(long)
104 |   )]
105 | 
106 |   # download the forecast for the specified location_code
107 |   d <- httr::GET(glue::glue("https://api.met.no/weatherapi/locationforecast/2.0/complete?lat={gps$lat}&lon={gps$long}"))
108 |   d <- httr::content(d)
109 | 
110 |   # The variable returned must be a named list
111 |   retval <- list(
112 |     "data" = d
113 |   )
114 | 
115 |   retval
116 | }
117 | 
118 | # **** functions **** ----

weather_clean_data.R

https://github.com/csids/cs9example/blob/main/R/weather_clean_data.R

https://github.com/csids/cs9example/blob/main/R/weather_clean_data.R

  1 | # **** action **** ----
  2 | #' weather_clean_data (action)
  3 | #' @param data Data
  4 | #' @param argset Argset
  5 | #' @param tables DB tables
  6 | #' @export
  7 | weather_clean_data_action <- function(data, argset, tables) {
  8 |   # cs9::run_task_sequentially_as_rstudio_job_using_load_all("weather_clean_data")
  9 |   # To be run outside of rstudio: cs9example::global$ss$run_task("weather_clean_data")
 10 | 
 11 | 
 12 |   if (plnr::is_run_directly()) {
 13 |     # global$ss$shortcut_get_plans_argsets_as_dt("weather_clean_data")
 14 | 
 15 |     index_plan <- 1
 16 |     index_analysis <- 1
 17 | 
 18 |     data <- global$ss$shortcut_get_data("weather_clean_data", index_plan = index_plan)
 19 |     argset <- global$ss$shortcut_get_argset("weather_clean_data", index_plan = index_plan, index_analysis = index_analysis)
 20 |     tables <- global$ss$shortcut_get_tables("weather_clean_data")
 21 |   }
 22 | 
 23 |   # special case that runs before everything
 24 |   if (argset$first_analysis == TRUE) {
 25 | 
 26 |   }
 27 | 
 28 |   # make sure there's no missing data via the creation of a skeleton
 29 |   # https://folkehelseinstituttet.github.io/fhidata/articles/Skeletons.html
 30 | 
 31 |   # Create a variable (possibly a list) to hold the data
 32 |   d_agg <- list()
 33 |   d_agg$day_municip <- copy(data$day_municip)
 34 | 
 35 |   # Pull out important dates
 36 |   date_min <- min(d_agg$day_municip$date, na.rm = T)
 37 |   date_max <- max(d_agg$day_municip$date, na.rm = T)
 38 | 
 39 |   # Create `multiskeleton`
 40 |   # granularity_geo should have the following groups:
 41 |   # - nodata (when no data is available, and there is no "finer" data available to aggregate up)
 42 |   # - all levels of granularity_geo where you have data available
 43 |   # If you do not have data for a specific granularity_geo, but there is "finer" data available
 44 |   # then you should not include this granularity_geo in the multiskeleton, because you will create
 45 |   # it later when you aggregate up your data (baregion)
 46 |   multiskeleton_day <- fhidata::make_skeleton(
 47 |     date_min = date_min,
 48 |     date_max = date_max,
 49 |     granularity_geo = list(
 50 |       "nodata" = c(
 51 |         "wardoslo",
 52 |         "extrawardoslo",
 53 |         "missingwardoslo",
 54 |         "wardbergen",
 55 |         "missingwardbergen",
 56 |         "wardstavanger",
 57 |         "missingwardstavanger",
 58 |         "notmainlandmunicip",
 59 |         "missingmunicip",
 60 |         "notmainlandcounty",
 61 |         "missingcounty"
 62 |       ),
 63 |       "municip" = c(
 64 |         "municip"
 65 |       )
 66 |     )
 67 |   )
 68 | 
 69 |   # Merge in the information you have at different geographical granularities
 70 |   # one level at a time
 71 |   # municip
 72 |   multiskeleton_day$municip[
 73 |     d_agg$day_municip,
 74 |     on = c("location_code", "date"),
 75 |     c(
 76 |       "temp_max",
 77 |       "temp_min",
 78 |       "precip"
 79 |     ) := .(
 80 |       temp_max,
 81 |       temp_min,
 82 |       precip
 83 |     )
 84 |   ]
 85 | 
 86 |   multiskeleton_day$municip[]
 87 | 
 88 |   # Aggregate up to higher geographical granularities (county)
 89 |   multiskeleton_day$county <- multiskeleton_day$municip[
 90 |     fhidata::norway_locations_hierarchy(
 91 |       from = "municip",
 92 |       to = "county"
 93 |     ),
 94 |     on = c(
 95 |       "location_code==from_code"
 96 |     )
 97 |   ][,
 98 |     .(
 99 |       temp_max = mean(temp_max, na.rm = T),
100 |       temp_min = mean(temp_min, na.rm = T),
101 |       precip = mean(precip, na.rm = T),
102 |       granularity_geo = "county"
103 |     ),
104 |     by = .(
105 |       granularity_time,
106 |       date,
107 |       location_code = to_code
108 |     )
109 |   ]
110 | 
111 |   multiskeleton_day$county[]
112 | 
113 |   # Aggregate up to higher geographical granularities (nation)
114 |   multiskeleton_day$nation <- multiskeleton_day$municip[
115 |     ,
116 |     .(
117 |       temp_max = mean(temp_max, na.rm = T),
118 |       temp_min = mean(temp_min, na.rm = T),
119 |       precip = mean(precip, na.rm = T),
120 |       granularity_geo = "nation",
121 |       location_code = "norge"
122 |     ),
123 |     by = .(
124 |       granularity_time,
125 |       date
126 |     )
127 |   ]
128 | 
129 |   multiskeleton_day$nation[]
130 | 
131 |   # combine all the different granularity_geos
132 |   skeleton_day <- rbindlist(multiskeleton_day, fill = TRUE, use.names = TRUE)
133 | 
134 |   skeleton_day[]
135 | 
136 |   # 10. (If desirable) aggregate up to higher time granularities
137 |   # if necessary, it is now easy to aggregate up to weekly data from here
138 |   skeleton_isoweek <- copy(skeleton_day)
139 |   skeleton_isoweek[, isoyearweek := fhiplot::isoyearweek_c(date)]
140 |   skeleton_isoweek <- skeleton_isoweek[
141 |     ,
142 |     .(
143 |       temp_max = mean(temp_max, na.rm = T),
144 |       temp_min = mean(temp_min, na.rm = T),
145 |       precip = mean(precip, na.rm = T),
146 |       granularity_time = "isoweek"
147 |     ),
148 |     keyby = .(
149 |       isoyearweek,
150 |       granularity_geo,
151 |       location_code
152 |     )
153 |   ]
154 | 
155 |   skeleton_isoweek[]
156 | 
157 |   # we now need to format it and fill in missing structural variables
158 |   # day
159 |   skeleton_day[, sex := "total"]
160 |   skeleton_day[, age := "total"]
161 |   skeleton_day[, border := global$border]
162 |   cstidy::set_csfmt_rts_data_v1(skeleton_day)
163 | 
164 |   # isoweek
165 |   skeleton_isoweek[, sex := "total"]
166 |   skeleton_isoweek[, age := "total"]
167 |   skeleton_isoweek[, border := global$border]
168 |   cstidy::set_csfmt_rts_data_v1(skeleton_isoweek)
169 | 
170 |   skeleton <- rbindlist(
171 |     list(
172 |       skeleton_day,
173 |       skeleton_isoweek
174 |     ),
175 |     use.names = T
176 |   )
177 | 
178 |   # put data in db table
179 |   tables$anon_example_weather_data$drop_all_rows_and_then_insert_data(skeleton)
180 | 
181 |   # special case that runs after everything
182 |   if (argset$last_analysis == TRUE) {
183 | 
184 |   }
185 | }
186 | 
187 | # **** data_selector **** ----
188 | #' weather_clean_data (data selector)
189 | #' @param argset Argset
190 | #' @param tables DB tables
191 | #' @export
192 | weather_clean_data_data_selector <- function(argset, tables) {
193 |   if (plnr::is_run_directly()) {
194 |     # global$ss$shortcut_get_plans_argsets_as_dt("weather_clean_data")
195 | 
196 |     index_plan <- 1
197 | 
198 |     argset <- global$ss$shortcut_get_argset("weather_clean_data", index_plan = index_plan)
199 |     tables <- global$ss$shortcut_get_tables("weather_clean_data")
200 |   }
201 | 
202 |   # The database tabless can be accessed here
203 |   d <- tables$anon_example_weather_rawdata$tbl() %>%
204 |     cs9::mandatory_db_filter(
205 |       granularity_time = "day",
206 |       granularity_time_not = NULL,
207 |       granularity_geo = "municip",
208 |       granularity_geo_not = NULL,
209 |       country_iso3 = NULL,
210 |       location_code = NULL,
211 |       age = "total",
212 |       age_not = NULL,
213 |       sex = "total",
214 |       sex_not = NULL
215 |     ) %>%
216 |     dplyr::select(
217 |       granularity_time,
218 |       # granularity_geo,
219 |       # country_iso3,
220 |       location_code,
221 |       # border,
222 |       # age,
223 |       # sex,
224 | 
225 |       date,
226 | 
227 |       # isoyear,
228 |       # isoweek,
229 |       # isoyearweek,
230 |       # season,
231 |       # seasonweek,
232 | 
233 |       # calyear,
234 |       # calmonth,
235 |       # calyearmonth,
236 | 
237 |       temp_max,
238 |       temp_min,
239 |       precip
240 |     ) %>%
241 |     dplyr::collect() %>%
242 |     as.data.table() %>%
243 |     setorder(
244 |       location_code,
245 |       date
246 |     )
247 | 
248 |   # The variable returned must be a named list
249 |   retval <- list(
250 |     "day_municip" = d
251 |   )
252 | 
253 |   retval
254 | }
255 | 
256 | # **** functions **** ----

weather_export_weather_plots.R

https://github.com/csids/cs9example/blob/main/R/weather_export_plots.R

https://github.com/csids/cs9example/blob/main/R/weather_export_plots.R

  1 | # **** action **** ----
  2 | #' weather_export_plots (action)
  3 | #' @param data Data
  4 | #' @param argset Argset
  5 | #' @param tables DB tables
  6 | #' @export
  7 | weather_export_plots_action <- function(data, argset, tables) {
  8 |   # cs9::run_task_sequentially_as_rstudio_job_using_load_all("weather_export_plots")
  9 |   # To be run outside of rstudio: cs9example::global$ss$run_task("weather_export_plots")
 10 | 
 11 |   if(plnr::is_run_directly()){
 12 |     # global$ss$shortcut_get_plans_argsets_as_dt("weather_export_plots")
 13 | 
 14 |     index_plan <- 1
 15 |     index_analysis <- 1
 16 | 
 17 |     data <- global$ss$shortcut_get_data("weather_export_plots", index_plan = index_plan)
 18 |     argset <- global$ss$shortcut_get_argset("weather_export_plots", index_plan = index_plan, index_analysis = index_analysis)
 19 |     tables <- global$ss$shortcut_get_tables("weather_export_plots")
 20 |   }
 21 | 
 22 |   # code goes here
 23 |   # special case that runs before everything
 24 |   if(argset$first_analysis == TRUE){
 25 | 
 26 |   }
 27 | 
 28 |   # create the output_dir (if it doesn't exist)
 29 |   fs::dir_create(glue::glue(argset$output_dir))
 30 | 
 31 |   q <- ggplot(data$data, aes(x = date, ymin = temp_min, ymax = temp_max))
 32 |   q <- q + geom_ribbon(alpha = 0.5)
 33 | 
 34 |   ggsave(
 35 |     filename = glue::glue(argset$output_absolute_path),
 36 |     plot = q
 37 |   )
 38 | 
 39 |   # special case that runs after everything
 40 |   # copy to anon_web?
 41 |   if(argset$last_analysis == TRUE){
 42 | 
 43 |   }
 44 | }
 45 | 
 46 | # **** data_selector **** ----
 47 | #' weather_export_plots (data selector)
 48 | #' @param argset Argset
 49 | #' @param tables DB tables
 50 | #' @export
 51 | weather_export_plots_data_selector = function(argset, tables){
 52 |   if(plnr::is_run_directly()){
 53 |     # global$ss$shortcut_get_plans_argsets_as_dt("weather_export_plots")
 54 | 
 55 |     index_plan <- 1
 56 | 
 57 |     argset <- global$ss$shortcut_get_argset("weather_export_plots", index_plan = index_plan, index_analysis = index_analysis)
 58 |     tables <- global$ss$shortcut_get_tables("weather_export_plots")
 59 |   }
 60 | 
 61 |   # The database tables can be accessed here
 62 |   d <- tables$anon_example_weather_data$tbl() %>%
 63 |     cs9::mandatory_db_filter(
 64 |       granularity_time = NULL,
 65 |       granularity_time_not = NULL,
 66 |       granularity_geo = NULL,
 67 |       granularity_geo_not = NULL,
 68 |       country_iso3 = NULL,
 69 |       location_code = argset$location_code,
 70 |       age = NULL,
 71 |       age_not = NULL,
 72 |       sex = NULL,
 73 |       sex_not = NULL
 74 |     ) %>%
 75 |     dplyr::select(
 76 |       # granularity_time,
 77 |       # granularity_geo,
 78 |       # country_iso3,
 79 |       # location_code,
 80 |       # border,
 81 |       # age,
 82 |       # sex,
 83 | 
 84 |       date,
 85 | 
 86 |       # isoyear,
 87 |       # isoweek,
 88 |       # isoyearweek,
 89 |       # season,
 90 |       # seasonweek,
 91 |       #
 92 |       # calyear,
 93 |       # calmonth,
 94 |       # calyearmonth,
 95 | 
 96 |       temp_max,
 97 |       temp_min
 98 |     ) %>%
 99 |     dplyr::collect() %>%
100 |     as.data.table() %>%
101 |     setorder(
102 |       # location_code,
103 |       date
104 |     )
105 | 
106 |   # The variable returned must be a named list
107 |   retval <- list(
108 |     "data" = d
109 |   )
110 |   retval
111 | }
112 | 
113 | # **** functions **** ----
114 | 
115 | 
116 | 
117 |