compareNA <- function(v1, v2) {
  same <- (v1 == v2) | (is.na(v1) & is.na(v2))
  same[is.na(same)] <- FALSE
  return(same)
}

test_that("mgus example: no Competing risk", {
  cdm <- mockMGUS2cdm()
  surv <- estimateSingleEventSurvival(cdm,
                                      targetCohortTable = "mgus_diagnosis",
                                      targetCohortId = 1,
                                      outcomeCohortTable = "death_cohort",
                                      outcomeCohortId = 1,
                                      eventGap = 7
  ) %>% asSurvivalResult()
  expect_true(tibble::is_tibble(surv))
  expect_true(all(c(
    "cdm_name", "result_type",
    "cohort",
    "strata_name", "strata_level",
    "variable_name","variable_level",
    "estimate_name",
    "estimate_value",
    "time",
    "outcome",
    "analysis_type") %in%
      colnames(surv)))

  expect_true(surv %>% dplyr::select(time) %>% dplyr::distinct() %>% dplyr::tally() == 425)

  expect_true(attr(surv, "events") %>%
                dplyr::select(variable_level) %>% dplyr::pull() %>% unique() == "death_cohort")
  expect_true(all(attr(surv, "events") %>%
                    dplyr::pull("time") %>% unique() %in% c(seq(0, 424, by = 7), 424)))

  expect_true(tibble::is_tibble(attr(surv, "summary")))

  expect_true(all(surv$variable_level == "death_cohort"))
  expect_true(all(attr(surv, "event")$variable_level == "death_cohort"))
  expect_true(all(attr(surv, "summary")$variable_level == "death_cohort"))

  # mgus example: Competing risk
  survCR <- estimateCompetingRiskSurvival(cdm,
                             targetCohortTable = "mgus_diagnosis",
                             targetCohortId = 1,
                             outcomeCohortTable = "progression",
                             outcomeCohortId = 1,
                             competingOutcomeCohortTable = "death_cohort",
                             competingOutcomeCohortId = 1
  ) %>% asSurvivalResult()

  expect_true(all(colnames(surv) %in% c(colnames(survCR), "competing_outcome")))
  expect_true(tibble::is_tibble(survCR))
  expect_true(all(survCR %>%
                    dplyr::select(variable_level) %>%
                    dplyr::pull() %>%
                    unique() %in%
                    c("death_cohort", "progression")))

  expect_true(all(compareNA(survCR %>%
                              dplyr::pull("time") %>%
                              unique(), c(0:424))))

  expect_true(all(attr(survCR, "events") %>%
                    dplyr::select(variable_level) %>%
                    dplyr::pull() %>%
                    unique() %in% c("progression", "death_cohort")))

  expect_true(all(attr(survCR, "events") %>%
                    dplyr::pull("time") %>% unique() %in% c(0:424)))

  expect_true(nrow(survCR %>%
                     dplyr::filter(.data$variable_level == "death_cohort") %>%
                     dplyr::collect())>=1)
  expect_true(nrow(survCR %>%
                     dplyr::filter(.data$variable_level == "progression") %>%
                     dplyr::collect())>=1)

  expect_true(all(c("death_cohort", "progression") %in%
                    (survCR %>%
                       dplyr::pull("variable_level") %>%
                       unique())))

  CDMConnector::cdmDisconnect(cdm)
})

test_that("mgus example: no Competing risk, strata", {
  skip_on_cran()

  cdm <- mockMGUS2cdm()
  cdm[["mgus_diagnosis"]] <- cdm[["mgus_diagnosis"]] %>%
    dplyr::mutate(mspike_r = round(mspike, digits = 0))
  surv <- estimateSingleEventSurvival(cdm,
                                      targetCohortTable = "mgus_diagnosis",
                                      targetCohortId = 1,
                                      outcomeCohortTable = "death_cohort",
                                      outcomeCohortId = 1,
                                      eventGap = c(1, 10, 100),
                                      strata = list(
                                        "age_gr" = c("age"),
                                        "sex" = c("sex"),
                                        "age and sex" = c("age", "sex"),
                                        "mspike rounded" = c("mspike_r")
                                      )
  ) %>% asSurvivalResult()
  expect_true(tibble::is_tibble(surv))

  expect_true(all(surv %>% dplyr::select(variable_level) %>% dplyr::pull() %>% unique() %in% c("death_cohort")))
  expect_true(all(surv %>% dplyr::pull("time") %>% unique() %in% c(0:424)))
  expect_true(all(surv %>% dplyr::select(strata_name) %>% dplyr::pull() %>% unique() %in%
                    c("overall", "sex", "age", "mspike_r", "age &&& sex")))
  expect_true(all(surv %>% dplyr::select(strata_level) %>% dplyr::pull() %>% unique() %in% c(
    "M", "F", 0, 1, 2, 3, c(24:96), "overall",
    paste(expand.grid(c(24:96), c("M", "F"))$Var1, expand.grid(c(24:96), c("M", "F"))$Var2, sep = " &&& ")
  )))
  expect_true(all(attr(surv, "events") %>% dplyr::select(strata_name) %>% dplyr::pull() %>% unique() %in%
                    c("overall", "sex", "age", "mspike_r", "age &&& sex")))
  expect_true(all(attr(surv, "events") %>% dplyr::select(strata_level) %>% dplyr::pull() %>% unique() %in% c(
    "M", "F", 0, 1, 2, 3, c(24:96), "overall",
    paste(expand.grid(c(24:96), c("M", "F"))$Var1, expand.grid(c(24:96), c("M", "F"))$Var2, sep = " &&& ")
  )))

  CDMConnector::cdmDisconnect(cdm)
})

test_that("mgus example: Competing risk, strata", {
  skip_on_cran()
  cdm <- mockMGUS2cdm()
  cdm[["mgus_diagnosis"]] <- cdm[["mgus_diagnosis"]] %>%
    dplyr::mutate(mspike_r = round(mspike, digits = 0))
  survCR <- estimateCompetingRiskSurvival(cdm,
                             targetCohortTable = "mgus_diagnosis",
                             targetCohortId = 1,
                             outcomeCohortTable = "progression",
                             outcomeCohortId = 1,
                             competingOutcomeCohortTable = "death_cohort",
                             competingOutcomeCohortId = 1,
                             strata = list(
                               c("age"),
                               c("sex"),
                               c("age", "sex"),
                               c("mspike_r")
                             )
  ) %>% asSurvivalResult()

  expect_true(tibble::is_tibble(survCR))
  expect_true(all(survCR %>% dplyr::select(variable_level) %>% dplyr::pull() %>% unique() %in%
                    c("death_cohort", "progression")))
  expect_true(all(survCR %>% dplyr::pull("time") %>% unique() %in% c(0:424)))
  expect_true(all(survCR %>% dplyr::select(strata_name) %>% dplyr::pull() %>% unique() %in%
                    c("overall", "sex", "age", "mspike_r", "age &&& sex")))
  expect_true(all(survCR %>% dplyr::select(strata_level) %>% dplyr::pull() %>% unique() %in% c(
    "M", "F", 0, 1, 2, 3, c(24:96), "overall",
    paste(expand.grid(c(24:96), c("M", "F"))$Var1, expand.grid(c(24:96), c("M", "F"))$Var2, sep = " &&& ")
  )))
  expect_true(all(attr(survCR, "events") %>% dplyr::select(strata_name) %>% dplyr::pull() %>% unique() %in%
                    c("overall", "sex", "age", "mspike_r", "age &&& sex")))
  expect_true(all(attr(survCR, "events") %>% dplyr::select(strata_level) %>% dplyr::pull() %>% unique() %in% c(
    "M", "F", 0, 1, 2, 3, c(24:96), "overall",
    paste(expand.grid(c(24:96), c("M", "F"))$Var1, expand.grid(c(24:96), c("M", "F"))$Var2, sep = " &&& ")
  )))
  # strata with only one value
  cdm$mgus_diagnosis <- cdm$mgus_diagnosis %>% dplyr::mutate(a = "X")
  survCR <- estimateCompetingRiskSurvival(cdm,
                             targetCohortTable = "mgus_diagnosis",
                             targetCohortId = 1,
                             outcomeCohortTable = "progression",
                             outcomeCohortId = 1,
                             competingOutcomeCohortTable = "death_cohort",
                             competingOutcomeCohortId = 1,
                             strata = list("a")) %>% asSurvivalResult()

  CDMConnector::cdmDisconnect(cdm)
})

