diff --git a/DESCRIPTION b/DESCRIPTION index d6164de..b683f6a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -8,7 +8,10 @@ Authors@R: person(given = "Nicolai Skov Johnsen", role = "aut", email = "nosj@novonordisk.com"), - person(given = "Anders Bilgrau", + person(given = "Henrik Sparre Spiegelhauer", + role = "aut", + email = "hspu@novonordisk.com"), + person(given = "ABIU (Anders Bilgrau)", role = "aut", email = "abiu@novonordisk.com"), person(given = "Simon Clancy", diff --git a/_pkgdown.yml b/_pkgdown.yml index 4bacde9..377f33f 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -18,6 +18,7 @@ reference: - n_subj_event - p_subj_event - count_set + - count_set - title: By strata, across treatment levels desc: | Function that operate by strata level but across treatment levels diff --git a/tests/testthat/_snaps/demographics.md b/tests/testthat/_snaps/demographics.md index 9d0b477..3189855 100644 --- a/tests/testthat/_snaps/demographics.md +++ b/tests/testthat/_snaps/demographics.md @@ -1,21 +1,101 @@ -# Demographics (categorical) work when strata provided +# Demographics (categorical) work when strata is provided - Code - actual_total - Output - label qualifiers value description - - 1: n_non_missing AGEGR1 85 Demographics - 2: n_missing AGEGR1 1 Demographics - 3: n_non_missing SEX 82 Demographics - 4: n_missing SEX 4 Demographics + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["label", "qualifiers", "value", "description"] + }, + "row.names": { + "type": "integer", + "attributes": {}, + "value": [1, 2, 3, 4] + }, + "class": { + "type": "character", + "attributes": {}, + "value": ["data.frame"] + } + }, + "value": [ + { + "type": "character", + "attributes": {}, + "value": ["n_non_missing", "n_missing", "n_non_missing", "n_missing"] + }, + { + "type": "integer", + "attributes": { + "levels": { + "type": "character", + "attributes": {}, + "value": ["AGEGR1", "SEX"] + }, + "class": { + "type": "character", + "attributes": {}, + "value": ["factor"] + } + }, + "value": [1, 1, 2, 2] + }, + { + "type": "double", + "attributes": {}, + "value": [85, 1, 82, 4] + }, + { + "type": "character", + "attributes": {}, + "value": ["Demographics", "Demographics", "Demographics", "Demographics"] + } + ] + } --- - Code - actual_f - Output - label description qualifiers value - - 1: n_non_missing Demographics 52 + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["label", "description", "qualifiers", "value"] + }, + "row.names": { + "type": "integer", + "attributes": {}, + "value": [1] + }, + "class": { + "type": "character", + "attributes": {}, + "value": ["data.frame"] + } + }, + "value": [ + { + "type": "character", + "attributes": {}, + "value": ["n_non_missing"] + }, + { + "type": "character", + "attributes": {}, + "value": ["Demographics"] + }, + { + "type": "character", + "attributes": {}, + "value": [null] + }, + { + "type": "double", + "attributes": {}, + "value": [52] + } + ] + } diff --git a/tests/testthat/test-demographics.R b/tests/testthat/test-demographics.R index ae72c31..2776cdb 100644 --- a/tests/testthat/test-demographics.R +++ b/tests/testthat/test-demographics.R @@ -1,4 +1,5 @@ -test_that("Demographics (categorical) work when strata provided", { +test_that("Demographics (categorical) work when strata is provided", { + # SETUP ------------------------------------------------------------------- input <- mk_advs() input[, INDEX_ := .I] |> setkey(INDEX_) @@ -27,7 +28,6 @@ test_that("Demographics (categorical) work when strata provided", { strata_var = "SEX" ) - # EXPECT ------------------------------------------------------------------ x <- mk_advs() @@ -36,15 +36,21 @@ test_that("Demographics (categorical) work when strata provided", { x[, missing_sex := FALSE] x[is.na(SEX), missing_sex := TRUE] b <- - x[TRT01A=="Placebo", .N, by = .(missing_sex, SEX)] |> setorder(SEX) + x[TRT01A == "Placebo", .N, by = .(missing_sex, SEX)] |> setorder(SEX) + + expect_equal(actual_total[qualifiers == "SEX" & label == "n_missing", value], + b[(missing_sex), N]) + + expect_snapshot_value(as.data.frame(actual_total), + tolerance = 1e-8, style = "json2") + + expect_snapshot_value(as.data.frame(actual_f), + tolerance = 1e-8, style = "json2") - expect_equal(actual_total[qualifiers=="SEX" & label=="n_missing", value], b[(missing_sex), N]) - expect_snapshot(actual_total) - expect_snapshot(actual_f) }) -test_that("Demographics (continuous) work when no strata level provided", { +test_that("Demographics (continuous) work when no strata level is provided", { # SETUP ------------------------------------------------------------------- ep <- chef::mk_endpoint_str( data_prepare = mk_advs, diff --git a/vignettes/add_functions.Rmd b/vignettes/add_functions.Rmd index 5b2962e..c576d86 100644 --- a/vignettes/add_functions.Rmd +++ b/vignettes/add_functions.Rmd @@ -21,7 +21,7 @@ library(data.table) library(kableExtra) ``` -To add new functions to chefStats, you follow three general steps: +To add new functions to chefStats, you follow four general steps: 1. Consider what type of function you need: `stat_by_strata_by_trt`, `stat_by_strata_across_trt` or `stat_across_strata_across_trt` (see article [Function types](https://hta-pharma.github.io/chefStats/articles/function_types.html). @@ -39,28 +39,26 @@ This is the workflow for writing such a function from scratch: 1. Decide which function type it is (see article [Function types](https://hta-pharma.github.io/chefStats/articles/function_types.html). Since the function produces a number by stratification level and by treatment level, this will be a `stat_by_strata_by_trt`. 2. Call `use_chefStats(fn_name = "num_subj_events", fn_type = "stat_by_strata_by_trt")`. This will produce a template R function that has the correct arguments for what is passed by the chef pipeline to `stat_by_strata_by_trt`-type functions (see section [Interface with chef](#interface-with-chef) for more details. The skeleton function will look like this: ```{r, eval=FALSE} - num_subj_events <- function(dat, - event_index, - cell_index, - strata_var, - strata_val, - treatment_var, - treatment_val, - subject_id, - ...) { - - # Function body here: - - # The final object retuned needs to be a data.table with the following format: - return( - data.table::data.table( - label = NA_character_, - value = NA_real_, - description = NA_character_ - ) +num_subj_events <- function(dat, + event_index, + cell_index, + strata_var, + strata_val, + treatment_var, + treatment_val, + subject_id, + ...) { + # Function body here: + + # The final object retuned needs to be a data.table with the following format: + return( + data.table::data.table( + label = NA_character_, + value = NA_real_, + description = NA_character_ ) - } - + ) +} ``` 3. Remove unneeded arguments. For our specific function, we only need the following variables: @@ -73,31 +71,30 @@ This is the workflow for writing such a function from scratch: 3. Modify the function definition for our needs. The final function definition might look like this: ```{r, eval=FALSE} - num_subj_events <- +num_subj_events <- function(dat, event_index, cell_index, subjectid_var, - ... - ) { + ...) { # Please see the "Interface with chef" section for details on what # `event_index` and `cell_index` - + # `intersect()` provides us with a vector of rows in `dat` that match both # `event_index` and `cell_index` - aka records that were BOTH eligible to # have the event (`cell_index`) AND had the event (`event_index`) index <- intersect(event_index, cell_index) - + # Return all matching rows in `dat` where `INDEX_` # matches `index`. event_rows <- dat[INDEX_ %in% index] - + # `dat` contains event data, meaning subjects can appear more than once if # they have >1 event, so we need to remove these extra rows to get a proper # count event_rows_unique_by_subject <- unique(event_rows, by = subjectid_var) - - stat <- NROW(event_rows_unique_by_subject) + + stat <- NROW(event_rows_unique_by_subject) # The return object has to be a data.table object with the following 3 # columns. The `value` column always has to be a double (not an integer) @@ -108,10 +105,7 @@ This is the workflow for writing such a function from scratch: value = as.double(stat) ) ) - } - - ```