Skip to content

Commit

Permalink
summariseInObservation
Browse files Browse the repository at this point in the history
  • Loading branch information
@martaalcalde
martaalcalde committed Jul 30, 2024
1 parent 464abba commit f9ea3f7
Show file tree
Hide file tree
Showing 2 changed files with 36 additions and 37 deletions.
11 changes: 6 additions & 5 deletions R/summariseInObservation.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -85,7 +85,7 @@ getDenominator <- function(cdm, output){
y <- cdm[["observation_period"]] |>
dplyr::ungroup() |>
dplyr::inner_join(cdm[["person"]] |> dplyr::select("person_id"), by = "person_id") %>%
dplyr::mutate(n = !!CDMConnector::datediff("observation_period_start_date", "observation_period_end_date",interval = "day")) |>
dplyr::mutate(n = !!CDMConnector::datediff("observation_period_start_date", "observation_period_end_date",interval = "day")+1) |>
dplyr::summarise("n" = sum(.data$n, na.rm = TRUE)) |>
dplyr::pull("n")

Expand All @@ -97,7 +97,7 @@ getDenominator <- function(cdm, output){
y <- cdm[["observation_period"]] |>
dplyr::ungroup() |>
dplyr::inner_join(cdm[["person"]] |> dplyr::select("person_id"), by = "person_id") %>%
dplyr::mutate(n = !!CDMConnector::datediff("observation_period_start_date", "observation_period_end_date",interval = "day")) |>
dplyr::mutate(n = !!CDMConnector::datediff("observation_period_start_date", "observation_period_end_date",interval = "day")+1) |>
dplyr::summarise("n" = sum(.data$n, na.rm = TRUE)) |>
dplyr::pull("n")

Expand Down Expand Up @@ -152,8 +152,9 @@ countRecords <- function(observationPeriod, cdm, start_date_name, end_date_name,
x <- cdm[["interval"]] |>
dplyr::cross_join(
observationPeriod |>
dplyr::rename("start_date" = "observation_period_start_date",
"end_date" = "observation_period_end_date")
dplyr::select("start_date" = "observation_period_start_date",
"end_date" = "observation_period_end_date",
"age_group", "sex","person_id")
) |>
dplyr::filter((.data$start_date < .data$interval_start_date & .data$end_date >= .data$interval_start_date) |
(.data$start_date >= .data$interval_start_date & .data$start_date <= .data$interval_end_date)) %>%
Expand All @@ -162,7 +163,7 @@ countRecords <- function(observationPeriod, cdm, start_date_name, end_date_name,
dplyr::compute(temporary = FALSE, name = tablePrefix)

personDays <- x %>%
dplyr::mutate(estimate_value = !!CDMConnector::datediff("start_date","end_date", interval = "day")) |>
dplyr::mutate(estimate_value = !!CDMConnector::datediff("start_date","end_date", interval = "day")+1) |>
dplyr::group_by(.data$interval_group, .data$sex, .data$age_group) |>
dplyr::summarise(estimate_value = sum(.data$estimate_value, na.rm = TRUE), .groups = "drop") |>
dplyr::mutate(variable_name = "person-days") |>
Expand Down
62 changes: 30 additions & 32 deletions tests/testthat/test-summariseInObservation.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -206,8 +206,6 @@ test_that("check ageGroup argument works", {

})



test_that("check output argument works", {
# Load mock database ----
con <- DBI::dbConnect(duckdb::duckdb(), CDMConnector::eunomia_dir())
Expand All @@ -226,14 +224,14 @@ test_that("check output argument works", {
dplyr::mutate("start_date" = as.Date("1964-01-01"), "end_date" = as.Date("1970-12-31")) %>%
dplyr::mutate("start_date" = pmax(start_date, observation_period_start_date, na.rm = TRUE),
"end_date" = pmin(end_date, observation_period_end_date, na.rm = TRUE)) %>%
dplyr::mutate(days = !!CDMConnector::datediff("start_date","end_date", interval = "day")) |>
dplyr::mutate(days = !!CDMConnector::datediff("start_date","end_date", interval = "day")+1) |>
dplyr::summarise(n = sum(days, na.rm = TRUE)) |> dplyr::pull("n")
expect_equal(x,y)

# Check percentage
den <- cdm$observation_period |>
dplyr::inner_join(cdm[["person"]] |> dplyr::select("person_id"), by = "person_id") %>%
dplyr::mutate(days = !!CDMConnector::datediff("observation_period_start_date","observation_period_end_date", interval = "day")) |>
dplyr::mutate(days = !!CDMConnector::datediff("observation_period_start_date","observation_period_end_date", interval = "day")+1) |>
dplyr::summarise(n = sum(days, na.rm = TRUE)) |> dplyr::pull("n")
x <- summariseInObservation(cdm$observation_period, unit = "year", unitInterval = 7, output = "all", ageGroup = NULL, sex = FALSE) |>
dplyr::filter(variable_name == "person-days", variable_level == "1964-01-01 to 1970-12-31", estimate_type == "percentage") |>
Expand All @@ -245,40 +243,40 @@ test_that("check output argument works", {
dplyr::mutate("start_date" = as.Date("1964-01-01"), "end_date" = as.Date("1970-12-31")) %>%
dplyr::mutate("start_date" = pmax(start_date, observation_period_start_date, na.rm = TRUE),
"end_date" = pmin(end_date, observation_period_end_date, na.rm = TRUE)) %>%
dplyr::mutate(days = !!CDMConnector::datediff("start_date","end_date", interval = "day")) |>
dplyr::mutate(days = !!CDMConnector::datediff("start_date","end_date", interval = "day")+1) |>
dplyr::summarise(n = sum(days, na.rm = TRUE)) |> dplyr::pull("n")/den*100
expect_equal(x,y)

# # Check sex stratified
# x <- summariseInObservation(cdm$observation_period, unit = "year", unitInterval = 7, output = "person-days", sex = TRUE) |>
# dplyr::filter(variable_name == "person-days", variable_level == "1964-01-01 to 1970-12-31", estimate_type == "integer") |>
# dplyr::filter(strata_level == "overall") |> dplyr::pull("estimate_value") |> as.numeric()
# y <- summariseInObservation(cdm$observation_period, unit = "year", unitInterval = 7, output = "person-days", sex = TRUE) |>
# dplyr::filter(variable_name == "person-days", variable_level == "1964-01-01 to 1970-12-31", estimate_type == "integer") |>
# dplyr::filter(strata_level != "overall") |> dplyr::pull("estimate_value") |> as.numeric() |> sum()
# expect_equal(x,y)
#
# # Check age stratified
# x <- summariseInObservation(cdm$observation_period, unit = "year", unitInterval = 7, output = "person-days", ageGroup = list("<=20" = c(0,20), ">20" = c(21,Inf))) |>
# dplyr::filter(variable_name == "person-days", variable_level == "1964-01-01 to 1970-12-31", estimate_type == "integer") |>
# dplyr::filter(strata_level == "overall") |> dplyr::pull("estimate_value") |> as.numeric()
# y <- summariseInObservation(cdm$observation_period, unit = "year", unitInterval = 7, output = "person-days", sex = TRUE) |>
# dplyr::filter(variable_name == "person-days", variable_level == "1964-01-01 to 1970-12-31", estimate_type == "integer") |>
# dplyr::filter(strata_level != "overall") |> dplyr::pull("estimate_value") |> as.numeric() |> sum()
# expect_equal(x,y)
# Check sex stratified
x <- summariseInObservation(cdm$observation_period, unit = "year", unitInterval = 7, output = "person-days", sex = TRUE) |>
dplyr::filter(variable_name == "person-days", variable_level == "1964-01-01 to 1970-12-31", estimate_type == "integer") |>
dplyr::filter(strata_level == "overall") |> dplyr::pull("estimate_value") |> as.numeric()
y <- summariseInObservation(cdm$observation_period, unit = "year", unitInterval = 7, output = "person-days", sex = TRUE) |>
dplyr::filter(variable_name == "person-days", variable_level == "1964-01-01 to 1970-12-31", estimate_type == "integer") |>
dplyr::filter(strata_level != "overall") |> dplyr::pull("estimate_value") |> as.numeric() |> sum()
expect_equal(x,y)

# Check age stratified
x <- summariseInObservation(cdm$observation_period, unit = "year", unitInterval = 7, output = "person-days", ageGroup = list("<=20" = c(0,20), ">20" = c(21,Inf))) |>
dplyr::filter(variable_name == "person-days", variable_level == "1964-01-01 to 1970-12-31", estimate_type == "integer") |>
dplyr::filter(strata_level == "overall") |> dplyr::pull("estimate_value") |> as.numeric()
y <- summariseInObservation(cdm$observation_period, unit = "year", unitInterval = 7, output = "person-days", sex = TRUE) |>
dplyr::filter(variable_name == "person-days", variable_level == "1964-01-01 to 1970-12-31", estimate_type == "integer") |>
dplyr::filter(strata_level != "overall") |> dplyr::pull("estimate_value") |> as.numeric() |> sum()
expect_equal(x,y)


})

# con <- DBI::dbConnect(duckdb::duckdb(), CDMConnector::eunomia_dir())
# cdm <- CDMConnector::cdmFromCon(
# con = con, cdmSchema = "main", writeSchema = "main"
# )
# observationPeriod <- cdm$observation_period
# unit <- "year"
# unitInterval <- 7
# sex <- TRUE
# ageGroup <- list("<= 20" = c(0,20), ">20" = c(21,Inf))
# output <- "person-days"
con <- DBI::dbConnect(duckdb::duckdb(), CDMConnector::eunomia_dir())
cdm <- CDMConnector::cdmFromCon(
con = con, cdmSchema = "main", writeSchema = "main"
)
observationPeriod <- cdm$observation_period
unit <- "year"
unitInterval <- 7
sex <- FALSE
ageGroup <- list("<= 20" = c(0,20), ">20" = c(21,Inf))
output <- "person-days"


0 comments on commit f9ea3f7

Please sign in to comment.