tests/testthat/test-Utility.R

In Colossus: "Risk Model Regression and Analysis with Complex Non-Linear Models"

## ------------------------------------- ##
## Verify the system check code
## ------------------------------------- ##
test_that("System version", {
  expect_no_error(System_Version())
  expect_no_error(Rcpp_version())
})

## ------------------------------------- ##
## Verify verbosity code
## ------------------------------------- ##
test_that("Check verbose, T/F", {
  expect_no_error(Check_Verbose(TRUE))
  expect_no_error(Check_Verbose(FALSE))
  expect_no_error(Check_Verbose("TRUE"))
})
test_that("Check verbose, 0/1/2/3/4", {
  expect_no_error(Check_Verbose(0))
  expect_no_error(Check_Verbose(1))
  expect_no_error(Check_Verbose(2))
  expect_no_error(Check_Verbose(3))
  expect_no_error(Check_Verbose(4))
  expect_no_error(Check_Verbose("1"))
})
test_that("Check verbose, Fails", {
  expect_error(Check_Verbose(-1))
  expect_error(Check_Verbose(5))
  expect_error(Check_Verbose("true"))
})
## ------------------------------------- ##
## Default control
## ------------------------------------- ##

test_that("Default control no error", {
  control_def <- list()
  expect_no_error(Def_Control(control_def))
})
# test_that( "Default control error", {
#     control_def<- list( "ncores"=detectCores()+100, "verbose"=TRUE)

#     expect_error(Def_Control(control_def))
# })
test_that("Default control no error", {
  control_def <- list("temp" = FALSE)
  a_n <- c(1, 2, 3)
  expect_no_error(Def_Control_Guess(control_def, a_n))
})
test_that("Default control guess combinations", {
  control_def <- list("verbose" = TRUE)
  a_n <- c(1, 2, 3)
  expect_no_error(Def_Control_Guess(control_def, a_n))
  control_def <- list("verbose" = "p")
  expect_error(Def_Control_Guess(control_def, a_n))
  control_def <- list("verbose" = TRUE, "guess_constant" = c(1))
  expect_no_error(Def_Control_Guess(control_def, a_n))
})

## ------------------------------------- ##
## Truncation
## ------------------------------------- ##

test_that("No truncation columns", {
  df <- data.table("time0" = c(0, 1, 2, 3, 4, 5, 6), "time1" = c(1, 2, 3, 4, 5, 6, 7), "dummy" = c(0, 0, 1, 1, 0, 1, 0))
  expect_equal(Check_Trunc(df, c("time0", "time1"))$ce, c("time0", "time1"))
})
test_that("Right truncation columns", {
  df <- data.table("time0" = c(0, 1, 2, 3, 4, 5, 6), "time1" = c(1, 2, 3, 4, 5, 6, 7), "dummy" = c(0, 0, 1, 1, 0, 1, 0))
  expect_equal(Check_Trunc(df, c("%trunc%", "time1"))$ce, c("right_trunc", "time1"))
})
test_that("Left truncation columns", {
  df <- data.table("time0" = c(0, 1, 2, 3, 4, 5, 6), "time1" = c(1, 2, 3, 4, 5, 6, 7), "dummy" = c(0, 0, 1, 1, 0, 1, 0))
  expect_equal(Check_Trunc(df, c("time0", "%trunc%"))$ce, c("time0", "left_trunc"))
})
test_that("Truncation no column error", {
  df <- data.table("time0" = c(0, 1, 2, 3, 4, 5, 6), "time1" = c(1, 2, 3, 4, 5, 6, 7), "dummy" = c(0, 0, 1, 1, 0, 1, 0))
  expect_error(Check_Trunc(df, c()))
})
test_that("Truncation left column not in df error", {
  df <- data.table("time0" = c(0, 1, 2, 3, 4, 5, 6), "time1" = c(1, 2, 3, 4, 5, 6, 7), "dummy" = c(0, 0, 1, 1, 0, 1, 0))
  expect_error(Check_Trunc(df, c("timebad", "%trunc%")))
})
test_that("Truncation right column not in df error", {
  df <- data.table("time0" = c(0, 1, 2, 3, 4, 5, 6), "time1" = c(1, 2, 3, 4, 5, 6, 7), "dummy" = c(0, 0, 1, 1, 0, 1, 0))
  expect_error(Check_Trunc(df, c("%trunc%", "timebad")))
})
test_that("Truncation both sides", {
  df <- data.table("time0" = c(0, 1, 2, 3, 4, 5, 6), "time1" = c(1, 2, 3, 4, 5, 6, 7), "dummy" = c(0, 0, 1, 1, 0, 1, 0))
  expect_error(Check_Trunc(df, c("%trunc%", "%trunc%")))
})

## ------------------------------------- ##
## Duplicate Columns
## ------------------------------------- ##

test_that("No dupe columns", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(1, 1, 1, 1, 1, 1, 1)
  d <- c(3, 4, 5, 6, 7, 8, 9)
  df <- data.table("a" = a, "b" = b, "c" = c, "d" = d)
  expect_equal(Check_Dupe_Columns(df, c("a", "b", "c", "d"), c(0, 0, 0, 0), TRUE), c("a", "b", "c", "d"))
})
test_that("No columns", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(1, 1, 1, 1, 1, 1, 1)
  d <- c(3, 4, 5, 6, 7, 8, 9)
  df <- data.table("a" = a, "b" = b, "c" = c, "d" = d)
  expect_equal(Check_Dupe_Columns(df, c(), c(), TRUE), c())
})
test_that("One column with varying", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(1, 1, 1, 1, 1, 1, 1)
  d <- c(3, 4, 5, 6, 7, 8, 9)
  df <- data.table("a" = a, "b" = b, "c" = c, "d" = d)
  expect_equal(Check_Dupe_Columns(df, c("a"), c(0), TRUE), c("a"))
})
test_that("One column with constant", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(1, 1, 1, 1, 1, 1, 1)
  d <- c(3, 4, 5, 6, 7, 8, 9)
  df <- data.table("a" = a, "b" = b, "c" = c, "d" = d)
  expect_equal(Check_Dupe_Columns(df, c("c"), c(0), TRUE), c("c"))
})
test_that("One column with constant 0", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(0, 0, 0, 0, 0, 0, 0)
  d <- c(3, 4, 5, 6, 7, 8, 9)
  df <- data.table("a" = a, "b" = b, "c" = c, "d" = d)
  expect_equal(Check_Dupe_Columns(df, c("c"), c(0), TRUE), c())
})
test_that("One duplicate column", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(1, 1, 1, 1, 1, 1, 1)
  d <- c(3, 4, 5, 6, 7, 8, 9)
  df <- data.table("a" = a, "b" = b, "c" = c, "d" = d, "e" = a)
  options(warn = -1)
  expect_equal(Check_Dupe_Columns(df, c("a", "b", "c", "d", "e"), c(0, 0, 0, 0, 0), TRUE), c("a", "b", "c", "d"))
})
test_that("One duplicate column, different term", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(1, 1, 1, 1, 1, 1, 1)
  d <- c(3, 4, 5, 6, 7, 8, 9)
  df <- data.table("a" = a, "b" = b, "c" = c, "d" = d, "e" = a)
  expect_equal(Check_Dupe_Columns(df, c("a", "b", "c", "d", "e"), c(0, 0, 0, 1, 1), TRUE), c("a", "b", "c", "d", "e"))
})
test_that("Multiple duplicate columns", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(1, 1, 1, 1, 1, 1, 1)
  d <- c(3, 4, 5, 6, 7, 8, 9)
  df <- data.table("a" = a, "b" = b, "c" = c, "d" = d, "e" = a, "f" = b)
  options(warn = -1)
  expect_equal(Check_Dupe_Columns(df, c("a", "b", "c", "e", "f"), c(0, 0, 0, 0, 0), TRUE), c("a", "b", "c"))
})
test_that("All duplicate columns, different terms", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(1, 1, 1, 1, 1, 1, 1)
  d <- c(3, 4, 5, 6, 7, 8, 9)
  df <- data.table("a" = a, "b" = a, "c" = a, "d" = a, "e" = a, "f" = a)
  expect_equal(Check_Dupe_Columns(df, c("a", "b", "c", "e", "f"), c(0, 1, 2, 3, 4), TRUE), c("a", "b", "c", "e", "f"))
})
test_that("Repeated duplicate columns", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(1, 1, 1, 1, 1, 1, 1)
  d <- c(3, 4, 5, 6, 7, 8, 9)
  df <- data.table("a" = a, "b" = b, "c" = c, "d" = a, "e" = a, "f" = a)
  options(warn = -1)
  expect_equal(Check_Dupe_Columns(df, c("a", "b", "c", "d", "f"), c(0, 0, 0, 0, 0), TRUE), c("a", "b", "c"))
})
test_that("All but one duplicate column with varying", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(1, 1, 1, 1, 1, 1, 1)
  d <- c(3, 4, 5, 6, 7, 8, 9)
  df <- data.table("a" = a, "b" = a, "c" = a)
  options(warn = -1)
  expect_equal(Check_Dupe_Columns(df, c("a", "b", "c"), c(0, 0, 0), TRUE), c("a"))
})
test_that("All but one duplicate column with constant", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(1, 1, 1, 1, 1, 1, 1)
  d <- c(3, 4, 5, 6, 7, 8, 9)
  df <- data.table("a" = c, "b" = c, "c" = c)
  options(warn = -1)
  expect_equal(Check_Dupe_Columns(df, c("a", "b", "c"), c(0, 0, 0), TRUE), c())
})
test_that("Duplicate with column not in df error", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(1, 1, 1, 1, 1, 1, 1)
  d <- c(3, 4, 5, 6, 7, 8, 9)
  df <- data.table("a" = c, "b" = c, "c" = c)
  options(warn = -1)
  expect_error(Check_Dupe_Columns(df, c("a", "b", "c", "e"), c(0, 0, 0, 0), TRUE))
  expect_error(Check_Dupe_Columns(df, c("a", "e", "c", "c"), c(0, 0, 0, 0), TRUE))
})

## ------------------------------------- ##
## LRT
## ------------------------------------- ##

test_that("Improve Ratio test", {
  a <- list("LogLik" = -400)
  b <- list("LogLik" = -350)
  expect_equal(Likelihood_Ratio_Test(b, a), 100)
})
test_that("Worse Ratio test", {
  a <- list("LogLik" = -300)
  b <- list("LogLik" = -350)
  expect_equal(Likelihood_Ratio_Test(b, a), -100)
})
test_that("Same Ratio test", {
  a <- list("LogLik" = -300)
  b <- list("LogLik" = -300)
  expect_equal(Likelihood_Ratio_Test(a, b), 0)
})
test_that("No Data Ratio test", {
  a <- list("baditem" = -300)
  b <- list("LogLik" = -300)
  expect_error(Likelihood_Ratio_Test(a, b))
})

## ------------------------------------- ##
## Interaction Terms
## ------------------------------------- ##