test_that("multiple exposures, multiple outcomes: single event", {
  skip_on_cran()

  observation_period <- dplyr::tibble(
    observation_period_id = c(1, 2, 3, 4, 5,6),
    person_id = c(1, 2, 3, 4, 5,6),
    observation_period_start_date = c(
      rep(as.Date("1980-07-20"),6)
    ),
    observation_period_end_date = c(
      rep(as.Date("2023-05-20"),6)
    ),
    period_type_concept_id = c(rep(0,6))
  )

  exposure_cohort <- dplyr::tibble(
    subject_id = c(1, 2, 3, 3, 4, 5),
    cohort_definition_id = c(1, 1, 1, 2, 2, 2),
    cohort_start_date = c(
      as.Date("2020-01-01"),
      as.Date("2020-02-03"),
      as.Date("2020-05-01"),
      as.Date("2020-05-01"),
      as.Date("2020-08-01"),
      as.Date("2020-09-01")
    ),
    cohort_end_date = c(
      as.Date("2020-01-31"),
      as.Date("2022-02-03"),
      as.Date("2021-06-28"),
      as.Date("2021-06-01"),
      as.Date("2021-08-01"),
      as.Date("2021-09-01")
    )
  )


  outcome_cohort <- dplyr::tibble(
    cohort_definition_id = c(2, 3, 3),
    subject_id = c(2, 3, 4),
    cohort_start_date = c(
      as.Date("2021-01-01"),
      as.Date("2021-01-01"),
      as.Date("2021-01-01")
    ),
    cohort_end_date = c(
      as.Date("2021-01-01"),
      as.Date("2021-01-01"),
      as.Date("2021-01-01")
    )
  )

  person <- dplyr::tibble(
    person_id = c(1, 2, 3, 4, 5),
    year_of_birth = c(rep("1990", 5)),
    month_of_birth = c(rep("02", 5)),
    day_of_birth = c(rep("11", 5)),
    gender_concept_id = c(rep(0,5)),
    ethnicity_concept_id = c(rep(0,5)),
    race_concept_id = c(rep(0,5))
  )

  cdm <- omopgenerics::cdmFromTables(
    tables = list(
      person = person,
      observation_period = observation_period
    ),
    cohortTables = list(
      exposure_cohort = exposure_cohort,
      cohort1 = outcome_cohort
    ),
    cdmName = "mock_es"
  )

  db <- DBI::dbConnect(duckdb::duckdb(), ":memory:")
  cdm2 = CDMConnector::copy_cdm_to(db,
                                   cdm,
                                   schema = "main",
                                   overwrite = TRUE)
  attr(cdm2, "cdm_schema") <- "main"
  attr(cdm2, "write_schema") <- "main"

  # one target, one outcome
  expect_no_error(surv <- estimateSingleEventSurvival(cdm2,
                                                      targetCohortTable = "exposure_cohort",
                                                      targetCohortId = 1,
                                                      outcomeCohortTable = "cohort1",
                                                      outcomeCohortId = 2
  ) %>% asSurvivalResult())
  expect_equal(unique(surv$cohort),
               omopgenerics::settings(cdm$exposure_cohort) %>%
                 dplyr::filter(cohort_definition_id == 1) %>%
                 dplyr::pull("cohort_name"))
  expect_equal(unique(surv$variable_level),
               omopgenerics::settings(cdm$cohort1) %>%
                 dplyr::filter(cohort_definition_id == 2) %>%
                 dplyr::pull("cohort_name"))

  # two target, one outcome
  surv <- estimateSingleEventSurvival(cdm2,
                                      targetCohortTable = "exposure_cohort",
                                      targetCohortId = c(1,2),
                                      outcomeCohortTable = "cohort1",
                                      outcomeCohortId = 2
  ) %>% asSurvivalResult()
  expect_equal(sort(unique(surv$cohort)),
               sort(omopgenerics::settings(cdm$exposure_cohort) %>%
                      dplyr::filter(cohort_definition_id %in%  c(1,2)) %>%
                      dplyr::pull("cohort_name")))
  expect_equal(unique(surv$variable_level),
               omopgenerics::settings(cdm$cohort1) %>%
                 dplyr::filter(cohort_definition_id == 2) %>%
                 dplyr::pull("cohort_name"))

  # two target, two outcome
  surv <- estimateSingleEventSurvival(cdm2,
                                      targetCohortTable = "exposure_cohort",
                                      targetCohortId = c(1,2),
                                      outcomeCohortTable = "cohort1",
                                      outcomeCohortId = c(2,3),
                                      minCellCount = 0
  ) %>% asSurvivalResult()
  expect_equal(sort(unique(surv$cohort)),
               sort(omopgenerics::settings(cdm$exposure_cohort) %>%
                      dplyr::filter(cohort_definition_id %in%  c(1,2)) %>%
                      dplyr::pull("cohort_name")))
  expect_equal(unique(surv$variable_level),
               omopgenerics::settings(cdm$cohort1) %>%
                 dplyr::filter(cohort_definition_id %in%  c(2,3)) %>%
                 dplyr::pull("cohort_name"))

  expect_equal(sort(unique(attr(surv, "event")$cohort)),
               sort(omopgenerics::settings(cdm$exposure_cohort) %>%
                      dplyr::filter(cohort_definition_id %in%  c(1,2)) %>%
                      dplyr::pull("cohort_name")))
  expect_equal(unique(attr(surv, "event")$variable_level),
               omopgenerics::settings(cdm$cohort1) %>%
                 dplyr::filter(cohort_definition_id %in%  c(2,3)) %>%
                 dplyr::pull("cohort_name"))

  expect_equal(sort(unique(attr(surv, "summary")$cohort)),
               sort(omopgenerics::settings(cdm$exposure_cohort) %>%
                      dplyr::filter(cohort_definition_id %in%  c(1,2)) %>%
                      dplyr::pull("cohort_name")))
  expect_equal(unique(attr(surv, "summary")$variable_level),
               omopgenerics::settings(cdm$cohort1) %>%
                 dplyr::filter(cohort_definition_id %in%  c(2,3)) %>%
                 dplyr::pull("cohort_name"))

  # two target, two outcome - without specifying
  surv <- estimateSingleEventSurvival(cdm2,
                                      targetCohortTable = "exposure_cohort",
                                      outcomeCohortTable = "cohort1"
  ) %>% asSurvivalResult()
  expect_equal(sort(unique(surv$cohort)),
               sort(omopgenerics::settings(cdm$exposure_cohort) %>%
                      dplyr::filter(cohort_definition_id %in%  c(1,2)) %>%
                      dplyr::pull("cohort_name")))
  expect_equal(unique(surv$variable_level),
               omopgenerics::settings(cdm$cohort1) %>%
                 dplyr::filter(cohort_definition_id %in%  c(2,3)) %>%
                 dplyr::pull("cohort_name"))

  CDMConnector::cdmDisconnect(cdm2)

})

test_that("multiple exposures, multiple outcomes: competing risk", {
  skip_on_cran()

  observation_period <- dplyr::tibble(
    observation_period_id = c(1, 2, 3, 4, 5,6),
    person_id = c(1, 2, 3, 4, 5,6),
    observation_period_start_date = c(
      rep(as.Date("1980-07-20"),6)
    ),
    observation_period_end_date = c(
      rep(as.Date("2023-05-20"),6)
    ),
    period_type_concept_id = c(rep(0,6))
  )

  exposure_cohort <- dplyr::tibble(
    subject_id = c(1, 2, 3, 3, 4, 5,6,6),
    cohort_definition_id = c(1, 1, 1, 2, 2, 2,1,2),
    cohort_start_date = c(
      as.Date("2020-01-01"),
      as.Date("2020-02-03"),
      as.Date("2020-05-01"),
      as.Date("2020-05-01"),
      as.Date("2020-08-01"),
      as.Date("2020-09-01"),
      as.Date("2020-09-01"),
      as.Date("2020-09-01")
    ),
    cohort_end_date = c(
      as.Date("2020-01-31"),
      as.Date("2022-02-03"),
      as.Date("2021-06-28"),
      as.Date("2021-06-01"),
      as.Date("2021-08-01"),
      as.Date("2021-09-01"),
      as.Date("2021-09-01"),
      as.Date("2021-09-01")
    )
  )

  outcome_cohort <- dplyr::tibble(
    cohort_definition_id = c(2,2, 3, 3),
    subject_id = c(2, 3, 3, 4),
    cohort_start_date = c(
      as.Date("2021-01-01"),
      as.Date("2021-01-01"),
      as.Date("2021-01-01"),
      as.Date("2021-01-01")
    ),
    cohort_end_date = c(
      as.Date("2021-01-01"),
      as.Date("2021-01-01"),
      as.Date("2021-01-01"),
      as.Date("2021-01-01")
    )
  )

  competing_cohort <- dplyr::tibble(
    cohort_definition_id = c(4,5, 4, 5),
    subject_id = c(1,1, 5, 5),
    cohort_start_date = c(
      as.Date("2020-11-01"),
      as.Date("2020-11-01"),
      as.Date("2020-11-01"),
      as.Date("2020-11-01")
    ),
    cohort_end_date = c(
      as.Date("2020-11-01"),
      as.Date("2020-11-01"),
      as.Date("2020-11-01"),
      as.Date("2020-11-01")
    )
  )

  person <- dplyr::tibble(
    person_id = c(1, 2, 3, 4, 5),
    year_of_birth = c(rep("1990", 5)),
    month_of_birth = c(rep("02", 5)),
    day_of_birth = c(rep("11", 5)),
    gender_concept_id = c(rep(0,5)),
    ethnicity_concept_id = c(rep(0,5)),
    race_concept_id = c(rep(0,5))
  )

  cdm <- omopgenerics::cdmFromTables(
    tables = list(
      person = person,
      observation_period = observation_period
    ),
    cohortTables = list(
      exposure_cohort = exposure_cohort,
      cohort1 = outcome_cohort,
      cohort2 = competing_cohort
    ),
    cdmName = "mock_es"
  )

  db <- DBI::dbConnect(duckdb::duckdb(), ":memory:")
  cdm2 = CDMConnector::copy_cdm_to(db,
                                   cdm,
                                   schema = "main",
                                   overwrite = TRUE)

  attr(cdm2, "cdm_schema") <- "main"
  attr(cdm2, "write_schema") <- "main"

  # one target, one outcome
  expect_no_error(surv <- estimateCompetingRiskSurvival(cdm2,
                                                        targetCohortTable = "exposure_cohort",
                                                        targetCohortId = 1,
                                                        outcomeCohortTable = "cohort1",
                                                        outcomeCohortId = 2,
                                                        competingOutcomeCohortTable  = "cohort2",
                                                        competingOutcomeCohortId = 4
  ) %>% asSurvivalResult())
  expect_equal(unique(surv$cohort),
               omopgenerics::settings(cdm2$exposure_cohort) %>%
                 dplyr::filter(cohort_definition_id == 1) %>%
                 dplyr::pull("cohort_name"))
  expect_equal(sort(unique(surv$variable_level)),
               sort(c(omopgenerics::settings(cdm2$cohort1) %>%
                        dplyr::filter(cohort_definition_id == 2) %>%
                        dplyr::pull("cohort_name"),
                      omopgenerics::settings(cdm2$cohort2) %>%
                        dplyr::filter(cohort_definition_id == 4) %>%
                        dplyr::pull("cohort_name"))))

  # two target, one outcome, one competing risk
  expect_no_error(surv <- estimateCompetingRiskSurvival(cdm2,
                                                        targetCohortTable = "exposure_cohort",
                                                        targetCohortId = c(1,2),
                                                        outcomeCohortTable = "cohort1",
                                                        outcomeCohortId = 2,
                                                        competingOutcomeCohortTable  = "cohort2",
                                                        competingOutcomeCohortId = 4
  ) %>% asSurvivalResult())
  expect_equal(sort(unique(surv$cohort)),
               sort(omopgenerics::settings(cdm2$exposure_cohort) %>%
                      dplyr::filter(cohort_definition_id %in%  c(1,2)) %>%
                      dplyr::pull("cohort_name")))
  expect_equal(sort(unique(surv$variable_level)),
               sort(c(omopgenerics::settings(cdm2$cohort1) %>%
                        dplyr::filter(cohort_definition_id == 2) %>%
                        dplyr::pull("cohort_name"),
                      omopgenerics::settings(cdm2$cohort2) %>%
                        dplyr::filter(cohort_definition_id == 4) %>%
                        dplyr::pull("cohort_name"))))

  # two target, two outcome, one competing risk
  surv <- estimateCompetingRiskSurvival(cdm2,
                                        targetCohortTable = "exposure_cohort",
                                        targetCohortId = c(1,2),
                                        outcomeCohortTable = "cohort1",
                                        outcomeCohortId = c(2,3),
                                        competingOutcomeCohortTable  = "cohort2",
                                        competingOutcomeCohortId = 4
  ) %>% asSurvivalResult()
  expect_equal(sort(unique(surv$cohort)),
               sort(omopgenerics::settings(cdm2$exposure_cohort) %>%
                      dplyr::filter(cohort_definition_id %in%  c(1,2)) %>%
                      dplyr::pull("cohort_name")))
  expect_equal(sort(unique(surv$variable_level)),
               sort(c(omopgenerics::settings(cdm2$cohort1) %>%
                        dplyr::filter(cohort_definition_id %in%  c(2,3)) %>%
                        dplyr::pull("cohort_name"),
                      omopgenerics::settings(cdm2$cohort2) %>%
                        dplyr::filter(cohort_definition_id == 4) %>%
                        dplyr::pull("cohort_name"))))

  # two target, two outcome, two competing risk
  surv <- estimateCompetingRiskSurvival(cdm2,
                                        targetCohortTable = "exposure_cohort",
                                        targetCohortId = c(1,2),
                                        outcomeCohortTable = "cohort1",
                                        outcomeCohortId = c(2,3),
                                        competingOutcomeCohortTable  = "cohort2",
                                        competingOutcomeCohortId = c(4,5),
                                        minCellCount = 1
  ) %>% asSurvivalResult()
  expect_equal(sort(unique(surv$cohort)),
               sort(omopgenerics::settings(cdm2$exposure_cohort) %>%
                      dplyr::filter(cohort_definition_id %in%  c(1,2)) %>%
                      dplyr::pull("cohort_name")))
  expect_equal(sort(unique(surv$variable_level)),
               sort(c(omopgenerics::settings(cdm2$cohort1) %>%
                        dplyr::filter(cohort_definition_id %in%  c(2,3)) %>%
                        dplyr::pull("cohort_name"),
                      omopgenerics::settings(cdm2$cohort2) %>%
                        dplyr::filter(cohort_definition_id %in% c(4,5)) %>%
                        dplyr::pull("cohort_name"))))

  #  two target, two outcome, two competing risk - without specifying
  surv <- estimateCompetingRiskSurvival(cdm2,
                                        targetCohortTable = "exposure_cohort",
                                        outcomeCohortTable = "cohort1",
                                        competingOutcomeCohortTable  = "cohort2"
  ) %>% asSurvivalResult()
  expect_equal(sort(unique(surv$cohort)),
               sort(omopgenerics::settings(cdm2$exposure_cohort) %>%
                      dplyr::filter(cohort_definition_id %in%  c(1,2)) %>%
                      dplyr::pull("cohort_name")))
  expect_equal(sort(unique(surv$variable_level)),
               sort(c(omopgenerics::settings(cdm2$cohort1) %>%
                        dplyr::filter(cohort_definition_id %in%  c(2,3)) %>%
                        dplyr::pull("cohort_name"),
                      omopgenerics::settings(cdm2$cohort2) %>%
                        dplyr::filter(cohort_definition_id %in% c(4,5)) %>%
                        dplyr::pull("cohort_name"))))

  CDMConnector::cdmDisconnect(cdm2)

})

