From 05fed220ef212b35cd6eaba30c47e5bd96bfc52b Mon Sep 17 00:00:00 2001 From: cecicampanile <campanile.cecilia@gmail.com> Date: Mon, 16 Dec 2024 12:58:45 +0000 Subject: [PATCH 1/3] test for interval argument in summariseConceptCount some bugs fixed also --- R/checks.R | 2 +- R/summariseRecordCount.R | 10 +- tests/testthat/test-summariseConceptCounts.R | 101 +++++++++++++++++++ 3 files changed, 107 insertions(+), 6 deletions(-) diff --git a/R/checks.R b/R/checks.R index 52ba593..2a74041 100644 --- a/R/checks.R +++ b/R/checks.R @@ -17,7 +17,7 @@ validateIntervals <- function(interval, call = parent.frame()){ unitInterval <- dplyr::case_when( interval == "overall" ~ NA, - interval == "quarters" ~ 4, + interval == "quarters" ~ 3, interval == "months" ~ 1, interval == "years" ~ 1 ) diff --git a/R/summariseRecordCount.R b/R/summariseRecordCount.R index d929b28..ab16fb9 100644 --- a/R/summariseRecordCount.R +++ b/R/summariseRecordCount.R @@ -204,15 +204,15 @@ getOmopTableEndDate <- function(omopTable, date){ } getIntervalTibble <- function(omopTable, start_date_name, end_date_name, interval, unitInterval){ - startDate <- getOmopTableStartDate(omopTable, start_date_name) - endDate <- getOmopTableEndDate(omopTable, end_date_name) + startDate <- getOmopTableStartDate(omopTable, start_date_name) + endDate <- getOmopTableEndDate(omopTable, end_date_name) tibble::tibble( "group" = seq.Date(as.Date(startDate), as.Date(endDate), "month") ) |> dplyr::rowwise() |> dplyr::mutate("interval" = max(which( - .data$group >= seq.Date(from = startDate, to = endDate, by = paste(.env$unitInterval, .env$interval)) + .data$group >= seq.Date(from = startDate, to = endDate, by = paste(.env$interval)) ), na.rm = TRUE)) |> dplyr::ungroup() |> @@ -227,9 +227,9 @@ getIntervalTibble <- function(omopTable, start_date_name, end_date_name, interva "interval_start_date" = as.Date(.data$interval_start_date), "interval_end_date" = as.Date(.data$interval_end_date) ) |> - dplyr::mutate( + dplyr::mutate( "interval_group" = paste(.data$interval_start_date,"to",.data$interval_end_date) - ) |> + ) |> dplyr::ungroup() |> dplyr::mutate("my" = paste0(clock::get_month(.data$group),"-",clock::get_year(.data$group))) |> dplyr::select("interval_group", "my", "interval_start_date","interval_end_date") |> diff --git a/tests/testthat/test-summariseConceptCounts.R b/tests/testthat/test-summariseConceptCounts.R index 9d268e5..a4b41e7 100644 --- a/tests/testthat/test-summariseConceptCounts.R +++ b/tests/testthat/test-summariseConceptCounts.R @@ -558,3 +558,104 @@ test_that("dateRange argument works", { expect_equal(colnames(settings(z)), colnames(settings(x))) PatientProfiles::mockDisconnect(cdm = cdm) }) +test_that("interval argument works", { + skip_on_cran() + # Load mock database ---- + cdm <- mockOmopSketch() + expect_no_error(y<-summariseConceptCounts(list(ANTIHISTAMINES= c(21603444)), + cdm = cdm, + interval = "years")) + + expect_no_error(o<-summariseConceptCounts(list(ANTIHISTAMINES= c(21603444)), + cdm = cdm, + interval = "overall")) + expect_no_error(q<-summariseConceptCounts(list(ANTIHISTAMINES= c(21603444)), + cdm = cdm, + interval = "quarters")) + expect_no_error(m<-summariseConceptCounts(list(ANTIHISTAMINES= c(21603444)), + cdm = cdm, + interval = "months")) + + + + m_quarters <- m|>omopgenerics::splitAdditional()|> + omopgenerics::pivotEstimates()|> + dplyr::filter(time_interval != "overall" & variable_name == "Number records" & standard_concept_id == 21603444)|> + dplyr::mutate( + start_date = as.Date(sub(" to .*", "", time_interval)), + quarter_start = lubridate::floor_date(start_date, "quarter"), + quarter_end = lubridate::ceiling_date(start_date, "quarter") - lubridate::days(1), + quarter = paste(quarter_start, "to", quarter_end) + ) |> + dplyr::select(!c("time_interval", "start_date", "quarter_start", "quarter_end"))|> + dplyr::group_by(quarter,)|> + dplyr::summarise(count = sum(count), .groups = "drop")|> + dplyr::rename("time_interval" = quarter)|> + dplyr::arrange(time_interval) + + q_quarters <- q|>omopgenerics::splitAdditional()|> + omopgenerics::pivotEstimates()|> + dplyr::filter(time_interval != "overall" & variable_name == "Number records"& standard_concept_id == 21603444)|> + dplyr::select(time_interval, count)|> + dplyr::arrange(time_interval) + + expect_equal(m_quarters, q_quarters) + + m_year <- m|> + omopgenerics::splitAdditional()|> + dplyr::filter(time_interval != "overall" & variable_name == "Number records" & standard_concept_id == 21603444)|> + dplyr::mutate( + # Extract the start date + start_date = clock::date_parse(stringr::str_extract(time_interval, "^\\d{4}-\\d{2}-\\d{2}")), + # Convert start_date to a year-month-day object and extract the year + year = clock::get_year(clock::as_year_month_day(start_date)) + )|> + omopgenerics::pivotEstimates()|> + dplyr::group_by(year) %>% + dplyr::summarise( + count = sum(count), + .groups = "drop" + )|> + dplyr::arrange(year) + y_year <- y|> + omopgenerics::splitAdditional()|> + dplyr::filter(time_interval != "overall" & variable_name == "Number records" & standard_concept_id == 21603444)|> + dplyr::mutate( + # Extract the start date + start_date = clock::date_parse(stringr::str_extract(time_interval, "^\\d{4}-\\d{2}-\\d{2}")), + # Convert start_date to a year-month-day object and extract the year + year = clock::get_year(clock::as_year_month_day(start_date)) + )|> + omopgenerics::pivotEstimates()|> + dplyr::select(year, count)|> + dplyr::arrange(year) + + expect_equal(m_year, y_year) + o <- o |> omopgenerics::splitAdditional()|> + dplyr::filter(variable_name == "Number records" & standard_concept_id == 21603444)|> + omopgenerics::pivotEstimates()|> + dplyr::select(count) + + expect_equal(y_year|>dplyr::summarise(count = sum(count)), o) + + + q_year <- q|> + omopgenerics::splitAdditional()|> + dplyr::filter(time_interval != "overall" & variable_name == "Number records" & standard_concept_id == 21603444)|> + dplyr::mutate( + # Extract the start date + start_date = clock::date_parse(stringr::str_extract(time_interval, "^\\d{4}-\\d{2}-\\d{2}")), + # Convert start_date to a year-month-day object and extract the year + year = clock::get_year(clock::as_year_month_day(start_date)) + )|> + omopgenerics::pivotEstimates()|> + dplyr::group_by(year) %>% + dplyr::summarise( + count = sum(count), + .groups = "drop" + )|> + dplyr::arrange(year) + + expect_equal(q_year, y_year) + PatientProfiles::mockDisconnect(cdm = cdm) +}) From f1cb3a82b8bd9bb6f7fa4494c3eac586f50e9ac7 Mon Sep 17 00:00:00 2001 From: cecicampanile <campanile.cecilia@gmail.com> Date: Mon, 16 Dec 2024 14:56:56 +0000 Subject: [PATCH 2/3] adds lubridate in suggests --- DESCRIPTION | 1 + tests/testthat/test-summariseConceptCounts.R | 14 +++++++------- 2 files changed, 8 insertions(+), 7 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 06b942d..681480b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -44,6 +44,7 @@ Suggests: gt, here, knitr, + lubridate, odbc, remotes, rmarkdown, diff --git a/tests/testthat/test-summariseConceptCounts.R b/tests/testthat/test-summariseConceptCounts.R index a4b41e7..a2bfdad 100644 --- a/tests/testthat/test-summariseConceptCounts.R +++ b/tests/testthat/test-summariseConceptCounts.R @@ -579,18 +579,18 @@ test_that("interval argument works", { m_quarters <- m|>omopgenerics::splitAdditional()|> - omopgenerics::pivotEstimates()|> - dplyr::filter(time_interval != "overall" & variable_name == "Number records" & standard_concept_id == 21603444)|> + omopgenerics::pivotEstimates() |> + dplyr::filter(time_interval != "overall" & variable_name == "Number records" & standard_concept_id == 21603444) |> dplyr::mutate( start_date = as.Date(sub(" to .*", "", time_interval)), - quarter_start = lubridate::floor_date(start_date, "quarter"), - quarter_end = lubridate::ceiling_date(start_date, "quarter") - lubridate::days(1), + quarter_start = lubridate::quarter(start_date, type = "date_first"), + quarter_end = lubridate::quarter(start_date, type = "date_last"), quarter = paste(quarter_start, "to", quarter_end) ) |> - dplyr::select(!c("time_interval", "start_date", "quarter_start", "quarter_end"))|> + dplyr::select(!c("time_interval", "start_date", "quarter_start", "quarter_end")) |> dplyr::group_by(quarter,)|> - dplyr::summarise(count = sum(count), .groups = "drop")|> - dplyr::rename("time_interval" = quarter)|> + dplyr::summarise(count = sum(count), .groups = "drop") |> + dplyr::rename("time_interval" = quarter) |> dplyr::arrange(time_interval) q_quarters <- q|>omopgenerics::splitAdditional()|> From a516400c3f0d60135205b9f48e2ca39851a414d6 Mon Sep 17 00:00:00 2001 From: cecicampanile <campanile.cecilia@gmail.com> Date: Mon, 16 Dec 2024 15:27:07 +0000 Subject: [PATCH 3/3] testing strata when density is computed in summariseObservationPeriod --- .../test-summariseObservationPeriod.R | 28 +++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/tests/testthat/test-summariseObservationPeriod.R b/tests/testthat/test-summariseObservationPeriod.R index 51f47a5..9869cf6 100644 --- a/tests/testthat/test-summariseObservationPeriod.R +++ b/tests/testthat/test-summariseObservationPeriod.R @@ -433,6 +433,34 @@ test_that("check summariseObservationPeriod strata works", { dplyr::pull("estimate_value"), "32" ) + expect_no_error(x<-summariseObservationPeriod(cdm$observation_period, estimates = "density", sex = TRUE, ageGroup = list(c(0,9), c(10, Inf)))) + expect_no_error( + x |> + plotObservationPeriod( + variableName = "duration in days", plotType = "densityplot", colour = "sex", facet = "age_group") + ) + + expect_no_error( + x |> + plotObservationPeriod( + variableName = "days to next observation period", plotType = "densityplot", colour = "sex", facet = "age_group") + ) + expect_no_error( + x |> + plotObservationPeriod( + variableName = "records per person", plotType = "densityplot", colour = "sex", facet = "age_group") + ) + + expect_error(x |> + plotObservationPeriod( + variableName = "number records", plotType = "densityplot", colour = "sex", facet = "age_group")) + y<-summariseObservationPeriod(cdm$observation_period, estimates = "mean", sex = TRUE, ageGroup = list(c(0,9), c(10, Inf))) + expect_error( + y |> + plotObservationPeriod( + variableName = "records per person", plotType = "densityplot", colour = "sex", facet = "age_group") + ) + PatientProfiles::mockDisconnect(cdm = cdm) })