test_that("Iteract no dupes", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(0, 0, 0, 0, 0, 0, 0)
  df <- data.table("a" = c, "b" = c, "c" = c)
  interactions <- c("a?+?b", "a?*?b")
  new_names <- c("", "")
  expect_equal(interact_them(df, interactions, new_names, FALSE)$cols, c("a+b", "a*b"))
})
test_that("Iteract no dupes with rename", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(0, 0, 0, 0, 0, 0, 0)
  df <- data.table("a" = c, "b" = c, "c" = c)
  interactions <- c("a?+?b", "a?*?b")
  new_names <- c("", "formtemp")
  expect_equal(interact_them(df, interactions, new_names, FALSE)$cols, c("a+b", "formtemp"))
})
test_that("Iteract with direct dupes", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(0, 0, 0, 0, 0, 0, 0)
  df <- data.table("a" = c, "b" = c, "c" = c)
  interactions <- c("a?+?b", "a?*?b", "a?+?b", "a?+?a")
  new_names <- c("", "", "", "")
  expect_equal(interact_them(df, interactions, new_names, TRUE)$cols, c("a*b", "a+b", "a+a"))
})
test_that("Iteract with reverse dupes", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(0, 0, 0, 0, 0, 0, 0)
  df <- data.table("a" = c, "b" = c, "c" = c)
  interactions <- c("a?+?b", "a?*?b", "b?+?a", "a?+?a")
  new_names <- c("", "", "", "")
  expect_equal(interact_them(df, interactions, new_names, TRUE)$cols, c("a*b", "b+a", "a+a"))
})
test_that("Iteract formula long error", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(0, 0, 0, 0, 0, 0, 0)
  df <- data.table("a" = c, "b" = c, "c" = c)
  interactions <- c("a?+?b?+c", "a?*?b")
  new_names <- c("", "")
  expect_error(interact_them(df, interactions, new_names, TRUE))
})
test_that("Iteract formula operation error", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(0, 0, 0, 0, 0, 0, 0)
  df <- data.table("a" = c, "b" = c, "c" = c)
  interactions <- c("a?++?b", "a?*?b")
  new_names <- c("", "")
  expect_error(interact_them(df, interactions, new_names, TRUE))
})
test_that("Iteract formula operation error", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(0, 0, 0, 0, 0, 0, 0)
  df <- data.table("a" = c, "b" = c, "c" = c)
  interactions <- c("a?++?b", "a?*?b")
  new_names <- c("", "")
  expect_error(interact_them(df, interactions, new_names, FALSE))
})

#######################################
## Modelform Fixes
#######################################

test_that("Modelform Fixes Additives", {
  control <- list("verbose" = 0, "ncores" = 2, "lr" = 0.75, "maxiter" = 5, "ties" = "breslow", "double_step" = 1)
  control <- Def_Control(control)
  model_control <- list("single" = TRUE)
  model_control <- Def_model_control(model_control)
  term_n <- c(0, 1, 1)
  modelform <- "a"
  expect_equal(Def_modelform_fix(control, model_control, modelform, term_n)$modelform, "A")
  modelform <- "pa"
  expect_equal(Def_modelform_fix(control, model_control, modelform, term_n)$modelform, "PA")
  modelform <- "pae"
  expect_equal(Def_modelform_fix(control, model_control, modelform, term_n)$modelform, "PAE")
})
test_that("Modelform Fixes Additives", {
  control <- list("verbose" = 0, "ncores" = 2, "lr" = 0.75, "maxiter" = 5, "ties" = "breslow", "double_step" = 1)
  control <- Def_Control(control)
  model_control <- list("single" = TRUE)
  model_control <- Def_model_control(model_control)
  term_n <- c(0, 1, 1)
  modelform <- "m"
  expect_equal(Def_modelform_fix(control, model_control, modelform, term_n)$modelform, "M")
  modelform <- "me"
  expect_equal(Def_modelform_fix(control, model_control, modelform, term_n)$modelform, "M")
})
test_that("Modelform Fixes gmix", {
  control <- list("verbose" = 0, "ncores" = 2, "lr" = 0.75, "maxiter" = 5, "ties" = "breslow", "double_step" = 1, "verbose" = 0)
  control <- Def_Control(control)
  model_control <- list("single" = TRUE)
  model_control <- Def_model_control(model_control)
  term_n <- c(0, 1, 1)
  modelform <- "gmix-r"
  expect_equal(Def_modelform_fix(control, model_control, modelform, term_n)$modelform, "GMIX")
  modelform <- "gmix-e"
  expect_equal(Def_modelform_fix(control, model_control, modelform, term_n)$modelform, "GMIX")
  model_control$gmix_term <- c(1, 1)
  modelform <- "gmix"
  expect_equal(Def_modelform_fix(control, model_control, modelform, term_n)$modelform, "GMIX")
})

test_that("gmix error", {
  control <- list("verbose" = 0, "ncores" = 2, "lr" = 0.75, "maxiter" = 5, "ties" = "breslow", "double_step" = 1)
  control <- Def_Control(control)
  model_control <- list("single" = TRUE)
  model_control <- Def_model_control(model_control)
  term_n <- c(0, 1, 1)
  modelform <- "gmix"
  expect_error(Def_modelform_fix(control, model_control, modelform, term_n))
})

test_that("unused model formula error", {
  control <- list("verbose" = 0, "ncores" = 2, "lr" = 0.75, "maxiter" = 5, "ties" = "breslow", "double_step" = 1)
  control <- Def_Control(control)
  model_control <- list("single" = TRUE)
  model_control <- Def_model_control(model_control)
  term_n <- c(0, 1, 1)
  modelform <- "failing_choice"
  expect_error(Def_modelform_fix(control, model_control, modelform, term_n))
  modelform <- "ma"
  expect_error(Def_modelform_fix(control, model_control, modelform, term_n))
  modelform <- "ea"
  expect_error(Def_modelform_fix(control, model_control, modelform, term_n))
})

######################################
# FACTORING
######################################

test_that("Factorize factor", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(1, 1, 1, 1, 1, 1, 1)
  df <- data.table("a" = a, "b" = b, "c" = c)
  col_list <- c("c")
  expect_equal(factorize(df, col_list, TRUE)$cols, c("c_1"))
})
test_that("Factorize discrete", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(0, 0, 0, 0, 0, 0, 0)
  df <- data.table("a" = a, "b" = b, "c" = c)
  col_list <- c("a")
  expect_equal(factorize(df, col_list, TRUE)$cols, c("a_0", "a_1", "a_2", "a_3", "a_4", "a_5", "a_6"))
})
test_that("Factorize missing", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(0, 0, 0, 0, 0, 0, 0)
  df <- data.table("a" = a, "b" = b, "c" = c)
  col_list <- c("d")
  expect_error(factorize(df, col_list, TRUE))
})
test_that("Factorize survival lung, test", {
  data(cancer, package = "survival")
  col_list <- c("inst")
  expect_no_error(factorize(cancer, col_list, TRUE))
})


test_that("Factorize parallel factor", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(1, 1, 1, 1, 1, 1, 1)
  df <- data.table("a" = a, "b" = b, "c" = c)
  col_list <- c("c")
  expect_equal(factorize_par(df, col_list, TRUE, 2)$cols, c("c_1"))
})
test_that("Factorize parallel discrete", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(0, 0, 0, 0, 0, 0, 0)
  df <- data.table("a" = a, "b" = b, "c" = c)
  col_list <- c("a")
  expect_equal(factorize_par(df, col_list, TRUE, 2)$cols, c("a_0", "a_1", "a_2", "a_3", "a_4", "a_5", "a_6"))
})
test_that("Factorize parallel missing", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(0, 0, 0, 0, 0, 0, 0)
  df <- data.table("a" = a, "b" = b, "c" = c)
  col_list <- c("d")
  expect_error(factorize_par(df, col_list, TRUE, 2))
})



######################################
# Time Dependent Cov gens
######################################

test_that("Gen_time_dep time error", {
  a <- c(20, 20, 5, 10, 15)
  b <- c(1, 2, 1, 1, 2)
  c <- c(0, 0, 1, 1, 1)
  df <- data.table("a" = a, "b" = b, "c" = c)

  time1 <- "%trunc%"
  time2 <- "a_bad"
  event <- "c"
  control <- list("lr" = 0.75, "maxiter" = -1, "halfmax" = 5, "epsilon" = 1e-9, "deriv_epsilon" = 1e-9, "abs_max" = 1.0, "change_all" = TRUE, "dose_abs_max" = 100.0, "verbose" = 0, "ties" = "breslow", "double_step" = 1)
  grt_f <- function(df, time_col) {
    return((df[, "b"] * df[, get(time_col)])[[1]])
  }
  func_form <- c("lin")


  expect_error(gen_time_dep(df, time1, time2, event, TRUE, 0.01, c("grt"), c(), c(grt_f), paste("test", "_new.csv", sep = ""), func_form, 2))
})
test_that("Gen_time_dep event error", {
  a <- c(20, 20, 5, 10, 15)
  b <- c(1, 2, 1, 1, 2)
  c <- c(0, 0, 1, 1, 1)
  df <- data.table("a" = a, "b" = b, "c" = c)

  time1 <- "%trunc%"
  time2 <- "a"
  event <- "c_bad"
  control <- list("lr" = 0.75, "maxiter" = -1, "halfmax" = 5, "epsilon" = 1e-9, "deriv_epsilon" = 1e-9, "abs_max" = 1.0, "change_all" = TRUE, "dose_abs_max" = 100.0, "verbose" = 0, "ties" = "breslow", "double_step" = 1)
  grt_f <- function(df, time_col) {
    return((df[, "b"] * df[, get(time_col)])[[1]])
  }
  func_form <- c("lin")


  expect_error(gen_time_dep(df, time1, time2, event, TRUE, 0.01, c("grt"), c(), c(grt_f), paste("test", "_new.csv", sep = ""), func_form, 2))
})
test_that("Gen_time_dep function error", {
  a <- c(20, 20, 5, 10, 15)
  b <- c(1, 2, 1, 1, 2)
  c <- c(0, 0, 1, 1, 1)
  df <- data.table("a" = a, "b" = b, "c" = c)

  time1 <- "%trunc%"
  time2 <- "a"
  event <- "c_bad"
  control <- list("lr" = 0.75, "maxiter" = -1, "halfmax" = 5, "epsilon" = 1e-9, "deriv_epsilon" = 1e-9, "abs_max" = 1.0, "change_all" = TRUE, "dose_abs_max" = 100.0, "verbose" = 0, "ties" = "breslow", "double_step" = 1)
  grt_f <- function(df, time_col) {
    stop()
    return((df[, "b"] * df[, get(time_col)])[[1]])
  }
  func_form <- c("lin")


  expect_error(gen_time_dep(df, time1, time2, event, TRUE, 0.01, c("grt"), c(), c(grt_f), paste("test", "_new.csv", sep = ""), func_form, 2))
})
test_that("Gen_time_dep functional form error", {
  a <- c(20, 20, 5, 10, 15)
  b <- c(1, 2, 1, 1, 2)
  c <- c(0, 0, 1, 1, 1)
  df <- data.table("a" = a, "b" = b, "c" = c)

  time1 <- "%trunc%"
  time2 <- "a"
  event <- "c"
  control <- list("lr" = 0.75, "maxiter" = -1, "halfmax" = 5, "epsilon" = 1e-9, "deriv_epsilon" = 1e-9, "abs_max" = 1.0, "change_all" = TRUE, "dose_abs_max" = 100.0, "verbose" = 0, "ties" = "breslow", "double_step" = 1)
  grt_f <- function(df, time_col) {
    return((df[, "b"] * df[, get(time_col)])[[1]])
  }
  func_form <- c("badbad")


  expect_error(gen_time_dep(df, time1, time2, event, TRUE, 0.01, c("grt"), c(), c(grt_f), paste(tempfile(), "test", "_new.csv", sep = ""), func_form, 2))
})