test_that("required estimateGap", {
  skip_on_cran()

  observation_period <- dplyr::tibble(
    observation_period_id = c(1, 2, 3, 4, 5),
    person_id = c(1, 2, 3, 4, 5),
    observation_period_start_date = c(
      rep(as.Date("1980-07-20"),5)
    ),
    observation_period_end_date = c(
      rep(as.Date("2023-05-20"),5)
    ),
    period_type_concept_id = c(rep(0,5))
  )

  exposure_cohort <- dplyr::tibble(
    subject_id = c(1, 2, 3, 3, 4, 5),
    cohort_definition_id = c(1, 1, 1, 2, 2, 2),
    cohort_start_date = c(
      as.Date("2020-01-01"),
      as.Date("2020-02-03"),
      as.Date("2020-05-01"),
      as.Date("2020-05-01"),
      as.Date("2020-08-01"),
      as.Date("2020-09-01")
    ),
    cohort_end_date = c(
      as.Date("2020-01-31"),
      as.Date("2022-02-03"),
      as.Date("2021-06-28"),
      as.Date("2021-06-01"),
      as.Date("2021-08-01"),
      as.Date("2021-09-01")
    )
  )


  outcome_cohort <- dplyr::tibble(
    cohort_definition_id = c(2, 3, 3),
    subject_id = c(2, 3, 4),
    cohort_start_date = c(
      as.Date("2021-01-01"),
      as.Date("2021-01-01"),
      as.Date("2021-01-01")
    ),
    cohort_end_date = c(
      as.Date("2021-01-01"),
      as.Date("2021-01-01"),
      as.Date("2021-01-01")
    )
  )

  competing_cohort <- dplyr::tibble(
    cohort_definition_id = c(4,5, 4, 5),
    subject_id = c(1,1, 5, 5),
    cohort_start_date = c(
      as.Date("2020-11-01"),
      as.Date("2020-11-01"),
      as.Date("2020-11-01"),
      as.Date("2020-11-01")
    ),
    cohort_end_date = c(
      as.Date("2020-11-01"),
      as.Date("2020-11-01"),
      as.Date("2020-11-01"),
      as.Date("2020-11-01")
    )
  )

  person <- dplyr::tibble(
    person_id = c(1, 2, 3, 4, 5),
    year_of_birth = c(rep("1990", 5)),
    month_of_birth = c(rep("02", 5)),
    day_of_birth = c(rep("11", 5)),
    gender_concept_id = c(rep(0,5)),
    ethnicity_concept_id = c(rep(0,5)),
    race_concept_id = c(rep(0,5))
  )

  cdm <- omopgenerics::cdmFromTables(
    tables = list(
      person = person,
      observation_period = observation_period
    ),
    cohortTables = list(
      exposure_cohort = exposure_cohort,
      cohort1 = outcome_cohort,
      cohort2 = competing_cohort
    ),
    cdmName = "mock_es"
  )

  db <- DBI::dbConnect(duckdb::duckdb(), ":memory:")
  cdm2 = CDMConnector::copy_cdm_to(db,
                                   cdm,
                                   schema = "main",
                                   overwrite = TRUE)

  attr(cdm2, "cdm_schema") <- "main"
  attr(cdm2, "write_schema") <- "main"

  # one target, one outcome
  surv <- estimateSingleEventSurvival(cdm2,
                                      targetCohortTable = "exposure_cohort",
                                      targetCohortId = 1,
                                      outcomeCohortTable = "cohort1",
                                      outcomeCohortId = 2
  ) %>% asSurvivalResult()

  surv_pair <- estimateSingleEventSurvival(cdm2,
                                           targetCohortTable = "exposure_cohort",
                                           targetCohortId = 1,
                                           outcomeCohortTable = "cohort1",
                                           outcomeCohortId = 2,
                                           estimateGap = 2
  ) %>% asSurvivalResult()

  surv2 <- surv %>%
    dplyr::filter(time %in% seq(0, 1235, by = 2))

  expect_true(all.equal(surv_pair, surv2))

  # two targets, two outcomes, competing risk event
  survCR <- estimateCompetingRiskSurvival(cdm2,
                                          targetCohortTable = "exposure_cohort",
                                          targetCohortId = c(1,2),
                                          outcomeCohortTable = "cohort1",
                                          outcomeCohortId = c(2,3),
                                          competingOutcomeCohortTable  = "cohort2",
                                          competingOutcomeCohortId = 4
  ) %>% asSurvivalResult()

  survCR_time <- estimateCompetingRiskSurvival(cdm2,
                                               targetCohortTable = "exposure_cohort",
                                               targetCohortId = c(1,2),
                                               outcomeCohortTable = "cohort1",
                                               outcomeCohortId = c(2,3),
                                               competingOutcomeCohortTable  = "cohort2",
                                               competingOutcomeCohortId = 4,
                                               estimateGap = 2
  ) %>% asSurvivalResult()

  survCR <- survCR %>%
    dplyr::filter(time %in% seq(0,1235,by = 2))

  expect_true(all.equal(survCR, survCR_time))

  CDMConnector::cdmDisconnect(cdm2)

})

