diff --git a/DESCRIPTION b/DESCRIPTION index 4517977..a430e4b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -44,6 +44,7 @@ Suggests: gt, here, knitr, + lubridate, odbc, remotes, rmarkdown, 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 0c435b3..a655e4d 100644 --- a/R/summariseRecordCount.R +++ b/R/summariseRecordCount.R @@ -213,15 +213,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() |> @@ -236,9 +236,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-summariseConceptSetCounts.R b/tests/testthat/test-summariseConceptSetCounts.R index 9c66daf..463d602 100644 --- a/tests/testthat/test-summariseConceptSetCounts.R +++ b/tests/testthat/test-summariseConceptSetCounts.R @@ -559,7 +559,6 @@ test_that("dateRange argument works", { PatientProfiles::mockDisconnect(cdm = cdm) }) - test_that("sample argument works", { skip_on_cran() # Load mock database ---- @@ -574,3 +573,105 @@ test_that("sample argument works", { expect_equal(y,z) 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::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::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) +}) 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) })