test_that("Gen_time_dep no error lin cox", {
  a <- c(20, 20, 5, 10, 15)
  b <- c(1, 2, 1, 1, 2)
  c <- c(0, 0, 1, 1, 1)
  df <- data.table("a" = a, "b" = b, "c" = c)

  time1 <- "%trunc%"
  time2 <- "a"
  event <- "c"
  control <- list("lr" = 0.75, "maxiter" = -1, "halfmax" = 5, "epsilon" = 1e-9, "deriv_epsilon" = 1e-9, "abs_max" = 1.0, "change_all" = TRUE, "dose_abs_max" = 100.0, "verbose" = 0, "ties" = "breslow", "double_step" = 1)
  grt_f <- function(df, time_col) {
    return((df[, "b"] * df[, get(time_col)])[[1]])
  }
  func_form <- c("lin")


  expect_no_error(gen_time_dep(df, time1, time2, event, TRUE, 0.01, c("grt"), c(), c(grt_f), paste(tempfile(), "test", "_new", sep = ""), func_form, 2))
})
test_that("Gen_time_dep, error length names, tform, func_form", {
  a <- c(20, 20, 5, 10, 15)
  b <- c(1, 2, 1, 1, 2)
  c <- c(0, 0, 1, 1, 1)
  df <- data.table("a" = a, "b" = b, "c" = c)

  time1 <- "%trunc%"
  time2 <- "a"
  event <- "c"
  control <- list("lr" = 0.75, "maxiter" = -1, "halfmax" = 5, "epsilon" = 1e-9, "deriv_epsilon" = 1e-9, "abs_max" = 1.0, "change_all" = TRUE, "dose_abs_max" = 100.0, "verbose" = 0, "ties" = "breslow", "double_step" = 1)
  grt_f <- function(df, time_col) {
    return((df[, "b"] * df[, get(time_col)])[[1]])
  }
  func_form <- c("lin", "lin", "lin", "lin")


  expect_error(gen_time_dep(df, time1, time2, event, TRUE, 0.01, c("grt"), c(), c(grt_f), paste(tempfile(), "test", "_new.csv", sep = ""), func_form, 2))
  func_form <- c("lin")
  expect_error(gen_time_dep(df, time1, time2, event, TRUE, 0.01, c("grt"), c(), c(grt_f, grt_f, grt_f, grt_f), paste(tempfile(), "test", "_new.csv", sep = ""), func_form, 2))
})
test_that("Gen_time_dep no error step cox", {
  a <- c(20, 20, 5, 10, 15)
  b <- c(1, 2, 1, 1, 2)
  c <- c(0, 0, 1, 1, 1)
  df <- data.table("a" = a, "b" = b, "c" = c)

  time1 <- "%trunc%"
  time2 <- "a"
  event <- "c"
  control <- list("lr" = 0.75, "maxiter" = -1, "halfmax" = 5, "epsilon" = 1e-9, "deriv_epsilon" = 1e-9, "abs_max" = 1.0, "change_all" = TRUE, "dose_abs_max" = 100.0, "verbose" = 0, "ties" = "breslow", "double_step" = 1)
  grt_f <- function(df, time_col) {
    return((df[, "b"] * df[, get(time_col)])[[1]])
  }
  func_form <- c("step?0g?7l?12a?18b?")


  expect_no_error(gen_time_dep(df, time1, time2, event, TRUE, 0.01, c("grt"), c(), c(grt_f), paste(tempfile(), "test", "_new.csv", sep = ""), func_form, 2))
})

test_that("Gen_time_dep no error lin not cox", {
  a <- c(20, 20, 5, 10, 15)
  b <- c(1, 2, 1, 1, 2)
  c <- c(0, 0, 1, 1, 1)
  df <- data.table("a" = a, "b" = b, "c" = c)

  time1 <- "%trunc%"
  time2 <- "a"
  event <- "c"
  control <- list("lr" = 0.75, "maxiter" = -1, "halfmax" = 5, "epsilon" = 1e-9, "deriv_epsilon" = 1e-9, "abs_max" = 1.0, "change_all" = TRUE, "dose_abs_max" = 100.0, "verbose" = 0, "ties" = "breslow", "double_step" = 1)
  grt_f <- function(df, time_col) {
    return((df[, "b"] * df[, get(time_col)])[[1]])
  }
  func_form <- c("lin")


  expect_no_error(gen_time_dep(df, time1, time2, event, FALSE, 0.01, c("grt"), c(), c(grt_f), paste(tempfile(), "test", "_new.csv", sep = ""), func_form, 2))
})
test_that("Gen_time_dep no error step not cox", {
  a <- c(20, 20, 5, 10, 15)
  b <- c(1, 2, 1, 1, 2)
  c <- c(0, 0, 1, 1, 1)
  df <- data.table("a" = a, "b" = b, "c" = c)

  time1 <- "%trunc%"
  time2 <- "a"
  event <- "c"
  control <- list("lr" = 0.75, "maxiter" = -1, "halfmax" = 5, "epsilon" = 1e-9, "deriv_epsilon" = 1e-9, "abs_max" = 1.0, "change_all" = TRUE, "dose_abs_max" = 100.0, "verbose" = 0, "ties" = "breslow", "double_step" = 1)
  grt_f <- function(df, time_col) {
    return((df[, "b"] * df[, get(time_col)])[[1]])
  }
  func_form <- c("step?0g?7l?10u?12a?18b?")


  expect_no_error(gen_time_dep(df, time1, time2, event, FALSE, 0.01, c("grt"), c(), c(grt_f), paste(tempfile(), "test", "_new.csv", sep = ""), func_form, 2))
})

test_that("linked quad negative slope error", {
  tforms <- list("first" = "quad")
  paras <- list("first" = c(-0.1, 10))
  expect_error(Linked_Dose_Formula(tforms, paras, TRUE))
})
test_that("linked quad string slope error", {
  tforms <- list("first" = "quad")
  paras <- list("first" = c("a", 10))
  expect_error(Linked_Dose_Formula(tforms, paras, TRUE))
})
test_that("linked quad string threshold error", {
  tforms <- list("first" = "quad")
  paras <- list("first" = c(0.1, "a"))
  expect_error(Linked_Dose_Formula(tforms, paras, TRUE))
})
test_that("linked quad no error", {
  tforms <- list("first" = "quad")
  paras <- list("first" = c(0.1, 10))
  expect_no_error(Linked_Dose_Formula(tforms, paras, TRUE))
})
test_that("linked exp negative slope error", {
  tforms <- list("first" = "exp")
  paras <- list("first" = c(-0.1, 10, 5))
  expect_error(Linked_Dose_Formula(tforms, paras, TRUE))
})
test_that("linked exp string slope error", {
  tforms <- list("first" = "exp")
  paras <- list("first" = c("a", 10, 5))
  expect_error(Linked_Dose_Formula(tforms, paras, TRUE))
})
test_that("linked exp string threshold error", {
  tforms <- list("first" = "exp")
  paras <- list("first" = c(0.1, "a", 5))
  expect_error(Linked_Dose_Formula(tforms, paras, TRUE))
})
test_that("linked exp string exp slope error", {
  tforms <- list("first" = "exp")
  paras <- list("first" = c(0.1, 10, "a"))
  expect_error(Linked_Dose_Formula(tforms, paras, TRUE))
})
test_that("linked exp no error", {
  tforms <- list("first" = "exp")
  paras <- list("first" = c(0.1, 10, 5))
  expect_no_error(Linked_Dose_Formula(tforms, paras, TRUE))
})
test_that("linked formula combinations", {
  tforms <- list("first" = "quad")
  paras <- list("first" = c(0.1, 10))
  expect_error(Linked_Dose_Formula(tforms, paras, verbose = "p"))
  paras <- list("first" = c(0.1, "10"))
  expect_error(Linked_Dose_Formula(tforms, paras, TRUE))
  #
  tforms <- list("first" = "exp")
  paras <- list("first" = c(0.1, "10", 5))
  expect_error(Linked_Dose_Formula(tforms, paras, TRUE))
  paras <- list("first" = c(0.1, 10, "5"))
  expect_error(Linked_Dose_Formula(tforms, paras, TRUE))
})

test_that("linked exp parameter low goal error", {
  y <- 10
  a0 <- 1
  a_goal <- 5
  expect_error(Linked_Lin_Exp_Para(y, a0, a_goal, TRUE))
})
test_that("linked exp parameter negative slope error", {
  y <- 10
  a0 <- -0.1
  a_goal <- 5
  expect_error(Linked_Lin_Exp_Para(y, a0, a_goal, TRUE))
})
test_that("linked exp parameter no error", {
  y <- 10
  a0 <- 0.1
  a_goal <- 5
  expect_no_error(Linked_Lin_Exp_Para(y, a0, a_goal, TRUE))
})

test_that("Missing Value missing column error", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(1, 1, 1, 1, 1, 1, 1)
  d <- c(3, 4, 5, 6, 7, 8, 9)
  df <- data.table("a" = a, "b" = b, "c" = c, "d" = d)
  expect_error(Replace_Missing(df, c("a", "e"), 0.0, TRUE))
})
test_that("Missing Value NA replacement error", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(1, 1, 1, 1, 1, 1, 1)
  d <- c(3, 4, 5, 6, 7, 8, 9)
  df <- data.table("a" = a, "b" = b, "c" = c, "d" = d)
  expect_error(Replace_Missing(df, c("a", "b", "c", "d"), NA, TRUE))
})
test_that("Missing Value no error", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(1, 1, 1, 1, 1, 1, 1)
  d <- c(3, 4, 5, 6, 7, 8, 9)
  df <- data.table("a" = a, "b" = b, "c" = c, "d" = d)
  expect_no_error(Replace_Missing(df, c("a", "b", "c", "d"), 0.0, TRUE))
})
test_that("Missing Value checked replaced 0", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(NA, 0, 0, 1, 0, 0, 1)
  c <- c(1, 1, 1, 1, 1, 1, 1)
  d <- c(3, 4, 5, 6, 7, 8, 9)
  df <- data.table("a" = a, "b" = b, "c" = c, "d" = d)

  df0 <- Replace_Missing(df, c("a", "b"), 0.0, TRUE)
  expect_equal(c(sum(df0$a), sum(df0$b)), c(sum(df$a), 2))
})
test_that("Missing Value checked replaced 1", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(NA, 0, 0, 1, 0, 0, 1)
  c <- c(1, 1, 1, 1, 1, 1, 1)
  d <- c(3, 4, 5, 6, 7, 8, 9)
  df <- data.table("a" = a, "b" = b, "c" = c, "d" = d)

  df0 <- Replace_Missing(df, c("a", "b"), 1.0, TRUE)
  expect_equal(c(sum(df0$a), sum(df0$b)), c(sum(df$a), 3))
})
test_that("Missing Value verbose error", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(1, 1, 1, 1, 1, 1, 1)
  d <- c(3, 4, 5, 6, 7, 8, 9)
  df <- data.table("a" = a, "b" = b, "c" = c, "d" = d)
  expect_no_error(Replace_Missing(df, c("a", "b", "c", "d"), 0.0, TRUE))
  expect_error(Replace_Missing(df, c("a", "b", "c", "d"), 0.0, -1))
})

# test_that( "Check Date Shift", {
#     m0 <- c(1,1,2,2)
#     m1 <- c(2,2,3,3)
#     d0 <- c(1,2,3,4)
#     d1 <- c(6,7,8,9)
#     y0 <- c(1990,1991,1997,1998)
#     y1 <- c(2001,2003,2005,2006)
#     df <- data.table( "m0"=m0, "m1"=m1, "d0"=d0, "d1"=d1, "y0"=y0, "y1"=y1)
#     expect_no_error(Date_Shift(df,c( "m0", "d0", "y0" ),c( "m1", "d1", "y1" ), "date_since" ))
# })
test_that("Check Date Shift, exact value", {
  m0 <- c(1, 1, 2, 2)
  m1 <- c(2, 2, 3, 3)
  d0 <- c(1, 2, 3, 4)
  d1 <- c(6, 7, 8, 9)
  y0 <- c(1990, 1991, 1997, 1998)
  y1 <- c(2001, 2003, 2005, 2006)
  df <- data.table("m0" = m0, "m1" = m1, "d0" = d0, "d1" = d1, "y0" = y0, "y1" = y1)
  e <- Date_Shift(df, c("m0", "d0", "y0"), c("m1", "d1", "y1"), "date_since")
  expect_equal(as.numeric(e$date_since), c(4054, 4419, 2955, 2955))
})