test_that("funcionality with created dataset", {
  skip_on_cran()
  exposure_cohort <- dplyr::tibble(
    subject_id = c(1, 2, 3),
    cohort_definition_id = c(1, 1, 1),
    cohort_start_date = c(
      as.Date("2020-01-01"),
      as.Date("2020-02-03"),
      as.Date("2020-05-01")
    ),
    cohort_end_date = c(
      as.Date("2020-01-31"),
      as.Date("2022-02-03"),
      as.Date("2021-06-28")
    ),
    age_group = c("20;29", "20;29", "60;69"),
    sex = c("Female", "Male", "Female"),
    blood_type = c("A", "B", "B")
  )
  outcome_cohort <- dplyr::tibble(
    cohort_definition_id = c(1, 1, 1, 1, 1),
    subject_id = c(1, 1, 2, 3, 3),
    cohort_start_date = c(
      as.Date("2020-01-10"),
      as.Date("2020-02-02"),
      as.Date("2020-02-09"),
      as.Date("2020-06-01"),
      as.Date("2020-06-03")
    ),
    cohort_end_date = c(
      as.Date("2020-01-10"),
      as.Date("2020-02-02"),
      as.Date("2020-02-09"),
      as.Date("2020-06-01"),
      as.Date("2020-06-03")
    )
  )
  observation_period <- dplyr::tibble(
    observation_period_id = c(1, 1, 1),
    person_id = c(1, 2, 3),
    observation_period_start_date = c(
      as.Date("2007-03-21"),
      as.Date("2006-09-09"),
      as.Date("1980-07-20")
    ),
    observation_period_end_date = c(
      as.Date("2022-09-08"),
      as.Date("2023-01-03"),
      as.Date("2023-05-20")
    ),
    period_type_concept_id = c(rep(0,3))
  )

  person <- dplyr::tibble(
    person_id = c(1, 2, 3, 4, 5),
    year_of_birth = c(rep("1990", 5)),
    month_of_birth = c(rep("02", 5)),
    day_of_birth = c(rep("11", 5)),
    gender_concept_id = c(rep(0,5)),
    ethnicity_concept_id = c(rep(0,5)),
    race_concept_id = c(rep(0,5))
  )

  cdm <- omopgenerics::cdmFromTables(
    tables = list(
      person = person,
      observation_period = observation_period
    ),
    cohortTables = list(
      exposure_cohort = exposure_cohort,
      cohort1 = outcome_cohort
    ),
    cdmName = "mock_es"
  )

  db <- DBI::dbConnect(duckdb::duckdb(), ":memory:")
  cdm2 = CDMConnector::copy_cdm_to(db,
                                   cdm,
                                   schema = "main",
                                   overwrite = TRUE)

  attr(cdm2, "cdm_schema") <- "main"
  attr(cdm2, "write_schema") <- "main"

  # No competing events
  surv <- estimateSingleEventSurvival(cdm2,
                                      targetCohortTable = "exposure_cohort",
                                      outcomeCohortTable = "cohort1",
                                      minCellCount = 1
  ) %>% asSurvivalResult()

  expect_true(all(surv %>%
                    dplyr::pull("time") %>%
                    unique() %in% c(0:31)))
  expect_true(all(attr(surv, "events") %>%
                    dplyr::filter(estimate_name == "n_risk") %>%
                    dplyr::select(estimate_value) %>%
                    dplyr::pull() ==
                    c(3, 1, 1)))
  expect_true(all(surv %>%
                    dplyr::filter(estimate_name == "estimate")  %>%
                    dplyr::select(estimate_value) %>%
                    dplyr::pull() - c(rep(1, 7), rep(0.667, 3), rep(0.333, 21), 0) < c(0.01)))
#  expect_true(all(surv %>%
#                    dplyr::filter(estimate_name == "estimate")  %>%
#                    dplyr::filter(estimate_type == "Cumulative failure probability") %>%
#                    dplyr::select(estimate_value) %>% dplyr::pull() - c(rep(0, 6), rep(0.333, 3), rep(0.667, 22), 1) < c(0.01)))

  expect_true(all(attr(surv, "events") %>% dplyr::select(variable_level) %>% dplyr::pull() %in% c("cohort_1")))
  expect_true(all(attr(surv, "events") %>%
                    dplyr::filter(time == 0,
                                  estimate_name == "n_risk") %>%
                    dplyr::pull("estimate_value") %in%  c(3)))

  CDMConnector::cdmDisconnect(cdm2)

  # Competing events
  outcome_cohort <- dplyr::tibble(
    cohort_definition_id = c(1, 1, 1),
    subject_id = c(2, 3, 3),
    cohort_start_date = c(
      as.Date("2020-02-09"),
      as.Date("2020-06-01"),
      as.Date("2020-06-03")
    ),
    cohort_end_date = c(
      as.Date("2020-02-09"),
      as.Date("2020-06-01"),
      as.Date("2020-06-03")
    )
  )
  competing_risk_cohort <- dplyr::tibble(
    cohort_definition_id = c(1, 1, 2),
    subject_id = c(2, 3, 1),
    cohort_start_date = c(
      as.Date("2020-02-07"),
      as.Date("2021-02-02"),
      as.Date("2020-01-03")
    ),
    cohort_end_date = c(
      as.Date("2020-02-07"),
      as.Date("2021-02-02"),
      as.Date("2020-01-03")
    )
  )
  person <- dplyr::tibble(
    person_id = c(1, 2, 3, 4, 5),
    year_of_birth = c(rep("1990", 5)),
    month_of_birth = c(rep("02", 5)),
    day_of_birth = c(rep("11", 5)),
    gender_concept_id = c(rep(0,5)),
    ethnicity_concept_id = c(rep(0,5)),
    race_concept_id = c(rep(0,5))
  )

  cdm <- omopgenerics::cdmFromTables(
    tables = list(
      person = person,
      observation_period = observation_period
    ),
    cohortTables = list(
      exposure_cohort = exposure_cohort,
      cohort1 = outcome_cohort,
      cohort2 = competing_risk_cohort
    ),
    cdmName = "mock_es"
  )

  db <- DBI::dbConnect(duckdb::duckdb(), ":memory:")
  cdm2 = CDMConnector::copy_cdm_to(db,
                                   cdm,
                                   schema = "main",
                                   overwrite = TRUE)

  attr(cdm2, "cdm_schema") <- "main"
  attr(cdm2, "write_schema") <- "main"

  surv2 <- estimateCompetingRiskSurvival(cdm2,
                                         targetCohortTable = "exposure_cohort",
                                         outcomeCohortTable = "cohort1",
                                         competingOutcomeCohortTable = "cohort2",
                                         competingOutcomeCohortId = 1,
                                         minCellCount = 1
  ) %>% asSurvivalResult()

  expect_true(all(surv2 %>%
                    dplyr::pull("time") %>%
                    unique() %in% c(0:981)))
  expect_true(all(attr(surv2, "events") %>%
                    dplyr::filter(variable_level == "cohort_1") %>%
                    dplyr::filter(estimate_name == "n_risk") %>%
                    dplyr::select(estimate_value) %>%
                    dplyr::pull() ==
                    c(3, 2, rep(1, 32))))

  expect_true(all(surv2 %>% dplyr::select(variable_level) %>% dplyr::pull() %in% c("cohort_1", "cohort_1_competing_outcome")))
  expect_true(all(attr(surv2, "events") %>%
                    dplyr::pull("time") %in%  c(seq(0,981, by = 30), 981)))

  CDMConnector::cdmDisconnect(cdm2)

  # Censor at cohort end
  outcome_cohort <- dplyr::tibble(
    cohort_definition_id = c(1, 1, 1, 1, 1),
    subject_id = c(1, 1, 2, 3, 3),
    cohort_start_date = c(
      as.Date("2020-02-10"),
      as.Date("2020-02-02"),
      as.Date("2020-02-09"),
      as.Date("2020-06-01"),
      as.Date("2020-06-03")
    ),
    cohort_end_date = c(
      as.Date("2020-02-10"),
      as.Date("2020-02-02"),
      as.Date("2020-02-09"),
      as.Date("2020-06-01"),
      as.Date("2020-06-03")
    )
  )

  person <- dplyr::tibble(
    person_id = c(1, 2, 3, 4, 5),
    year_of_birth = c(rep("1990", 5)),
    month_of_birth = c(rep("02", 5)),
    day_of_birth = c(rep("11", 5)),
    gender_concept_id = c(rep(0,5)),
    ethnicity_concept_id = c(rep(0,5)),
    race_concept_id = c(rep(0,5))
  )

  cdm <- omopgenerics::cdmFromTables(
    tables = list(
      person = person,
      observation_period = observation_period
    ),
    cohortTables = list(
      exposure_cohort = exposure_cohort,
      cohort1 = outcome_cohort
    ),
    cdmName = "mock_es"
  )

  db <- DBI::dbConnect(duckdb::duckdb(), ":memory:")
  cdm2 = CDMConnector::copy_cdm_to(db,
                                   cdm,
                                   schema = "main",
                                   overwrite = TRUE)

  attr(cdm2, "cdm_schema") <- "main"
  attr(cdm2, "write_schema") <- "main"

  surv3 <- estimateSingleEventSurvival(cdm2, "exposure_cohort",
                                       outcomeCohortTable = "cohort1",
                                       censorOnCohortExit = TRUE,
                                       minCellCount = 1
  ) %>% asSurvivalResult()

  expect_true(all(surv3 %>%
                    dplyr::pull("time") %>%
                    unique() %in% c(0:31)))
  expect_true(all(attr(surv3, "events") %>% dplyr::filter(estimate_name == "n_risk") %>%
                    dplyr::select(estimate_value) %>% dplyr::pull() == c(3, 2, 1)))
  expect_true(all(surv3  %>%
                    dplyr::filter(estimate_name == "estimate") %>%
                    dplyr::select(estimate_value) %>% dplyr::pull() - c(rep(1, 6), rep(0.667, 25), 0) < c(0.01)))

  CDMConnector::cdmDisconnect(cdm2)

  cdm <- omopgenerics::cdmFromTables(
    tables = list(
      person = person,
      observation_period = observation_period
    ),
    cohortTables = list(
      exposure_cohort = exposure_cohort,
      cohort1 = outcome_cohort
    ),
    cdmName = "mock_es"
  )

  db <- DBI::dbConnect(duckdb::duckdb(), ":memory:")
  cdm2 = CDMConnector::copy_cdm_to(db,
                                   cdm,
                                   schema = "main",
                                   overwrite = TRUE)

  attr(cdm2, "cdm_schema") <- "main"
  attr(cdm2, "write_schema") <- "main"

  # Censor by follow up days
  surv4 <- estimateSingleEventSurvival(cdm2, "exposure_cohort",
                                       outcomeCohortTable = "cohort1",
                                       followUpDays = 10,
                                       minCellCount = 1
  ) %>% asSurvivalResult()

  expect_true(all(surv4 %>%
                    dplyr::pull("time") %>%
                    unique() %in% c(0:10)))
  expect_true(all(attr(surv4, "events") %>% dplyr::filter(estimate_name == "n_risk") %>% dplyr::select(estimate_value) %>% dplyr::pull() == c(3, 2)))
  expect_true(all(surv4 %>%
                    dplyr::filter(estimate_name == "estimate") %>%
                    dplyr::select(estimate_value) %>% dplyr::pull() - c(rep(1, 6), rep(0.667, 5)) < c(0.01)))
  expect_true(all(attr(surv4, "events") %>%
                    dplyr::pull("time") %in%  c(0:10)))

  # if followUpDays larger than last of the times, follow until then
  surv4b <- estimateSingleEventSurvival(cdm2, "exposure_cohort",
                                        outcomeCohortTable = "cohort1",
                                        followUpDays = 40,
                                        minCellCount = 1
  ) %>% asSurvivalResult()

  expect_true(all(attr(surv4, "events") %>%
                    dplyr::pull("time") %in%  c(0:40)))

  CDMConnector::cdmDisconnect(cdm2)

  outcome_cohort <- dplyr::tibble(
    cohort_definition_id = c(1, 1, 1, 1, 1),
    subject_id = c(1, 1, 2, 3, 3),
    cohort_start_date = c(
      as.Date("2020-01-10"),
      as.Date("2020-02-02"),
      as.Date("2020-02-09"),
      as.Date("2020-06-01"),
      as.Date("2020-06-03")
    ),
    cohort_end_date = c(
      as.Date("2020-01-10"),
      as.Date("2020-02-02"),
      as.Date("2020-02-09"),
      as.Date("2020-06-01"),
      as.Date("2020-06-03")
    )
  )

  cdm <- omopgenerics::cdmFromTables(
    tables = list(
      person = person,
      observation_period = observation_period
    ),
    cohortTables = list(
      exposure_cohort = exposure_cohort,
      cohort1 = outcome_cohort
    ),
    cdmName = "mock_es"
  )

  db <- DBI::dbConnect(duckdb::duckdb(), ":memory:")
  cdm2 = CDMConnector::copy_cdm_to(db,
                                   cdm,
                                   schema = "main",
                                   overwrite = TRUE)

  attr(cdm2, "cdm_schema") <- "main"
  attr(cdm2, "write_schema") <- "main"

  # Strata
  surv5 <- estimateSingleEventSurvival(cdm2, "exposure_cohort",
                                       outcomeCohortTable = "cohort1",
                                       strata = list(
                                         c("age_group"),
                                         c("sex"),
                                         c("age_group", "sex"),
                                         c("blood_type")
                                       ),
                                       minCellCount = 1
  ) %>% asSurvivalResult()

  expect_true(all(surv5 %>%
                    dplyr::filter(strata_name == "overall") %>%
                    dplyr::pull("time") %>%
                    unique() %in% c(0:31)))
  expect_true(all(attr(surv5, "events") %>% dplyr::filter(strata_name == "overall") %>% dplyr::filter(estimate_name == "n_risk") %>% dplyr::select(estimate_value) %>% dplyr::pull() == c(3, 1, 1)))
  expect_true(all(surv5 %>% dplyr::filter(strata_name == "overall") %>%
                    dplyr::filter(estimate_name == "estimate") %>%
                    dplyr::select(estimate_value) %>% dplyr::pull() - c(rep(1, 6), rep(0.667, 3), rep(0.333, 22), 0) < c(0.01)))

  expect_true(all(surv5 %>% dplyr::filter(strata_name == "age_group; sex" &
                                            strata_level == "20;29; Female") %>%
                    dplyr::select("time") %>% dplyr::pull() %in% c(0:31)))
  expect_true(all(compareNA(attr(surv5, "events") %>% dplyr::filter(strata_name == "age_group; sex" &
                                                                      strata_level == "20;29; Female") %>%
                              dplyr::filter(estimate_name == "n_risk") %>% dplyr::select(estimate_value) %>%
                              dplyr::pull(), c(1,1))))
  expect_true(all(surv5 %>% dplyr::filter(strata_name == "age_group; sex" &
                                            strata_level == "20;29; Female") %>%
                    dplyr::filter(estimate_name == "estimate") %>%
                    dplyr::select(estimate_value) %>% dplyr::pull() - c(rep(1, 9), 0) < c(0.01)))

  expect_true(all(attr(surv5, "events") %>%
                    dplyr::filter(strata_name == "age_group; sex" &
                                    strata_level == "20;29; Female") %>%
                    dplyr::pull("time") %in%  c(0,9)))

  expect_true(all(surv5 %>% dplyr::filter(estimate_name == "estimate" & strata_name == "blood_type" & strata_level == "B") %>%
                    dplyr::select(time) %>% dplyr::pull() == c(0:31)))
  expect_true(all(surv5 %>% dplyr::filter(estimate_name == "n_risk" & strata_name == "blood_type" & strata_level == "B") %>% dplyr::select(estimate_value) %>% dplyr::pull() == c(rep(2, 7), rep(1, 25))))
  expect_true(all(surv5 %>% dplyr::filter(estimate_name == "estimate" & strata_name == "blood_type" & strata_level == "B") %>%
                    dplyr::select(estimate_value) %>% dplyr::pull() - c(rep(1, 6), rep(0.5, 25), 0) < c(0.01)))

  CDMConnector::cdmDisconnect(cdm2)

  outcome_cohort <- dplyr::tibble(
    cohort_definition_id = c(1, 1, 1, 1),
    subject_id = c(1, 2, 3, 3),
    cohort_start_date = c(
      as.Date("2019-01-10"),
      as.Date("2020-02-09"),
      as.Date("2020-06-01"),
      as.Date("2020-06-03")
    ),
    cohort_end_date = c(
      as.Date("2019-01-10"),
      as.Date("2020-02-09"),
      as.Date("2020-06-01"),
      as.Date("2020-06-03")
    )
  )

  cdm <- omopgenerics::cdmFromTables(
    tables = list(
      person = person,
      observation_period = observation_period
    ),
    cohortTables = list(
      exposure_cohort = exposure_cohort,
      cohort1 = outcome_cohort
    ),
    cdmName = "mock_es"
  )

  db <- DBI::dbConnect(duckdb::duckdb(), ":memory:")
  cdm2 = CDMConnector::copy_cdm_to(db,
                                   cdm,
                                   schema = "main",
                                   overwrite = TRUE)

  attr(cdm2, "cdm_schema") <- "main"
  attr(cdm2, "write_schema") <- "main"

  # Washout for outcome
  surv6 <- estimateSingleEventSurvival(cdm2,
                                       targetCohortTable = "exposure_cohort",
                                       outcomeCohortTable = "cohort1",
                                       minCellCount = 1
  ) %>% asSurvivalResult()

  expect_true(all(surv6 %>%
                    dplyr::pull("time") %>%
                    unique() %in% c(0:31)))
  expect_true(all(attr(surv6, "events") %>% dplyr::filter(estimate_name == "n_risk") %>% dplyr::select(estimate_value) %>% dplyr::pull() == c(2, 1, 1)))
  expect_true(all(surv6 %>%
                    dplyr::filter(estimate_name == "estimate") %>%
                    dplyr::select(estimate_value) %>% dplyr::pull() - c(rep(1, 6), rep(0.5, 25), 0) < c(0.01)))

  CDMConnector::cdmDisconnect(cdm2)

  outcome_cohort <- dplyr::tibble(
    cohort_definition_id = c(1, 1, 1, 1),
    subject_id = c(1, 2, 3, 3),
    cohort_start_date = c(
      as.Date("2020-01-10"),
      as.Date("2020-02-09"),
      as.Date("2020-06-01"),
      as.Date("2020-06-03")
    ),
    cohort_end_date = c(
      as.Date("2020-01-10"),
      as.Date("2020-02-09"),
      as.Date("2020-06-01"),
      as.Date("2020-06-03")
    )
  )

  cdm <- omopgenerics::cdmFromTables(
    tables = list(
      person = person,
      observation_period = observation_period
    ),
    cohortTables = list(
      exposure_cohort = exposure_cohort,
      cohort1 = outcome_cohort
    ),
    cdmName = "mock_es"
  )

  db <- DBI::dbConnect(duckdb::duckdb(), ":memory:")
  cdm2 = CDMConnector::copy_cdm_to(db,
                                   cdm,
                                   schema = "main",
                                   overwrite = TRUE)

  attr(cdm2, "cdm_schema") <- "main"
  attr(cdm2, "write_schema") <- "main"

  # Censor on date
  surv7 <- estimateSingleEventSurvival(cdm2,
                                       targetCohortTable = "exposure_cohort",
                                       outcomeCohortTable = "cohort1",
                                       minCellCount = 1,
                                       censorOnDate = as.Date("2020-05-04")
  ) %>% asSurvivalResult()

  expect_true(all(surv7 %>%
                    dplyr::pull("time") %>%
                    unique() %in% c(0:9)))
  expect_true(all(attr(surv7, "events") %>% dplyr::filter(estimate_name == "n_risk") %>% dplyr::select(estimate_value) %>% dplyr::pull() == c(3, 1)))
  expect_true(all(surv7 %>%
                    dplyr::filter(estimate_name == "estimate") %>%
                    dplyr::select(estimate_value)%>% dplyr::pull() - c(rep(1, 6), 0.5, 0.5, 0.5, 0) < c(0.01)))

  CDMConnector::cdmDisconnect(cdm2)
})

