R Under development (unstable) (2023-11-26 r85638 ucrt) -- "Unsuffered Consequences" Copyright (C) 2023 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. > > set.seed(290875) > library("party") Loading required package: grid Loading required package: mvtnorm Loading required package: modeltools Loading required package: stats4 Loading required package: strucchange Loading required package: zoo Attaching package: 'zoo' The following objects are masked from 'package:base': as.Date, as.Date.numeric Loading required package: sandwich > if (!require("MASS", quietly = TRUE)) + stop("cannot load package MASS") > > ### get rid of the NAMESPACE > attach(list2env(as.list(asNamespace("party")))) The following objects are masked from package:party: cforest, cforest_classical, cforest_control, cforest_unbiased, conditionalTree, ctree, ctree_control, edge_simple, initVariableFrame, mob, mob_control, node_barplot, node_bivplot, node_boxplot, node_density, node_hist, node_inner, node_scatterplot, node_surv, node_terminal, nodes, party_intern, prettytree, proximity, ptrafo, response, reweight, sctest.mob, treeresponse, varimp, varimpAUC, where > > ### > ### > ### Regression tests for utility functions > ### > ### functions defined in file ./src/Utils.c' > ### > ### > > ### tests for function C_kronecker > for (i in 1:10) { + A = matrix(rnorm(i*5), ncol = i, nrow = 5) + B = matrix(rnorm(i*10), ncol = 10, nrow = i) + Rkr = kronecker(A, B) + mykr = .Call(R_kronecker, A, B) + stopifnot(isequal(Rkr, mykr)) + } > > ### test for function CR_svd (singular value decomposition) > x <- matrix(rnorm(100), ncol = 10) > x <- t(x) %*% x > svdx <- qsvd(x) > stopifnot(isequal(svd(x)$d, svdx$d)) > stopifnot(isequal(svd(x)$u, svdx$u)) > stopifnot(isequal(svd(x)$v, t(svdx$vt))) > > ### test for function R_MPinv (Moore-Penrose inverse) > mpinvx <- MPinv(x) > stopifnot(isequal(mpinvx, ginv(x))) > > ### test for function C_max > y <- rnorm(1000) > stopifnot(isequal(max(y), .Call(R_max, y))) > > ### test for function C_abs > y <- rnorm(1000) > stopifnot(isequal(abs(y), .Call(R_abs, y))) > > ### tests for function C_matprod{T} > x <- matrix(rnorm(100), ncol = 4) > y <- matrix(rnorm(40), nrow = 4) > stopifnot(isequal(x %*% y, + .Call(R_matprod, x, y))) > x <- matrix(rnorm(100), ncol = 20) > y <- matrix(rnorm(200), ncol = 20) > stopifnot(isequal(x %*% t(y), + .Call(R_matprodT, x, y))) > > ### test for function C_SampleNoReplace > ### permutation case > m <- 10000 > storage.mode(m) <- "integer" > perm <- .Call(R_permute, m) + 1 > stopifnot(all(sort(perm) == (1:m))) > > ### the random subset case > k <- 100 > storage.mode(k) <- "integer" > perm <- .Call(R_rsubset, m, k) + 1 > stopifnot(all(perm %in% (1:m))) > > proc.time() user system elapsed 1.73 0.34 2.04