# test_that( "Check Date Since", {
#     m0 <- c(1,1,2,2)
#     m1 <- c(2,2,3,3)
#     d0 <- c(1,2,3,4)
#     d1 <- c(6,7,8,9)
#     y0 <- c(1990,1991,1997,1998)
#     y1 <- c(2001,2003,2005,2006)
#     df <- data.table( "m0"=m0, "m1"=m1, "d0"=d0, "d1"=d1, "y0"=y0, "y1"=y1)
#     tref <- strptime( "3-22-1997", format = "%m-%d-%Y",tz = 'UTC' )
#     expect_no_error(Time_Since(df,c( "m1", "d1", "y1" ),tref, "date_since" ))
# })
test_that("Check Date Since", {
  m0 <- c(1, 1, 2, 2)
  m1 <- c(2, 2, 3, 3)
  d0 <- c(1, 2, 3, 4)
  d1 <- c(6, 7, 8, 9)
  y0 <- c(1990, 1991, 1997, 1998)
  y1 <- c(2001, 2003, 2005, 2006)
  df <- data.table("m0" = m0, "m1" = m1, "d0" = d0, "d1" = d1, "y0" = y0, "y1" = y1)
  tref <- "3-22-1997"
  expect_error(Time_Since(df, c("m1", "d1", "y1"), tref, "date_since"))
})
test_that("Check Date Since, exact value", {
  m0 <- c(1, 1, 2, 2)
  m1 <- c(2, 2, 3, 3)
  d0 <- c(1, 2, 3, 4)
  d1 <- c(6, 7, 8, 9)
  y0 <- c(1990, 1991, 1997, 1998)
  y1 <- c(2001, 2003, 2005, 2006)
  df <- data.table("m0" = m0, "m1" = m1, "d0" = d0, "d1" = d1, "y0" = y0, "y1" = y1)
  tref <- strptime("3-22-1997", format = "%m-%d-%Y", tz = "UTC")
  e <- Time_Since(df, c("m1", "d1", "y1"), tref, "date_since")
  expect_equal(as.numeric(e$date_since), c(1417, 2148, 2908, 3274))
})


#####################################
# Formula order
#####################################
test_that("tform order, tform order", {
  term_n <- c(0, 0, 0, 0, 0)
  tform <- c("loglin", "quad_slope", "lin", "lin_int", "lin_slope")
  keep_constant <- c(0, 0, 0, 0, 0)
  a_n <- c(1, 2, 3, 4, 5)
  names <- c("a", "a", "a", "a", "a")
  val <- Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE)
  term_n <- val$term_n
  tform <- val$tform
  keep_constant <- val$keep_constant
  a_n <- val$a_n
  names <- val$names
  expect_equal(a_n, c(1, 3, 5, 4, 2))
})
test_that("tform order, tform and term_n order", {
  term_n <- c(0, 1, 2, 0, 0)
  tform <- c("loglin", "quad_slope", "lin", "lin_int", "lin_slope")
  keep_constant <- c(0, 0, 0, 0, 0)
  a_n <- c(1, 2, 3, 4, 5)
  names <- c("a", "a", "a", "a", "a")
  val <- Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE)
  term_n <- val$term_n
  tform <- val$tform
  keep_constant <- val$keep_constant
  a_n <- val$a_n
  names <- val$names
  expect_equal(a_n, c(1, 5, 4, 2, 3))
})
test_that("tform order, combined", {
  term_n <- c(0, 1, 1, 0, 0)
  tform <- c("loglin", "quad_slope", "lin", "lin_int", "lin_slope")
  keep_constant <- c(0, 0, 0, 1, 0)
  a_n <- c(1, 2, 3, 4, 5)
  names <- c("a", "a", "a", "a", "a")
  val <- Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE)
  term_n <- val$term_n
  tform <- val$tform
  keep_constant <- val$keep_constant
  a_n <- val$a_n
  names <- val$names
  expect_equal(a_n, c(1, 5, 4, 3, 2))
})
test_that("tform order, tform order, list single", {
  term_n <- c(0, 0, 0, 0, 0)
  tform <- c("loglin", "quad_slope", "lin", "lin_int", "lin_slope")
  keep_constant <- c(0, 0, 0, 0, 0)
  a_n <- list(c(1, 2, 3, 4, 5))
  names <- c("a", "a", "a", "a", "a")
  val <- Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE)
  term_n <- val$term_n
  tform <- val$tform
  keep_constant <- val$keep_constant
  a_n <- val$a_n
  names <- val$names
  expect_equal(a_n, c(1, 3, 5, 4, 2))
})
test_that("tform order, tform and term_n order, list single", {
  term_n <- c(0, 1, 2, 0, 0)
  tform <- c("loglin", "quad_slope", "lin", "lin_int", "lin_slope")
  keep_constant <- c(0, 0, 0, 0, 0)
  a_n <- list(c(1, 2, 3, 4, 5))
  names <- c("a", "a", "a", "a", "a")
  val <- Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE)
  term_n <- val$term_n
  tform <- val$tform
  keep_constant <- val$keep_constant
  a_n <- val$a_n
  names <- val$names
  expect_equal(a_n, c(1, 5, 4, 2, 3))
})
test_that("tform order, combined, list single", {
  term_n <- c(0, 1, 1, 0, 0)
  tform <- c("loglin", "quad_slope", "lin", "lin_int", "lin_slope")
  keep_constant <- c(0, 0, 0, 1, 0)
  a_n <- list(c(1, 2, 3, 4, 5))
  names <- c("a", "a", "a", "a", "a")
  val <- Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE)
  term_n <- val$term_n
  tform <- val$tform
  keep_constant <- val$keep_constant
  a_n <- val$a_n
  names <- val$names
  expect_equal(a_n, c(1, 5, 4, 3, 2))
})
test_that("formula order, too few parameters", {
  term_n <- c(0, 1, 1, 0, 0)
  tform <- c("loglin", "quad_slope", "lin", "lin_int", "lin_slope")
  keep_constant <- c(0, 0, 0, 1, 0)
  a_n <- c(1, 2, 3, 4)
  names <- c("a", "a", "a", "a", "a")
  options(warn = -1)
  expect_no_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE))
})
test_that("formula order, no free", {
  term_n <- c(0, 1, 1, 0, 0)
  tform <- c("loglin", "quad_slope", "lin", "lin_int", "lin_slope")
  keep_constant <- c(1, 1, 1, 1, 1)
  a_n <- c(1, 2, 3, 4, 5, 6)
  names <- c("a", "a", "a", "a", "a")
  expect_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE))
})
test_that("formula order, too many parameters", {
  term_n <- c(0, 1, 1, 0, 0)
  tform <- c("loglin", "quad_slope", "lin", "lin_int", "lin_slope")
  keep_constant <- c(0, 0, 0, 1, 0)
  a_n <- c(1, 2, 3, 4, 5, 6)
  names <- c("a", "a", "a", "a", "a")
  expect_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE))
})
test_that("formula order, too few term numbers", {
  term_n <- c(0, 1, 1, 0)
  tform <- c("loglin", "quad_slope", "lin", "lin_int", "lin_slope")
  keep_constant <- c(0, 0, 0, 1, 0)
  a_n <- c(1, 2, 3, 4, 5)
  names <- c("a", "a", "a", "a", "a")
  options(warn = -1)
  expect_no_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE))
})
test_that("formula order, too many term numbers", {
  term_n <- c(0, 1, 1, 0, 0, 1)
  tform <- c("loglin", "quad_slope", "lin", "lin_int", "lin_slope")
  keep_constant <- c(0, 0, 0, 1, 0)
  a_n <- c(1, 2, 3, 4, 5)
  names <- c("a", "a", "a", "a", "a")
  options(warn = -1)
  expect_no_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE))
})
test_that("formula order, too few term types", {
  term_n <- c(1, 1, 0, 0, 0)
  tform <- c("quad_slope", "lin", "lin_int", "lin_slope")
  keep_constant <- c(0, 0, 1, 0, 0)
  a_n <- c(1, 2, 3, 4, 5)
  names <- c("a", "a", "a", "a", "a")
  options(warn = -1)
  expect_no_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE))
})
test_that("formula order, too many term types", {
  term_n <- c(0, 1, 1, 0, 0)
  tform <- c("loglin", "quad_slope", "lin", "lin_int", "lin_slope", "lin")
  keep_constant <- c(0, 0, 0, 1, 0)
  a_n <- c(1, 2, 3, 4, 5)
  names <- c("a", "a", "a", "a", "a")
  options(warn = -1)
  expect_no_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE))
})

test_that("formula order, missing lin_int", {
  term_n <- c(0, 1, 1, 0, 0)
  tform <- c("loglin", "quad_slope", "lin", "lin_slope", "lin")
  keep_constant <- c(0, 0, 0, 1, 0)
  a_n <- c(1, 2, 3, 4, 5)
  names <- c("a", "a", "a", "a", "a")
  expect_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE))
})
test_that("formula order, missing step_int", {
  term_n <- c(0, 1, 1, 0, 0)
  tform <- c("loglin", "quad_slope", "lin", "step_slope", "lin")
  keep_constant <- c(0, 0, 0, 1, 0)
  a_n <- c(1, 2, 3, 4, 5)
  names <- c("a", "a", "a", "a", "a")
  expect_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE))
})
test_that("formula order, missing loglin_top", {
  term_n <- c(0, 1, 1, 0, 0)
  tform <- c("loglin", "quad_slope", "lin", "loglin_slope", "lin")
  keep_constant <- c(0, 0, 0, 1, 0)
  a_n <- c(1, 2, 3, 4, 5)
  names <- c("a", "a", "a", "a", "a")
  expect_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE))
})
test_that("formula order, missing lin_quad_slope", {
  term_n <- c(0, 1, 1, 0, 0)
  tform <- c("loglin", "quad_slope", "lin", "lin_quad_slope", "lin")
  keep_constant <- c(0, 0, 0, 1, 0)
  a_n <- c(1, 2, 3, 4, 5)
  names <- c("a", "a", "a", "a", "a")
  expect_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE))
})
test_that("formula order, missing lin_exp_int", {
  term_n <- c(0, 1, 1, 0, 0)
  tform <- c("loglin", "quad_slope", "lin", "lin_exp_slope", "lin_exp_exp_slope")
  keep_constant <- c(0, 0, 0, 1, 0)
  a_n <- c(1, 2, 3, 4, 5)
  names <- c("a", "a", "a", "a", "a")
  expect_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE))
})
test_that("formula order, missing lin_exp_exp_slope", {
  term_n <- c(0, 1, 1, 0, 0)
  tform <- c("loglin", "quad_slope", "lin", "lin_exp_slope", "lin_exp_int")
  keep_constant <- c(0, 0, 0, 1, 0)
  a_n <- c(1, 2, 3, 4, 5)
  names <- c("a", "a", "a", "a", "a")
  expect_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE))
})