test_that("different exposure cohort ids", {
  skip_on_cran()
  cohort <- dplyr::tibble(
    cohort_definition_id = c(1, 1, 2),
    subject_id = c(1, 2, 3),
    cohort_start_date = c(
      as.Date("2020-01-01"),
      as.Date("2020-01-02"),
      as.Date("2020-01-01")
    ),
    cohort_end_date = c(
      as.Date("2020-01-11"),
      as.Date("2020-01-12"),
      as.Date("2020-01-11")
    )
  )
  outcome_cohort <- dplyr::tibble(
    cohort_definition_id = c(1, 1, 1),
    subject_id = c(1, 2, 3),
    cohort_start_date = c(
      as.Date("2020-01-10"),
      as.Date("2020-01-03"),
      as.Date("2020-01-09")
    ),
    cohort_end_date = c(
      as.Date("2020-01-10"),
      as.Date("2020-01-03"),
      as.Date("2020-01-09")
    )
  )

  observation_period <- dplyr::tibble(
    observation_period_id = c(1, 1, 1),
    person_id = c(1, 2, 3),
    observation_period_start_date = c(
      as.Date("2000-01-01"),
      as.Date("2000-01-02"),
      as.Date("2000-01-01")
    ),
    observation_period_end_date = c(
      as.Date("2023-04-01"),
      as.Date("2023-05-02"),
      as.Date("2023-03-01")
    ),
    period_type_concept_id = c(rep(0,3))
  )
  person <- dplyr::tibble(
    person_id = c(1, 2, 3, 4, 5),
    year_of_birth = c(rep("1990", 5)),
    month_of_birth = c(rep("02", 5)),
    day_of_birth = c(rep("11", 5)),
    gender_concept_id = c(rep(0,5)),
    ethnicity_concept_id = c(rep(0,5)),
    race_concept_id = c(rep(0,5))
  )

  cdm <- omopgenerics::cdmFromTables(
    tables = list(
      person = person,
      observation_period = observation_period
    ),
    cohortTables = list(
      cohort1 = cohort,
      cohort2 = outcome_cohort
    ),
    cdmName = "mock_es"
  )

  db <- DBI::dbConnect(duckdb::duckdb(), ":memory:")
  cdm2 = CDMConnector::copy_cdm_to(db,
                                   cdm,
                                   schema = "main",
                                   overwrite = TRUE)

  attr(cdm2, "cdm_schema") <- "main"
  attr(cdm2, "write_schema") <- "main"

  surv8 <-
    estimateSingleEventSurvival(
      cdm = cdm2,
      targetCohortTable = "cohort1",
      targetCohortId = 1,
      outcomeCohortTable = "cohort2",
      outcomeCohortId = 1,
      minCellCount = 0
    ) %>% asSurvivalResult()
  expect_true(all(surv8 %>%
                    dplyr::pull("time") %>% unique() %in% c(0:9)))
  expect_true(all(attr(surv8, "events") %>% dplyr::filter(estimate_name == "n_risk") %>% dplyr::select(estimate_value) %>% dplyr::pull() == c(2, 1)))
  expect_true(all(surv8 %>%
                    dplyr::filter(estimate_name == "estimate") %>%
                    dplyr::select(estimate_value) %>% dplyr::pull() - c(1, rep(0.5, 8), 0) < c(0.01)))

  expect_true(all(attr(surv8, "events") %>% dplyr::filter(!is.na(estimate_value) & estimate_name =="n_risk") %>%
                    dplyr::select(time) == c(0,9)))
  expect_true(all(attr(surv8, "events") %>%
                    dplyr::filter(estimate_name =="n_risk") %>%
                    dplyr::filter(time == 0) %>% dplyr::select(estimate_value) %>%
                    dplyr::pull() == c(2, 2, 2, 2)))

  surv9 <-
    estimateSingleEventSurvival(
      cdm = cdm2,
      targetCohortTable = "cohort1",
      targetCohortId = 2,
      outcomeCohortTable = "cohort2",
      outcomeCohortId = 1,
      minCellCount = 1
    ) %>% asSurvivalResult()

  expect_true(all(surv9 %>% dplyr::pull("time") %>% unique() %in% c(0:8)))
  expect_true(all(surv9 %>% dplyr::filter(estimate_name == "n_risk") %>% dplyr::select(estimate_value) %>% dplyr::pull() == c(rep(1, 9))))
  expect_true(all(surv9 %>%
                    dplyr::filter(estimate_name == "estimate") %>%
                    dplyr::select(estimate_value) %>% dplyr::pull() - c(rep(1, 8), 0) < c(0.01)))

  expect_true(all(attr(surv9, "events") %>% dplyr::filter(!is.na(estimate_value)) %>%
                    dplyr::pull("time") %in%  c(0:8)))
  expect_true(all(attr(surv9, "events") %>%
                    dplyr::filter(estimate_name =="n_risk") %>%
                    dplyr::filter(time == 0) %>% dplyr::select(estimate_value) %>%
                    dplyr::pull() %in%  c(1)))

  CDMConnector::cdm_disconnect(cdm2)
})

