build: fix CRAN checks

.Rbuildignore

@@ -10,3 +10,5 @@
 ^pkgdown$
 ^\.vscode$
 ^_targets$
+^_targets\.R$
+^justfile$

DESCRIPTION

@@ -1,6 +1,6 @@
 Type: Package
 Package: osdc
-Title: Open Source Diabetes Classifier (OSCD) for Danish Registers
+Title: Open Source Diabetes Classifier (OSDC) for Danish Registers
 Version: 0.0.1.9000
 Authors@R: c(
     person(c("Luke", "William"), "Johnston", , "lwjohnst@gmail.com", role = c("aut", "cre"),
@@ -25,7 +25,8 @@ Imports:
     cli,
     dplyr,
     lifecycle,
-    rlang
+    rlang,
+    utils
 Suggests:
     dbplyr,
     glue,
@@ -34,14 +35,13 @@ Suggests:
     spelling,
     stringr,
     testthat (>= 3.0.0),
-    tibble
-VignetteBuilder: 
-    knitr
-Config/testthat/edition: 3
-Config/Needs/tests:
+    tibble,
     data.table,
     arrow,
     duckdb
+VignetteBuilder: 
+    knitr
+Config/testthat/edition: 3
 Config/Needs/data:
     fabricatr,
     codeCollection,

NEWS.md

@@ -1,4 +1,4 @@
-# osdc (development version)
+# osdc 0.0.1.9000 (development version)
 
 ## General
 

R/as-markdown.R

@@ -30,7 +30,7 @@ registers_as_md_table <- function(caption = NULL) {
     knitr::kable(caption = caption)
 }
 
-#' Convert the register name into text to use in a Markdown header.
+#' Convert the register name into text to use in a Markdown header
 #'
 #' @param register The abbreviation of the register name.
 #'
@@ -48,24 +48,24 @@ register_as_md_header <- function(register) {
     )
 }
 
-#' Convert the fake register data into a Markdown table.
+#' Convert the fake register data into a Markdown table
 #'
-#' @param register The abbreviation of the register name.
+#' @param data The data of a specific register from [register_data].
 #' @param caption A caption to add to the table.
 #'
 #' @return A character vector as a Markdown table.
 #' @keywords internal
 #'
-register_data_as_md_table <- function(register, caption = NULL) {
+register_data_as_md_table <- function(data, caption = NULL) {
   rlang::check_installed("glue")
   rlang::check_installed("knitr")
 
-  register_data[[register]] |>
-    head(4) |>
+  data |>
+    utils::head(4) |>
     knitr::kable(caption = caption)
 }
 
-#' Converts the variables for a register into a Markdown table.
+#' Converts the variables for a register into a Markdown table
 #'
 #' @inheritParams register_data_as_md_table
 #'

R/get-algorithm.R

@@ -6,7 +6,9 @@
 #' @keywords internal
 #'
 #' @examples
+#' \dontrun{
 #' get_algorithm_logic("hba1c")
+#' }
 get_algorithm_logic <- function(criteria) {
   algorithm |>
     dplyr::filter(.data$name == criteria) |>

R/include-hba1c.R

@@ -10,25 +10,30 @@
 #' @keywords internal
 #'
 #' @examples
+#' \dontrun{
 #' register_data$lab_forsker |> include_hba1c()
+#' }
 include_hba1c <- function(data) {
   verify_required_variables(data, "lab_forsker")
-  hba1c_criteria <- get_algorithm_logic("hba1c")
+  hba1c_criteria <- get_algorithm_logic("hba1c") |>
+    # To convert the string into an R expression.
+    rlang::parse_expr()
   data |>
     column_names_to_lower() |>
-    dplyr::filter({{ hba1c_criteria }}) |>
+    # Use !! to inject the expression into filter.
+    dplyr::filter(!!hba1c_criteria) |>
     # Keep only the columns we need.
     dplyr::mutate(
       pnr = .data$patient_cpr,
-      date == .data$samplingdate,
+      date = .data$samplingdate,
       included_hba1c = TRUE,
       .keep = "none"
     ) |>
     # Remove any duplicates
     dplyr::distinct() |>
-    dplyr::group_by(pnr) |>
-    # FIXME: This might not work with some databases
+    # FIXME: This might be computationally intensive.
+    dplyr::group_by(.data$pnr) |>
     # Keep earliest two dates.
-    dplyr::slice_min(date, n = 2) |>
+    dplyr::filter(dplyr::row_number(date) %in% 1:2) |>
     dplyr::ungroup()
 }

R/osdc-package.R

@@ -19,3 +19,17 @@ utils::globalVariables(".data")
 #' @format
 #' Is a list with several registers.
 "register_data"
+
+#' Data frame of the logic for the OSDC algorithm
+#'
+#' This data frame contains the logic details of the algorithm for specific
+#' inclusion and exclusion criteria.
+#'
+#' @format
+#' Is a [tibble::tibble()] with two columns:
+#'
+#' \describe{
+#'  \item{name}{The inclusion or exclusion criteria name.}
+#'  \item{logic}{The logic for the criteria.}
+#' }
+"algorithm"

README.md

@@ -41,7 +41,7 @@ more data or running the full test suite, use:
 ``` r
 pak::pak(
   "steno-aarhus/osdc",
-  dependencies = c("all", "Config/Needs/tests", "Config/Needs/data")
+  dependencies = c("all", "Config/Needs/data")
 )
 ```
 

_targets.R

@@ -24,19 +24,41 @@ list(
     command = "data-raw/algorithm.csv",
     format = "file"
   ),
+  tar_target(
+    name = algorithm,
+    command = read_algorithm_data(algorithm_csv)
+  ),
   tar_target(
     name = algorithm_rda,
-    command = create_algorithm_data(algorithm_csv),
+    command = {
+      usethis::use_data(algorithm, overwrite = TRUE)
+      here::here("data/algorithm.rda")
+    },
     format = "file"
   ),
   tar_target(
     name = variable_description_csv,
     command = "data-raw/variable-description.csv",
     format = "file"
   ),
+  tar_target(
+    name = variable_description,
+    command = read_variable_description_data(variable_description_csv)
+  ),
   tar_target(
     name = variable_description_rda,
-    command = create_variable_description_data(variable_description_csv),
+    command = {
+      usethis::use_data(variable_description, overwrite = TRUE)
+      here::here("data/variable_description.rda")
+    },
+    format = "file"
+  ),
+  tar_target(
+    name = internal_rda,
+    command = {
+      usethis::use_data(algorithm, variable_description, overwrite = TRUE, internal = TRUE)
+      here::here("R/sysdata.rda")
+    },
     format = "file"
   )
 )

_targets/meta/meta

@@ -1,18 +1,25 @@
 name|type|data|command|depend|seed|path|time|size|bytes|format|repository|iteration|parent|children|seconds|warnings|error
 .__global__|object|87b8d4f266c27bf4|||||||||||||||
-algorithm_csv|stem|98f92607dd48318b|72b6696561a29259|2c530c1562a7fbd1|48686226|data-raw/algorithm.csv|t19893.417610553s|530f140998b50d1c|112|file|local|vector|||0.003||
-algorithm_rda|stem|66f7362503371611|299578725db47571|a73128224189f273|-930623318|/home/luke/Documents/organizations/steno-aarhus/osdc/data/algorithm.rda|t19893.4400342999s|a96add13dbb67aa3|376|file|local|vector|||0.166||
+algorithm|stem|10ca7cf5842c7665|e6ba0f398c6f1faa|60a40402a9fb99aa|-536052671||t19899.4087817699s|9fa82258c19da069|337|rds|local|vector|||0.001||
+algorithm_csv|stem|98f92607dd48318b|72b6696561a29259|2c530c1562a7fbd1|48686226|data-raw/algorithm.csv|t19893.5100784042s|530f140998b50d1c|112|file|local|vector|||0.003||
+algorithm_rda|stem|66f7362503371611|07904a5fa14d0614|9fd483aca6d9122e|-930623318|/home/luke/Documents/organizations/steno-aarhus/osdc/data/algorithm.rda|t19899.4272374029s|a96add13dbb67aa3|376|file|local|vector|||0.01||
 column_names_to_lower|function|1f9ed89ec76f0ce4|||||||||||||||
-create_algorithm_data|function|260984c321b10f83|||||||||||||||
-create_variable_description_data|function|e6984763ad307bc4|||||||||||||||
+create_algorithm_data|function|721802c40fcbce4e|||||||||||||||
+create_variable_description_data|function|ede086e002225ffb|||||||||||||||
 get_algorithm_logic|function|87ff06f2c9ce0900|||||||||||||||
 get_register_abbrev|function|a82c561691b651df|||||||||||||||
 get_required_variables|function|986ccd76798db1ba|||||||||||||||
-include_hba1c|function|dd23db245d8e630d|||||||||||||||
+include_hba1c|function|e0b1243dd274269a|||||||||||||||
+internal_rda|stem|7d593b3244eb6fb5|76d906cefcbfa41d|cbd1dbe82f00b76b|765355582|/home/luke/Documents/organizations/steno-aarhus/osdc/R/sysdata.rda|t19899.427237588s|f58dd1a2582f84fa|1758|file|local|vector|||0.008||
+read_algorithm_data|function|ef107d4466f53ae2|||||||||||||||
+read_variable_description_data|function|bac5d03645e8328d|||||||||||||||
 register_as_md_header|function|1b9b0bb62cc1e264|||||||||||||||
-register_data_as_md_table|function|27e92012b850a984|||||||||||||||
+register_data_as_md_table|function|bbdda3785a7bdb63|||||||||||||||
 registers_as_md_table|function|ab56ce7262ba313b|||||||||||||||
+variable_description|stem|6d3dd1f2baa26b82|c2153d67e5651737|a01d9e94aead7bb8|1287048845||t19899.4087817236s|b9834ab70a709536|1311|rds|local|vector|||0.133||
 variable_description_csv|stem|900853341b756f57|2347307fa16d111b|2c530c1562a7fbd1|113481566|data-raw/variable-description.csv|t19845.4834059685s|75bbd1de9a7a9806|4683|file|local|vector|||0.005||
-variable_description_rda|stem|450aefe34ecbfb32|1742010767fda041|824677c99eb59944|-1262878967|/home/luke/Documents/organizations/steno-aarhus/osdc/data/variable_description.rda|t19893.4447566339s|5272409a13fc9df9|1550|file|local|vector|||0.496|Use of .data in tidyselect expressions was deprecated in tidyselect 1.2.0.ℹ Please use register_name instead of .dataregister_name. Use of .data in tidyselect expressions was deprecated in tidyselect 1.2.0.ℹ Please use register_abbrev instead of .dataregister_abbrev. Use of .data in tidyselect expressions was deprecated in tidyselect 1.2.0.ℹ Please use variable_name instead of .datavariable_name. Use of .data in tidyselect expressions was deprecated in tidyselect 1.2.0.ℹ Please use start_year instead of .datastart_year. Use of .data in tidyselect expressions was deprecated in tidyselect 1.2.0.ℹ Please use end_year instead of .dataend_year. Use of .data in tidyselect expressions was deprecated in tidyselect 1.2.0.ℹ Please use danish_description instead of .datadanish_description. Use of .data in tidyselect expressions was deprecated in tidyselect 1.2.0.ℹ Please use english_description instead of .dataenglish_description|
+variable_description_rda|stem|450aefe34ecbfb32|afe48e93eb17b9c8|92ce3d1b47fe163e|-1262878967|/home/luke/Documents/organizations/steno-aarhus/osdc/data/variable_description.rda|t19899.427237264s|5272409a13fc9df9|1550|file|local|vector|||0.058||
 variables_as_md_table|function|bf10d1f0df6a170a|||||||||||||||
 verify_required_variables|function|52bf07b827f57531|||||||||||||||
+write_external_rda|function|c0c90c7048a0d89b|||||||||||||||
+write_internal_rda|function|95b61d841de16e96|||||||||||||||

data-raw/algorithm.R

@@ -1,5 +1,3 @@
-create_algorithm_data <- function(path) {
-  algorithm <- readr::read_csv(path, show_col_types = FALSE)
-  usethis::use_data(algorithm, overwrite = TRUE)
-  fs::dir_ls(here::here("data"), regexp = "algorithm")
+read_algorithm_data <- function(path) {
+  readr::read_csv(path, show_col_types = FALSE)
 }