test_that("formula order, missing step_slope", {
  term_n <- c(0, 1, 1, 0, 0)
  tform <- c("loglin", "quad_slope", "lin", "step_int", "lin")
  keep_constant <- c(0, 0, 0, 1, 0)
  a_n <- c(1, 2, 3, 4, 5)
  names <- c("a", "a", "a", "a", "a")
  expect_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE))
})
test_that("formula order, missing lin_slope", {
  term_n <- c(0, 1, 1, 0, 0)
  tform <- c("loglin", "quad_slope", "lin", "lin_int", "lin")
  keep_constant <- c(0, 0, 0, 1, 0)
  a_n <- c(1, 2, 3, 4, 5)
  names <- c("a", "a", "a", "a", "a")
  expect_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE))
})
test_that("formula order, missing lin_quad_slope", {
  term_n <- c(0, 1, 1, 0, 0)
  tform <- c("loglin", "quad_slope", "lin", "lin_quad_int", "lin")
  keep_constant <- c(0, 0, 0, 1, 0)
  a_n <- c(1, 2, 3, 4, 5)
  names <- c("a", "a", "a", "a", "a")
  expect_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE))
})
test_that("formula order, missing lin_exp_slope", {
  term_n <- c(0, 1, 1, 0, 0)
  tform <- c("loglin", "quad_slope", "lin", "lin_exp_int", "lin_exp_exp_slope")
  keep_constant <- c(0, 0, 0, 1, 0)
  a_n <- c(1, 2, 3, 4, 5)
  names <- c("a", "a", "a", "a", "a")
  expect_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE))
})
test_that("formula order, missing lin_exp_exp_int", {
  term_n <- c(0, 1, 1, 0, 0)
  tform <- c("loglin", "quad_slope", "lin", "lin_exp_slope", "lin_exp_exp_slope")
  keep_constant <- c(0, 0, 0, 1, 0)
  a_n <- c(1, 2, 3, 4, 5)
  names <- c("a", "a", "a", "a", "a")
  expect_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE))
})

#####################################
# Formula order, List a_n
#####################################
test_that("tform order, tform order, list double", {
  term_n <- c(0, 0, 0, 0, 0)
  tform <- c("loglin", "quad_slope", "lin", "lin_int", "lin_slope")
  keep_constant <- c(0, 0, 0, 0, 0)
  a_n <- list(c(1, 2, 3, 4, 5), c(2, 3, 4, 5, 6))
  names <- c("a", "a", "a", "a", "a")
  val <- Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE)
  term_n <- val$term_n
  tform <- val$tform
  keep_constant <- val$keep_constant
  a_n <- val$a_n
  names <- val$names
  expect_equal(a_n, list(c(1, 3, 5, 4, 2), c(2, 4, 6, 5, 3)))
})
test_that("tform order, tform and term_n order, list double", {
  term_n <- c(0, 1, 2, 0, 0)
  tform <- c("loglin", "quad_slope", "lin", "lin_int", "lin_slope")
  keep_constant <- c(0, 0, 0, 0, 0)
  a_n <- list(c(1, 2, 3, 4, 5), c(2, 3, 4, 5, 6))
  names <- c("a", "a", "a", "a", "a")
  val <- Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE)
  term_n <- val$term_n
  tform <- val$tform
  keep_constant <- val$keep_constant
  a_n <- val$a_n
  names <- val$names
  expect_equal(a_n, list(c(1, 5, 4, 2, 3), c(2, 6, 5, 3, 4)))
})
test_that("tform order, combined, list double", {
  term_n <- c(0, 1, 1, 0, 0)
  tform <- c("loglin", "quad_slope", "lin", "lin_int", "lin_slope")
  keep_constant <- c(0, 0, 0, 1, 0)
  a_n <- list(c(1, 2, 3, 4, 5), c(2, 3, 4, 5, 6))
  names <- c("a", "a", "a", "a", "a")
  val <- Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE)
  term_n <- val$term_n
  tform <- val$tform
  keep_constant <- val$keep_constant
  a_n <- val$a_n
  names <- val$names
  expect_equal(a_n, list(c(1, 5, 4, 3, 2), c(2, 6, 5, 4, 3)))
})
test_that("formula order, different parameter lengths, list double", {
  term_n <- c(0, 1, 1, 0, 0)
  tform <- c("loglin", "quad_slope", "lin", "lin_int", "lin_slope")
  keep_constant <- c(0, 0, 0, 1, 0)
  a_n <- list(c(1, 2, 3, 4, 5), c(2, 3, 4, 5))
  names <- c("a", "a", "a", "a", "a")
  expect_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE))
})
test_that("formula order, too few parameters, list double", {
  term_n <- c(0, 1, 1, 0, 0)
  tform <- c("loglin", "quad_slope", "lin", "lin_int", "lin_slope")
  keep_constant <- c(0, 0, 0, 1, 0)
  a_n <- list(c(1, 2, 3, 4), c(2, 3, 4, 5))
  names <- c("a", "a", "a", "a", "a")
  options(warn = -1)
  expect_no_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE))
})
test_that("formula order, too many parameters, list double", {
  term_n <- c(0, 1, 1, 0, 0)
  tform <- c("loglin", "quad_slope", "lin", "lin_int", "lin_slope")
  keep_constant <- c(0, 0, 0, 1, 0)
  a_n <- list(c(1, 2, 3, 4, 5, 6), c(2, 3, 4, 5, 6, 7))
  names <- c("a", "a", "a", "a", "a")
  expect_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE))
})
test_that("formula order, too few term numbers, list double", {
  term_n <- c(0, 1, 1, 0)
  tform <- c("loglin", "quad_slope", "lin", "lin_int", "lin_slope")
  keep_constant <- c(0, 0, 0, 1, 0)
  a_n <- list(c(1, 2, 3, 4, 5), c(2, 3, 4, 5, 6))
  names <- c("a", "a", "a", "a", "a")
  options(warn = -1)
  expect_no_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE))
})
test_that("formula order, too many term numbers, list double", {
  term_n <- c(0, 1, 1, 0, 0, 1)
  tform <- c("loglin", "quad_slope", "lin", "lin_int", "lin_slope")
  keep_constant <- c(0, 0, 0, 1, 0)
  a_n <- list(c(1, 2, 3, 4, 5), c(2, 3, 4, 5, 6))
  names <- c("a", "a", "a", "a", "a")
  options(warn = -1)
  expect_no_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE))
})
test_that("formula order, too few term types, list double", {
  term_n <- c(1, 1, 0, 0, 0)
  tform <- c("quad_slope", "lin", "lin_int", "lin_slope")
  keep_constant <- c(0, 0, 1, 0, 0)
  a_n <- list(c(1, 2, 3, 4, 5), c(2, 3, 4, 5, 6))
  names <- c("a", "a", "a", "a", "a")
  options(warn = -1)
  expect_no_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE))
})
test_that("formula order, too many term types, list double", {
  term_n <- c(0, 1, 1, 0, 0)
  tform <- c("loglin", "quad_slope", "lin", "lin_int", "lin_slope", "lin")
  keep_constant <- c(0, 0, 0, 1, 0)
  a_n <- list(c(1, 2, 3, 4, 5), c(2, 3, 4, 5, 6))
  names <- c("a", "a", "a", "a", "a")
  options(warn = -1)
  expect_no_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE))
})
#####################################
# Formula order, Constraints and verbose check
#####################################
test_that("Checking constraint matrix", {
  term_n <- c(0, 1, 1, 0, 0)
  tform <- c("loglin", "quad_slope", "lin", "lin_int", "lin_slope")
  keep_constant <- c(0, 0, 0, 1, 0)
  a_n <- list(c(1, 2, 3, 4, 5))
  names <- c("a", "a", "a", "a", "a")
  cons_mat <- matrix(c(1:12), nrow = 3, byrow = TRUE)
  cons_vec <- c(1, 0, -1)

  val <- Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, cons_mat, cons_vec)
  cons_mat <- val$cons_mat

  expect_equal(cons_mat[1, ], c(1, 4, 3, 2))
  expect_equal(cons_mat[, 3], c(3, 7, 11))
})
test_that("Checking verbose", {
  term_n <- c(0, 1, 1, 0, 0)
  tform <- c("loglin", "quad_slope", "lin", "lin_int", "lin_slope")
  keep_constant <- c(0, 0, 0, 1, 0)
  a_n <- list(c(1, 2, 3, 4, 5))
  names <- c("a", "a", "a", "a", "a")
  cons_mat <- matrix(c(1:12), nrow = 3, byrow = TRUE)
  cons_vec <- c(1, 0, -1)

  expect_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, cons_mat, cons_vec, verbose = -1))
  expect_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, cons_mat, cons_vec, verbose = 5))
  expect_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, cons_mat, cons_vec, verbose = "bad"))

  expect_no_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, cons_mat, cons_vec, verbose = TRUE))
  expect_no_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, cons_mat, cons_vec, verbose = FALSE))
  expect_no_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, cons_mat, cons_vec, verbose = 4))
  expect_no_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, cons_mat, cons_vec, verbose = 3))
  expect_no_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, cons_mat, cons_vec, verbose = 2))
  expect_no_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, cons_mat, cons_vec, verbose = 1))
  expect_no_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, cons_mat, cons_vec, verbose = 0))
})
test_that("Checking keep_constant limits", {
  term_n <- c(0, 1, 1, 0, 0)
  tform <- c("loglin", "quad_slope", "lin", "lin_int", "lin_slope")
  keep_constant <- c(0, 0, 0, 1, 0)
  a_n <- list(c(1, 2, 3, 4, 5), c(2, 3, 4, 5, 6))
  names <- c("a", "a", "a", "a", "a")
  keep_constant <- c(0, 0, 0, -1, 0)
  expect_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE))
  keep_constant <- c(0, 0, 0, 10, 0)
  expect_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE))
  keep_constant <- c(0, 0, 0, 1, 0.5)
  expect_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE))
})
test_that("Checking term_n limits", {
  term_n <- c(0, 1, 1, 0, 0)
  tform <- c("loglin", "loglin", "loglin", "loglin", "loglin")
  keep_constant <- c(0, 0, 0, 1, 0)
  a_n <- list(c(1, 2, 3, 4, 5), c(2, 3, 4, 5, 6))
  names <- c("a", "a", "a", "a", "a")
  term_n <- c(0, 0, 0, -1, 0)
  options(warn = -1)
  expect_no_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE))
  term_n <- c(0, 0, 0, 1, 0.5)
  expect_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE))
  term_n <- c(0, 1, 1, 1, 3)
  expect_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE))
})
test_that("Checking tform values", {
  term_n <- c(0, 1, 1, 0, 0)
  tform <- c("loglin", "loglin", "loglin", "loglin", "loglin")
  keep_constant <- c(0, 0, 0, 1, 0)
  a_n <- list(c(1, 2, 3, 4, 5), c(2, 3, 4, 5, 6))
  names <- c("a", "a", "a", "a", "a")
  term_n <- c(0, 0, 0, -1, 0)
  options(warn = -1)
  tform <- c("loglin", "fake", "loglin", "loglin", "loglin")
  expect_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE))
  tform <- c("loglin", "fake", "bad", "loglin", "loglin")
  expect_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE))
})
test_that("tform order, matrix errors", {
  term_n <- c(0, 0, 0, 0, 0)
  tform <- c("loglin", "quad_slope", "lin", "lin_int", "lin_slope")
  keep_constant <- c(0, 0, 0, 0, 0)
  a_n <- c(1, 2, 3, 4, 5)
  names <- c("a", "a", "a", "a", "a")
  cons_mat <- matrix(c(1, 2, 3, 4, 5), nrow = 1, byrow = TRUE)
  cons_vec <- c(1)

  expect_no_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, cons_mat, cons_vec))
  cons_mat <- matrix(c(1, 2, 3), nrow = 1, byrow = TRUE)
  expect_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, cons_mat, cons_vec))
  cons_mat <- matrix(c(1, 2, 3, 4, 5), nrow = 1, byrow = TRUE)
  cons_vec <- c(1, 1, 1)
  expect_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, cons_mat, cons_vec))
})
test_that("tform order, keep_constant errors", {
  term_n <- c(0, 0, 0, 0, 0)
  tform <- c("loglin", "quad_slope", "lin", "lin_int", "lin_slope")
  keep_constant <- c(0, 0, 0)
  a_n <- c(1, 2, 3, 4, 5)
  names <- c("a", "a", "a", "a", "a")
  cons_mat <- matrix(c(1, 2, 3, 4, 5), nrow = 1, byrow = TRUE)
  cons_vec <- c(1)
  expect_no_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, cons_mat, cons_vec))
  keep_constant <- c(0, 0, 0, 0, 0, 0, 0, 0)
  expect_no_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, cons_mat, cons_vec))
  #
  keep_constant <- c(0, 0, 0)
  a_n <- list(c(1, 2, 3, 4, 5), c(4, 2, 3, 4, 5), c(1, 2, 7, 4, 5))
  names <- c("a", "a", "a", "a", "a")
  cons_mat <- matrix(c(1, 2, 3, 4, 5), nrow = 1, byrow = TRUE)
  cons_vec <- c(1)
  expect_no_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, cons_mat, cons_vec))
  keep_constant <- c(0, 0, 0, 0, 0, 0, 0, 0)
  expect_no_error(Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, cons_mat, cons_vec))
})