test_that("expected errors", {
  skip_on_cran()
  cdm <- mockMGUS2cdm()

  expect_error(estimateSurvival("cdm", targetCohortTable = "mgus_diagnosis", outcomeCohortTable = "progression"))
  expect_error(estimateSurvival(cdm, targetCohortTable = "mgus_diagnosiss", outcomeCohortTable = "progression"))
  expect_error(estimateSurvival(cdm, targetCohortTable = "mgus_diagnosis", outcomeCohortTable = "outcome"))
  expect_error(estimateSurvival(cdm, targetCohortTable = "mgus_diagnosis", outcomeCohortTable = "progression", outcomeCohortId = c(1, 3)))
  expect_error(estimateSurvival(cdm, targetCohortTable = "mgus_diagnosis", outcomeCohortTable = "progression", outcomeCohortId = 1, eventGap = -3))
  expect_error(estimateSurvival(cdm, targetCohortTable = "mgus_diagnosis", outcomeCohortTable = "progression", outcomeCohortId = 1, eventGap = "time"))
  expect_error(estimateSurvival(cdm, targetCohortTable = "mgus_diagnosis", outcomeCohortTable = "progression", outcomeCohortId = 1, eventGap = NULL))
  expect_error(estimateSurvival(cdm, targetCohortTable = "mgus_diagnosis", outcomeCohortTable = "progression", outcomeCohortId = 1, strata = "age"))
  expect_error(estimateSurvival(cdm, targetCohortTable = "mgus_diagnosis", outcomeCohortTable = "progression", outcomeCohortId = 1, strata = list("name" = "noname")))
  expect_error(estimateSurvival(cdm, targetCohortTable = "mgus_diagnosis", outcomeCohortTable = "progression", outcomeCohortId = 1, censorOnDate = "2020-09-02"))
  expect_error(estimateSurvival(cdm, targetCohortTable = "mgus_diagnosis", outcomeCohortTable = "progression", outcomeCohortId = 1, minimumSurvivalDays = -3))
  expect_error(estimateSurvival(cdm, targetCohortTable = "mgus_diagnosis", outcomeCohortTable = "progression", outcomeCohortId = 1, minimumSurvivalDays = c(0,3)))
  expect_error(estimateSurvival(cdm, targetCohortTable = "mgus_diagnosis", outcomeCohortTable = "progression", outcomeCohortId = 1, outcomeWashout = 0))
  expect_error(estimateSurvival(cdm, targetCohortTable = "mgus_diagnosis", outcomeCohortTable = "progression", outcomeCohortId = 1, competingOutcomeWashout = "1"))

  CDMConnector::cdmDisconnect(cdm)
})

test_that("return participants", {
  skip_on_cran()
  cdm <- mockMGUS2cdm()
  surv1 <- estimateSingleEventSurvival(cdm,
                                       targetCohortTable = "mgus_diagnosis",
                                       outcomeCohortTable = "death_cohort",
                                       returnParticipants = FALSE
  ) %>% asSurvivalResult()
  expect_true(is.null(attr(surv1, "participants")))
  surv2 <- estimateSingleEventSurvival(cdm,
                                       targetCohortTable = "mgus_diagnosis",
                                       targetCohortId = 1,
                                       outcomeCohortTable = "death_cohort",
                                       outcomeCohortId = 1,
                                       eventGap = 7, returnParticipants = TRUE
  ) %>% asSurvivalResult()
  expect_false(is.null(attr(surv2, "participants")))

  expect_equal(
    colnames(survivalParticipants(surv2) %>%
               head(1) %>%
               dplyr::collect()),
    c(
      "cohort_definition_id",
      "subject_id",
      "cohort_start_date",
      "cohort_end_date",
      "exposure_id",
      "outcome_id"
    )
  )

  CDMConnector::cdmDisconnect(cdm)
})

test_that("within cohort survival", {
  skip_on_cran()
  cohort <- dplyr::tibble(
    cohort_definition_id = c(1, 1, 1),
    subject_id = c(1, 2, 3),
    cohort_start_date = c(
      as.Date("2020-01-01"),
      as.Date("2020-01-02"),
      as.Date("2020-01-01")
    ),
    cohort_end_date = c(
      as.Date("2020-04-01"),
      as.Date("2020-08-02"),
      as.Date("2021-03-01")
    )
  )
  observation_period <- dplyr::tibble(
    observation_period_id = c(1, 1, 1),
    person_id = c(1, 2, 3),
    observation_period_start_date = c(
      as.Date("2000-01-01"),
      as.Date("2000-01-02"),
      as.Date("2000-01-01")
    ),
    observation_period_end_date = c(
      as.Date("2023-04-01"),
      as.Date("2023-05-02"),
      as.Date("2023-03-01")
    ),
    period_type_concept_id = c(rep(0,3))
  )

  person <- dplyr::tibble(
    person_id = c(1, 2, 3, 4, 5),
    year_of_birth = c(rep("1990", 5)),
    month_of_birth = c(rep("02", 5)),
    day_of_birth = c(rep("11", 5)),
    gender_concept_id = c(rep(0,5)),
    ethnicity_concept_id = c(rep(0,5)),
    race_concept_id = c(rep(0,5))
  )

  cdm <- omopgenerics::cdmFromTables(
    tables = list(
      person = person,
      observation_period = observation_period
    ),
    cohortTables = list(
      cohort1 = cohort
    ),
    cdmName = "mock_es"
  )

  db <- DBI::dbConnect(duckdb::duckdb(), ":memory:")
  cdm2 = CDMConnector::copy_cdm_to(db,
                                   cdm,
                                   schema = "main",
                                   overwrite = TRUE)

  attr(cdm2, "cdm_schema") <- "main"
  attr(cdm2, "write_schema") <- "main"

  surv <- estimateSingleEventSurvival(cdm2,
                                      targetCohortTable = "cohort1",
                                      targetCohortId = 1,
                                      outcomeCohortTable = "cohort1",
                                      outcomeCohortId = 1,
                                      outcomeDateVariable = "cohort_end_date",
                                      eventGap = 7,
                                      minCellCount = 0
  ) %>% asSurvivalResult()
  expect_true(max(attr(surv, "events") %>% dplyr::select(estimate_value) %>% dplyr::pull(), na.rm = TRUE) == 3)

  CDMConnector::cdmDisconnect(cdm2)
})

test_that("strata specific survival", {
  skip_on_cran()

  exposure_cohort <- dplyr::tibble(
    subject_id = c(1, 2, 3, 4, 5),
    cohort_definition_id = c(1, 1, 1,1,1),
    cohort_start_date = c(
      as.Date("2008-01-01"),
      as.Date("2010-01-01"),
      as.Date("2000-01-01"),
      as.Date("2010-01-01"),
      as.Date("2010-01-01")
    ),
    cohort_end_date = c(
      as.Date("2020-01-31"),
      as.Date("2012-01-01"),
      as.Date("2021-06-28"),
      as.Date("2012-01-01"),
      as.Date("2012-01-01")
    ),
    sex = c("Female", "Male", "Female", "Male", "Male")
  )
  outcome_cohort <- dplyr::tibble(
    cohort_definition_id = c(1, 1, 1, 1, 1),
    subject_id = c(1, 1, 2, 3, 3),
    cohort_start_date = c(
      as.Date("2020-01-10"),
      as.Date("2020-02-02"),
      as.Date("2011-02-09"),
      as.Date("2020-06-01"),
      as.Date("2020-06-03")
    ),
    cohort_end_date = c(
      as.Date("2020-01-10"),
      as.Date("2020-02-02"),
      as.Date("2011-02-09"),
      as.Date("2020-06-01"),
      as.Date("2020-06-03")
    )
  )
  other_outcome_cohort <- dplyr::tibble(
    cohort_definition_id = c(1),
    subject_id = c(4),
    cohort_start_date = c(
      as.Date("2011-02-09")
    ),
    cohort_end_date = c(
      as.Date("2011-02-09")
    )
  )
  observation_period <- dplyr::tibble(
    observation_period_id = c(1, 2, 3,4,5),
    person_id = c(1, 2, 3,4,5),
    observation_period_start_date = c(
      as.Date("2007-03-21"),
      as.Date("2009-09-09"),
      as.Date("1980-07-20"),
      as.Date("2009-09-09"),
      as.Date("2009-09-09")
    ),
    observation_period_end_date = c(
      as.Date("2022-09-08"),
      as.Date("2022-01-03"),
      as.Date("2023-05-20"),
      as.Date("2015-01-03"),
      as.Date("2015-01-05")
    ),
    period_type_concept_id = c(rep(0,5))
  )

  person <- dplyr::tibble(
    person_id = c(1, 2, 3, 4, 5),
    year_of_birth = c(rep("1990", 5)),
    month_of_birth = c(rep("02", 5)),
    day_of_birth = c(rep("11", 5)),
    gender_concept_id = c(rep(0,5)),
    ethnicity_concept_id = c(rep(0,5)),
    race_concept_id = c(rep(0,5))
  )

  cdm <- omopgenerics::cdmFromTables(
    tables = list(
      person = person,
      observation_period = observation_period
    ),
    cohortTables = list(
      exposure_cohort = exposure_cohort,
      cohort1 = outcome_cohort,
      cohort2 = other_outcome_cohort
    ),
    cdmName = "mock_es"
  )

  db <- DBI::dbConnect(duckdb::duckdb(), ":memory:")
  cdm2 = CDMConnector::copy_cdm_to(db,
                                   cdm,
                                   schema = "main",
                                   overwrite = TRUE)

  attr(cdm2, "cdm_schema") <- "main"
  attr(cdm2, "write_schema") <- "main"

  surv <- estimateSingleEventSurvival(cdm2,
                                      targetCohortTable = "exposure_cohort",
                                      outcomeCohortTable = "cohort1",
                                      strata = list("sex"),
                                      minCellCount = 1
  ) %>% asSurvivalResult()
  surv_cr <- estimateCompetingRiskSurvival(cdm2,
                                           targetCohortTable = "exposure_cohort",
                                           outcomeCohortTable = "cohort1",
                                           competingOutcomeCohortTable = "cohort2",
                                           strata = list("sex"),
                                           minCellCount = 1
  ) %>% asSurvivalResult()

  # only males
  cdm2[["exposure_cohort_m"]] <- cdm2$exposure_cohort %>%
    dplyr::filter(sex =="Male") %>%
    dplyr::compute()
  surv_m <- estimateSingleEventSurvival(cdm2,
                                        targetCohortTable = "exposure_cohort_m",
                                        outcomeCohortTable = "cohort1",
                                        minCellCount = 1
  ) %>% asSurvivalResult()
  surv_cr_m <- estimateCompetingRiskSurvival(cdm2,
                                             targetCohortTable = "exposure_cohort_m",
                                             outcomeCohortTable = "cohort1",
                                             competingOutcomeCohortTable = "cohort2",
                                             minCellCount = 1
  ) %>% asSurvivalResult()

  # overall result should now be the same as the strata of males before filtering
  expect_equal(surv %>%
                 dplyr::filter(!is.na(time)) %>%
                 dplyr::filter(strata_name == "sex" & strata_level =="Male") %>%
                 dplyr::pull(),
               surv_m  %>%
                 dplyr::filter(!is.na(time)) %>%
                 dplyr::pull()
  )
  expect_equal(surv %>%
                 dplyr::filter(is.na(time)) %>%
                 dplyr::filter(strata_name == "sex" & strata_level =="Male") %>%
                 dplyr::pull(),
               surv_m  %>%
                 dplyr::filter(is.na(time)) %>%
                 dplyr::pull()
  )
  expect_equal(
    surv %>%
      dplyr::filter(strata_name == "sex" & strata_level =="Male") %>%
      dplyr::select("estimate_value") %>%
      dplyr::pull(),
    surv_m %>%
      dplyr::select("estimate_value") %>%
      dplyr::pull()
  )


  expect_equal(surv_cr %>%
                 dplyr::filter(!is.na(time)) %>%
                 dplyr::filter(strata_name == "sex" & strata_level =="Male") %>%
                 dplyr::pull(),
               surv_cr_m  %>%
                 dplyr::filter(!is.na(time)) %>%
                 dplyr::pull()
  )

  expect_equal(surv_cr %>%
                 dplyr::filter(is.na(time)) %>%
                 dplyr::filter(strata_name == "sex" & strata_level =="Male") %>%
                 dplyr::pull(),
               surv_cr_m  %>%
                 dplyr::filter(is.na(time)) %>%
                 dplyr::pull()
  )


  # strata with only one value
  cdm2$exposure_cohort <- cdm2$exposure_cohort %>% dplyr::mutate(a = "X")
  surv <- estimateSingleEventSurvival(cdm2,
                                      targetCohortTable = "exposure_cohort",
                                      outcomeCohortTable = "cohort1",
                                      strata = list("sex", "a"),
                                      minCellCount = 1
  ) %>% asSurvivalResult()


  CDMConnector::cdmDisconnect(cdm2)
})

