R Under development (unstable) (2025-01-16 r87584 ucrt) -- "Unsuffered Consequences" Copyright (C) 2025 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > > library("basefun") Loading required package: variables > > x <- 1:5 > y <- as.double(1:4) > g <- gl(3, 1) > d <- expand.grid(x = x, y = y, g = g) > xvar <- numeric_var("x", support = x) > > cb <- c(logx = log_basis(xvar, remove_intercept = TRUE), + X = as.basis(~ y + g, data = expand.grid(y = y, g = g))) > > X <- model.matrix(cb, data = d) > stopifnot(nrow(X) == nrow(d)) > > p <- predict(cb, newdata = d, coef = rep(1, ncol(X))) > stopifnot(length(p) == nrow(d)) > > (p2 <- predict(cb, newdata = list(x = x, y = y, g = g), + coef = rep(1, ncol(X)))) , , 1 [,1] [,2] [,3] [,4] [1,] 2.000000 3.000000 4.000000 5.000000 [2,] 2.693147 3.693147 4.693147 5.693147 [3,] 3.098612 4.098612 5.098612 6.098612 [4,] 3.386294 4.386294 5.386294 6.386294 [5,] 3.609438 4.609438 5.609438 6.609438 , , 2 [,1] [,2] [,3] [,4] [1,] 3.000000 4.000000 5.000000 6.000000 [2,] 3.693147 4.693147 5.693147 6.693147 [3,] 4.098612 5.098612 6.098612 7.098612 [4,] 4.386294 5.386294 6.386294 7.386294 [5,] 4.609438 5.609438 6.609438 7.609438 , , 3 [,1] [,2] [,3] [,4] [1,] 3.000000 4.000000 5.000000 6.000000 [2,] 3.693147 4.693147 5.693147 6.693147 [3,] 4.098612 5.098612 6.098612 7.098612 [4,] 4.386294 5.386294 6.386294 7.386294 [5,] 4.609438 5.609438 6.609438 7.609438 > > stopifnot(all.equal(p, c(p2), check.attributes = FALSE)) > > (p4 <- predict(cb, newdata = mkgrid(cb, 4), coef = rep(1, ncol(X)))) , , 1 [,1] [,2] [,3] [,4] [1,] 2.000000 3.000000 4.000000 5.000000 [2,] 2.693147 3.693147 4.693147 5.693147 [3,] 3.098612 4.098612 5.098612 6.098612 [4,] 3.386294 4.386294 5.386294 6.386294 [5,] 3.609438 4.609438 5.609438 6.609438 , , 2 [,1] [,2] [,3] [,4] [1,] 3.000000 4.000000 5.000000 6.000000 [2,] 3.693147 4.693147 5.693147 6.693147 [3,] 4.098612 5.098612 6.098612 7.098612 [4,] 4.386294 5.386294 6.386294 7.386294 [5,] 4.609438 5.609438 6.609438 7.609438 , , 3 [,1] [,2] [,3] [,4] [1,] 3.000000 4.000000 5.000000 6.000000 [2,] 3.693147 4.693147 5.693147 6.693147 [3,] 4.098612 5.098612 6.098612 7.098612 [4,] 4.386294 5.386294 6.386294 7.386294 [5,] 4.609438 5.609438 6.609438 7.609438 > > stopifnot(all.equal(p, c(p4), check.attributes = FALSE)) > > p <- predict(cb, newdata = expand.grid(g = g, x = x, y = y), + coef = rep(1, ncol(X))) > > (p2 <- predict(cb, newdata = list(x = x, y = y, g = g), + coef = rep(1, ncol(X)), + dim = c(g = length(g), x = length(x), y = length(y)))) , , 1 [,1] [,2] [,3] [,4] [,5] [1,] 2 2.693147 3.098612 3.386294 3.609438 [2,] 3 3.693147 4.098612 4.386294 4.609438 [3,] 3 3.693147 4.098612 4.386294 4.609438 , , 2 [,1] [,2] [,3] [,4] [,5] [1,] 3 3.693147 4.098612 4.386294 4.609438 [2,] 4 4.693147 5.098612 5.386294 5.609438 [3,] 4 4.693147 5.098612 5.386294 5.609438 , , 3 [,1] [,2] [,3] [,4] [,5] [1,] 4 4.693147 5.098612 5.386294 5.609438 [2,] 5 5.693147 6.098612 6.386294 6.609438 [3,] 5 5.693147 6.098612 6.386294 6.609438 , , 4 [,1] [,2] [,3] [,4] [,5] [1,] 5 5.693147 6.098612 6.386294 6.609438 [2,] 6 6.693147 7.098612 7.386294 7.609438 [3,] 6 6.693147 7.098612 7.386294 7.609438 > > stopifnot(all.equal(p, c(p2), check.attributes = FALSE)) > > XX <- model.matrix(cb[["X"]], data = list(y = y, g = g), + dim = c(y = length(y), g = length(g))) > > pX <- predict(cb[["X"]], newdata = list(y = y, g = g), coef = rep(1, ncol(X) - 1)) > > pX2 <- predict(cb[["X"]], newdata = expand.grid(y = y, g = g), + coef = rep(1, ncol(X) - 1)) > > stopifnot(all.equal(c(pX), c(pX2), check.attributes = FALSE)) > > bb <- b(logx = log_basis(xvar, remove_intercept = TRUE), + X = as.basis(~ y + g, data = expand.grid(y = y, g = g))) > > X <- model.matrix(bb, data = d) > stopifnot(nrow(X) == nrow(d)) > > p <- predict(bb, newdata = d, coef = rep(1, ncol(X))) > stopifnot(length(p) == nrow(d)) > > (p2 <- predict(bb, newdata = list(x = x, y = y, g = g), coef = rep(1, ncol(X)))) , , 1 [,1] [,2] [,3] [,4] [1,] 0.000000 0.000000 0.000000 0.000000 [2,] 1.386294 2.079442 2.772589 3.465736 [3,] 2.197225 3.295837 4.394449 5.493061 [4,] 2.772589 4.158883 5.545177 6.931472 [5,] 3.218876 4.828314 6.437752 8.047190 , , 2 [,1] [,2] [,3] [,4] [1,] 0.000000 0.000000 0.000000 0.000000 [2,] 2.079442 2.772589 3.465736 4.158883 [3,] 3.295837 4.394449 5.493061 6.591674 [4,] 4.158883 5.545177 6.931472 8.317766 [5,] 4.828314 6.437752 8.047190 9.656627 , , 3 [,1] [,2] [,3] [,4] [1,] 0.000000 0.000000 0.000000 0.000000 [2,] 2.079442 2.772589 3.465736 4.158883 [3,] 3.295837 4.394449 5.493061 6.591674 [4,] 4.158883 5.545177 6.931472 8.317766 [5,] 4.828314 6.437752 8.047190 9.656627 > > stopifnot(all.equal(p, c(p2), check.attributes = FALSE)) > > dd <- list(x = x, y = y[1:3], g = rep(g[1], 3)) > (p3 <- predict(bb, newdata = dd, coef = rep(1, ncol(X)), + dim = c(x = 5, y = 3, g = 1))) , , 1 [,1] [,2] [,3] [1,] 0.000000 0.000000 0.000000 [2,] 1.386294 2.079442 2.772589 [3,] 2.197225 3.295837 4.394449 [4,] 2.772589 4.158883 5.545177 [5,] 3.218876 4.828314 6.437752 > > stopifnot(all.equal(drop(p3), + matrix(p2[as.matrix(expand.grid(1:5, 1:3, 1))], nrow = 5), + check.attributes = FALSE)) > > ### matrix coefficients > X <- model.matrix(cb, data = d) > cf <- matrix(sample(1:(nrow(X) * ncol(X))), nrow = nrow(X)) > p <- predict(cb, newdata = d, coef = cf) > all.equal(p, rowSums(X * cf)) [1] TRUE > > proc.time() user system elapsed 1.26 0.25 1.43