3 File Layout
3.1 Introduction
Implementing Sykdomspulsen Core 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/sykdomspulsen-org/scskeleton
We suggest that you clone this GitHub repo to your server, and then do a global find/replace on scskeleton with the name you want for your R package.
Descriptions of the required files/functions are detailed below.
3.2 00_env_and_namespace.r
https://github.com/sykdomspulsen-org/scskeleton/blob/main/R/00_env_and_namespace.r
## https://github.com/sykdomspulsen-org/scskeleton/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 | # Declaring our own "tm_run_task" inside this package, as a wrapper around
## 12 | # sc::tm_run_task.
## 13 | #
## 14 | # We cannot run sc::tm_run_task directly, because we need to load all of the
## 15 | # database connections, db schemas, tasks, etc. *before* we run the task.
## 16 | # Hence, this wrapper ensures that all of this package's configs files are
## 17 | # loaded via OURPACKAGE::.onLoad() first, and then sc::tm_run_task can run.
## 18 | #
## 19 | # PURPOSE 3:
## 20 | # Declaration of environments that can be used globally.
## 21 | #
## 22 | # PURPOSE 4:
## 23 | # Fix issues/integration with other packages.
## 24 | #
## 25 | # Most notably is the issue with rmarkdown, where an error is thrown when
## 26 | # rendering multiple rmarkdown documents in parallel.
## 27 | #
## 28 | # ******************************************************************************
## 29 | # ******************************************************************************
## 30 |
## 31 | #' @import ggplot2
## 32 | #' @import data.table
## 33 | #' @importFrom magrittr %>% %<>%
## 34 | 1
## 35 |
## 36 | #' Shortcut to run task
## 37 | #'
## 38 | #' This task is needed to ensure that all the definitions/db schemas/tasks/etc
## 39 | #' are loaded from the package scskeleton. We cannot run sc::tm_run_task directly,
## 40 | #' because we need to load all of the database connections, db schemas, tasks,
## 41 | #' etc. *before* we run the task. Hence, this wrapper ensures that all of this
## 42 | #' package's configs files are loaded via OURPACKAGE::.onLoad() first, and then
## 43 | #' sc::tm_run_task can run.
## 44 | #'
## 45 | #' @param task_name Name of the task
## 46 | #' @param index_plan Not used
## 47 | #' @param index_analysis Not used
## 48 | #' @export
## 49 | tm_run_task <- function(task_name, index_plan = NULL, index_analysis = NULL) {
## 50 | sc::tm_run_task(
## 51 | task_name = task_name,
## 52 | index_plan = index_plan,
## 53 | index_analysis = index_analysis
## 54 | )
## 55 | }
## 56 |
## 57 | #' Declaration of environments that can be used globally
## 58 | #' @export config
## 59 | config <- new.env()
## 60 |
## 61 | # https://github.com/rstudio/rmarkdown/issues/1632
## 62 | # An error is thrown when rendering multiple rmarkdown documents in parallel.
## 63 | clean_tmpfiles_mod <- function() {
## 64 | # message("Calling clean_tmpfiles_mod()")
## 65 | }3.3 01_definitions.r
https://github.com/sykdomspulsen-org/scskeleton/blob/main/R/01_definitions.r
## https://github.com/sykdomspulsen-org/scskeleton/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 2020-01-01
## 22 | config$border <- 2020
## 23 |
## 24 | # fhidata needs to know which border is in use
## 25 | # fhidata should also replace the population of 1900 with the current year,
## 26 | # because year = 1900 is shorthand for granularity_geo = "total".
## 27 | # This means that it is more appropriate to use the current year's population
## 28 | # for year = 1900.
## 29 | fhidata::set_config(
## 30 | border = config$border,
## 31 | use_current_year_as_1900_pop = TRUE
## 32 | )
## 33 | }3.4 02_permissions.r
https://github.com/sykdomspulsen-org/scskeleton/blob/main/R/02_permissions.r
## https://github.com/sykdomspulsen-org/scskeleton/blob/main/R/02_permissions.r
##
## 1 | # ******************************************************************************
## 2 | # ******************************************************************************
## 3 | #
## 4 | # 02_permissions.r
## 5 | #
## 6 | # PURPOSE 1:
## 7 | # Set permissions that can be used in this package.
## 8 | #
## 9 | # PURPOSE 2:
## 10 | # Permissions are a way of ensuring that a task only runs once per hour/day/week.
## 11 | # This can be useful when you want to be 100% sure that you don't want to spam
## 12 | # emails to your recipients.
## 13 | #
## 14 | # PURPOSE 3:
## 15 | # Permissions can also be used to differentiate between "production days" and
## 16 | # "preliminary days". This can be useful when you have different email lists
## 17 | # for production days (everyone) and preliminary days (a smaller group).
## 18 | #
## 19 | # ******************************************************************************
## 20 | # ******************************************************************************
## 21 |
## 22 | set_permissions <- function() {
## 23 | # sc::add_permission(
## 24 | # name = "khtemails_send_emails",
## 25 | # permission = sc::Permission$new(
## 26 | # key = "khtemails_send_emails",
## 27 | # value = as.character(lubridate::today()), # one time per day
## 28 | # production_days = c(3) # wed, send to everyone, otherwise prelim
## 29 | # )
## 30 | # )
## 31 | }3.5 03_db_schemas.r
https://github.com/sykdomspulsen-org/scskeleton/blob/main/R/03_db_schemas.r
## https://github.com/sykdomspulsen-org/scskeleton/blob/main/R/03_db_schemas.r
##
## 1 | # ******************************************************************************
## 2 | # ******************************************************************************
## 3 | #
## 4 | # 03_db_schemas.r
## 5 | #
## 6 | # PURPOSE 1:
## 7 | # Set db schemas that are used throughout the package.
## 8 | #
## 9 | # These are basically all of the database tables that you will be writing to,
## 10 | # and reading from.
## 11 | #
## 12 | # ******************************************************************************
## 13 | # ******************************************************************************
## 14 |
## 15 | set_db_schemas <- function() {
## 16 | # __________ ----
## 17 | # Weather ----
## 18 | ## > anon_example_weather_rawdata ----
## 19 | sc::add_schema_v8(
## 20 | name_access = c("anon"),
## 21 | name_grouping = "example_weather",
## 22 | name_variant = "rawdata",
## 23 | db_configs = sc::config$db_configs,
## 24 | field_types = c(
## 25 | "granularity_time" = "TEXT",
## 26 | "granularity_geo" = "TEXT",
## 27 | "country_iso3" = "TEXT",
## 28 | "location_code" = "TEXT",
## 29 | "border" = "INTEGER",
## 30 | "age" = "TEXT",
## 31 | "sex" = "TEXT",
## 32 |
## 33 | "date" = "DATE",
## 34 |
## 35 | "isoyear" = "INTEGER",
## 36 | "isoweek" = "INTEGER",
## 37 | "isoyearweek" = "TEXT",
## 38 | "season" = "TEXT",
## 39 | "seasonweek" = "DOUBLE",
## 40 |
## 41 | "calyear" = "INTEGER",
## 42 | "calmonth" = "INTEGER",
## 43 | "calyearmonth" = "TEXT",
## 44 |
## 45 | "temp_max" = "DOUBLE",
## 46 | "temp_min" = "DOUBLE",
## 47 | "precip" = "DOUBLE"
## 48 | ),
## 49 | keys = c(
## 50 | "granularity_time",
## 51 | "location_code",
## 52 | "date",
## 53 | "age",
## 54 | "sex"
## 55 | ),
## 56 | censors = list(
## 57 | anon = list(
## 58 |
## 59 | )
## 60 | ),
## 61 | validator_field_types = sc::validator_field_types_sykdomspulsen,
## 62 | validator_field_contents = sc::validator_field_contents_sykdomspulsen,
## 63 | info = "This db table is used for..."
## 64 | )
## 65 |
## 66 | ## > anon_example_weather_data ----
## 67 | sc::add_schema_v8(
## 68 | name_access = c("anon"),
## 69 | name_grouping = "example_weather",
## 70 | name_variant = "data",
## 71 | db_configs = sc::config$db_configs,
## 72 | field_types = c(
## 73 | "granularity_time" = "TEXT",
## 74 | "granularity_geo" = "TEXT",
## 75 | "country_iso3" = "TEXT",
## 76 | "location_code" = "TEXT",
## 77 | "border" = "INTEGER",
## 78 | "age" = "TEXT",
## 79 | "sex" = "TEXT",
## 80 |
## 81 | "date" = "DATE",
## 82 |
## 83 | "isoyear" = "INTEGER",
## 84 | "isoweek" = "INTEGER",
## 85 | "isoyearweek" = "TEXT",
## 86 | "season" = "TEXT",
## 87 | "seasonweek" = "DOUBLE",
## 88 |
## 89 | "calyear" = "INTEGER",
## 90 | "calmonth" = "INTEGER",
## 91 | "calyearmonth" = "TEXT",
## 92 |
## 93 | "temp_max" = "DOUBLE",
## 94 | "temp_min" = "DOUBLE",
## 95 | "precip" = "DOUBLE"
## 96 | ),
## 97 | keys = c(
## 98 | "granularity_time",
## 99 | "location_code",
## 100 | "date",
## 101 | "age",
## 102 | "sex"
## 103 | ),
## 104 | censors = list(
## 105 | anon = list(
## 106 |
## 107 | )
## 108 | ),
## 109 | validator_field_types = sc::validator_field_types_sykdomspulsen,
## 110 | validator_field_contents = sc::validator_field_contents_sykdomspulsen,
## 111 | info = "This db table is used for..."
## 112 | )
## 113 | }3.6 04_tasks.r
https://github.com/sykdomspulsen-org/scskeleton/blob/main/R/04_tasks.r
## https://github.com/sykdomspulsen-org/scskeleton/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 | # Weather ----
## 19 | ## > weather_download_and_import_rawdata ----
## 20 | # tm_run_task("weather_download_and_import_rawdata")
## 21 | sc::add_task_from_config_v8(
## 22 | name_grouping = "weather",
## 23 | name_action = "download_and_import_rawdata",
## 24 | name_variant = NULL,
## 25 | cores = 1,
## 26 | plan_analysis_fn_name = NULL,
## 27 | for_each_plan = plnr::expand_list(
## 28 | location_code = fhidata::norway_locations_names()[granularity_geo %in% c("municip")]$location_code
## 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 = "scskeleton::weather_download_and_import_rawdata_action",
## 35 | data_selector_fn_name = "scskeleton::weather_download_and_import_rawdata_data_selector",
## 36 | schema = list(
## 37 | # input
## 38 |
## 39 | # output
## 40 | "anon_example_weather_rawdata" = sc::config$schemas$anon_example_weather_rawdata
## 41 | ),
## 42 | info = "This task downloads and imports the raw weather data from MET's API at the municipal level"
## 43 | )
## 44 |
## 45 | ## > weather_clean_data ----
## 46 | # tm_run_task("weather_clean_data")
## 47 | sc::add_task_from_config_v8(
## 48 | name_grouping = "weather",
## 49 | name_action = "clean_data",
## 50 | name_variant = NULL,
## 51 | cores = 1,
## 52 | plan_analysis_fn_name = NULL,
## 53 | for_each_plan = plnr::expand_list(
## 54 | x = 1
## 55 | ),
## 56 | for_each_analysis = NULL,
## 57 | universal_argset = NULL,
## 58 | upsert_at_end_of_each_plan = FALSE,
## 59 | insert_at_end_of_each_plan = FALSE,
## 60 | action_fn_name = "scskeleton::weather_clean_data_action",
## 61 | data_selector_fn_name = "scskeleton::weather_clean_data_data_selector",
## 62 | schema = list(
## 63 | # input
## 64 | "anon_example_weather_rawdata" = sc::config$schemas$anon_example_weather_rawdata,
## 65 |
## 66 | # output
## 67 | "anon_example_weather_data" = sc::config$schemas$anon_example_weather_data
## 68 | ),
## 69 | info = "This task cleans the raw data and aggregates it to county and national level"
## 70 | )
## 71 |
## 72 | ## > weather_clean_data ----
## 73 | # tm_run_task("weather_export_plots")
## 74 | sc::add_task_from_config_v8(
## 75 | name_grouping = "weather",
## 76 | name_action = "export_plots",
## 77 | name_variant = NULL,
## 78 | cores = 1,
## 79 | plan_analysis_fn_name = NULL,
## 80 | for_each_plan = plnr::expand_list(
## 81 | location_code = fhidata::norway_locations_names()[granularity_geo %in% c("county")]$location_code
## 82 | ),
## 83 | for_each_analysis = NULL,
## 84 | universal_argset = list(
## 85 | output_dir = tempdir(),
## 86 | output_filename = "weather_{argset$location_code}.png",
## 87 | output_absolute_path = fs::path("{argset$output_dir}", "{argset$output_filename}")
## 88 | ),
## 89 | upsert_at_end_of_each_plan = FALSE,
## 90 | insert_at_end_of_each_plan = FALSE,
## 91 | action_fn_name = "scskeleton::weather_export_plots_action",
## 92 | data_selector_fn_name = "scskeleton::weather_export_plots_data_selector",
## 93 | schema = list(
## 94 | # input
## 95 | "anon_example_weather_data" = sc::config$schemas$anon_example_weather_data
## 96 |
## 97 | # output
## 98 | ),
## 99 | info = "This task ploduces plots"
## 100 | )
## 101 | }3.7 05_deliverables.r
https://github.com/sykdomspulsen-org/scskeleton/blob/main/R/05_deliverables.r
## https://github.com/sykdomspulsen-org/scskeleton/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 | }3.8 06_config.r
https://github.com/sykdomspulsen-org/scskeleton/blob/main/R/06_config.r
## https://github.com/sykdomspulsen-org/scskeleton/blob/main/R/06_config.r
##
## 1 | # ******************************************************************************
## 2 | # ******************************************************************************
## 3 | #
## 4 | # 06_config.r
## 5 | #
## 6 | # PURPOSE 1:
## 7 | # Call all the functions defined in 01, 02, 03, 04, and 05 in the correct order.
## 8 | #
## 9 | # PURPOSE 2:
## 10 | # Set all necessary configs that do not belong anywhere else.
## 11 | #
## 12 | # E.g. Formatting for progress bars.
## 13 | #
## 14 | # ******************************************************************************
## 15 | # ******************************************************************************
## 16 |
## 17 | set_config <- function() {
## 18 | # 01_definitions.r
## 19 | set_definitions()
## 20 |
## 21 | # 02_permissions.r
## 22 | set_permissions()
## 23 |
## 24 | # 03_db_schemas.r
## 25 | set_db_schemas()
## 26 |
## 27 | # 04_tasks.r
## 28 | set_tasks()
## 29 |
## 30 | # 05_deliverables.r
## 31 | set_deliverables()
## 32 |
## 33 | # 06_config.r
## 34 | set_progressr()
## 35 | }
## 36 |
## 37 | set_progressr <- function() {
## 38 | progressr::handlers(progressr::handler_progress(
## 39 | format = "[:bar] :current/:total (:percent) in :elapsedfull, eta: :eta",
## 40 | clear = FALSE
## 41 | ))
## 42 | }3.9 07_onLoad.r
https://github.com/sykdomspulsen-org/scskeleton/blob/main/R/07_onLoad.r
## https://github.com/sykdomspulsen-org/scskeleton/blob/main/R/07_onLoad.r
##
## 1 | # ******************************************************************************
## 2 | # ******************************************************************************
## 3 | #
## 4 | # 07_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 as defined in 06_config.r.
## 11 | #
## 12 | # ******************************************************************************
## 13 | # ******************************************************************************
## 14 |
## 15 | .onLoad <- function(libname, pkgname) {
## 16 | # Mechanism to authenticate as necessary (e.g. Kerebros)
## 17 | try(system2("/bin/authenticate.sh", stdout = NULL), TRUE)
## 18 |
## 19 | # 5_config.r
## 20 | set_config()
## 21 |
## 22 | # https://github.com/rstudio/rmarkdown/issues/1632
## 23 | assignInNamespace("clean_tmpfiles", clean_tmpfiles_mod, ns = "rmarkdown")
## 24 |
## 25 | invisible()
## 26 | }3.10 08_onAttach.r
https://github.com/sykdomspulsen-org/scskeleton/blob/main/R/08_onAttach.r
## https://github.com/sykdomspulsen-org/scskeleton/blob/main/R/08_onAttach.r
##
## 1 | # ******************************************************************************
## 2 | # ******************************************************************************
## 3 | #
## 4 | # 08_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 |
## 14 | }3.11 99_util_*.r
https://github.com/sykdomspulsen-org/scskeleton/blob/main/R/99_util_no_data_plot.r
## https://github.com/sykdomspulsen-org/scskeleton/blob/main/R/99_util_no_data_plot.r
##
## 1 | # ******************************************************************************
## 2 | # ******************************************************************************
## 3 | #
## 4 | # 99_util_*.r
## 5 | #
## 6 | # PURPOSE 1:
## 7 | # Utility functions that are used across multiple tasks
## 8 | #
## 9 | # ******************************************************************************
## 10 | # ******************************************************************************
## 11 |
## 12 | no_data_plot <- function(){
## 13 | data=data.frame(x=0,y=0)
## 14 | q <- ggplot(data=data)
## 15 | q <- q + theme_void()
## 16 | q <- q + annotate("text", label=glue::glue("Ikke noe data {fhi::nb$aa} vise"), x=0, y=0, size=10)
## 17 | q
## 18 | }3.12 Task files
Task files are placed in .r files under their own names.
3.12.1 weather_download_and_import_rawdata.r
https://github.com/sykdomspulsen-org/scskeleton/blob/main/R/weather_download_and_import_rawdata.r
## https://github.com/sykdomspulsen-org/scskeleton/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 schema DB Schema
## 6 | #' @export
## 7 | weather_download_and_import_rawdata_action <- function(data, argset, schema) {
## 8 | # tm_run_task("weather_download_and_import_rawdata")
## 9 |
## 10 | if (plnr::is_run_directly()) {
## 11 | # sc::tm_get_plans_argsets_as_dt("weather_download_and_import_rawdata")
## 12 |
## 13 | index_plan <- 1
## 14 | index_analysis <- 1
## 15 |
## 16 | data <- sc::tm_get_data("weather_download_and_import_rawdata", index_plan = index_plan)
## 17 | argset <- sc::tm_get_argset("weather_download_and_import_rawdata", index_plan = index_plan, index_analysis = index_analysis)
## 18 | schema <- sc::tm_get_schema("weather_download_and_import_rawdata")
## 19 | }
## 20 |
## 21 | # special case that runs before everything
## 22 | if (argset$first_analysis == TRUE) {
## 23 |
## 24 | }
## 25 |
## 26 | a <- data$data
## 27 |
## 28 | baz <- xml2::xml_find_all(a, ".//maxTemperature")
## 29 | res <- vector("list", length = length(baz))
## 30 | for (i in seq_along(baz)) {
## 31 | parent <- xml2::xml_parent(baz[[i]])
## 32 | grandparent <- xml2::xml_parent(parent)
## 33 | time_from <- xml2::xml_attr(grandparent, "from")
## 34 | time_to <- xml2::xml_attr(grandparent, "to")
## 35 | x <- xml2::xml_find_all(parent, ".//minTemperature")
## 36 | temp_min <- xml2::xml_attr(x, "value")
## 37 | x <- xml2::xml_find_all(parent, ".//maxTemperature")
## 38 | temp_max <- xml2::xml_attr(x, "value")
## 39 | x <- xml2::xml_find_all(parent, ".//precipitation")
## 40 | precip <- xml2::xml_attr(x, "value")
## 41 | res[[i]] <- data.frame(
## 42 | time_from = as.character(time_from),
## 43 | time_to = as.character(time_to),
## 44 | temp_max = as.numeric(temp_max),
## 45 | temp_min = as.numeric(temp_min),
## 46 | precip = as.numeric(precip)
## 47 | )
## 48 | }
## 49 | res <- rbindlist(res)
## 50 | res <- res[stringr::str_sub(time_from, 12, 13) %in% c("00", "06", "12", "18")]
## 51 | res[, date := as.Date(stringr::str_sub(time_from, 1, 10))]
## 52 | res[, N := .N, by = date]
## 53 | res <- res[N == 4]
## 54 | res <- res[
## 55 | ,
## 56 | .(
## 57 | temp_max = max(temp_max),
## 58 | temp_min = min(temp_min),
## 59 | precip = sum(precip)
## 60 | ),
## 61 | keyby = .(date)
## 62 | ]
## 63 |
## 64 | # we look at the downloaded data
## 65 | # res
## 66 |
## 67 | # we now need to format it
## 68 | res[, granularity_time := "day"]
## 69 | res[, sex := "total"]
## 70 | res[, age := "total"]
## 71 | res[, location_code := argset$location_code]
## 72 |
## 73 | # fill in missing structural variables
## 74 | sc::fill_in_missing_v8(res, border = 2020)
## 75 |
## 76 | # we look at the downloaded data
## 77 | # res
## 78 |
## 79 | # put data in db table
## 80 | schema$anon_example_weather_rawdata$insert_data(res)
## 81 |
## 82 | # special case that runs after everything
## 83 | if (argset$last_analysis == TRUE) {
## 84 |
## 85 | }
## 86 | }
## 87 |
## 88 | # **** data_selector **** ----
## 89 | #' weather_download_and_import_rawdata (data selector)
## 90 | #' @param argset Argset
## 91 | #' @param schema DB Schema
## 92 | #' @export
## 93 | weather_download_and_import_rawdata_data_selector <- function(argset, schema) {
## 94 | if (plnr::is_run_directly()) {
## 95 | # sc::tm_get_plans_argsets_as_dt("weather_download_and_import_rawdata")
## 96 |
## 97 | index_plan <- 1
## 98 |
## 99 | argset <- sc::tm_get_argset("weather_download_and_import_rawdata", index_plan = index_plan)
## 100 | schema <- sc::tm_get_schema("weather_download_and_import_rawdata")
## 101 | }
## 102 |
## 103 | # find the mid lat/long for the specified location_code
## 104 | gps <- fhimaps::norway_lau2_map_b2020_default_dt[location_code == argset$location_code,.(
## 105 | lat = mean(lat),
## 106 | long = mean(long)
## 107 | )]
## 108 |
## 109 | # download the forecast for the specified location_code
## 110 | d <- httr::GET(glue::glue("https://api.met.no/weatherapi/locationforecast/2.0/classic?lat={gps$lat}&lon={gps$long}"), httr::content_type_xml())
## 111 | d <- xml2::read_xml(d$content)
## 112 |
## 113 | # The variable returned must be a named list
## 114 | retval <- list(
## 115 | "data" = d
## 116 | )
## 117 |
## 118 | retval
## 119 | }
## 120 |
## 121 | # **** functions **** ----3.12.2 weather_clean_data.r
https://github.com/sykdomspulsen-org/scskeleton/blob/main/R/weather_clean_data.r
## https://github.com/sykdomspulsen-org/scskeleton/blob/main/R/weather_clean_data.r
##
## 1 | # **** action **** ----
## 2 | #' weather_clean_data (action)
## 3 | #' @param data Data
## 4 | #' @param argset Argset
## 5 | #' @param schema DB Schema
## 6 | #' @export
## 7 | weather_clean_data_action <- function(data, argset, schema) {
## 8 | # tm_run_task("weather_clean_data")
## 9 |
## 10 | if (plnr::is_run_directly()) {
## 11 | # sc::tm_get_plans_argsets_as_dt("weather_clean_data")
## 12 |
## 13 | index_plan <- 1
## 14 | index_analysis <- 1
## 15 |
## 16 | data <- sc::tm_get_data("weather_clean_data", index_plan = index_plan)
## 17 | argset <- sc::tm_get_argset("weather_clean_data", index_plan = index_plan, index_analysis = index_analysis)
## 18 | schema <- sc::tm_get_schema("weather_clean_data")
## 19 | }
## 20 |
## 21 | # special case that runs before everything
## 22 | if (argset$first_analysis == TRUE) {
## 23 |
## 24 | }
## 25 |
## 26 | # make sure there's no missing data via the creation of a skeleton
## 27 | # https://folkehelseinstituttet.github.io/fhidata/articles/Skeletons.html
## 28 |
## 29 | # Create a variable (possibly a list) to hold the data
## 30 | d_agg <- list()
## 31 | d_agg$day_municip <- copy(data$day_municip)
## 32 |
## 33 | # Pull out important dates
## 34 | date_min <- min(d_agg$day_municip$date, na.rm = T)
## 35 | date_max <- max(d_agg$day_municip$date, na.rm = T)
## 36 |
## 37 | # Create `multiskeleton`
## 38 | # granularity_geo should have the following groups:
## 39 | # - nodata (when no data is available, and there is no "finer" data available to aggregate up)
## 40 | # - all levels of granularity_geo where you have data available
## 41 | # If you do not have data for a specific granularity_geo, but there is "finer" data available
## 42 | # then you should not include this granularity_geo in the multiskeleton, because you will create
## 43 | # it later when you aggregate up your data (baregion)
## 44 | multiskeleton_day <- fhidata::make_skeleton(
## 45 | date_min = date_min,
## 46 | date_max = date_max,
## 47 | granularity_geo = list(
## 48 | "nodata" = c(
## 49 | "wardoslo",
## 50 | "extrawardoslo",
## 51 | "missingwardoslo",
## 52 | "wardbergen",
## 53 | "missingwardbergen",
## 54 | "wardstavanger",
## 55 | "missingwardstavanger",
## 56 | "notmainlandmunicip",
## 57 | "missingmunicip",
## 58 | "notmainlandcounty",
## 59 | "missingcounty"
## 60 | ),
## 61 | "municip" = c(
## 62 | "municip"
## 63 | )
## 64 | )
## 65 | )
## 66 |
## 67 | # Merge in the information you have at different geographical granularities
## 68 | # one level at a time
## 69 | # municip
## 70 | multiskeleton_day$municip[
## 71 | d_agg$day_municip,
## 72 | on = c("location_code", "date"),
## 73 | c(
## 74 | "temp_max",
## 75 | "temp_min",
## 76 | "precip"
## 77 | ) := .(
## 78 | temp_max,
## 79 | temp_min,
## 80 | precip
## 81 | )
## 82 | ]
## 83 |
## 84 | multiskeleton_day$municip[]
## 85 |
## 86 | # Aggregate up to higher geographical granularities (county)
## 87 | multiskeleton_day$county <- multiskeleton_day$municip[
## 88 | fhidata::norway_locations_hierarchy(
## 89 | from = "municip",
## 90 | to = "county"
## 91 | ),
## 92 | on = c(
## 93 | "location_code==from_code"
## 94 | )
## 95 | ][,
## 96 | .(
## 97 | temp_max = mean(temp_max, na.rm = T),
## 98 | temp_min = mean(temp_min, na.rm = T),
## 99 | precip = mean(precip, na.rm = T),
## 100 | granularity_geo = "county"
## 101 | ),
## 102 | by = .(
## 103 | granularity_time,
## 104 | date,
## 105 | location_code = to_code
## 106 | )
## 107 | ]
## 108 |
## 109 | multiskeleton_day$county[]
## 110 |
## 111 | # Aggregate up to higher geographical granularities (nation)
## 112 | multiskeleton_day$nation <- multiskeleton_day$municip[
## 113 | ,
## 114 | .(
## 115 | temp_max = mean(temp_max, na.rm = T),
## 116 | temp_min = mean(temp_min, na.rm = T),
## 117 | precip = mean(precip, na.rm = T),
## 118 | granularity_geo = "nation",
## 119 | location_code = "norge"
## 120 | ),
## 121 | by = .(
## 122 | granularity_time,
## 123 | date
## 124 | )
## 125 | ]
## 126 |
## 127 | multiskeleton_day$nation[]
## 128 |
## 129 | # combine all the different granularity_geos
## 130 | skeleton_day <- rbindlist(multiskeleton_day, fill = TRUE, use.names = TRUE)
## 131 |
## 132 | skeleton_day[]
## 133 |
## 134 | # 10. (If desirable) aggregate up to higher time granularities
## 135 | # if necessary, it is now easy to aggregate up to weekly data from here
## 136 | skeleton_isoweek <- copy(skeleton_day)
## 137 | skeleton_isoweek[, isoyearweek := fhiplot::isoyearweek_c(date)]
## 138 | skeleton_isoweek <- skeleton_isoweek[
## 139 | ,
## 140 | .(
## 141 | temp_max = mean(temp_max, na.rm = T),
## 142 | temp_min = mean(temp_min, na.rm = T),
## 143 | precip = mean(precip, na.rm = T),
## 144 | granularity_time = "isoweek"
## 145 | ),
## 146 | keyby = .(
## 147 | isoyearweek,
## 148 | granularity_geo,
## 149 | location_code
## 150 | )
## 151 | ]
## 152 |
## 153 | skeleton_isoweek[]
## 154 |
## 155 | # we now need to format it and fill in missing structural variables
## 156 | # day
## 157 | skeleton_day[, sex := "total"]
## 158 | skeleton_day[, age := "total"]
## 159 | sc::fill_in_missing_v8(skeleton_day, border = config$border)
## 160 |
## 161 | # isoweek
## 162 | skeleton_isoweek[, sex := "total"]
## 163 | skeleton_isoweek[, age := "total"]
## 164 | sc::fill_in_missing_v8(skeleton_isoweek, border = config$border)
## 165 | skeleton_isoweek[, date := as.Date(date)]
## 166 |
## 167 | skeleton <- rbindlist(
## 168 | list(
## 169 | skeleton_day,
## 170 | skeleton_isoweek
## 171 | ),
## 172 | use.names = T
## 173 | )
## 174 |
## 175 | # put data in db table
## 176 | schema$anon_example_weather_data$drop_all_rows_and_then_insert_data(skeleton)
## 177 |
## 178 | # special case that runs after everything
## 179 | if (argset$last_analysis == TRUE) {
## 180 |
## 181 | }
## 182 | }
## 183 |
## 184 | # **** data_selector **** ----
## 185 | #' weather_clean_data (data selector)
## 186 | #' @param argset Argset
## 187 | #' @param schema DB Schema
## 188 | #' @export
## 189 | weather_clean_data_data_selector <- function(argset, schema) {
## 190 | if (plnr::is_run_directly()) {
## 191 | # sc::tm_get_plans_argsets_as_dt("weather_clean_data")
## 192 |
## 193 | index_plan <- 1
## 194 |
## 195 | argset <- sc::tm_get_argset("weather_clean_data", index_plan = index_plan)
## 196 | schema <- sc::tm_get_schema("weather_clean_data")
## 197 | }
## 198 |
## 199 | # The database schemas can be accessed here
## 200 | d <- schema$anon_example_weather_rawdata$tbl() %>%
## 201 | sc::mandatory_db_filter(
## 202 | granularity_time = "day",
## 203 | granularity_time_not = NULL,
## 204 | granularity_geo = "municip",
## 205 | granularity_geo_not = NULL,
## 206 | country_iso3 = NULL,
## 207 | location_code = NULL,
## 208 | age = "total",
## 209 | age_not = NULL,
## 210 | sex = "total",
## 211 | sex_not = NULL
## 212 | ) %>%
## 213 | dplyr::select(
## 214 | granularity_time,
## 215 | # granularity_geo,
## 216 | # country_iso3,
## 217 | location_code,
## 218 | # border,
## 219 | # age,
## 220 | # sex,
## 221 |
## 222 | date,
## 223 |
## 224 | # isoyear,
## 225 | # isoweek,
## 226 | # isoyearweek,
## 227 | # season,
## 228 | # seasonweek,
## 229 |
## 230 | # calyear,
## 231 | # calmonth,
## 232 | # calyearmonth,
## 233 |
## 234 | temp_max,
## 235 | temp_min,
## 236 | precip
## 237 | ) %>%
## 238 | dplyr::collect() %>%
## 239 | as.data.table() %>%
## 240 | setorder(
## 241 | location_code,
## 242 | date
## 243 | )
## 244 |
## 245 | # The variable returned must be a named list
## 246 | retval <- list(
## 247 | "day_municip" = d
## 248 | )
## 249 |
## 250 | retval
## 251 | }
## 252 |
## 253 | # **** functions **** ----3.12.3 weather_export_weather_plots.r
https://github.com/sykdomspulsen-org/scskeleton/blob/main/R/weather_export_plots.r
## https://github.com/sykdomspulsen-org/scskeleton/blob/main/R/weather_export_plots.r
##
## 1 | # **** action **** ----
## 2 | #' weather_export_plots (action)
## 3 | #' @param data Data
## 4 | #' @param argset Argset
## 5 | #' @param schema DB Schema
## 6 | #' @export
## 7 | weather_export_plots_action <- function(data, argset, schema) {
## 8 | # tm_run_task("weather_export_plots")
## 9 |
## 10 | if(plnr::is_run_directly()){
## 11 | # sc::tm_get_plans_argsets_as_dt("weather_export_plots")
## 12 |
## 13 | index_plan <- 1
## 14 | index_analysis <- 1
## 15 |
## 16 | data <- sc::tm_get_data("weather_export_plots", index_plan = index_plan)
## 17 | argset <- sc::tm_get_argset("weather_export_plots", index_plan = index_plan, index_analysis = index_analysis)
## 18 | schema <- sc::tm_get_schema("weather_export_plots")
## 19 | }
## 20 |
## 21 | # code goes here
## 22 | # special case that runs before everything
## 23 | if(argset$first_analysis == TRUE){
## 24 |
## 25 | }
## 26 |
## 27 | # create the output_dir (if it doesn't exist)
## 28 | fs::dir_create(glue::glue(argset$output_dir))
## 29 |
## 30 | q <- ggplot(data$data, aes(x = date, ymin = temp_min, ymax = temp_max))
## 31 | q <- q + geom_ribbon(alpha = 0.5)
## 32 |
## 33 | ggsave(
## 34 | filename = glue::glue(argset$output_absolute_path),
## 35 | plot = q
## 36 | )
## 37 |
## 38 | # special case that runs after everything
## 39 | # copy to anon_web?
## 40 | if(argset$last_analysis == TRUE){
## 41 |
## 42 | }
## 43 | }
## 44 |
## 45 | # **** data_selector **** ----
## 46 | #' weather_export_plots (data selector)
## 47 | #' @param argset Argset
## 48 | #' @param schema DB Schema
## 49 | #' @export
## 50 | weather_export_plots_data_selector = function(argset, schema){
## 51 | if(plnr::is_run_directly()){
## 52 | # sc::tm_get_plans_argsets_as_dt("weather_export_plots")
## 53 |
## 54 | index_plan <- 1
## 55 |
## 56 | argset <- sc::tm_get_argset("weather_export_plots", index_plan = index_plan)
## 57 | schema <- sc::tm_get_schema("weather_export_plots")
## 58 | }
## 59 |
## 60 | # The database schemas can be accessed here
## 61 | d <- schema$anon_example_weather_data$tbl() %>%
## 62 | sc::mandatory_db_filter(
## 63 | granularity_time = NULL,
## 64 | granularity_time_not = NULL,
## 65 | granularity_geo = NULL,
## 66 | granularity_geo_not = NULL,
## 67 | country_iso3 = NULL,
## 68 | location_code = argset$location_code,
## 69 | age = NULL,
## 70 | age_not = NULL,
## 71 | sex = NULL,
## 72 | sex_not = NULL
## 73 | ) %>%
## 74 | dplyr::select(
## 75 | # granularity_time,
## 76 | # granularity_geo,
## 77 | # country_iso3,
## 78 | # location_code,
## 79 | # border,
## 80 | # age,
## 81 | # sex,
## 82 |
## 83 | date,
## 84 |
## 85 | # isoyear,
## 86 | # isoweek,
## 87 | # isoyearweek,
## 88 | # season,
## 89 | # seasonweek,
## 90 | #
## 91 | # calyear,
## 92 | # calmonth,
## 93 | # calyearmonth,
## 94 |
## 95 | temp_max,
## 96 | temp_min
## 97 | ) %>%
## 98 | dplyr::collect() %>%
## 99 | as.data.table() %>%
## 100 | setorder(
## 101 | # location_code,
## 102 | date
## 103 | )
## 104 |
## 105 | # The variable returned must be a named list
## 106 | retval <- list(
## 107 | "data" = d
## 108 | )
## 109 | retval
## 110 | }
## 111 |
## 112 | # **** functions **** ----
## 113 |
## 114 |
## 115 |
## 116 |