test_that("multiple rows per person - same observation period", {
  skip_on_cran()

  exposure_cohort <- dplyr::tibble(
    subject_id = c(1, 1, 2, 2, 3,4),
    cohort_definition_id = rep(1,6),
    cohort_start_date = c(
      as.Date("2010-01-01"),
      as.Date("2015-01-01"),
      as.Date("2010-01-01"),
      as.Date("2016-01-01"),
      as.Date("2010-01-01"),
      as.Date("2010-01-01")
    ),
    cohort_end_date = c(
      as.Date("2010-01-01"),
      as.Date("2015-01-01"),
      as.Date("2010-01-01"),
      as.Date("2016-01-01"),
      as.Date("2010-01-01"),
      as.Date("2010-01-01")
    )
  )
  # outcome during first cohort entry for id 1
  # outcome during second cohort entry for id 2
  outcome_cohort <- dplyr::tibble(
    cohort_definition_id = c(1, 1),
    subject_id = c(1, 2),
    cohort_start_date = c(
      as.Date("2012-01-10"),
      as.Date("2017-01-10")
    ),
    cohort_end_date = c(
      as.Date("2012-01-10"),
      as.Date("2017-01-10")
    ))
  observation_period <- dplyr::tibble(
    observation_period_id = c(1, 2,3,4),
    person_id = c(1, 2, 3, 4),
    observation_period_start_date = c(
      as.Date("2007-03-21"),
      as.Date("2006-09-09"),
      as.Date("1980-07-20"),
      as.Date("1980-07-20")
    ),
    observation_period_end_date = c(
      as.Date("2022-09-08"),
      as.Date("2023-01-03"),
      as.Date("2023-05-20"),
      as.Date("2023-05-20")
    ),
    period_type_concept_id = c(rep(0,4))
  )
  competing_cohort <- dplyr::tibble(
    cohort_definition_id = c(1),
    subject_id = c(4),
    cohort_start_date = c(
      as.Date("2012-01-10")
    ),
    cohort_end_date = c(
      as.Date("2012-01-10")
    )
  )

  person <- dplyr::tibble(
    person_id = c(1, 2, 3, 4, 5),
    year_of_birth = c(rep("1990", 5)),
    month_of_birth = c(rep("02", 5)),
    day_of_birth = c(rep("11", 5)),
    gender_concept_id = c(rep(0,5)),
    ethnicity_concept_id = c(rep(0,5)),
    race_concept_id = c(rep(0,5))
  )

  cdm <- omopgenerics::cdmFromTables(
    tables = list(
      person = person,
      observation_period = observation_period
    ),
    cohortTables = list(
      exposure_cohort = exposure_cohort,
      cohort1 = outcome_cohort,
      cohort2 = competing_cohort
    ),
    cdmName = "mock_es"
  )

  db <- DBI::dbConnect(duckdb::duckdb(), ":memory:")
  cdm2 = CDMConnector::copy_cdm_to(db,
                                   cdm,
                                   schema = "main",
                                   overwrite = TRUE)

  attr(cdm2, "cdm_schema") <- "main"
  attr(cdm2, "write_schema") <- "main"

  expect_no_error(surv <- estimateSingleEventSurvival(cdm2,
                                                      targetCohortTable = "exposure_cohort",
                                                      outcomeCohortTable = "cohort1",
                                                      returnParticipants = TRUE,
                                                      minCellCount = 1
  ) %>% asSurvivalResult())

  # we have three events because subject 2 has two events
  expect_true(max(attr(surv, "summary") %>%
                    dplyr::filter(estimate_name == "n_events") %>%
                    dplyr::pull("estimate_value")) == 3)

  # we have five for n_start because subject 2 appears twice
  expect_true(max(attr(surv, "summary") %>%
                    dplyr::filter(estimate_name == "number_records") %>%
                    dplyr::pull("estimate_value")) == 5)

  ## competing risk
  expect_no_error(surv <- estimateCompetingRiskSurvival(cdm2,
                                                        targetCohortTable = "exposure_cohort",
                                                        outcomeCohortTable = "cohort1",
                                                        competingOutcomeCohortTable = "cohort2",
                                                        returnParticipants = TRUE
  ) %>% asSurvivalResult())


  CDMConnector::cdm_disconnect(cdm2)
})

test_that("multiple outcomes competing risk", {
  skip_on_cran()
  cdm <- mockMGUS2cdm()

  result <- estimateCompetingRiskSurvival(
    cdm = cdm,
    targetCohortTable = "mgus_diagnosis",
    outcomeCohortTable = "progression_type",
    competingOutcomeCohortTable = "death_cohort"
  ) %>% asSurvivalResult()

  x <- result %>%
    dplyr::group_by(dplyr::across(!"estimate_value")) %>%
    dplyr::summarise(
      number_rows = dplyr::n(),
      distinct_values = dplyr::n_distinct(estimate_value),
      .groups = "drop"
    ) %>%
    dplyr::summarise(
      number_groups = dplyr::n(),
      multiple_rows = sum(number_rows>1),
      multiple_values = sum(distinct_values > 1)
    )

  expect_true(x$multiple_rows == 0)
  expect_true(x$multiple_values == 0)

  CDMConnector::cdm_disconnect(cdm)
})

test_that("empty cohort table", {
  skip_on_cran()
  cdm <- mockMGUS2cdm()

  cdm$progression_type <- cdm$progression_type %>%
    dplyr::filter(.data$cohort_definition_id != 1) %>%
    CDMConnector::recordCohortAttrition("filter")

  expect_no_error(result <- estimateCompetingRiskSurvival(
    cdm = cdm,
    targetCohortTable = "mgus_diagnosis",
    outcomeCohortTable = "progression_type",
    competingOutcomeCohortTable = "death_cohort"
  ) %>% asSurvivalResult())

  CDMConnector::cdm_disconnect(cdm)

})

test_that("min cell count", {
  skip_on_cran()
  cdm <- mockMGUS2cdm()
  surv <- estimateSingleEventSurvival(cdm,
                                      targetCohortTable = "mgus_diagnosis",
                                      outcomeCohortTable = "death_cohort",
                                      strata = list(
                                        "age" = c("age")
                                      ),
                                      eventGap = 7,
                                      minCellCount = 35) %>% asSurvivalResult()

  expect_true(nrow(attr(surv, "events") %>%
                     dplyr::filter(estimate_name == "n_risk") %>%
                     dplyr::filter(estimate_value < 35)) == 0)
  expect_true(nrow(attr(surv, "summary") %>%
                     dplyr::filter(estimate_name == "n_records") %>%
                     dplyr::filter(estimate_value < 35)) == 0)

  result <- estimateCompetingRiskSurvival(
    cdm = cdm,
    targetCohortTable = "mgus_diagnosis",
    outcomeCohortTable = "progression_type",
    competingOutcomeCohortTable = "death_cohort",
    minCellCount = 35
  ) %>% asSurvivalResult()
  expect_true(nrow(attr(result, "events") %>%
                     dplyr::filter(estimate_name == "n_risk") %>%
                     dplyr::filter(estimate_value < 35)) == 0)

  CDMConnector::cdm_disconnect(cdm)

})

test_that("minimum survival days", {
  skip_on_cran()

  exposure_cohort <- dplyr::tibble(
    subject_id = c(1, 2, 3, 4, 5),
    cohort_definition_id = c(1, 1, 1,1,1),
    cohort_start_date = c(
      as.Date("2008-01-01"),
      as.Date("2010-01-01"),
      as.Date("2000-01-01"),
      as.Date("2010-01-01"),
      as.Date("2010-01-01")
    ),
    cohort_end_date = c(
      as.Date("2020-01-31"),
      as.Date("2012-01-01"),
      as.Date("2021-06-28"),
      as.Date("2012-01-01"),
      as.Date("2012-01-01")
    ),
    sex = c("Female", "Male", "Female", "Male", "Male")
  )
  outcome_cohort <- dplyr::tibble(
    cohort_definition_id = c(1, 1, 1, 1, 1),
    subject_id = c(1, 2, 2, 3, 3),
    cohort_start_date = c(
      as.Date("2020-01-10"),
      as.Date("2010-01-01"),
      as.Date("2011-02-09"),
      as.Date("2020-06-01"),
      as.Date("2020-06-03")
    ),
    cohort_end_date = c(
      as.Date("2020-01-10"),
      as.Date("2010-02-02"),
      as.Date("2011-02-09"),
      as.Date("2020-06-01"),
      as.Date("2020-06-03")
    )
  )
  other_outcome_cohort <- dplyr::tibble(
    cohort_definition_id = c(1,1),
    subject_id = c(4,3),
    cohort_start_date = c(
      as.Date("2011-02-09"),
      as.Date("2000-01-01")
    ),
    cohort_end_date = c(
      as.Date("2011-02-09"),
      as.Date("2000-01-01")
    )
  )
  observation_period <- dplyr::tibble(
    observation_period_id = c(1, 2, 3,4,5),
    person_id = c(1, 2, 3,4,5),
    observation_period_start_date = c(
      as.Date("2007-03-21"),
      as.Date("2009-09-09"),
      as.Date("1980-07-20"),
      as.Date("2009-09-09"),
      as.Date("2009-09-09")
    ),
    observation_period_end_date = c(
      as.Date("2022-09-08"),
      as.Date("2022-01-03"),
      as.Date("2023-05-20"),
      as.Date("2015-01-03"),
      as.Date("2015-01-05")
    ),
    period_type_concept_id = c(rep(0,5))
  )

  person <- dplyr::tibble(
    person_id = c(1, 2, 3, 4, 5),
    year_of_birth = c(rep("1990", 5)),
    month_of_birth = c(rep("02", 5)),
    day_of_birth = c(rep("11", 5)),
    gender_concept_id = c(rep(0,5)),
    ethnicity_concept_id = c(rep(0,5)),
    race_concept_id = c(rep(0,5))
  )

  cdm <- omopgenerics::cdmFromTables(
    tables = list(
      person = person,
      observation_period = observation_period
    ),
    cohortTables = list(
      exposure_cohort = exposure_cohort,
      cohort1 = outcome_cohort,
      cohort2 = other_outcome_cohort
    ),
    cdmName = "mock_es"
  )

  db <- DBI::dbConnect(duckdb::duckdb(), ":memory:")
  cdm2 = CDMConnector::copy_cdm_to(db,
                                   cdm,
                                   schema = "main",
                                   overwrite = TRUE)

  attr(cdm2, "cdm_schema") <- "main"
  attr(cdm2, "write_schema") <- "main"

  surv <- estimateSingleEventSurvival(cdm2,
                                      targetCohortTable = "exposure_cohort",
                                      outcomeCohortTable = "cohort1",
                                      strata = list("sex"),
                                      minCellCount = 1
  ) %>% asSurvivalResult()

  expect_true(attr(surv, "attrition") %>%
                dplyr::filter(reason == "Survival days for outcome less than 1") %>%
                dplyr::select(excluded_records) == 1)

  surv_cr <- estimateCompetingRiskSurvival(cdm2,
                                           targetCohortTable = "exposure_cohort",
                                           outcomeCohortTable = "cohort1",
                                           competingOutcomeCohortTable = "cohort2",
                                           strata = list("sex"),
                                           minCellCount = 1
  ) %>% asSurvivalResult()

  expect_true(attr(surv_cr, "attrition") %>%
                dplyr::filter(reason == "Survival days for competing outcome less than 1") %>%
                dplyr::select(excluded_records) == 1)

  CDMConnector::cdm_disconnect(cdm2)

})

