tests/testthat/helper_testthat_runability_clvfitted.R

In bachmannpatrick/CLVTools: Tools for Customer Lifetime Value Estimation

fct.testthat.runability.clvfitted.out.of.the.box.no.hold <- function(method, clv.data.noholdout, fct.test.all.s3, l.args.test.all.s3){
  test_that("Works out-of-the box, without additional params (no holdout)", {
    l.args.no.hold <- list(clv.data = clv.data.noholdout, verbose=FALSE)

    expect_silent(m.no.hold <- do.call(what = method, args = l.args.no.hold))
    l.args.test.all.s3 <- modifyList(l.args.test.all.s3, list(clv.fitted = m.no.hold))
    do.call(fct.test.all.s3, l.args.test.all.s3)
  })
}

fct.testthat.runability.clvfitted.out.of.the.box.with.hold <- function(method, clv.data.withholdout, fct.test.all.s3, l.args.test.all.s3){
  test_that("Works out-of-the box, without additional params (with holdout)", {
    skip_on_cran()
    l.args.hold <- list(clv.data = clv.data.withholdout, verbose=FALSE)

    expect_silent(m.hold <- do.call(what = method, args = l.args.hold))
    l.args.test.all.s3   <- modifyList(l.args.test.all.s3, list(clv.fitted = m.hold))
    do.call(fct.test.all.s3, l.args.test.all.s3)
  })
}

fct.testthat.runability.clvfitted.custom.model.start.params <- function(method, start.params.model, clv.data){
  test_that("Works with custom model.start.params", {
    skip_on_cran()
    skip_on_ci()
    skip_on_covr()

    l.args <- list(clv.data = clv.data,   start.params.model = start.params.model, verbose=FALSE)

    expect_silent(do.call(what = method, args = l.args))
  })
}

fct.testthat.runability.clvfitted.custom.optimx.args <- function(method, clv.data){
  test_that("Works with custom optimx.args", {
    skip_on_cran()
    skip_on_ci()
    skip_on_covr()
    # output although verbose = FALSE
    l.args <- list(clv.data = clv.data, verbose = FALSE, optimx.args = list(control = list(trace=6)))
    expect_output(do.call(what = method, args = l.args))
  })
}


fct.testthat.runability.clvfitted.all.optimization.methods <- function(method, clv.data, expected.message){
  test_that("Works for all optimx optimization methods", {
    skip_on_cran()
    skip_on_ci()
    skip_on_covr()

    l.args <- list(clv.data = clv.data, optimx.args = list(control=list(all.methods=TRUE)), verbose=FALSE)
    expect_warning(do.call(what = method, args = l.args), regexp = expected.message, all=TRUE)
  })
}

fct.testthat.runability.clvfitted.multiple.optimization.methods <- function(method, clv.data, fct.test.all.s3, l.args.test.all.s3){
  test_that("Works fully with multiple optimization methods", {
    skip_on_cran()
    skip_on_ci()
    skip_on_covr()

    l.args <- list(clv.data = clv.data, optimx.args = list(method = c("BFGS", "L-BFGS-B", "Nelder-Mead")), verbose=FALSE)

    expect_silent(m.fit <- do.call(what = method, args = l.args))
    l.args.test.all.s3 <- modifyList(l.args.test.all.s3, list(clv.fitted = m.fit))
    do.call(fct.test.all.s3, l.args.test.all.s3)
  })
}


fct.testthat.runability.clvfitted.hourly.data <- function(method, data.cdnow, start.params.model, fct.test.all.s3, l.args.test.all.s3){
  test_that("Works with hourly data", {
    skip_on_cran()

    # scale down by spacing same as in weeks
    data.cdnow <- copy(data.cdnow)
    data.cdnow[, secs.since.start := as.numeric(Date- min(Date), unit='secs')]
    data.cdnow[, Date.hours := min(Date) + seconds(secs.since.start/24/7)]

    l.args <- list(clv.data = clvdata(data.transactions = data.cdnow, date.format = "ymdHMS", time.unit = "h",
                                      name.date = "Date.hours", estimation.split = 38), verbose = FALSE)

    expect_silent(fitted.hours <- do.call(what = method, args = l.args))

    l.args.test.all.s3 <- modifyList(l.args.test.all.s3, list(clv.fitted = fitted.hours))
    do.call(fct.test.all.s3, l.args.test.all.s3)

    # can predict
    expect_silent(predict(fitted.hours, verbose=FALSE, predict.spending=TRUE))
    # can plot
    expect_silent(plot(fitted.hours, verbose=FALSE))
  })
}