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 |