test_that("outcomeWashout", {
  skip_on_cran()

  exposure_cohort <- dplyr::tibble(
    subject_id = c(1, 2, 3, 4, 5),
    cohort_definition_id = c(1, 1, 1,1,1),
    cohort_start_date = c(
      as.Date("2008-01-01"),
      as.Date("2010-01-01"),
      as.Date("2000-01-01"),
      as.Date("2010-01-01"),
      as.Date("2010-01-01")
    ),
    cohort_end_date = c(
      as.Date("2020-01-31"),
      as.Date("2012-01-01"),
      as.Date("2021-06-28"),
      as.Date("2012-01-01"),
      as.Date("2012-01-01")
    ),
    sex = c("Female", "Male", "Female", "Male", "Male")
  )
  outcome_cohort <- dplyr::tibble(
    cohort_definition_id = c(1, 1, 1, 1, 1),
    subject_id = c(1, 2, 2, 3, 3),
    cohort_start_date = c(
      as.Date("2020-01-10"),
      as.Date("2009-01-01"),
      as.Date("2011-02-09"),
      as.Date("2020-06-01"),
      as.Date("2020-06-03")
    ),
    cohort_end_date = c(
      as.Date("2020-01-10"),
      as.Date("2009-02-02"),
      as.Date("2011-02-09"),
      as.Date("2020-06-01"),
      as.Date("2020-06-03")
    )
  )
  other_outcome_cohort <- dplyr::tibble(
    cohort_definition_id = c(1,1),
    subject_id = c(4,3),
    cohort_start_date = c(
      as.Date("2011-02-09"),
      as.Date("2000-01-01")
    ),
    cohort_end_date = c(
      as.Date("2011-02-09"),
      as.Date("2000-01-01")
    )
  )
  observation_period <- dplyr::tibble(
    observation_period_id = c(1, 2, 3,4,5),
    person_id = c(1, 2, 3,4,5),
    observation_period_start_date = c(
      as.Date("2007-03-21"),
      as.Date("2008-09-09"),
      as.Date("1980-07-20"),
      as.Date("2009-09-09"),
      as.Date("2009-09-09")
    ),
    observation_period_end_date = c(
      as.Date("2022-09-08"),
      as.Date("2022-01-03"),
      as.Date("2023-05-20"),
      as.Date("2015-01-03"),
      as.Date("2015-01-05")
    ),
    period_type_concept_id = c(rep(0,5))
  )

  person <- dplyr::tibble(
    person_id = c(1, 2, 3, 4, 5),
    year_of_birth = c(rep("1990", 5)),
    month_of_birth = c(rep("02", 5)),
    day_of_birth = c(rep("11", 5)),
    gender_concept_id = c(rep(0,5)),
    ethnicity_concept_id = c(rep(0,5)),
    race_concept_id = c(rep(0,5))
  )

  cdm <- omopgenerics::cdmFromTables(
    tables = list(
      person = person,
      observation_period = observation_period
    ),
    cohortTables = list(
      exposure_cohort = exposure_cohort,
      cohort1 = outcome_cohort,
      cohort2 = other_outcome_cohort
    ),
    cdmName = "mock_es"
  )

  db <- DBI::dbConnect(duckdb::duckdb(), ":memory:")
  cdm2 = CDMConnector::copy_cdm_to(db,
                                   cdm,
                                   schema = "main",
                                   overwrite = TRUE)

  attr(cdm2, "cdm_schema") <- "main"
  attr(cdm2, "write_schema") <- "main"

  surv <- estimateSingleEventSurvival(cdm2,
                                      targetCohortTable = "exposure_cohort",
                                      outcomeCohortTable = "cohort1",
                                      minCellCount = 1
  ) %>% asSurvivalResult()

  surv_w0 <- estimateSingleEventSurvival(cdm2,
                                      targetCohortTable = "exposure_cohort",
                                      outcomeCohortTable = "cohort1",
                                      outcomeWashout = 1,
                                      minCellCount = 1
  ) %>% asSurvivalResult()

  # We should have one extra event when washout is 0 because we don't censor person 2
  expect_true(attr(surv_w0, "summary") %>%
                dplyr::filter(estimate_name == "n_events") %>%
                dplyr::pull(estimate_value) ==
                attr(surv, "summary") %>%
                dplyr::filter(estimate_name == "n_events") %>%
                dplyr::pull(estimate_value) + 1)

  CDMConnector::cdm_disconnect(cdm2)
})

test_that("restrictedMeanFollowUp", {
  skip_on_cran()
  cdm <- mockMGUS2cdm()
  cdm[["mgus_diagnosis"]] <- cdm[["mgus_diagnosis"]] %>%
    dplyr::mutate(mspike_r = round(mspike, digits = 0))
  survCR <- estimateCompetingRiskSurvival(cdm,
                                          targetCohortTable = "mgus_diagnosis",
                                          targetCohortId = 1,
                                          outcomeCohortTable = "progression",
                                          outcomeCohortId = 1,
                                          competingOutcomeCohortTable = "death_cohort",
                                          competingOutcomeCohortId = 1
  )
  survCR_rmean <- estimateCompetingRiskSurvival(cdm,
                                          targetCohortTable = "mgus_diagnosis",
                                          targetCohortId = 1,
                                          outcomeCohortTable = "progression",
                                          outcomeCohortId = 1,
                                          competingOutcomeCohortTable = "death_cohort",
                                          competingOutcomeCohortId = 1,
                                          restrictedMeanFollowUp = 100
  )
  tsurv <- tableSurvival(survCR, type = "tibble", .options = list(includeHeaderKey = FALSE))
  tsurvrmean <- tableSurvival(survCR_rmean, type = "tibble", .options = list(includeHeaderKey = FALSE))

  expect_true(all.equal(tsurv %>% dplyr::select(-"Restricted mean survival"),
                        tsurvrmean %>% dplyr::select(-"Restricted mean survival")))
  expect_true(all(tsurv %>% dplyr::pull("Restricted mean survival") == c("35.00", "260.00")))
  expect_true(all(tsurvrmean %>% dplyr::pull("Restricted mean survival") == c("3.00", "28.00")))

  CDMConnector::cdm_disconnect(cdm)
})

  test_that("no outcomes among cohort", {

  cdm <- mockMGUS2cdm()
  cdm$death_cohort <- cdm$death_cohort |>
    dplyr::filter(subject_id == 1)
  cdm$mgus_diagnosis <- cdm$mgus_diagnosis |>
    dplyr::filter(subject_id != 1)

  expect_no_error(surv <- estimateSingleEventSurvival(cdm,
                                      targetCohortTable = "mgus_diagnosis",
                                      outcomeCohortTable = "death_cohort"
  ))

  # empty death table
  cdm$death_cohort <- cdm$death_cohort |>
    dplyr::filter(subject_id == 2) # now nobody
  expect_warning(surv <- estimateSingleEventSurvival(cdm,
                                      targetCohortTable = "mgus_diagnosis",
                                      outcomeCohortTable = "death_cohort"
  ))

})


  test_that("mgus example: empty outcome tables or cohorts", {
    cdm <- mockMGUS2cdm()
    cdm$death_c <- cdm$death_cohort %>%
      dplyr::filter(cohort_definition_id == 2) %>%
      dplyr::compute(name = "death_c")
    attr(cdm$death_c, "cohort_set") <- dplyr::tibble(
      cohort_definition_id = 1,
      cohort_name = "death_c"
    )
    attr(cdm$death_c, "cohort_attrition") <- omopgenerics:::defaultCohortAttrition(cdm$death_c, attr(cdm$death_c, "cohort_set"))
    attr(cdm$death_c, "tbl_name") <- "death_c"

    # Whole empty table throws warning for outcome
    expect_warning(estimateSingleEventSurvival(cdm, targetCohortTable = "mgus_diagnosis",
                                             outcomeCohortTable = "death_c"))

    # and error for target
    expect_error(estimateSingleEventSurvival(cdm, targetCohortTable = "death_c",
                                             outcomeCohortTable = "mgus_diagnosis"))

    # Some empty cohortIds are just not calculated, for both primary and competing outcomes
    attr(cdm$death_cohort, "cohort_set") <- dplyr::tibble(
      cohort_definition_id = c(1,3),
      cohort_name = c("death_cohort", "death_test_empty")
    )
    attr(cdm$death_cohort, "cohort_attrition") <- omopgenerics:::defaultCohortAttrition(cdm$death_cohort, attr(cdm$death_cohort, "cohort_set"))
    attr(cdm$progression, "cohort_set") <- dplyr::tibble(
      cohort_definition_id = c(1,2),
      cohort_name = c("progression", "progression_fake_empty")
    )
    attr(cdm$progression, "cohort_attrition") <- omopgenerics:::defaultCohortAttrition(cdm$progression, attr(cdm$progression, "cohort_set"))

    expect_warning(emptyResultBis <- estimateSingleEventSurvival(cdm, targetCohortTable = "mgus_diagnosis",
                                                  outcomeCohortTable = "death_cohort",
                                                  outcomeCohortId = c(1,3)))
    expect_true(all(emptyResultBis %>%
                  dplyr::filter(variable_level == "death_test_empty" & variable_name == "survival_probability") %>%
                  dplyr::pull("estimate_value") == c(1)))

    expect_warning(emptyResultBisBis <- estimateCompetingRiskSurvival(cdm, targetCohortTable = "mgus_diagnosis",
                                                       outcomeCohortTable = "progression",
                                                       outcomeCohortId = c(1,2),
                                                       competingOutcomeCohortTable = "death_cohort",
                                                       competingOutcomeCohortId = c(1,3)))

    expect_true(emptyResultBisBis %>%
                  dplyr::select(variable_level) %>%
                  dplyr::distinct() %>%
                  dplyr::tally() %>%
                  dplyr::pull() == 2)

    PatientProfiles::mockDisconnect(cdm)
  })