# ------------------------------------- ##
# gather guesses
# ------------------------------------- ##
test_that("Gather Guesses no error", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(0, 1, 0, 0, 0, 1, 0)
  d <- c(3, 4, 5, 6, 7, 8, 9)
  df <- data.table("a" = a, "b" = b, "c" = c, "d" = d)
  time1 <- "a"
  time2 <- "b"
  event <- "c"
  names <- c("d", "d", "d", "d")
  term_n <- c(0, 0, 0, 0)
  tform <- c("loglin", "lin_exp_int", "lin_exp_slope", "lin_exp_exp_slope")
  keep_constant <- c(0, 0, 0, 0)
  a_n <- c(-0.1, 6, -0.1, 0.1)
  a_n_default <- a_n
  modelform <- "M"

  options(warn = -1)
  val <- Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE)
  term_n <- val$term_n
  tform <- val$tform
  keep_constant <- val$keep_constant
  a_n <- val$a_n
  names <- val$names

  control <- list("ncores" = 2, "lr" = 0.75, "maxiter" = -1, "halfmax" = 5, "epsilon" = 1e-9, "deriv_epsilon" = 1e-9, "abs_max" = 1.0, "change_all" = TRUE, "dose_abs_max" = 100.0, "verbose" = 0, "ties" = "breslow", "double_step" = 1)
  guesses_control <- list()
  model_control <- list()

  all_names <- unique(names(df))

  dfc <- match(names, all_names)

  term_tot <- max(term_n) + 1
  x_all <- as.matrix(df[, all_names, with = FALSE])

  control <- Def_Control(control)
  guesses_control <- Def_Control_Guess(guesses_control, a_n)
  model_control <- Def_model_control(model_control)

  expect_no_error(Gather_Guesses_CPP(df, dfc, names, term_n, tform, keep_constant, a_n, x_all, a_n_default, modelform, control, guesses_control))
  guesses_control$rmin <- c(-0.1, -1, -0.1, 0)
  guesses_control$rmax <- c(0.1, 1, 0.1, 0.1)
  expect_no_error(Gather_Guesses_CPP(df, dfc, names, term_n, tform, keep_constant, a_n, x_all, a_n_default, modelform, control, guesses_control))
})
test_that("Gather Guesses error, many a_n", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(0, 1, 0, 0, 0, 1, 0)
  d <- c(3, 4, 5, 6, 7, 8, 9)
  df <- data.table("a" = a, "b" = b, "c" = c, "d" = d)
  time1 <- "a"
  time2 <- "b"
  event <- "c"
  names <- c("d", "d", "d", "d")
  term_n <- c(0, 0, 0, 0)
  tform <- c("loglin", "lin_exp_int", "lin_exp_slope", "lin_exp_exp_slope")
  keep_constant <- c(0, 0, 0, 0)
  a_n <- c(-0.1, 6, -0.1, 0.1)
  a_n_default <- a_n
  modelform <- "M"


  val <- Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE)
  term_n <- val$term_n
  tform <- val$tform
  keep_constant <- val$keep_constant
  a_n <- val$a_n
  names <- val$names

  control <- list("ncores" = 2, "lr" = 0.75, "maxiter" = -1, "halfmax" = 5, "epsilon" = 1e-9, "deriv_epsilon" = 1e-9, "abs_max" = 1.0, "change_all" = TRUE, "dose_abs_max" = 100.0, "verbose" = 0, "ties" = "breslow", "double_step" = 1)
  guesses_control <- list()
  model_control <- list()
  a_n <- c(-0.1, 6, -0.1, 0.1, 1, 1, 1)
  a_n_default <- a_n

  all_names <- unique(names(df))

  dfc <- match(names, all_names)

  term_tot <- max(term_n) + 1
  x_all <- as.matrix(df[, all_names, with = FALSE])

  control <- Def_Control(control)
  guesses_control <- Def_Control_Guess(guesses_control, a_n)
  model_control <- Def_model_control(model_control)

  expect_error(Gather_Guesses_CPP(df, dfc, names, term_n, tform, keep_constant, a_n, x_all, a_n_default, modelform, control, guesses_control))
})
test_that("Gather Guesses error, few term numbers", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(0, 1, 0, 0, 0, 1, 0)
  d <- c(3, 4, 5, 6, 7, 8, 9)
  df <- data.table("a" = a, "b" = b, "c" = c, "d" = d)
  time1 <- "a"
  time2 <- "b"
  event <- "c"
  names <- c("d", "d", "d", "d")
  term_n <- c(0, 0, 0, 0)
  tform <- c("loglin", "lin_exp_int", "lin_exp_slope", "lin_exp_exp_slope")
  keep_constant <- c(0, 0, 0, 0)
  a_n <- c(-0.1, 6, -0.1, 0.1)
  a_n_default <- a_n
  modelform <- "M"


  val <- Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE)
  term_n <- val$term_n
  tform <- val$tform
  keep_constant <- val$keep_constant
  a_n <- val$a_n
  names <- val$names

  control <- list("ncores" = 2, "lr" = 0.75, "maxiter" = -1, "halfmax" = 5, "epsilon" = 1e-9, "deriv_epsilon" = 1e-9, "abs_max" = 1.0, "change_all" = TRUE, "dose_abs_max" = 100.0, "verbose" = 0, "ties" = "breslow", "double_step" = 1)
  guesses_control <- list()
  model_control <- list()

  all_names <- unique(names(df))

  dfc <- match(names, all_names)
  term_n <- c(0)

  term_tot <- max(term_n) + 1
  x_all <- as.matrix(df[, all_names, with = FALSE])

  control <- Def_Control(control)
  guesses_control <- Def_Control_Guess(guesses_control, a_n)
  model_control <- Def_model_control(model_control)

  options(warn = -1)
  expect_no_error(Gather_Guesses_CPP(df, dfc, names, term_n, tform, keep_constant, a_n, x_all, a_n_default, modelform, control, guesses_control))
})
test_that("Gather Guesses error, many term numbers", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(0, 1, 0, 0, 0, 1, 0)
  d <- c(3, 4, 5, 6, 7, 8, 9)
  df <- data.table("a" = a, "b" = b, "c" = c, "d" = d)
  time1 <- "a"
  time2 <- "b"
  event <- "c"
  names <- c("d", "d", "d", "d")
  term_n <- c(0, 0, 0, 0)
  tform <- c("loglin", "lin_exp_int", "lin_exp_slope", "lin_exp_exp_slope")
  keep_constant <- c(0, 0, 0, 0)
  a_n <- c(-0.1, 6, -0.1, 0.1)
  a_n_default <- a_n
  modelform <- "M"


  val <- Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE)
  term_n <- val$term_n
  tform <- val$tform
  keep_constant <- val$keep_constant
  a_n <- val$a_n
  names <- val$names

  control <- list("ncores" = 2, "lr" = 0.75, "maxiter" = -1, "halfmax" = 5, "epsilon" = 1e-9, "deriv_epsilon" = 1e-9, "abs_max" = 1.0, "change_all" = TRUE, "dose_abs_max" = 100.0, "verbose" = 0, "ties" = "breslow", "double_step" = 1)
  guesses_control <- list()
  model_control <- list()
  term_n <- c(0, 0, 0, 0, 0, 0, 0, 0)

  all_names <- unique(names(df))

  dfc <- match(names, all_names)

  term_tot <- max(term_n) + 1
  x_all <- as.matrix(df[, all_names, with = FALSE])

  control <- Def_Control(control)
  guesses_control <- Def_Control_Guess(guesses_control, a_n)
  model_control <- Def_model_control(model_control)

  options(warn = -1)
  expect_no_error(Gather_Guesses_CPP(df, dfc, names, term_n, tform, keep_constant, a_n, x_all, a_n_default, modelform, control, guesses_control))
})
test_that("Gather Guesses error, few term formula", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(0, 1, 0, 0, 0, 1, 0)
  d <- c(3, 4, 5, 6, 7, 8, 9)
  df <- data.table("a" = a, "b" = b, "c" = c, "d" = d)
  time1 <- "a"
  time2 <- "b"
  event <- "c"
  names <- c("d", "d", "d", "d")
  term_n <- c(0, 0, 0, 0)
  tform <- c("loglin", "lin_exp_int", "lin_exp_slope", "lin_exp_exp_slope")
  keep_constant <- c(0, 0, 0, 0)
  a_n <- c(-0.1, 6, -0.1, 0.1)
  a_n_default <- a_n
  modelform <- "M"


  val <- Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE)
  term_n <- val$term_n
  tform <- val$tform
  keep_constant <- val$keep_constant
  a_n <- val$a_n
  names <- val$names

  control <- list("ncores" = 2, "lr" = 0.75, "maxiter" = -1, "halfmax" = 5, "epsilon" = 1e-9, "deriv_epsilon" = 1e-9, "abs_max" = 1.0, "change_all" = TRUE, "dose_abs_max" = 100.0, "verbose" = 0, "ties" = "breslow", "double_step" = 1)
  guesses_control <- list()
  model_control <- list()

  all_names <- unique(names(df))
  tform <- c("loglin")

  dfc <- match(names, all_names)

  term_tot <- max(term_n) + 1
  x_all <- as.matrix(df[, all_names, with = FALSE])

  control <- Def_Control(control)
  guesses_control <- Def_Control_Guess(guesses_control, a_n)
  model_control <- Def_model_control(model_control)

  options(warn = -1)
  expect_no_error(Gather_Guesses_CPP(df, dfc, names, term_n, tform, keep_constant, a_n, x_all, a_n_default, modelform, control, guesses_control))
})
test_that("Gather Guesses error, many term formula", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(0, 1, 0, 0, 0, 1, 0)
  d <- c(3, 4, 5, 6, 7, 8, 9)
  df <- data.table("a" = a, "b" = b, "c" = c, "d" = d)
  time1 <- "a"
  time2 <- "b"
  event <- "c"
  names <- c("d", "d", "d", "d")
  term_n <- c(0, 0, 0, 0)
  tform <- c("loglin", "lin_exp_int", "lin_exp_slope", "lin_exp_exp_slope")
  keep_constant <- c(0, 0, 0, 0)
  a_n <- c(-0.1, 6, -0.1, 0.1)
  a_n_default <- a_n
  modelform <- "M"


  val <- Correct_Formula_Order(term_n, tform, keep_constant, a_n, names, TRUE)
  term_n <- val$term_n
  tform <- val$tform
  keep_constant <- val$keep_constant
  a_n <- val$a_n
  names <- val$names

  control <- list("ncores" = 2, "lr" = 0.75, "maxiter" = -1, "halfmax" = 5, "epsilon" = 1e-9, "deriv_epsilon" = 1e-9, "abs_max" = 1.0, "change_all" = TRUE, "dose_abs_max" = 100.0, "verbose" = 0, "ties" = "breslow", "double_step" = 1)
  guesses_control <- list()
  model_control <- list()
  tform <- c("loglin", "lin_exp_int", "lin_exp_slope", "lin_exp_exp_slope", "lin")

  all_names <- unique(names(df))

  dfc <- match(names, all_names)

  term_tot <- max(term_n) + 1
  x_all <- as.matrix(df[, all_names, with = FALSE])

  control <- Def_Control(control)
  guesses_control <- Def_Control_Guess(guesses_control, a_n)
  model_control <- Def_model_control(model_control)

  options(warn = -1)
  expect_no_error(Gather_Guesses_CPP(df, dfc, names, term_n, tform, keep_constant, a_n, x_all, a_n_default, modelform, control, guesses_control))
})
test_that("Gather Guesses, different a_n and names list", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(0, 1, 0, 0, 0, 1, 0)
  d <- c(3, 4, 5, 6, 7, 8, 9)
  df <- data.table("a" = a, "b" = b, "c" = c, "d" = d)
  time1 <- "a"
  time2 <- "b"
  event <- "c"
  names <- c("d", "d", "d", "d")
  term_n <- c(0, 0, 0, 0)
  tform <- c("loglin", "loglin", "loglin", "loglin")
  keep_constant <- c(0, 0)
  a_n <- list(c(-0.1, 6, 0.1, 0.1))
  a_n_default <- unlist(a_n[1])
  modelform <- "M"

  #
  #
  control <- list("ncores" = 2, "lr" = 0.75, "maxiter" = -1, "halfmax" = 5, "epsilon" = 1e-9, "deriv_epsilon" = 1e-9, "abs_max" = 1.0, "change_all" = TRUE, "dose_abs_max" = 100.0, "verbose" = 0, "ties" = "breslow", "double_step" = 1)
  guesses_control <- list()
  model_control <- list()

  all_names <- unique(names(df))
  #
  dfc <- match(names, all_names)

  term_tot <- max(term_n) + 1
  x_all <- as.matrix(df[, all_names, with = FALSE])
  #
  control <- Def_Control(control)
  guesses_control <- Def_Control_Guess(guesses_control, a_n_default)
  guesses_control$verbose <- TRUE
  model_control <- Def_model_control(model_control)
  #
  names <- c("d")
  expect_error(Gather_Guesses_CPP(df, dfc, names, term_n, tform, keep_constant, a_n, x_all, a_n_default, modelform, control, guesses_control))
})
test_that("Gather Guesses list, incorrect keep_constant length and rmin/rmax not used", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(0, 1, 0, 0, 0, 1, 0)
  d <- c(3, 4, 5, 6, 7, 8, 9)
  df <- data.table("a" = a, "b" = b, "c" = c, "d" = d)
  time1 <- "a"
  time2 <- "b"
  event <- "c"
  names <- c("d", "d", "d", "d")
  term_n <- c(0, 0, 0, 0)
  tform <- c("loglin", "loglin", "loglin", "loglin")
  keep_constant <- c(0, 0)
  a_n <- list(c(-0.1, 6, 0.1, 0.1))
  a_n_default <- unlist(a_n[1])
  modelform <- "M"

  #
  #
  control <- list("ncores" = 2, "lr" = 0.75, "maxiter" = -1, "halfmax" = 5, "epsilon" = 1e-9, "deriv_epsilon" = 1e-9, "abs_max" = 1.0, "change_all" = TRUE, "dose_abs_max" = 100.0, "verbose" = 0, "ties" = "breslow", "double_step" = 1)
  guesses_control <- list()
  model_control <- list()

  all_names <- unique(names(df))
  #
  dfc <- match(names, all_names)

  term_tot <- max(term_n) + 1
  x_all <- as.matrix(df[, all_names, with = FALSE])
  #
  control <- Def_Control(control)
  guesses_control <- Def_Control_Guess(guesses_control, a_n_default)
  guesses_control$verbose <- TRUE
  model_control <- Def_model_control(model_control)
  #
  options(warn = -1)
  expect_no_error(Gather_Guesses_CPP(df, dfc, names, term_n, tform, keep_constant, a_n, x_all, a_n_default, modelform, control, guesses_control))
  keep_constant <- c(1, 0, 0, 0, 0, 0, 0)
  guesses_control$rmin <- c(-0.1, -1, -0.1, 0)
  guesses_control$rmax <- c(0.1, 1, 0.1, 0.1)
  expect_no_error(Gather_Guesses_CPP(df, dfc, names, term_n, tform, keep_constant, a_n, x_all, a_n_default, modelform, control, guesses_control))
})
test_that("Gather Guesses list, negative risk found", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(0, 1, 0, 0, 0, 1, 0)
  d <- c(3, 4, 5, 6, 7, 8, 9)
  df <- data.table("a" = a, "b" = b, "c" = c, "d" = d)
  time1 <- "a"
  time2 <- "b"
  event <- "c"
  names <- c("d", "d", "d", "d")
  term_n <- c(0, 0, 0, 0)
  tform <- c("lin", "loglin", "loglin", "loglin")
  keep_constant <- c(0, 0)
  a_n <- list(c(-0.1, 6, 0.1, 0.1))
  a_n_default <- unlist(a_n[1])
  modelform <- "M"

  #
  #
  control <- list("ncores" = 2, "lr" = 0.75, "maxiter" = -1, "halfmax" = 5, "epsilon" = 1e-9, "deriv_epsilon" = 1e-9, "abs_max" = 1.0, "change_all" = TRUE, "dose_abs_max" = 100.0, "verbose" = 0, "ties" = "breslow", "double_step" = 1)
  guesses_control <- list()
  model_control <- list()

  all_names <- unique(names(df))
  #
  dfc <- match(names, all_names)

  term_tot <- max(term_n) + 1
  x_all <- as.matrix(df[, all_names, with = FALSE])
  #
  control <- Def_Control(control)
  guesses_control <- Def_Control_Guess(guesses_control, a_n_default)
  guesses_control$verbose <- TRUE
  model_control <- Def_model_control(model_control)
  #
  options(warn = -1)
  expect_no_error(Gather_Guesses_CPP(df, dfc, names, term_n, tform, keep_constant, a_n, x_all, a_n_default, modelform, control, guesses_control))
})
test_that("Gather Guesses list, bad tform", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(0, 1, 0, 0, 0, 1, 0)
  d <- c(3, 4, 5, 6, 7, 8, 9)
  df <- data.table("a" = a, "b" = b, "c" = c, "d" = d)
  time1 <- "a"
  time2 <- "b"
  event <- "c"
  names <- c("d", "d", "d", "d")
  term_n <- c(0, 0, 0, 0)
  tform <- c("loglin", "loglin", "loglin", "bad_bad")
  keep_constant <- c(0, 0)
  a_n <- list(c(-0.1, 6, 0.1, 0.1))
  a_n_default <- unlist(a_n[1])
  modelform <- "M"

  #
  #
  control <- list("ncores" = 2, "lr" = 0.75, "maxiter" = -1, "halfmax" = 5, "epsilon" = 1e-9, "deriv_epsilon" = 1e-9, "abs_max" = 1.0, "change_all" = TRUE, "dose_abs_max" = 100.0, "verbose" = 0, "ties" = "breslow", "double_step" = 1)
  guesses_control <- list()
  model_control <- list()

  all_names <- unique(names(df))
  #
  dfc <- match(names, all_names)

  term_tot <- max(term_n) + 1
  x_all <- as.matrix(df[, all_names, with = FALSE])
  #
  control <- Def_Control(control)
  guesses_control <- Def_Control_Guess(guesses_control, a_n_default)
  guesses_control$verbose <- TRUE
  model_control <- Def_model_control(model_control)
  #
  guesses_control$rmin <- c(-0.1, -1, -0.1, 0)
  guesses_control$rmax <- c(0.1, 1, 0.1, 0.1, 0, 0, 0)
  expect_error(Gather_Guesses_CPP(df, dfc, names, term_n, tform, keep_constant, a_n, x_all, a_n_default, modelform, control, guesses_control))
})
test_that("Gather Guesses list combinations", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(0, 1, 0, 0, 0, 1, 0)
  d <- c(3, 4, 5, 6, 7, 8, 9)
  df <- data.table("a" = a, "b" = b, "c" = c, "d" = d)
  time1 <- "a"
  time2 <- "b"
  event <- "c"
  names <- c("d", "d", "d", "d")
  term_n <- c(0, 0, 0, 0)
  tform <- c("loglin", "loglin", "loglin", "loglin")
  keep_constant <- c(0, 0)
  a_n <- list(c(-0.1, 6, 0.1, 0.1))
  a_n_default <- unlist(a_n[1])
  modelform <- "M"

  #
  #
  control <- list("ncores" = 2, "lr" = 0.75, "maxiter" = -1, "halfmax" = 5, "epsilon" = 1e-9, "deriv_epsilon" = 1e-9, "abs_max" = 1.0, "change_all" = TRUE, "dose_abs_max" = 100.0, "verbose" = 0, "ties" = "breslow", "double_step" = 1)
  guesses_control <- list()
  model_control <- list()

  all_names <- unique(names(df))
  #
  dfc <- match(names, all_names)

  term_tot <- max(term_n) + 1
  x_all <- as.matrix(df[, all_names, with = FALSE])
  #
  control <- Def_Control(control)
  guesses_control <- Def_Control_Guess(guesses_control, a_n_default)
  guesses_control$verbose <- TRUE
  model_control <- Def_model_control(model_control)
  #
  options(warn = -1)
  names <- c("d", "d", "d", "d", "d", "d")
  expect_error(Gather_Guesses_CPP(df, dfc, names, term_n, tform, keep_constant, a_n, x_all, a_n_default, modelform, control, guesses_control))
  names <- c("d", "d", "d", "d")
  tform <- c("plin", "plin", "lin", "lin")
  expect_no_error(Gather_Guesses_CPP(df, dfc, names, term_n, tform, keep_constant, a_n, x_all, a_n_default, modelform, control, guesses_control))
  tform <- c("Not", "Implemented", "Currently", "Error")
  expect_error(Gather_Guesses_CPP(df, dfc, names, term_n, tform, keep_constant, a_n, x_all, a_n_default, modelform, control, guesses_control))
  keep_constant <- c(0, 1)
  names <- c("d", "d", "d", "d")
  term_n <- c(0, 0, 0, 0)
  tform <- c("loglin", "loglin", "loglin", "loglin")
  expect_no_error(Gather_Guesses_CPP(df, dfc, names, term_n, tform, keep_constant, a_n, x_all, a_n_default, modelform, control, guesses_control))
})

