Skip to content

Commit

Permalink
Fix merge conflicts
Browse files Browse the repository at this point in the history
  • Loading branch information
@matthew-phelps
matthew-phelps committed Apr 12, 2024
2 parents af70e56 + 60bfeea commit b73f86d
Show file tree
Hide file tree
Showing 5 changed files with 174 additions and 78 deletions.
5 changes: 4 additions & 1 deletion DESCRIPTION
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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",
Expand Down
1 change: 1 addition & 0 deletions _pkgdown.yml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
112 changes: 96 additions & 16 deletions tests/testthat/_snaps/demographics.md
View file
Original file line number Diff line number Diff line change
@@ -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
<char> <fctr> <num> <char>
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
<char> <char> <char> <num>
1: n_non_missing Demographics <NA> 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]
}
]
}

20 changes: 13 additions & 7 deletions tests/testthat/test-demographics.R
View file
Original file line number Diff line number Diff line change
@@ -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_)
Expand Down Expand Up @@ -27,7 +28,6 @@ test_that("Demographics (categorical) work when strata provided", {
strata_var = "SEX"
)


# EXPECT ------------------------------------------------------------------

x <- mk_advs()
Expand All @@ -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,
Expand Down
114 changes: 60 additions & 54 deletions vignettes/add_functions.Rmd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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).
Expand All @@ -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:
Expand All @@ -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)
Expand All @@ -108,10 +105,7 @@ This is the workflow for writing such a function from scratch:
value = as.double(stat)
)
)
}
```

<style>
Expand Down Expand Up @@ -148,11 +142,13 @@ dt <-
)
)
dt |>
kable(format = "html",
table.attr = "class='table table-bordered'",
caption = "Arguments always passed to chefStats functions") |>
kable(
format = "html",
table.attr = "class='table table-bordered'",
caption = "Arguments always passed to chefStats functions"
) |>
kable_styling(bootstrap_options = c("hover", "condensed", "responsive")) |>
row_spec(0, background = "#2C3E50", color="white")
row_spec(0, background = "#2C3E50", color = "white")
```

<br><br>
Expand All @@ -176,11 +172,13 @@ dt <-
)
)
dt |>
kable(format = "html",
table.attr = "class='table table-bordered'",
caption = "Additional arguments passed to by_strata_by_trt functions") |>
kable(
format = "html",
table.attr = "class='table table-bordered'",
caption = "Additional arguments passed to by_strata_by_trt functions"
) |>
kable_styling(bootstrap_options = c("hover", "condensed", "responsive")) |>
row_spec(0, background = "#2C3E50", color="white")
row_spec(0, background = "#2C3E50", color = "white")
```


Expand All @@ -190,41 +188,49 @@ dt |>
```{r, echo=FALSE}
dt <-
data.table::data.table(
`Argument Names` = c("`cell_index`",
"`strata_val`",
"`treatment_refval`"),
`Argument Names` = c(
"`cell_index`",
"`strata_val`",
"`treatment_refval`"
),
Description = c(
"A `vector` of indicies specifying which rows in `dat` are considered to be part of the analysis for the given strata level and treatment level under evaluation. For example, if the current instance of the function was analysis \"Number of Events\" for SEX==\"M\" and TRT01A == \"Placebo\", then `cell_index` would be a vector of records in `dat$INDEX_` that match those parameters. You can thus obtain the analysis set by filtering `dat` via: `dat[cell_index %in% INDEX_]`",
"A `character` specifying the stratification level under evaluation. For example if `strat_var ==\"SEX\"`, then `strat_val` could be either `\"M\"` or `\"F\"`",
"A `character` specifying the treatment reference level. *Not to be confused with the `treatment_val` that specifies the treatment value for `by_strata_by_trt` functions"
)
)
dt |>
kable(format = "html",
table.attr = "class='table table-bordered'",
caption = "Additional arguments passed to by_strata_across_trt functions") |>
kable(
format = "html",
table.attr = "class='table table-bordered'",
caption = "Additional arguments passed to by_strata_across_trt functions"
) |>
kable_styling(bootstrap_options = c("hover", "condensed", "responsive")) |>
row_spec(0, background = "#2C3E50", color="white")
row_spec(0, background = "#2C3E50", color = "white")
```
#### stat_by_strata_across_trt


```{r, echo=FALSE}
dt <-
data.table::data.table(
`Argument Names` = c("`strata_val`",
"`treatment_refval`"),
`Argument Names` = c(
"`strata_val`",
"`treatment_refval`"
),
Description = c(
"A `character` specifying the stratification level under evaluation. For example if `strat_var ==\"SEX\"`, then `strat_val` could be either `\"M\"` or `\"F\"`",
"A `character` specifying the treatment reference level. *Not to be confused with the `treatment_val` that specifies the treatment value for `by_strata_by_trt` functions"
)
)
dt |>
kable(format = "html",
table.attr = "class='table table-bordered'",
caption = "Additional arguments passed to across_strata_across_trt functions") |>
kable(
format = "html",
table.attr = "class='table table-bordered'",
caption = "Additional arguments passed to across_strata_across_trt functions"
) |>
kable_styling(bootstrap_options = c("hover", "condensed", "responsive")) |>
row_spec(0, background = "#2C3E50", color="white")
row_spec(0, background = "#2C3E50", color = "white")
```


Expand Down

0 comments on commit b73f86d

Please sign in to comment.