Nothing
test_that("summariseSequenceRatios", {
skip_if_not_installed("omock")
indexCohort <- dplyr::tibble(
cohort_definition_id = c(1, 1, 1, 1, 1, 2, 2, 2, 2, 2),
subject_id = c(1, 4, 2, 3, 5, 5, 4, 3, 6, 1),
cohort_start_date = as.Date(
c(
"2020-04-01", "2021-06-01", "2022-05-22", "2010-01-01", "2019-08-01", "2019-04-07", "2021-01-01", "2008-02-02", "2010-09-09", "2021-01-01"
)
),
cohort_end_date = as.Date(
c(
"2020-04-01", "2021-08-01", "2022-05-23", "2010-03-01", "2020-04-01", "2020-05-30", "2022-02-02", "2013-12-03", "2010-11-01", "2021-01-01"
)
)
)|>
dplyr::mutate(cohort_definition_id = as.integer(.data$cohort_definition_id),
subject_id = as.integer(.data$subject_id))
markerCohort <- dplyr::tibble(
cohort_definition_id = c(1, 1, 1, 1, 1, 3, 3, 3, 3, 3, 3),
subject_id = c(1, 3, 4, 2, 5, 1, 2, 3, 4, 5, 6),
cohort_start_date = as.Date(
c(
"2020-12-30", "2010-01-01","2021-05-25","2022-05-31", "2020-05-25", "2019-05-25", "2022-05-25", "2010-09-30", "2022-05-25", "2020-02-29", "2021-01-01"
)
),
cohort_end_date = cohort_start_date
)|>
dplyr::mutate(cohort_definition_id = as.integer(.data$cohort_definition_id),
subject_id = as.integer(.data$subject_id))
cdm <- mockCohortSymmetry(indexCohort = indexCohort,
markerCohort = markerCohort)
cdm <- generateSequenceCohortSet(cdm = cdm,
name = "joined_cohorts",
indexTable = "cohort_1",
markerTable = "cohort_2")
expect_warning(
expect_no_error(
res <- summariseSequenceRatios(
cohort = cdm$joined_cohorts)
)
)
expect_true("summarised_result" %in% class(res))
expect_error(
summariseSequenceRatios(
cohort = cdm$joined_cohorts2)
)
expect_error(
summariseSequenceRatios(
cohort = cdm$joined_cohorts,
confidenceInterval = 101)
)
expect_error(
summariseSequenceRatios(
cohort = cdm$joined_cohorts,
confidenceInterval = -101)
)
CDMConnector::cdmDisconnect(cdm = cdm)
})
test_that("summariseSequenceRatios - testing ratios and CIs, Example 1", {
skip_if_not_installed("omock")
indexCohort <- dplyr::tibble(
cohort_definition_id = c(1, 1, 1, 1, 1, 2, 2, 2, 2, 2),
subject_id = c(1, 4, 2, 3, 5, 5, 4, 3, 6, 1),
cohort_start_date = as.Date(
c(
"2020-04-01", "2021-06-01", "2022-05-22", "2010-01-01", "2019-08-01", "2019-04-07", "2021-01-01", "2008-02-02", "2010-09-09", "2021-01-01"
)
),
cohort_end_date = as.Date(
c(
"2020-04-01", "2021-08-01", "2022-05-23", "2010-03-01", "2020-04-01", "2020-05-30", "2022-02-02", "2013-12-03", "2010-11-01", "2021-01-01"
)
)
)|>
dplyr::mutate(cohort_definition_id = as.integer(.data$cohort_definition_id),
subject_id = as.integer(.data$subject_id))
markerCohort <- dplyr::tibble(
cohort_definition_id = c(1, 1, 1, 1, 1, 3, 3, 3, 3, 3, 3),
subject_id = c(1, 3, 4, 2, 5, 1, 2, 3, 4, 5, 6),
cohort_start_date = as.Date(
c(
"2020-12-30", "2010-01-01","2021-05-25","2022-05-31", "2020-05-25", "2019-05-25", "2022-05-25", "2010-09-30", "2022-05-25", "2020-02-29", "2021-01-01"
)
),
cohort_end_date = cohort_start_date
)|>
dplyr::mutate(cohort_definition_id = as.integer(.data$cohort_definition_id),
subject_id = as.integer(.data$subject_id))
cdm <- mockCohortSymmetry(indexCohort = indexCohort,
markerCohort = markerCohort)
cdm <- generateSequenceCohortSet(cdm = cdm,
name = "joined_cohorts",
indexTable = "cohort_1",
markerTable = "cohort_2")
suppressWarnings(
res <- summariseSequenceRatios(
cohort = cdm$joined_cohorts)
)
res <- res |>
visOmopResults::splitAll() |>
dplyr::filter(variable_name != "settings") |>
dplyr::select(-"estimate_type") |>
tidyr::pivot_wider(names_from = c("variable_level", "variable_name", "estimate_name"),
values_from = "estimate_value") |>
dplyr::left_join(res |> omopgenerics::settings())
expect_true(all(res$days_prior_observation==0))
expect_true(all(res$washout_window==0))
expect_true(all(res$combination_window == "0, 365"))
expect_true(all(res$index_marker_gap=="Inf"))
expect_true(all(res$confidence_interval==95))
expect_true(all(as.integer(res$first_pharmac_index_percentage)<=100 & 0 <= as.integer(res$first_pharmac_index_percentage)))
int <- res %>%
dplyr::mutate(crude_ci_check = .data$sequence_ratio_crude_lower_CI <= .data$sequence_ratio_crude_upper_CI)
expect_true(all(as.integer(int$crude_ci_check== T)))
CDMConnector::cdmDisconnect(cdm)
})
test_that("summariseSequenceRatios - testing ratios and CIs, Example 2", {
skip_if_not_installed("omock")
indexCohort <- dplyr::tibble(
cohort_definition_id = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1),
subject_id = c(1, 4, 2, 3, 5, 7, 8, 9, 6, 10),
cohort_start_date = as.Date(
c(
"2020-04-01", "2021-06-01", "2022-05-22", "2010-01-01", "2019-08-01", "2019-04-07", "2021-01-01", "2008-02-02", "2010-09-09", "2021-01-01"
)
),
cohort_end_date = as.Date(
c(
"2020-04-01", "2021-08-01", "2022-05-23", "2010-03-01", "2020-04-01", "2020-05-30", "2022-02-02", "2013-12-03", "2010-11-01", "2021-01-01"
)
)
)|>
dplyr::mutate(cohort_definition_id = as.integer(.data$cohort_definition_id),
subject_id = as.integer(.data$subject_id))
markerCohort <- dplyr::tibble(
cohort_definition_id = c(3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3),
subject_id = c(1, 3, 4, 2, 5, 10, 9, 8, 7, 11, 6),
cohort_start_date = as.Date(
c(
"2020-12-30", "2010-01-01","2021-05-25","2022-05-31", "2020-05-25", "2019-05-25", "2022-05-25", "2010-09-30", "2022-05-25", "2020-02-29", "2021-01-01"
)
),
cohort_end_date = cohort_start_date
)|>
dplyr::mutate(cohort_definition_id = as.integer(.data$cohort_definition_id),
subject_id = as.integer(.data$subject_id))
cdm <- mockCohortSymmetry(indexCohort = indexCohort,
markerCohort = markerCohort)
cdm <- generateSequenceCohortSet(cdm = cdm,
name = "joined_cohorts",
indexTable = "cohort_1",
markerTable = "cohort_2")
res <- summariseSequenceRatios(
cohort = cdm$joined_cohorts)
res <- res |>
visOmopResults::splitAll() |>
dplyr::filter(variable_name != "settings") |>
dplyr::select(-"estimate_type") |>
tidyr::pivot_wider(names_from = c("variable_level", "variable_name", "estimate_name"),
values_from = "estimate_value") |>
dplyr::left_join(res |> omopgenerics::settings(), by = c("result_id", "cdm_name"))
expect_true(all(res$days_prior_observation==0))
expect_true(all(res$washout_window==0))
expect_true(all(res$combination_window == "0, 365"))
expect_true(all(res$index_marker_gap=="Inf"))
expect_true(all(res$confidence_interval==95))
expect_true((res$index_cohort_name=="cohort_1"))
expect_true((res$marker_cohort_name=="cohort_3"))
expect_true(all(as.integer(res$first_pharmac_index_percentage)<=100 & 0 <= as.integer(res$first_pharmac_index_percentage)))
int <- res %>%
dplyr::mutate(crude_ci_check = .data$sequence_ratio_crude_lower_CI <= .data$sequence_ratio_crude_upper_CI,
adjusted_ci_check = .data$sequence_ratio_adjusted_lower_CI <= .data$sequence_ratio_adjusted_upper_CI)
expect_true(all(as.integer(int$crude_ci_check== T)))
expect_true(all(as.integer(int$adjusted_ci_check== T)))
CDMConnector::cdmDisconnect(cdm)
})
test_that("summariseSequenceRatios - testing CI", {
skip_on_cran()
indexCohort <- dplyr::tibble(
cohort_definition_id = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1),
subject_id = c(1, 4, 2, 3, 5, 7, 8, 9, 6, 10),
cohort_start_date = as.Date(
c(
"2020-04-01", "2021-06-01", "2022-05-22", "2010-01-01", "2019-08-01", "2019-04-07", "2021-01-01", "2008-02-02", "2010-09-09", "2021-01-01"
)
),
cohort_end_date = as.Date(
c(
"2020-04-01", "2021-08-01", "2022-05-23", "2010-03-01", "2020-04-01", "2020-05-30", "2022-02-02", "2013-12-03", "2010-11-01", "2021-01-01"
)
)
)|>
dplyr::mutate(cohort_definition_id = as.integer(.data$cohort_definition_id),
subject_id = as.integer(.data$subject_id))
markerCohort <- dplyr::tibble(
cohort_definition_id = c(3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3),
subject_id = c(1, 3, 4, 2, 5, 10, 9, 8, 7, 11, 6),
cohort_start_date = as.Date(
c(
"2020-12-30", "2010-01-01","2021-05-25","2022-05-31", "2020-05-25", "2019-05-25", "2022-05-25", "2010-09-30", "2022-05-25", "2020-02-29", "2021-01-01"
)
),
cohort_end_date = cohort_start_date
)|>
dplyr::mutate(cohort_definition_id = as.integer(.data$cohort_definition_id),
subject_id = as.integer(.data$subject_id))
cdm <- mockCohortSymmetry(indexCohort = indexCohort,
markerCohort = markerCohort)
cdm <- generateSequenceCohortSet(cdm = cdm,
name = "joined_cohorts",
indexTable = "cohort_1",
markerTable = "cohort_2")
res_90 <- summariseSequenceRatios(
cohort = cdm$joined_cohorts,
confidenceInterval = 90)
expect_equal(res_90 %>% dplyr::filter(variable_level == "first_pharmac",
variable_name == "index",
estimate_name == "count") %>%
dplyr::pull("estimate_value") %>%
as.numeric(),
3)
expect_equal(res_90 %>% dplyr::filter(variable_level == "first_pharmac",
variable_name == "index",
estimate_name == "percentage") %>%
dplyr::pull("estimate_value") %>%
as.numeric(),
75)
expect_equal(res_90 %>% dplyr::filter(variable_level == "first_pharmac",
variable_name == "marker",
estimate_name == "count") %>%
dplyr::pull("estimate_value") %>%
as.numeric(),
1)
expect_equal(res_90 %>% dplyr::filter(variable_level == "first_pharmac",
variable_name == "marker",
estimate_name == "percentage") %>%
dplyr::pull("estimate_value") %>%
as.numeric(),
25)
expect_equal(res_90 %>% dplyr::filter(variable_level == "sequence_ratio",
variable_name == "crude",
estimate_name == "point_estimate") %>%
dplyr::pull("estimate_value") %>%
as.numeric(),
3)
res_95 <- summariseSequenceRatios(
cohort = cdm$joined_cohorts,
confidenceInterval = 95)
expect_equal(res_95 %>% dplyr::filter(variable_level == "first_pharmac",
variable_name == "index",
estimate_name == "count") %>%
dplyr::pull("estimate_value") %>%
as.numeric(),
3)
expect_equal(res_95 %>% dplyr::filter(variable_level == "first_pharmac",
variable_name == "index",
estimate_name == "percentage") %>%
dplyr::pull("estimate_value") %>%
as.numeric(),
75)
expect_equal(res_95 %>% dplyr::filter(variable_level == "first_pharmac",
variable_name == "marker",
estimate_name == "count") %>%
dplyr::pull("estimate_value") %>%
as.numeric(),
1)
expect_equal(res_95 %>% dplyr::filter(variable_level == "first_pharmac",
variable_name == "marker",
estimate_name == "percentage") %>%
dplyr::pull("estimate_value") %>%
as.numeric(),
25)
expect_equal(res_95 %>% dplyr::filter(variable_level == "sequence_ratio",
variable_name == "crude",
estimate_name == "point_estimate") %>%
dplyr::pull("estimate_value") %>%
as.numeric(),
3)
res_99 <- summariseSequenceRatios(
cohort = cdm$joined_cohorts,
confidenceInterval = 99)
expect_equal(res_99 %>% dplyr::filter(variable_level == "first_pharmac",
variable_name == "index",
estimate_name == "count") %>%
dplyr::pull("estimate_value") %>%
as.numeric(),
3)
expect_equal(res_99 %>% dplyr::filter(variable_level == "first_pharmac",
variable_name == "index",
estimate_name == "percentage") %>%
dplyr::pull("estimate_value") %>%
as.numeric(),
75)
expect_equal(res_99 %>% dplyr::filter(variable_level == "first_pharmac",
variable_name == "marker",
estimate_name == "count") %>%
dplyr::pull("estimate_value") %>%
as.numeric(),
1)
expect_equal(res_99 %>% dplyr::filter(variable_level == "first_pharmac",
variable_name == "marker",
estimate_name == "percentage") %>%
dplyr::pull("estimate_value") %>%
as.numeric(),
25)
expect_equal(res_99 %>% dplyr::filter(variable_level == "sequence_ratio",
variable_name == "crude",
estimate_name == "point_estimate") %>%
dplyr::pull("estimate_value") %>%
as.numeric(),
3)
expect_true(
(res_90 %>%
dplyr::filter(estimate_name == "lower_CI",
variable_name == "crude") %>%
dplyr::pull(estimate_value) %>%
as.numeric()) >=
(res_95 %>%
dplyr::filter(estimate_name == "lower_CI",
variable_name == "crude") %>%
dplyr::pull(estimate_value) %>%
as.numeric())
)
expect_true(
(res_95 %>%
dplyr::filter(estimate_name == "lower_CI",
variable_name == "crude") %>%
dplyr::pull(estimate_value) %>%
as.numeric()) >=
(res_99 %>%
dplyr::filter(estimate_name == "lower_CI",
variable_name == "crude") %>%
dplyr::pull(estimate_value) %>%
as.numeric())
)
expect_true(
(res_90 %>%
dplyr::filter(estimate_name == "upper_CI",
variable_name == "crude") %>%
dplyr::pull(estimate_value) %>%
as.numeric()) <=
(res_95 %>%
dplyr::filter(estimate_name == "upper_CI",
variable_name == "crude") %>%
dplyr::pull(estimate_value) %>%
as.numeric())
)
expect_true(
(res_95 %>%
dplyr::filter(estimate_name == "upper_CI",
variable_name == "crude") %>%
dplyr::pull(estimate_value) %>%
as.numeric()) <=
(res_99 %>%
dplyr::filter(estimate_name == "upper_CI",
variable_name == "crude") %>%
dplyr::pull(estimate_value) %>%
as.numeric())
)
CDMConnector::cdmDisconnect(cdm)
})
test_that("summariseSequenceRatios - testing cohortId", {
skip_on_cran()
indexCohort <- dplyr::tibble(
cohort_definition_id = c(1, 1, 1, 1, 1, 2, 2, 2, 2, 2),
subject_id = c(1, 4, 2, 3, 5, 5, 4, 3, 6, 1),
cohort_start_date = as.Date(
c(
"2020-04-01", "2021-06-01", "2022-05-22", "2010-01-01", "2019-08-01", "2019-04-07", "2021-01-01", "2008-02-02", "2010-09-09", "2021-01-01"
)
),
cohort_end_date = as.Date(
c(
"2020-04-01", "2021-08-01", "2022-05-23", "2010-03-01", "2020-04-01", "2020-05-30", "2022-02-02", "2013-12-03", "2010-11-01", "2021-01-01"
)
)
)|>
dplyr::mutate(cohort_definition_id = as.integer(.data$cohort_definition_id),
subject_id = as.integer(.data$subject_id))
markerCohort <- dplyr::tibble(
cohort_definition_id = c(1, 1, 1, 1, 1, 3, 3, 3, 3, 3, 3),
subject_id = c(1, 3, 4, 2, 5, 1, 2, 3, 4, 5, 6),
cohort_start_date = as.Date(
c(
"2020-12-30", "2010-01-01","2021-05-25","2022-05-31", "2020-05-25", "2019-05-25", "2022-05-25", "2010-09-30", "2022-05-25", "2020-02-29", "2021-01-01"
)
),
cohort_end_date = cohort_start_date
)|>
dplyr::mutate(cohort_definition_id = as.integer(.data$cohort_definition_id),
subject_id = as.integer(.data$subject_id))
cdm <- mockCohortSymmetry(indexCohort = indexCohort,
markerCohort = markerCohort)
cdm <- generateSequenceCohortSet(cdm = cdm,
name = "joined_cohorts",
indexTable = "cohort_1",
markerTable = "cohort_2",
daysPriorObservation = 0,
combinationWindow = c(0, Inf))
expect_no_error(
result <- summariseSequenceRatios(cohort = cdm$joined_cohorts,
cohortId = 1) %>%
visOmopResults::splitAll()
)
expect_equal(
result %>%
dplyr::select("index_cohort_name") %>%
dplyr::distinct() %>%
as.character(),
"cohort_1"
)
expect_equal(
result %>%
dplyr::select("marker_cohort_name") %>%
dplyr::distinct() %>%
as.character(),
"cohort_1"
)
expect_equal(
attr(cdm$joined_cohorts, "cohort_set") %>%
dplyr::collect() %>%
dplyr::filter(cohort_definition_id == 1) |>
nrow() |>
as.numeric(),
1
)
expect_equal(
attr(cdm$joined_cohorts, "cohort_set") %>%
dplyr::collect() %>%
dplyr::filter(cohort_definition_id == 1) |>
dplyr::pull("index_name"),
"cohort_1")
expect_equal(
attr(cdm$joined_cohorts, "cohort_set") %>%
dplyr::collect() %>%
dplyr::filter(cohort_definition_id == 1) |>
dplyr::pull("marker_name"),
"cohort_1")
expect_no_error(
result2 <- summariseSequenceRatios(cohort = cdm$joined_cohorts,
cohortId = c(1,3)) %>%
visOmopResults::splitAll()
)
expect_equal(
result2 %>%
dplyr::group_by(index_cohort_name, marker_cohort_name) %>%
dplyr::tally() |>
nrow() |>
as.numeric(),
2
)
CDMConnector::cdmDisconnect(cdm)
})
test_that("summariseSequenceRatios - testing moving average restriction, ex1", {
skip_on_cran()
indexCohort <- dplyr::tibble(
cohort_definition_id = c(1, 1, 1, 1, 1, 2, 2, 2, 2, 2),
subject_id = c(1, 4, 2, 3, 5, 5, 4, 3, 6, 1),
cohort_start_date = as.Date(
c(
"2020-04-01", "2021-06-01", "2022-05-22", "2010-01-01", "2019-08-01", "2019-04-07", "2021-01-01", "2008-02-02", "2010-09-09", "2021-01-01"
)
),
cohort_end_date = as.Date(
c(
"2020-04-01", "2021-08-01", "2022-05-23", "2010-03-01", "2020-04-01", "2020-05-30", "2022-02-02", "2013-12-03", "2010-11-01", "2021-01-01"
)
)
)|>
dplyr::mutate(cohort_definition_id = as.integer(.data$cohort_definition_id),
subject_id = as.integer(.data$subject_id))
markerCohort <- dplyr::tibble(
cohort_definition_id = c(1, 1, 1, 1, 1, 3, 3, 3, 3, 3, 3),
subject_id = c(1, 3, 4, 2, 5, 1, 2, 3, 4, 5, 6),
cohort_start_date = as.Date(
c(
"2020-12-30", "2010-01-01","2021-05-25","2022-05-31", "2020-05-25", "2019-05-25", "2022-05-25", "2010-09-30", "2022-05-25", "2020-02-29", "2021-01-01"
)
),
cohort_end_date = cohort_start_date
)|>
dplyr::mutate(cohort_definition_id = as.integer(.data$cohort_definition_id),
subject_id = as.integer(.data$subject_id))
cdm <- mockCohortSymmetry(indexCohort = indexCohort,
markerCohort = markerCohort)
expect_no_error(
cdm <- generateSequenceCohortSet(cdm = cdm,
name = "joined_cohorts",
indexTable = "cohort_1",
markerTable = "cohort_2",
daysPriorObservation = 0,
combinationWindow = c(0, Inf),
movingAverageRestriction = 730)
)
expect_no_error(
result <- summariseSequenceRatios(cohort = cdm$joined_cohorts,
cohortId = 1)
)
expect_true(
(result %>%
dplyr::filter(variable_name == "crude", estimate_name == "lower_CI") %>%
dplyr::pull("estimate_value") %>%
as.numeric())
<=
(result %>%
dplyr::filter(variable_name == "crude", estimate_name == "upper_CI") %>%
dplyr::pull("estimate_value") %>%
as.numeric())
)
expect_true(
(result %>%
dplyr::filter(variable_name == "adjusted", estimate_name == "lower_CI") %>%
dplyr::pull("estimate_value") %>%
as.numeric())
<=
(result %>%
dplyr::filter(variable_name == "adjusted", estimate_name == "upper_CI") %>%
dplyr::pull("estimate_value") %>%
as.numeric())
)
CDMConnector::cdmDisconnect(cdm)
})
test_that("summariseSequenceRatios - testing moving average restriction, ex2", {
skip_on_cran()
indexCohort <- dplyr::tibble(
cohort_definition_id = c(1, 1, 1, 1, 1, 2, 2, 2, 2, 2),
subject_id = c(1, 4, 2, 3, 5, 5, 4, 3, 6, 1),
cohort_start_date = as.Date(
c(
"2020-04-01", "2021-06-01", "2022-05-22", "2010-01-01", "2019-08-01", "2019-04-07", "2021-01-01", "2008-02-02", "2010-09-09", "2021-01-01"
)
),
cohort_end_date = as.Date(
c(
"2020-04-01", "2021-08-01", "2022-05-23", "2010-03-01", "2020-04-01", "2020-05-30", "2022-02-02", "2013-12-03", "2010-11-01", "2021-01-01"
)
)
)|>
dplyr::mutate(cohort_definition_id = as.integer(.data$cohort_definition_id),
subject_id = as.integer(.data$subject_id))
markerCohort <- dplyr::tibble(
cohort_definition_id = c(1, 1, 1, 1, 1, 3, 3, 3, 3, 3, 3),
subject_id = c(1, 3, 4, 2, 5, 1, 2, 3, 4, 5, 6),
cohort_start_date = as.Date(
c(
"2020-12-30", "2010-01-01","2021-05-25","2022-05-31", "2020-05-25", "2019-05-25", "2022-05-25", "2010-09-30", "2022-05-25", "2020-02-29", "2021-01-01"
)
),
cohort_end_date = cohort_start_date
)|>
dplyr::mutate(cohort_definition_id = as.integer(.data$cohort_definition_id),
subject_id = as.integer(.data$subject_id))
cdm <- mockCohortSymmetry(indexCohort = indexCohort,
markerCohort = markerCohort)
expect_no_error(
cdm <- generateSequenceCohortSet(cdm = cdm,
name = "joined_cohorts",
indexTable = "cohort_1",
markerTable = "cohort_2",
daysPriorObservation = 0,
combinationWindow = c(0, Inf),
movingAverageRestriction = Inf)
)
expect_no_error(
result <- summariseSequenceRatios(cohort = cdm$joined_cohorts)
)
expect_true(all(
(result %>%
dplyr::filter(variable_name == "crude", estimate_name == "lower_CI") %>%
dplyr::pull("estimate_value") %>%
as.numeric())
<=
(result %>%
dplyr::filter(variable_name == "crude", estimate_name == "upper_CI") %>%
dplyr::pull("estimate_value") %>%
as.numeric())
))
expect_true(all(
(result %>%
dplyr::filter(variable_name == "adjusted", estimate_name == "lower_CI") %>%
dplyr::pull("estimate_value") %>%
as.numeric())
<=
(result %>%
dplyr::filter(variable_name == "adjusted", estimate_name == "upper_CI") %>%
dplyr::pull("estimate_value") %>%
as.numeric())
))
cdm <- generateSequenceCohortSet(cdm = cdm,
name = "joined_cohorts",
indexTable = "cohort_1",
markerTable = "cohort_2",
daysPriorObservation = 0,
combinationWindow = c(0, Inf),
movingAverageRestriction = Inf)
res_90 <- summariseSequenceRatios(
cohort = cdm$joined_cohorts,
cohortId = 1,
confidenceInterval = 90)
res_95 <- summariseSequenceRatios(
cohort = cdm$joined_cohorts,
cohortId = 1,
confidenceInterval = 95)
res_99 <- summariseSequenceRatios(
cohort = cdm$joined_cohorts,
cohortId = 1,
confidenceInterval = 99)
expect_true(
(res_90 %>%
dplyr::filter(estimate_name == "lower_CI",
variable_name == "crude") %>%
dplyr::pull(estimate_value) %>%
as.numeric()) >=
(res_95 %>%
dplyr::filter(estimate_name == "lower_CI",
variable_name == "crude") %>%
dplyr::pull(estimate_value) %>%
as.numeric())
)
expect_true(
(res_95 %>%
dplyr::filter(estimate_name == "lower_CI",
variable_name == "crude") %>%
dplyr::pull(estimate_value) %>%
as.numeric()) >=
(res_99 %>%
dplyr::filter(estimate_name == "lower_CI",
variable_name == "crude") %>%
dplyr::pull(estimate_value) %>%
as.numeric())
)
expect_true(
(res_90 %>%
dplyr::filter(estimate_name == "upper_CI",
variable_name == "crude") %>%
dplyr::pull(estimate_value) %>%
as.numeric()) <=
(res_95 %>%
dplyr::filter(estimate_name == "upper_CI",
variable_name == "crude") %>%
dplyr::pull(estimate_value) %>%
as.numeric())
)
expect_true(
(res_95 %>%
dplyr::filter(estimate_name == "upper_CI",
variable_name == "crude") %>%
dplyr::pull(estimate_value) %>%
as.numeric()) <=
(res_99 %>%
dplyr::filter(estimate_name == "upper_CI",
variable_name == "crude") %>%
dplyr::pull(estimate_value) %>%
as.numeric())
)
CDMConnector::cdmDisconnect(cdm)
})
test_that("edge case 1", {
skip_on_cran()
indexCohort <- dplyr::tibble(
cohort_definition_id = c(1),
subject_id = c(1),
cohort_start_date = as.Date(
c("2020-04-01")
),
cohort_end_date = as.Date(
c("2020-04-01")
)
)
markerCohort <- dplyr::tibble(
cohort_definition_id = c(1),
subject_id = c(1),
cohort_start_date = as.Date(
c("2020-04-01")
),
cohort_end_date = cohort_start_date
)
cdm <- mockCohortSymmetry(indexCohort = indexCohort,
markerCohort = markerCohort)
cdm <- generateSequenceCohortSet(cdm = cdm,
name = "joined_cohorts",
indexTable = "cohort_1",
markerTable = "cohort_2",
daysPriorObservation = 0,
combinationWindow = c(0, Inf))
expect_error(
result <- summariseSequenceRatios(cohort = cdm$joined_cohorts)
)
CDMConnector::cdmDisconnect(cdm = cdm)
})
test_that("edge case 2", {
skip_on_cran()
indexCohort <- dplyr::tibble(
cohort_definition_id = c(1),
subject_id = c(1),
cohort_start_date = as.Date(
c("2020-04-01")
),
cohort_end_date = as.Date(
c("2020-04-01")
)
)
markerCohort <- dplyr::tibble(
cohort_definition_id = c(1),
subject_id = c(1),
cohort_start_date = as.Date(
c("2020-04-02")
),
cohort_end_date = cohort_start_date
)
cdm <- mockCohortSymmetry(indexCohort = indexCohort,
markerCohort = markerCohort)
cdm <- generateSequenceCohortSet(cdm = cdm,
name = "joined_cohorts",
indexTable = "cohort_1",
markerTable = "cohort_2",
daysPriorObservation = 0,
combinationWindow = c(0, Inf))
expect_warning(
result <- summariseSequenceRatios(cohort = cdm$joined_cohorts)
)
CDMConnector::cdmDisconnect(cdm = cdm)
})
test_that("edge case 3", {
skip_on_cran()
indexCohort <- dplyr::tibble(
cohort_definition_id = c(1),
subject_id = c(1),
cohort_start_date = as.Date(
c("2020-04-03")
),
cohort_end_date = as.Date(
c("2020-04-03")
)
)
markerCohort <- dplyr::tibble(
cohort_definition_id = c(1),
subject_id = c(1),
cohort_start_date = as.Date(
c("2020-04-02")
),
cohort_end_date = cohort_start_date
)
cdm <- mockCohortSymmetry(indexCohort = indexCohort,
markerCohort = markerCohort)
cdm <- generateSequenceCohortSet(cdm = cdm,
name = "joined_cohorts",
indexTable = "cohort_1",
markerTable = "cohort_2",
daysPriorObservation = 0,
combinationWindow = c(0, Inf))
expect_warning(
result <- summariseSequenceRatios(cohort = cdm$joined_cohorts)
)
CDMConnector::cdmDisconnect(cdm = cdm)
})
test_that("Inf CI", {
skip_on_cran()
indexCohort <- dplyr::tibble(
cohort_definition_id = c(1, 1, 1, 1),
subject_id = c(1, 2, 3, 4),
cohort_start_date = as.Date(
c(
"2020-04-01", "2021-06-01", "2022-05-22", "2010-01-01"
)
),
cohort_end_date = as.Date(
c(
"2020-04-01", "2021-06-01", "2022-05-22", "2010-01-01"
)
)
)|>
dplyr::mutate(cohort_definition_id = as.integer(.data$cohort_definition_id),
subject_id = as.integer(.data$subject_id))
markerCohort <- dplyr::tibble(
cohort_definition_id = c(1, 1, 1, 1),
subject_id = c(1, 2, 3, 4),
cohort_start_date = as.Date(
c(
"2020-04-02", "2021-06-02", "2022-05-23", "2010-01-02"
)
),
cohort_end_date = as.Date(
c(
"2020-04-02", "2021-06-02", "2022-05-23", "2010-01-02"
)
)
)|>
dplyr::mutate(cohort_definition_id = as.integer(.data$cohort_definition_id),
subject_id = as.integer(.data$subject_id))
cdm <- mockCohortSymmetry(indexCohort = indexCohort,
markerCohort = markerCohort)
cdm <- generateSequenceCohortSet(cdm = cdm,
name = "joined_cohorts",
indexTable = "cohort_1",
markerTable = "cohort_2")
expect_warning(
res <- summariseSequenceRatios(cohort = cdm$joined_cohorts)
)
expect_true(
all(res |>
dplyr::filter(estimate_name %in% c("lower_CI", "upper_CI")) |>
dplyr::pull("estimate_value") == "Inf"
)
)
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.