## ------------------------------------- ##
## Verify equation expression code
## ------------------------------------- ##
test_that("Check basic input/output works", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(0, 1, 0, 0, 0, 1, 0)
  d <- c(1, 2, 3, 4, 5, 6, 7)
  e <- c(2, 3, 2, 2, 2, 3, 3)
  table <- data.table::data.table(
    "a" = a, "b" = b, "c" = c,
    "d" = d, "e" = e
  )
  # cox
  Model_Eq <- "cox(a,b, c) ~ loglinear(d, factor(e), 0) + multiplicative()"
  eq_out <- Convert_Model_Eq(Model_Eq, table)
  expect_equal(eq_out$names, c("d", "e_2", "e_3"))
  expect_equal(eq_out$survival_model_type, "cox")
  expect_equal(eq_out$person_year, "NONE")
  expect_equal(eq_out$modelform, "M")
  Model_Eq <- "cox(a,b, c) ~ loglinear(d, factor(e), 0)"
  eq_out <- Convert_Model_Eq(Model_Eq, table)
  expect_equal(eq_out$modelform, "M")
  expect_equal(eq_out$end_age, "b")
  Model_Eq <- "cox(b, c) ~ loglinear(d, factor(e), 0)"
  eq_out <- Convert_Model_Eq(Model_Eq, table)
  expect_equal(eq_out$end_age, "b")
  Model_Eq <- "cox_strata(a,b, c,e) ~ loglinear(d, 0)"
  eq_out <- Convert_Model_Eq(Model_Eq, table)
  expect_equal(eq_out$end_age, "b")
  Model_Eq <- "cox_strata(b, c,e) ~ loglinear(d, 0)"
  eq_out <- Convert_Model_Eq(Model_Eq, table)
  expect_equal(eq_out$end_age, "b")
  # poisson
  Model_Eq <- "poisson(b, c) ~ loglinear(d, factor(e), 0)"
  eq_out <- Convert_Model_Eq(Model_Eq, table)
  expect_equal(eq_out$start_age, "NONE")
  expect_equal(eq_out$person_year, "b")
  Model_Eq <- "poisson_strata(b, c,e) ~ loglinear(d, 0)"
  eq_out <- Convert_Model_Eq(Model_Eq, table)
  expect_equal(eq_out$person_year, "b")
  # factor baseline check
  Model_Eq <- "cox(a,b, c) ~ loglinear(d, factor(e), 0) + multiplicative()"
  eq_out <- Convert_Model_Eq(Model_Eq, table)
  expect_equal(eq_out$names, c("d", "e_2", "e_3"))
  Model_Eq <- "cox(a,b, c) ~ loglinear(d, factor(e;baseline=2), 0) + multiplicative()"
  eq_out <- Convert_Model_Eq(Model_Eq, table)
  expect_equal(eq_out$names, c("d", "e_3"))
  options(warn = -1)
  Model_Eq <- "cox(a,b, c) ~ loglinear(d, factor(e; baseline = 10), 0) + multiplicative()"
  eq_out <- Convert_Model_Eq(Model_Eq, table)
  expect_equal(eq_out$names, c("d", "e_2", "e_3"))
})
test_that("Check basic survival formula errors", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(0, 1, 0, 0, 0, 1, 0)
  d <- c(1, 2, 3, 4, 5, 6, 7)
  e <- c(2, 3, 2, 2, 2, 3, 3)
  table <- data.table::data.table(
    "a" = a, "b" = b, "c" = c,
    "d" = d, "e" = e
  )
  Model_Eq <- "cox(a) ~ loglinear(d, factor(e), 0) + multiplicative()"
  expect_error(Convert_Model_Eq(Model_Eq, table))
  Model_Eq <- "cox_strata(a) ~ loglinear(d, factor(e), 0) + multiplicative()"
  expect_error(Convert_Model_Eq(Model_Eq, table))
  Model_Eq <- "poisson(a) ~ loglinear(d, factor(e), 0) + multiplicative()"
  expect_error(Convert_Model_Eq(Model_Eq, table))
  Model_Eq <- "poisson_strata(a) ~ loglinear(d, factor(e), 0) + multiplicative()"
  expect_error(Convert_Model_Eq(Model_Eq, table))
  Model_Eq <- "unknown(a) ~ loglinear(d, factor(e), 0) + multiplicative()"
  expect_error(Convert_Model_Eq(Model_Eq, table))
  #
  Model_Eq <- "poisson(b, c) - loglinear(d, factor(e), 0)"
  expect_error(Convert_Model_Eq(Model_Eq, table))
  Model_Eq <- "poisson b, c ~ loglinear(d, factor(e), 0)"
  expect_error(Convert_Model_Eq(Model_Eq, table))
  Model_Eq <- "poisson(b, c) ~ loglinear d, 0 "
  expect_error(Convert_Model_Eq(Model_Eq, table))
  #
  Model_Eq <- "poisson(b, c) ~ loglinear(d, factor(e), 0) + multiplicative() + multiplicative()"
  expect_error(Convert_Model_Eq(Model_Eq, table))
  Model_Eq <- "poisson(b, c) ~ loglinear(d, factor(e), 0) + unknown()"
  expect_error(Convert_Model_Eq(Model_Eq, table))
})
test_that("Check basic modelform conversion works", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(0, 1, 0, 0, 0, 1, 0)
  d <- c(1, 2, 3, 4, 5, 6, 7)
  e <- c(2, 3, 2, 2, 2, 3, 3)
  table <- data.table::data.table(
    "a" = a, "b" = b, "c" = c,
    "d" = d, "e" = e
  )
  # cox
  eq_out <- Convert_Model_Eq("cox(a,b, c) ~ loglinear(d, factor(e), 0) + multiplicative()", table)
  expect_equal(eq_out$modelform, "M")
  eq_out <- Convert_Model_Eq("cox(a,b, c) ~ loglinear(d, factor(e), 0) + multiplicative-excess()", table)
  expect_equal(eq_out$modelform, "M")
  eq_out <- Convert_Model_Eq("cox(a,b, c) ~ loglinear(d, factor(e), 0) + additive()", table)
  expect_equal(eq_out$modelform, "A")
  eq_out <- Convert_Model_Eq("cox(a,b, c) ~ loglinear(d, factor(e), 0) + product-additive()", table)
  expect_equal(eq_out$modelform, "PA")
  eq_out <- Convert_Model_Eq("cox(a,b, c) ~ loglinear(d, factor(e), 0) + product-additive-excess()", table)
  expect_equal(eq_out$modelform, "PAE")
  eq_out <- Convert_Model_Eq("cox(a,b, c) ~ loglinear(d, factor(e), 0) + A()", table)
  expect_equal(eq_out$modelform, "A")
  eq_out <- Convert_Model_Eq("cox(a,b, c) ~ loglinear(d, factor(e), 0) + PA()", table)
  expect_equal(eq_out$modelform, "PA")
  eq_out <- Convert_Model_Eq("cox(a,b, c) ~ loglinear(d, factor(e), 0) + PAE()", table)
  expect_equal(eq_out$modelform, "PAE")
  eq_out <- Convert_Model_Eq("cox(a,b, c) ~ loglinear(d, factor(e), 0) + M()", table)
  expect_equal(eq_out$modelform, "M")
  eq_out <- Convert_Model_Eq("cox(a,b, c) ~ loglinear(d, factor(e), 0) + ME()", table)
  expect_equal(eq_out$modelform, "M")
})
test_that("Check basic subterm conversion works", {
  a <- c(0, 1, 2, 3, 4, 5, 6)
  b <- c(1, 2, 3, 4, 5, 6, 7)
  c <- c(0, 1, 0, 0, 0, 1, 0)
  d <- c(1, 2, 3, 4, 5, 6, 7)
  e <- c(2, 3, 2, 2, 2, 3, 3)
  table <- data.table::data.table(
    "a" = a, "b" = b, "c" = c,
    "d" = d, "e" = e
  )
  # cox
  full <- "cox(a,b, c) ~ plin(d) + lin(d) + loglin(d) + loglin-dose(d) + lin_dose(d) + quad_dose(d) + step_dose(d) + lin_quad_dose(d) + lin_exp_dose(d) + plinear(d) + product-linear(d) + linear(d) + loglinear(d) + log-linear(d) + loglinear-dose(d) + log-linear-dose(d) + linear-dose(d) + linear-piecewise(d) + quadratic(d) + quad(d) + quad-dose(d) + quadratic-dose(d) + step-dose(d) + step-piecewise(d) + linear-quadratic-dose(d) + linear-quadratic-piecewise(d) + linear-exponential-dose(d) + linear-exponential-piecewise(d)"

  base_eq <- "cox(a,b, c) ~ plin(d) + lin(d) + loglin(d) + plinear(d) + product-linear(d) + linear(d) + loglinear(d) + log-linear(d)"
  base_out <- c("plin", "lin", "loglin", "plin", "plin", "lin", "loglin", "loglin")
  eq_out <- Convert_Model_Eq(base_eq, table)
  expect_equal(eq_out$tform, base_out)

  base_dose_eq <- "cox(a,b, c) ~ loglin-dose(d) + lin_dose(d) + quad_dose(d) + step_dose(d) + loglinear-dose(d) + log-linear-dose(d) + linear-dose(d) + linear-piecewise(d) + quadratic(d) + quad(d) + quad-dose(d) + quadratic-dose(d) + step-dose(d) + step-piecewise(d)"
  base_dose_out <- c("loglin_slope", "loglin_top", "lin_slope", "lin_int", "quad_slope", "step_slope", "step_int", "loglin_slope", "loglin_top", "loglin_slope", "loglin_top", "lin_slope", "lin_int", "lin_slope", "lin_int", "quad_slope", "quad_slope", "quad_slope", "quad_slope", "step_slope", "step_int", "step_slope", "step_int")
  eq_out <- Convert_Model_Eq(base_dose_eq, table)
  expect_equal(eq_out$tform, base_dose_out)

  complx_dose_eq <- "cox(a,b, c) ~ lin_quad_dose(d) + lin_exp_dose(d) + linear-quadratic-dose(d) + linear-quadratic-piecewise(d) + linear-exponential-dose(d) + linear-exponential-piecewise(d)"
  complx_dose_out <- c("lin_quad_slope", "lin_quad_int", "lin_exp_slope", "lin_exp_int", "lin_exp_exp_slope", "lin_quad_slope", "lin_quad_int", "lin_quad_slope", "lin_quad_int", "lin_exp_slope", "lin_exp_int", "lin_exp_exp_slope", "lin_exp_slope", "lin_exp_int", "lin_exp_exp_slope")
  eq_out <- Convert_Model_Eq(complx_dose_eq, table)
  expect_equal(eq_out$tform, complx_dose_out)
})

