test_that("internal helpers work correctly", { # Log: safe log expect_equal(Log(0), log(.Machine$double.xmin)) expect_equal(Log(1), 0) expect_true(is.finite(Log(-1))) # Outer: wrapper around outer() result <- Outer(1:3, 1:3, "+") expect_equal(dim(result), c(3L, 3L)) expect_equal(result[1, 1], 2) expect_equal(result[2, 3], 5) # group.sum: grouped sum x <- c(1, 2, 3, 4, 5) ina <- c(1, 1, 2, 2, 2) gs <- group.sum(x, ina) expect_equal(gs, c(3, 12)) # rep_row: repeat row vector m <- c(1, 2, 3) r <- rep_row(m, 4) expect_equal(dim(r), c(4L, 3L)) expect_true(all(r[2, ] == m)) # match_formals: filter to accepted args f <- function(a, b, c = 1) a + b + c mf <- match_formals(f, a = 10, b = 20, d = 99) expect_true("a" %in% names(mf)) expect_true("b" %in% names(mf)) expect_false("d" %in% names(mf)) }) test_that("xreg2_control creates correct class", { ctrl <- xreg2_control( formulas = list(y ~ INTERCEPT + x * SLOPE), start_values = c(INTERCEPT = 0, SLOPE = 0), name = "test" ) expect_s3_class(ctrl, "xreg2Control") expect_true("xreg2Control" %in% class(ctrl)) # After c(), we get an xreg2ControlList cl <- c(ctrl) expect_s3_class(cl, "xreg2ControlList") }) test_that("xreg2_control adds required sigma formula for xreg2_cont_normal", { ctrl <- xreg2_control( formulas = list(y ~ INTERCEPT + x * SLOPE), p_fun = xreg2_cont_normal, name = "test" ) # sigma_est formula should be added automatically from required attr formula_targets <- sapply(ctrl$formulas, function(f) as.character(f[[2]])) expect_true("sigma_est" %in% formula_targets) # LN_SIGMA should be in start_values expect_true("LN_SIGMA" %in% names(ctrl$start_values)) }) test_that("xreg2_fit produces finite coefficients on synthetic data", { skip_if_not_installed("ucminf") set.seed(42) n <- 150 df <- data.frame(y = rnorm(n, 2, 0.5), x = rnorm(n)) ctrl <- xreg2_control( formulas = list(y ~ INTERCEPT + x * SLOPE), start_values = c(INTERCEPT = 2, SLOPE = 0), name = "main" ) cl <- c(ctrl) fit <- xreg2_fit(controlList = cl, dataList = list(main = df)) expect_s3_class(fit, "xreg2") expect_true(all(is.finite(fit$coef))) expect_true(is.finite(fit$minima[["total"]])) # Intercept should be close to 2 expect_equal(fit$coef[["INTERCEPT"]], 2, tolerance = 0.2) }) test_that("predict.xreg2 returns augmented data frame", { skip_if_not_installed("ucminf") set.seed(1) n <- 100 df <- data.frame(y = rnorm(n, 1, 0.3), x = rnorm(n)) ctrl <- xreg2_control( formulas = list(y ~ INTERCEPT + x * SLOPE), start_values = c(INTERCEPT = 1, SLOPE = 0), name = "main" ) fit <- xreg2_fit(controlList = c(ctrl), dataList = list(main = df)) newdf <- data.frame(x = c(-1, 0, 1)) preds <- predict(fit, newdata = list(main = newdf)) expect_type(preds, "list") expect_true("main" %in% names(preds)) expect_true("Xb" %in% colnames(preds[["main"]])) expect_equal(nrow(preds[["main"]]), 3) }) test_that("AIC and BIC return finite numeric values", { skip_if_not_installed("ucminf") set.seed(7) n <- 100 df <- data.frame(y = rnorm(n, 0, 1), x = rnorm(n)) ctrl <- xreg2_control( formulas = list(y ~ INTERCEPT + x * SLOPE), start_values = c(INTERCEPT = 0, SLOPE = 0), name = "main" ) fit <- xreg2_fit(controlList = c(ctrl), dataList = list(main = df)) aic_val <- AIC(fit) bic_val <- BIC(fit) expect_true(is.numeric(aic_val)) expect_true(is.finite(aic_val)) expect_true(is.numeric(bic_val)) expect_true(is.finite(bic_val)) # BIC >= AIC for n > e^2 ~ 7.4 expect_true(bic_val >= aic_val) }) test_that("xreg2_cont_normal attr is set correctly", { req <- attr(xreg2_cont_normal, "required") expect_type(req, "list") expect_true("sigma_est" %in% names(req)) expect_true("LN_SIGMA" %in% names(req$sigma_est$start_values)) }) test_that("xreg2_cont_r_normal attr is set correctly", { req <- attr(xreg2_cont_r_normal, "required") expect_type(req, "list") expect_true("sigma_est" %in% names(req)) expect_true("omega_est" %in% names(req)) }) test_that("L-BFGS-B method produces finite coefficients", { set.seed(42) n <- 150 df <- data.frame(y = rnorm(n, 2, 0.5), x = rnorm(n)) ctrl <- xreg2_control( formulas = list(y ~ INTERCEPT + x * SLOPE), start_values = c(INTERCEPT = 2, SLOPE = 0), name = "main" ) fit <- xreg2_fit(controlList = c(ctrl), dataList = list(main = df), method = "L-BFGS-B") expect_s3_class(fit, "xreg2") expect_true(all(is.finite(fit$coef))) expect_equal(fit$method, "L-BFGS-B") # Intercept should be close to the data mean (~2) expect_equal(fit$coef[["INTERCEPT"]], 2, tolerance = 0.2) }) test_that("L-BFGS-B respects lower bound on INTERCEPT", { set.seed(10) n <- 200 df <- data.frame(y = rnorm(n, 0.5, 0.3), x = rnorm(n)) # Constrain INTERCEPT >= 0.8 (above the true mean of 0.5), # so the optimizer should be pushed to the bound. ctrl <- xreg2_control( formulas = list(y ~ INTERCEPT + x * SLOPE), start_values = c(INTERCEPT = 1, SLOPE = 0), lower = c(INTERCEPT = 0.8), name = "main" ) fit <- xreg2_fit(controlList = c(ctrl), dataList = list(main = df), method = "L-BFGS-B") expect_s3_class(fit, "xreg2") expect_true(all(is.finite(fit$coef))) # Bound must be respected expect_gte(fit$coef[["INTERCEPT"]], 0.8 - 1e-6) }) test_that("L-BFGS-B respects upper bound on INTERCEPT", { set.seed(20) n <- 200 df <- data.frame(y = rnorm(n, 3, 0.3), x = rnorm(n)) # Constrain INTERCEPT <= 2 (below the true mean of 3). ctrl <- xreg2_control( formulas = list(y ~ INTERCEPT + x * SLOPE), start_values = c(INTERCEPT = 2, SLOPE = 0), upper = c(INTERCEPT = 2), name = "main" ) fit <- xreg2_fit(controlList = c(ctrl), dataList = list(main = df), method = "L-BFGS-B") expect_s3_class(fit, "xreg2") expect_true(all(is.finite(fit$coef))) expect_lte(fit$coef[["INTERCEPT"]], 2 + 1e-6) }) test_that("optim_control overrides default L-BFGS-B settings", { set.seed(5) n <- 100 df <- data.frame(y = rnorm(n, 1, 0.5), x = rnorm(n)) ctrl <- xreg2_control( formulas = list(y ~ INTERCEPT + x * SLOPE), start_values = c(INTERCEPT = 1, SLOPE = 0), name = "main" ) # maxit = 1 forces early termination; fit should still complete without error fit <- xreg2_fit(controlList = c(ctrl), dataList = list(main = df), method = "L-BFGS-B", optim_control = list(maxit = 1)) expect_s3_class(fit, "xreg2") }) test_that("unsupported method without optimx gives informative error", { skip_if(requireNamespace("optimx", quietly = TRUE), "optimx is installed; skipping fallback-error test") set.seed(1) n <- 50 df <- data.frame(y = rnorm(n), x = rnorm(n)) ctrl <- xreg2_control( formulas = list(y ~ INTERCEPT + x * SLOPE), start_values = c(INTERCEPT = 0, SLOPE = 0), name = "main" ) expect_error( xreg2_fit(controlList = c(ctrl), dataList = list(main = df), method = "nlminb"), regexp = "optimx" ) })