From 90e0cce1ccf7f774320aee70a7c03f82ee751d29 Mon Sep 17 00:00:00 2001 From: nmercadeb Date: Tue, 3 Sep 2024 15:54:03 +0100 Subject: [PATCH 1/3] casting warnings --- R/conceptCohort.R | 11 ++++++----- R/exitAtColumnDate.R | 1 + R/intersectCohorts.R | 8 ++++---- R/matchCohorts.R | 9 +++++++-- R/requireDemographics.R | 1 + R/sampleCohorts.R | 1 + R/stratifyCohorts.R | 6 +++--- R/trimDemographics.R | 18 ++---------------- R/unionCohorts.R | 3 ++- R/yearCohorts.R | 1 + tests/testthat/test-conceptCohort.R | 12 ++++++------ tests/testthat/test-entryAtColumnDate.R | 8 ++++---- tests/testthat/test-intersectCohorts.R | 3 ++- tests/testthat/test-padCohortStart.R | 10 ++-------- 14 files changed, 42 insertions(+), 50 deletions(-) diff --git a/R/conceptCohort.R b/R/conceptCohort.R index cc7c8de3..67d7d308 100644 --- a/R/conceptCohort.R +++ b/R/conceptCohort.R @@ -318,7 +318,7 @@ fulfillCohortReqs <- function(cdm, name) { conceptSetToCohortSet <- function(conceptSet, cdm) { cohSet <- dplyr::tibble("cohort_name" = names(conceptSet)) |> dplyr::mutate( - "cohort_definition_id" = dplyr::row_number(), + "cohort_definition_id" = as.integer(dplyr::row_number()), "cdm_version" = attr(cdm, "cdm_version"), "vocabulary_version" = CodelistGenerator::getVocabVersion(cdm) ) @@ -331,16 +331,17 @@ conceptSetToCohortSet <- function(conceptSet, cdm) { conceptSetToCohortCodelist <- function(conceptSet) { cohortSet <- dplyr::tibble("cohort_name" = names(conceptSet)) |> - dplyr::mutate("cohort_definition_id" = dplyr::row_number()) + dplyr::mutate("cohort_definition_id" = as.integer(dplyr::row_number())) lapply(conceptSet, dplyr::as_tibble) |> dplyr::bind_rows(.id = "cohort_name") |> dplyr::inner_join(cohortSet, by = "cohort_name") |> + dplyr::mutate("type" = "index event", "value" = as.integer(.data$value)) |> dplyr::select("cohort_definition_id", + "codelist_name" = "cohort_name", "concept_id" = "value", - "codelist_name" = "cohort_name" - ) |> - dplyr::mutate("type" = "index event") + "type" + ) } # upload codes to cdm and add domain diff --git a/R/exitAtColumnDate.R b/R/exitAtColumnDate.R index 65ff6867..c6d168dc 100644 --- a/R/exitAtColumnDate.R +++ b/R/exitAtColumnDate.R @@ -215,6 +215,7 @@ exitAtColumnDate <- function(cohort, } newCohort <- newCohort |> + dplyr::relocate(dplyr::all_of(omopgenerics::cohortColumns("cohort"))) |> dplyr::compute(name = name, temporary = FALSE) |> omopgenerics::newCohortTable(.softValidation = TRUE) diff --git a/R/intersectCohorts.R b/R/intersectCohorts.R index f837dd3f..9b393379 100644 --- a/R/intersectCohorts.R +++ b/R/intersectCohorts.R @@ -538,10 +538,10 @@ intersectCohortAttrition <- function(cohort, cohAtt <- counts |> dplyr::filter(.data$cohort_definition_id %in% .env$intersectId) |> dplyr::mutate( - "reason_id" = 1, + "reason_id" = 1L, "reason" = "Initial qualifying events", - "excluded_records" = 0, - "excluded_subjects" = 0 + "excluded_records" = 0L, + "excluded_subjects" = 0L ) if (!keepOriginalCohorts) { # individual cohorts @@ -613,7 +613,7 @@ addAttritionReason <- function(att, counts, ids, reason) { ) |> dplyr::select("cohort_definition_id", "reason_id") |> dplyr::rowwise() |> - dplyr::mutate("reason_id" = .data$reason_id + 1, "reason" = reason), + dplyr::mutate("reason_id" = .data$reason_id + 1L, "reason" = reason), by = "cohort_definition_id" ) |> dplyr::select(dplyr::all_of( diff --git a/R/matchCohorts.R b/R/matchCohorts.R index da3157b9..1017745b 100644 --- a/R/matchCohorts.R +++ b/R/matchCohorts.R @@ -70,6 +70,7 @@ matchCohorts <- function(cohort, if (cohort |> settings() |> nrow() == 0) { cdm[[name]] <- cohort |> + dplyr::relocate(dplyr::all_of(omopgenerics::cohortColumns("cohort"))) |> dplyr::compute(name = name, temporary = FALSE) |> omopgenerics::newCohortTable(.softValidation = TRUE) return(cdm[[name]]) @@ -117,6 +118,7 @@ matchCohorts <- function(cohort, # update settings cdm[[control]] <- cdm[[control]] |> + dplyr::relocate(dplyr::all_of(omopgenerics::cohortColumns("cohort"))) |> omopgenerics::newCohortTable( cohortSetRef = settings(cdm[[control]]) |> dplyr::select("cohort_definition_id", "cohort_name") |> @@ -146,6 +148,7 @@ matchCohorts <- function(cohort, .softValidation = TRUE ) cdm[[target]] <- cdm[[target]] |> + dplyr::relocate(dplyr::all_of(omopgenerics::cohortColumns("cohort"))) |> omopgenerics::newCohortTable( cohortSetRef = settings(cdm[[target]]) |> dplyr::select("cohort_definition_id", "cohort_name") |> @@ -205,15 +208,16 @@ getNewCohort <- function(cohort, cohortId, control) { cdm <- omopgenerics::dropTable(cdm, temp_name) controls <- controls |> + dplyr::relocate(dplyr::all_of(omopgenerics::cohortColumns("cohort"))) |> omopgenerics::newCohortTable( cohortSetRef = settings(cohort) |> dplyr::mutate("cohort_name" = paste0(.data$cohort_name, "_matched")), cohortAttritionRef = dplyr::tibble( "cohort_definition_id" = as.integer(cohortId), - "number_records" = controls |> dplyr::tally() |> dplyr::pull(), + "number_records" = controls |> dplyr::tally() |> dplyr::pull() |> as.integer(), "number_subjects" = controls |> dplyr::summarise(dplyr::n_distinct(.data$subject_id)) |> - dplyr::pull(), + dplyr::pull() |> as.integer(), "reason_id" = 1L, "reason" = "First observation per person", "excluded_records" = 0L, @@ -375,6 +379,7 @@ observationControl <- function(x) { .data$cohort_start_date >= .data$observation_period_start_date ) |> dplyr::select(-"observation_period_start_date") |> + dplyr::relocate(dplyr::all_of(omopgenerics::cohortColumns("cohort"))) |> dplyr::compute(name = tableName(x), temporary = FALSE) |> omopgenerics::recordCohortAttrition(reason = "Exclude individuals not in observation") } diff --git a/R/requireDemographics.R b/R/requireDemographics.R index 9ad035af..0a7679d7 100644 --- a/R/requireDemographics.R +++ b/R/requireDemographics.R @@ -522,6 +522,7 @@ demographicsFilter <- function(cohort, ) )) |> dplyr::select(!"target_cohort_rand01") |> + dplyr::relocate(dplyr::all_of(omopgenerics::cohortColumns("cohort"))) |> dplyr::compute(name = name, temporary = FALSE) |> omopgenerics::newCohortTable( cohortSetRef = newSet, diff --git a/R/sampleCohorts.R b/R/sampleCohorts.R index c95b9172..e45576eb 100644 --- a/R/sampleCohorts.R +++ b/R/sampleCohorts.R @@ -44,6 +44,7 @@ sampleCohorts <- function(cohort, .data$cohort_definition_id %in% .env$cohortId ))) |> dplyr::ungroup() |> + dplyr::relocate(dplyr::all_of(omopgenerics::cohortColumns("cohort"))) |> omopgenerics::recordCohortAttrition( reason = paste0("Sample ", n, " individuals"), cohortId = cohortId diff --git a/R/stratifyCohorts.R b/R/stratifyCohorts.R index fe15014f..6290022d 100644 --- a/R/stratifyCohorts.R +++ b/R/stratifyCohorts.R @@ -210,8 +210,8 @@ getNewAttritionStrata <- function(originalAttrition, set, counts) { newAttrition |> dplyr::bind_rows() } addAttritionLine <- function(oldAttrition, reason, count) { - nr <- sum(count$number_records) - ns <- sum(count$number_subjects) + nr <- as.integer(sum(count$number_records)) + ns <- as.integer(sum(count$number_subjects)) oldAttrition |> dplyr::union_all( oldAttrition |> @@ -222,7 +222,7 @@ addAttritionLine <- function(oldAttrition, reason, count) { "excluded_subjects" = .data$number_subjects - .env$ns, "number_records" = .env$nr, "number_subjects" = .env$ns, - "reason_id" = .data$reason_id + 1 + "reason_id" = .data$reason_id + 1L ) ) } diff --git a/R/trimDemographics.R b/R/trimDemographics.R index a3715e90..20528327 100644 --- a/R/trimDemographics.R +++ b/R/trimDemographics.R @@ -127,25 +127,10 @@ trimDemographics <- function(cohort, by = "target_cohort_rand01", relationship = "many-to-many" ) |> + dplyr::relocate(dplyr::all_of(omopgenerics::cohortColumns("cohort"))) |> dplyr::compute(name = tmpNewCohort, temporary = FALSE) - # make sure cohort variables are first - orderVars <- c( - "cohort_definition_id", - "subject_id", - "cohort_start_date", - "cohort_end_date", - colnames(newCohort)[!colnames(newCohort) %in% - c( - "cohort_definition_id", - "subject_id", - "cohort_start_date", - "cohort_end_date" - )] - ) - newCohort <- newCohort |> - dplyr::select(dplyr::all_of(orderVars)) |> omopgenerics::newCohortTable( cohortSetRef = newSet, cohortAttritionRef = newAtt, @@ -342,6 +327,7 @@ trimDemographics <- function(cohort, ) )), by = unique(c("target_cohort_rand01", "subject_id"))) |> dplyr::select(!"target_cohort_rand01") |> + dplyr::relocate(dplyr::all_of(omopgenerics::cohortColumns("cohort"))) |> dplyr::compute(name = name, temporary = FALSE) |> omopgenerics::newCohortTable( cohortSetRef = newSet, diff --git a/R/unionCohorts.R b/R/unionCohorts.R index 7360a9db..f2a06c9c 100644 --- a/R/unionCohorts.R +++ b/R/unionCohorts.R @@ -75,9 +75,10 @@ unionCohorts <- function(cohort, dplyr::compute(name = tmpTable, temporary = FALSE) cohCodelist <- attr(cohort, "cohort_codelist") if (!is.null(cohCodelist)) { - cohCodelist <- cohCodelist |> dplyr::mutate("cohort_definition_id" = 1) + cohCodelist <- cohCodelist |> dplyr::mutate("cohort_definition_id" = 1L) } unionedCohort <- unionedCohort |> + dplyr::relocate(dplyr::all_of(omopgenerics::cohortColumns("cohort"))) |> omopgenerics::newCohortTable( cohortSetRef = cohSet, cohortAttritionRef = NULL, diff --git a/R/yearCohorts.R b/R/yearCohorts.R index 3b3d271a..60038399 100644 --- a/R/yearCohorts.R +++ b/R/yearCohorts.R @@ -166,6 +166,7 @@ yearCohorts <- function(cohort, # new cohort cohort <- cohort |> + dplyr::relocate(dplyr::all_of(omopgenerics::cohortColumns("cohort"))) |> dplyr::compute(name = name, temporary = FALSE) |> omopgenerics::newCohortTable( cohortSetRef = newSet, diff --git a/tests/testthat/test-conceptCohort.R b/tests/testthat/test-conceptCohort.R index 1fb01596..54ed9f72 100644 --- a/tests/testthat/test-conceptCohort.R +++ b/tests/testthat/test-conceptCohort.R @@ -65,14 +65,14 @@ test_that("expected errors and messages", { test_that("simple example", { cdm <- omock::mockCdmReference() |> omock::mockCdmFromTables(tables = list("cohort" = dplyr::tibble( - "cohort_definition_id" = 1, - "subject_id" = c(1, 2, 3), + "cohort_definition_id" = 1L, + "subject_id" = c(1L, 2L, 3L), "cohort_start_date" = as.Date("2020-01-01"), "cohort_end_date" = as.Date("2029-12-31") ))) cdm <- omopgenerics::insertTable( cdm = cdm, name = "concept", table = dplyr::tibble( - "concept_id" = 1, + "concept_id" = 1L, "concept_name" = "my concept", "domain_id" = "drUg", "vocabulary_id" = NA, @@ -84,9 +84,9 @@ test_that("simple example", { ) cdm <- omopgenerics::insertTable( cdm = cdm, name = "drug_exposure", table = dplyr::tibble( - "drug_exposure_id" = 1:11, - "person_id" = c(1, 1, 1, 1, 2, 2, 3, 1, 1, 1, 1), - "drug_concept_id" = c(1, 1, 1, 2, 1, 1, 2, 1, 1, 1, 1), + "drug_exposure_id" = 1:11 |> as.integer(), + "person_id" = c(1, 1, 1, 1, 2, 2, 3, 1, 1, 1, 1) |> as.integer(), + "drug_concept_id" = c(1, 1, 1, 2, 1, 1, 2, 1, 1, 1, 1) |> as.integer(), "drug_exposure_start_date" = c(0, 300, 1500, 750, 10, 800, 150, 1800, 1801, 1802, 1803), "drug_exposure_end_date" = c(400, 800, 1600, 1550, 2000, 1000, 600, 1801, 1802, 1803, 1804), "drug_type_concept_id" = 1 diff --git a/tests/testthat/test-entryAtColumnDate.R b/tests/testthat/test-entryAtColumnDate.R index f5563cb1..c8cc9455 100644 --- a/tests/testthat/test-entryAtColumnDate.R +++ b/tests/testthat/test-entryAtColumnDate.R @@ -3,8 +3,8 @@ test_that("entry at first date", { cdm <- mockCohortConstructor( tables = list( "cohort" = dplyr::tibble( - cohort_definition_id = 1, - subject_id = c(1, 2, 3, 4, 4), + cohort_definition_id = 1L, + subject_id = c(1, 2, 3, 4, 4) |> as.integer(), cohort_start_date = as.Date(c("2000-06-03", "2000-01-01", "2015-01-15", "1989-12-09", "2000-12-09")), cohort_end_date = as.Date(c("2001-09-01", "2001-01-12", "2015-02-15", "1990-12-09", "2002-12-09")), other_date_1 = as.Date(c("2001-08-01", "2001-01-01", "2015-01-15", NA, "2002-12-09")), @@ -59,8 +59,8 @@ test_that("entry at last date", { cdm <- mockCohortConstructor( tables = list( "cohort" = dplyr::tibble( - cohort_definition_id = c(1, 1, 2, 2, 2), - subject_id = c(1, 2, 3, 4, 4), + cohort_definition_id = c(1, 1, 2, 2, 2) |> as.integer(), + subject_id = c(1, 2, 3, 4, 4) |> as.integer(), cohort_start_date = as.Date(c("2000-06-03", "2000-01-01", "2015-01-15", "1989-12-09", "2000-12-09")), cohort_end_date = as.Date(c("2001-10-01", "2001-04-15", "2015-02-15", "1990-12-09", "2002-12-09")), other_date_1 = as.Date(c("2001-09-02", "2001-01-01", "2015-01-15", "1989-11-09", "2002-12-09")), diff --git a/tests/testthat/test-intersectCohorts.R b/tests/testthat/test-intersectCohorts.R index 4fdb8a8c..21ec1227 100644 --- a/tests/testthat/test-intersectCohorts.R +++ b/tests/testthat/test-intersectCohorts.R @@ -450,7 +450,7 @@ test_that("codelist", { cdm$cohort4 <- intersectCohorts(cdm$cohort1, keepOriginalCohorts = TRUE, name = "cohort4") expect_true(all( cdm$cohort4 %>% dplyr::pull("cohort_start_date") %>% sort() == - c("2012-01-21", "2014-02-09") + c("2012-01-data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAYAAABWzo5XAAAAbElEQVR4Xs2RQQrAMAgEfZgf7W9LAguybljJpR3wEse5JOL3ZObDb4x1loDhHbBOFU6i2Ddnw2KNiXcdAXygJlwE8OFVBHDgKrLgSInN4WMe9iXiqIVsTMjH7z/GhNTEibOxQswcYIWYOR/zAjBJfiXh3jZ6AAAAAElFTkSuQmCC21", "2014-02-09") )) expect_true(all( cdm$cohort4 %>% dplyr::pull("cohort_end_date") %>% sort() == @@ -476,3 +476,4 @@ test_that("codelist", { PatientProfiles::mockDisconnect(cdm) }) + diff --git a/tests/testthat/test-padCohortStart.R b/tests/testthat/test-padCohortStart.R index 3a63473f..331fc0a4 100644 --- a/tests/testthat/test-padCohortStart.R +++ b/tests/testthat/test-padCohortStart.R @@ -24,17 +24,13 @@ test_that("adding days to cohort start", { cdm$cohort_1 <- padCohortStart(cdm$cohort, days = 2, name = "cohort_1") - expect_identical(cdm$cohort_1 |> - dplyr::pull("cohort_start_date"), - as.Date("2020-01-05")) - + expect_identical(cdm$cohort_1 |> dplyr::pull("cohort_start_date"), as.Date("2020-01-05")) # minus days cdm$cohort_2 <- padCohortStart(cdm$cohort, days = -2, name = "cohort_2") - expect_identical(cdm$cohort_2 |> - dplyr::pull("cohort_start_date"), + expect_identical(cdm$cohort_2 |> dplyr::pull("cohort_start_date"), as.Date("2020-01-01")) # minus days goes outside of current observation period @@ -135,6 +131,4 @@ test_that("adding days to cohort start", { cohortId = 1, name = "my_cohort 1" )) - - }) From 84155710c3e709842beca305d1caa44415c9335c Mon Sep 17 00:00:00 2001 From: nmercadeb Date: Tue, 3 Sep 2024 17:34:00 +0100 Subject: [PATCH 2/3] checks --- tests/testthat/test-intersectCohorts.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/tests/testthat/test-intersectCohorts.R b/tests/testthat/test-intersectCohorts.R index 21ec1227..4fdb8a8c 100644 --- a/tests/testthat/test-intersectCohorts.R +++ b/tests/testthat/test-intersectCohorts.R @@ -450,7 +450,7 @@ test_that("codelist", { cdm$cohort4 <- intersectCohorts(cdm$cohort1, keepOriginalCohorts = TRUE, name = "cohort4") expect_true(all( cdm$cohort4 %>% dplyr::pull("cohort_start_date") %>% sort() == - c("2012-01-data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAYAAABWzo5XAAAAbElEQVR4Xs2RQQrAMAgEfZgf7W9LAguybljJpR3wEse5JOL3ZObDb4x1loDhHbBOFU6i2Ddnw2KNiXcdAXygJlwE8OFVBHDgKrLgSInN4WMe9iXiqIVsTMjH7z/GhNTEibOxQswcYIWYOR/zAjBJfiXh3jZ6AAAAAElFTkSuQmCC21", "2014-02-09") + c("2012-01-21", "2014-02-09") )) expect_true(all( cdm$cohort4 %>% dplyr::pull("cohort_end_date") %>% sort() == @@ -476,4 +476,3 @@ test_that("codelist", { PatientProfiles::mockDisconnect(cdm) }) - From 39a94d0292d4525ec0e038a5e52eb1f42d4d2897 Mon Sep 17 00:00:00 2001 From: nmercadeb Date: Tue, 3 Sep 2024 17:40:56 +0100 Subject: [PATCH 3/3] cast stratifyCohorts --- R/stratifyCohorts.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/stratifyCohorts.R b/R/stratifyCohorts.R index 6290022d..52069063 100644 --- a/R/stratifyCohorts.R +++ b/R/stratifyCohorts.R @@ -144,6 +144,7 @@ stratifyCohorts <- function(cohort, newCohort <- purrr::reduce(newCohort, dplyr::union_all) |> dplyr::select(!dplyr::all_of(c("target_cohort_id", strataCols[removeStrata]))) |> + dplyr::relocate(dplyr::all_of(omopgenerics::cohortColumns("cohort"))) |> dplyr::compute(name = name, temporary = FALSE) |> omopgenerics::newCohortTable( cohortSetRef = newSettings,