Nothing
fct.helper.has.pmf <- function(clv.fitted.transactions){
return(is(clv.fitted.transactions, "clv.fitted.transactions") &
!is(clv.fitted.transactions, "clv.ggomnbd") & !is(clv.fitted.transactions, "clv.ggomnbd.static.cov") &
!is(clv.fitted.transactions, "clv.pnbd.dynamic.cov"))
}
fct.helper.has.DERT <- function(clv.fitted.transactions){
if(is(clv.fitted.transactions, "clv.pnbd") |
is(clv.fitted.transactions, "clv.pnbd.static.cov") |
is(clv.fitted.transactions, "clv.pnbd.dynamic.cov")){
return(TRUE)
}else{
return(FALSE)
}
}
# has.cor NEVER HAS FITTED MODEL :(
# fct.helper.has.cor <- function(clv.fitted.transactions){
# # pnbd nocov and staticcov have, all other do not
# if((is(clv.fitted.transactions, "clv.pnbd") | is(clv.fitted.transactions, "clv.pnbd.static.cov"))
# & !is(clv.fitted.transactions, "clv.pnbd.dynamic.cov")){
# return(TRUE)
# }else{
# return(FALSE)
# }
# }
.fct.helper.s3.fitted.coef <- function(clv.fitted, full.names){
expect_silent(res.coef <- coef(clv.fitted))
test_that("Named numeric vector", {
expect_type(res.coef, "double")
expect_named(res.coef, full.names, ignore.order = TRUE)
})
test_that("Same length as during optimization", {
expect_length(res.coef, ncol(coef(clv.fitted@optimx.estimation.output)))
})
test_that("Names have same order as vcov()", {
skip_on_cran()
expect_silent(res.vcov <- vcov(clv.fitted))
expect_named(res.coef, rownames(vcov(clv.fitted)), ignore.case = FALSE, ignore.order = FALSE)
expect_named(res.coef, colnames(vcov(clv.fitted)), ignore.case = FALSE, ignore.order = FALSE)
})
test_that("Same order as coef(summary())", {
skip_on_cran()
expect_named(res.coef, rownames(coef(summary(clv.fitted))), ignore.case = FALSE, ignore.order = FALSE)
})
test_that("No NAs", {
expect_false(anyNA(res.coef))
})
# **Todo: model specific: coef() same as exp(coef(optimx))
}
.fct.helper.s3.fitted.vcov <- function(clv.fitted, full.names){
expect_silent(res.vcov <- vcov(clv.fitted))
test_that("Named numeric matrix", {
res.attr <- attributes(res.vcov)
expect_named(res.attr, c("dim", "dimnames"))
expect_length(res.attr$dimnames, 2)
expect_equal(res.attr$dim, c(length(full.names), length(full.names)))
expect_equal(res.attr$dimnames[[1]], names(coef(clv.fitted)))
expect_equal(res.attr$dimnames[[2]], names(coef(clv.fitted)))
})
test_that("Names same order as coef()", {
skip_on_cran()
expect_named(coef(clv.fitted), rownames(res.vcov), ignore.case = FALSE, ignore.order = FALSE)
expect_named(coef(clv.fitted), colnames(res.vcov), ignore.case = FALSE, ignore.order = FALSE)
})
test_that("Names same order as coef(summary())", {
skip_on_cran()
expect_equal(rownames(coef(summary(clv.fitted))), rownames(res.vcov))
expect_equal(rownames(coef(summary(clv.fitted))), colnames(res.vcov))
})
test_that("No NAs",{
expect_false(anyNA(res.vcov))
})
}
.fct.helper.s3.fitted.confint <- function(clv.fitted, full.names){
test_that("Confint works with different alphas", {
expect_silent(ci.99 <- confint(clv.fitted, level = 0.99))
expect_silent(ci.95 <- confint(clv.fitted, level = 0.95))
expect_silent(ci.90 <- confint(clv.fitted, level = 0.90))
expect_silent(ci.70 <- confint(clv.fitted, level = 0.70))
# Level works and provides different values
expect_false(isTRUE(all.equal(ci.99,ci.95,check.attributes=FALSE)))
expect_false(isTRUE(all.equal(ci.95,ci.90,check.attributes=FALSE)))
expect_false(isTRUE(all.equal(ci.90,ci.70,check.attributes=FALSE)))
# Rightly named, all same
expect_setequal(rownames(ci.99), full.names)
expect_setequal(rownames(ci.99), rownames(ci.95))
expect_setequal(rownames(ci.95), rownames(ci.90))
expect_setequal(rownames(ci.90), rownames(ci.70))
# Also title label correct
expect_equal(colnames(ci.95), c("2.5 %", "97.5 %"))
expect_equal(colnames(ci.90), c("5 %", "95 %"))
expect_equal(colnames(ci.99), c("0.5 %", "99.5 %"))
})
test_that("Confint works with character param", {
skip_on_cran()
# Single
for(p in full.names)
expect_equal(rownames(confint(clv.fitted, parm = p)), expected = p)
# Multiple
p <- full.names[1:3]
expect_setequal(rownames(confint(clv.fitted, parm = p)), expected = p)
p <- full.names[1:2]
expect_setequal(rownames(confint(clv.fitted, parm = p)), expected = p)
# All - excplicitely
p <- full.names
expect_setequal(rownames(confint(clv.fitted, parm = p)), expected = p)
# All - implicitely (ie none given)
expect_setequal(rownames(confint(clv.fitted)), expected = p)
})
test_that("Confint works with integer param", {
skip_on_cran()
p <- full.names
# Single
expect_equal(rownames(confint(clv.fitted, parm = 2)), expected = p[2])
expect_equal(rownames(confint(clv.fitted, parm = 4)), expected = p[4])
# Sequence
expect_setequal(rownames(confint(clv.fitted, parm = 1:3)), expected = p[1:3])
expect_setequal(rownames(confint(clv.fitted, parm =c(1,2,4))), expected = p[c(1,2,4)])
# All - excplicitely
expect_setequal(rownames(confint(clv.fitted, parm = seq(length(p)))), expected = p)
# All - implicitely (ie none given)
expect_setequal(rownames(confint(clv.fitted)), expected = p)
# Minus removes
expect_setequal(rownames(confint(clv.fitted, parm = -2)), expected = p[-2])
expect_setequal(rownames(confint(clv.fitted, parm = -c(2,4))), expected = p[-c(2,4)])
# Remove all
expect_null(rownames(confint(clv.fitted, parm = -seq(length(p)))))
})
# same behavior as lm
test_that("confint NA if unknown parm", {
skip_on_cran()
# Unknown character
expect_true(all(is.na( confint(clv.fitted, parm = "abc") )))
expect_true(all(is.na( confint(clv.fitted, parm = c("abc", "zcgd")) )))
# Wrong indices
expect_true(all(is.na( confint(clv.fitted, parm = 50:100))))
expect_true(all(is.na( confint(clv.fitted, parm = 99) )))
# Part of it are known
expect_true(all(full.names %in%
rownames(confint(clv.fitted, parm = 1:100))))
expect_true(!all(is.na( confint(clv.fitted, parm = 1:100))))
})
}
.fct.helper.s3.fitted.summary <- function(clv.fitted){
expect_silent(res.sum <- summary(clv.fitted))
test_that("Basic summary structure", {
expect_s3_class(res.sum, class = "summary.clv.fitted")
expect_true(is.list(res.sum))
expect_true(all(c("call", "name.model", "tp.estimation.start","tp.estimation.end",
"time.unit", "coefficients", "AIC", "BIC","kkt1", "kkt2","additional.options") %in%
names(res.sum)))
expect_true(is.call(res.sum$call))
expect_true(is.character(res.sum$name.model))
expect_true(lubridate::is.Date(res.sum$tp.estimation.start) | lubridate::is.POSIXct(res.sum$tp.estimation.start))
expect_true(lubridate::is.Date(res.sum$tp.estimation.end) | lubridate::is.POSIXct(res.sum$tp.estimation.end))
expect_true(is.character(res.sum$time.unit))
expect_true(is.matrix(res.sum$coefficients))
expect_true(is.numeric(res.sum$AIC))
expect_true(is.numeric(res.sum$BIC))
expect_true(is.logical(res.sum$kkt1))
expect_true(is.logical(res.sum$kkt2))
expect_true(is.list(res.sum$additional.options))
})
test_that("Correct coef structure", {
# Basic correct
sum.coef <- coef(res.sum)
expect_true(ncol(sum.coef) == 4)
expect_true(all(colnames(sum.coef) != ""))
# Same order as vcov()
expect_equal(rownames(sum.coef), rownames(vcov(clv.fitted)))
expect_equal(rownames(sum.coef), colnames(vcov(clv.fitted)))
# Same order as coef()
expect_equal(rownames(sum.coef), names(coef(clv.fitted)))
})
test_that("summary() prints", {
expect_output(res.show <- show(res.sum))
expect_null(res.show)
expect_output(res.print <- print(res.sum))
expect_equal(res.print, res.sum)
})
}
.fct.helper.s3.fitted.print <- function(clv.fitted){
test_that("Prints in different ways", {
# Just that they work and return their input
expect_output(res <- show(clv.fitted))
# expect_null(res)
expect_output(res <- print(clv.fitted))
expect_identical(res, clv.fitted)
})
}
.fct.helper.s3.fitted.nobs <- function(clv.fitted){
test_that("has correct format",{
expect_silent(res.nobs <- nobs(clv.fitted))
expect_true(is.integer(res.nobs))
expect_equal(res.nobs, nrow(clv.fitted@cbs))
})
}
.fct.helper.s3.fitted.logLik <- function(clv.fitted){
test_that("has correct format", {
expect_silent(res.loglik <- logLik(clv.fitted))
expect_s3_class(res.loglik, "logLik")
res.attr <- attributes(res.loglik)
expect_named(res.attr, expected = c("nall", "nobs", "df", "class"))
expect_equal(res.attr$df, length(coef(clv.fitted)))
expect_equal(res.attr$df, ncol(coef(clv.fitted@optimx.estimation.output)))
# **TOOD: Ask Jeff
# expect_equal(res.attr$nall, nrow())?
# expect_equal(res.attr$nobs, nobs(clv.fitted))
})
}
.fct.helper.clvfitted.all.s3.except.plot.and.predict <- function(clv.fitted, full.names){
.fct.helper.s3.fitted.coef(clv.fitted = clv.fitted, full.names = full.names)
.fct.helper.s3.fitted.vcov(clv.fitted = clv.fitted, full.names = full.names)
.fct.helper.s3.fitted.confint(clv.fitted = clv.fitted, full.names = full.names)
.fct.helper.s3.fitted.summary(clv.fitted = clv.fitted)
.fct.helper.s3.fitted.print(clv.fitted = clv.fitted)
.fct.helper.s3.fitted.nobs(clv.fitted = clv.fitted)
.fct.helper.s3.fitted.logLik(clv.fitted = clv.fitted)
}
fct.helper.clvfittedtransactions.all.s3 <- function(clv.fitted, full.names,
clv.newdata.nohold, clv.newdata.withhold){
.fct.helper.clvfitted.all.s3.except.plot.and.predict(clv.fitted = clv.fitted, full.names = full.names)
fct.testthat.runability.clvfittedtransactions.plot(clv.fitted = clv.fitted, clv.newdata.nohold=clv.newdata.nohold,
clv.newdata.withhold=clv.newdata.withhold)
fct.testthat.runability.clvfittedtransactions.predict(fitted.transactions = clv.fitted, clv.newdata.nohold=clv.newdata.nohold,
clv.newdata.withhold=clv.newdata.withhold)
if(fct.helper.has.pmf(clv.fitted)){
fct.testthat.runability.clvfittedtransactions.pmf(fitted.transactions=clv.fitted)
}
}
fct.helper.clvfittedspending.all.s3 <- function(clv.fitted, full.names,
clv.newdata.nohold, clv.newdata.withhold){
.fct.helper.clvfitted.all.s3.except.plot.and.predict(clv.fitted = clv.fitted, full.names = full.names)
fct.testthat.runability.clvfittedspending.plot(fitted.spending = clv.fitted)
fct.testthat.runability.clvfittedspending.predict(fitted.spending = clv.fitted,
clv.newdata.nohold = clv.newdata.nohold, clv.newdata.withhold = clv.newdata.withhold)
}
# plot with different ways of naming
# plot with predict.end=NULL same as predict.end=holdout.end and predict.end=holdout.period.in.tu
# correct that label = model name same as no label
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.