Merge pull request #296 from OHDSI/casting

casting warnings

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

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)
 

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(

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")
 }

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,

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

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,
@@ -210,8 +211,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 +223,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
  )
  )
 }

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,

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,

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,

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

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")),

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"
  ))
-
-
 })