## ---------------------- ##
## Censoring Weight Tests ##
## ---------------------- ##

test_that("Coxph loglin_M CENSOR Default various_fixes", {
  fname <- "ll_cens_0.csv"
  colTypes <- c("double", "double", "double", "integer", "integer")
  df <- fread(fname, nThread = min(c(detectCores(), 2)), data.table = TRUE, header = TRUE, colClasses = colTypes, verbose = FALSE, fill = TRUE)
  time1 <- "t0"
  time2 <- "t1"
  event <- "lung"
  names <- c("dose", "fac")
  term_n <- c(0, 0)
  tform <- c("loglin", "loglin")
  keep_constant <- c(0, 0)
  a_n <- c(0, 0)
  modelform <- "M"

  control <- list("ncores" = 2, "lr" = 0.75, "maxiter" = -1, "halfmax" = -1, "epsilon" = 1e-6, "deriv_epsilon" = 1e-6, "abs_max" = 1.0, "change_all" = TRUE, "dose_abs_max" = 100.0, "verbose" = 0, "ties" = "breslow", "double_step" = 1)
  plot_options <- list("name" = paste(tempfile(), "run", sep = ""), "verbose" = TRUE, "studyid" = "studyid", "age_unit" = "years")
  expect_no_error(GetCensWeight(df, time1, time2, event, names, term_n, tform, keep_constant, a_n, modelform, control, plot_options))
  keep_constant <- c(1, 1)
  expect_error(GetCensWeight(df, time1, time2, event, names, term_n, tform, keep_constant, a_n, modelform, control, plot_options))
  keep_constant <- c(0, 0)
  df$lung <- rep(0, nrow(df))
  expect_error(GetCensWeight(df, time1, time2, event, names, term_n, tform, keep_constant, a_n, modelform, control, plot_options))
  #
})