diff --git a/DESCRIPTION b/DESCRIPTION index 6b71979..267e315 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: mvtnorm Title: Multivariate Normal and t Distributions -Version: 1.2-6 -Date: 2024-08-17 +Version: 1.3-0 +Date: 2024-08-28 Authors@R: c(person("Alan", "Genz", role = "aut"), person("Frank", "Bretz", role = "aut"), person("Tetsuhisa", "Miwa", role = "aut"), @@ -24,7 +24,7 @@ Suggests: qrng, numDeriv License: GPL-2 URL: http://mvtnorm.R-forge.R-project.org NeedsCompilation: yes -Packaged: 2024-08-17 12:32:20 UTC; hothorn +Packaged: 2024-08-30 10:34:27 UTC; hothorn Author: Alan Genz [aut], Frank Bretz [aut], Tetsuhisa Miwa [aut], @@ -36,4 +36,4 @@ Author: Alan Genz [aut], Torsten Hothorn [aut, cre] () Maintainer: Torsten Hothorn Repository: CRAN -Date/Publication: 2024-08-17 15:30:02 UTC +Date/Publication: 2024-08-30 14:00:01 UTC diff --git a/MD5 b/MD5 index d808931..828b8a3 100644 --- a/MD5 +++ b/MD5 @@ -1,36 +1,38 @@ -7e7f59bad83c0bd79db8068b61b5629a *DESCRIPTION -54402e88b4a15c8a8c926d91b5b1ca81 *NAMESPACE -eed63d9b23f452034ca4da2324c1b4a9 *R/lpmvnorm.R -15d62e38e550dd52d12a04f79d3e422b *R/ltMatrices.R +b0b3c63b01247d465d31ad0c4ce28476 *DESCRIPTION +ce9bd85032d7f143b06fc61430505fd9 *NAMESPACE +2d6311b3b298b96576e653eeccb4ed91 *R/interface.R +12c3f7464b6975c2106916c049ae3fcb *R/lpmvnorm.R +2c5420d58bb487ceadaf6317a369d039 *R/ltMatrices.R ca05e05ca25ae52b9a8630f2b698fbf7 *R/mvnorm.R 27cb73940c326c1e2bc4e7b294895eeb *R/mvt.R ccd0495f9e9ad30e9f136c5c41cc3a03 *R/noisy-root.R 468c054d0ef43dd8e7835772599869e3 *R/tvpack.R -e9b8544d057a01460ba06f47d12860da *build/partial.rdb -a8a26e89ceb20df4bd496ea9459be673 *build/vignette.rds -5d3f52c685942a64b550023c19179ddb *cleanup +69e9937a118fa134e374f2bdae1f323d *build/partial.rdb +e72fc08829dd8e569f69467f270a657a *build/vignette.rds +3d99dd47f69e76b29b9c3d6f161567cf *cleanup 2a44eee6dc12d03d74f49d257fe871a3 *inst/CITATION ceb9f3d20b3e0f3ecd95cefd43449da1 *inst/C_API_Example/DESCRIPTION ca4c35956e7a8aa253e2c52cd49f0d99 *inst/C_API_Example/NAMESPACE 990127bb625b41c7181a653020e3f6a9 *inst/C_API_Example/R/test.R 5c4bbffc1a0108c090cfa2dbb1918d2d *inst/C_API_Example/src/test.c 64fd633725dcd93cdd836e3535f19788 *inst/C_API_Example/tests/test.R -5596c974afdc27535db28777ab267e83 *inst/NEWS.Rd +7f2ba3addcdb5786eea4869605655d11 *inst/NEWS.Rd 18cb4997813a62c609ac2519f4013a4b *inst/NEWS.old 1b063d23365215f4e5822ba94010c85c *inst/doc/MVT_Rnews.R 8f949c53fd5c9bfbf8f0949c949a6682 *inst/doc/MVT_Rnews.Rnw -94da1b929cc7ed522386d635fa477d8d *inst/doc/MVT_Rnews.pdf -42a68b7a8503a9b399a349e35dd04116 *inst/doc/lmvnorm_src.R -e679542eb30c0357e46beaf734b84057 *inst/doc/lmvnorm_src.Rnw -94deebce06d9e1eb3c7f00710fd30351 *inst/doc/lmvnorm_src.pdf +e7e33ded646005ca04946164354dc59b *inst/doc/MVT_Rnews.pdf +ecb968aa45eff60ebc5545030a11e9f1 *inst/doc/lmvnorm_src.R +9862cf7af7677c210e674a291aae3c3a *inst/doc/lmvnorm_src.Rnw +8dcea6a51f3600bde4d86208f8e659eb *inst/doc/lmvnorm_src.pdf c01fca8c2a532bb50cedc724d28a4019 *inst/include/mvtnorm.h 2ac853ab98c7223bbca7e418096966fb *inst/include/mvtnormAPI.h -91a133fc5c7893d4984213a2dfbe9e8c *inst/litdb.bib +e3f392b8e73bb8227abfef0acc72eb64 *inst/litdb.bib 48d06df1c0ede2af2082380f04f109a0 *man/Mvnorm.Rd aeea1ca8a79e11a6bc318f348e568e69 *man/Mvt.Rd 9c7f78f788a715989e00991bac0534df *man/algorithms.Rd +b85956dd1fe4928abeedacacd8863d64 *man/interface.Rd eedaca8ee45ebcc103df9269348636dc *man/lpmvnorm.Rd -d7519b9c89782b68ebb4247de6eefb2f *man/ltMatrices.Rd +df3ca5c9cd9042e2d2e5a91e7c5d3538 *man/ltMatrices.Rd b6e7f27c6865a85c9d4ff87192be81cb *man/margcond.Rd 31e6da03c2a15ef80a6668a1d068d670 *man/mvtnorm-package.Rd e5d97a5d95fdf3fec155f923acbe117f *man/pmvnorm.Rd @@ -39,8 +41,8 @@ e5d97a5d95fdf3fec155f923acbe117f *man/pmvnorm.Rd a32881a25b6d380f12082677fd9e7c5e *man/qmvt.Rd bca5c4987a057c2a6bab0cd6bbebed5b *src/C_FORTRAN_interface.c 1a3e64eb2af2ed6d6fbb037da1bc216f *src/Makevars -861eddc5d0317621fe37e477f5720e72 *src/lpmvnorm.c -979e77650ceb2dada7b0ba36676c7c5b *src/ltMatrices.c +565f028eade9d79e1004774bebc1ff16 *src/lpmvnorm.c +d971c269cdc4d2ef4606bd59e06ec63f *src/ltMatrices.c f64456aad2c956a18af275f09a013bb3 *src/miwa.c b46cb432899a2857561790e63a41396a *src/miwa.h b9866a363a76d1fa0ae89a5d88142379 *src/mvt.f @@ -56,14 +58,16 @@ da0a2380a4431dca695d098a5566250a *tests/plmvnorm-Ex.R 37453737be0fbea6a8f07cff5dcaac1b *tests/plmvnorm-Ex.Rout.save d9034636261183332943f06a53b60374 *tests/regtest-TVPACK.R 1b25011e35567fec9ac70f48f3039272 *tests/regtest-TVPACK.Rout.save +f0317b9f1f4db12308c0fd1a64a93ed4 *tests/regtest-aperm.R 870aa71dd88f6223f55a48c18160531c *tests/regtest-scores.R 4476e684bec45b38bedc61940ada7836 *tests/regtest-scores.Rout.save +ada3030aec51dfeb5fc5b5455f92078e *tests/regtest_mvnorm.R 687306863999aefde464e78798856d6b *tests/rmvnorm.R 0fc8c5d63a61b4e378d339f1cbecb462 *tests/slpmvnorm.R ffb7fa80edcd873dfca1ad13dd718da0 *tests/test-getInt.R 8433ca0a135c017df7229030259bc9c1 *tests/test-noisy-root.R b9c5f09cb4556e20e5e2a3b3f168c88a *tests/test-noisy-root.Rout.save 8f949c53fd5c9bfbf8f0949c949a6682 *vignettes/MVT_Rnews.Rnw -91a133fc5c7893d4984213a2dfbe9e8c *vignettes/litdb.bib -e679542eb30c0357e46beaf734b84057 *vignettes/lmvnorm_src.Rnw -8b4412a43257a0f2cfde4301765c36ee *vignettes/lmvnorm_src.Rout.save +e3f392b8e73bb8227abfef0acc72eb64 *vignettes/litdb.bib +9862cf7af7677c210e674a291aae3c3a *vignettes/lmvnorm_src.Rnw +34b44fc652891e197f69897934f3c9f9 *vignettes/lmvnorm_src.Rout.save diff --git a/NAMESPACE b/NAMESPACE index 2542076..b072f1d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,16 +4,18 @@ useDynLib(mvtnorm, .registration = TRUE, .fixes = "mvtnorm_") importFrom("stats", pnorm, qnorm, rnorm, dnorm, runif, pt, qt, - rchisq, uniroot, + rchisq, uniroot, simulate, cov2cor, optim, coef, glm, pcauchy, qcauchy, predict, quasi) export(rmvnorm, dmvnorm, pmvnorm, pmvt, rmvt, qmvnorm, qmvt, dmvt, GenzBretz, Miwa, TVPACK, ltMatrices, syMatrices, as.syMatrices, Tcrossprod, Crossprod, diagonals, + is.ltMatrices, is.syMatrices, as.ltMatrices, is.chol, is.invchol, as.chol, as.invchol, chol2cov, invchol2chol, chol2invchol, invchol2cov, invchol2pre, chol2pre, Dchol, invcholD, chol2cor, invchol2cor, invchol2pc, chol2pc, "diagonals<-", vectrick, Lower_tri, logdet, marg_mvnorm, cond_mvnorm, Mult, lpmvnorm, slpmvnorm, - ldmvnorm, sldmvnorm, ldpmvnorm, sldpmvnorm, standardize, destandardize) + ldmvnorm, sldmvnorm, ldpmvnorm, sldpmvnorm, standardize, destandardize, deperma, + mvnorm, margDist, condDist, lLgrad) S3method("as.array", "ltMatrices") S3method("as.array", "syMatrices") @@ -35,10 +37,23 @@ S3method("diagonals", "integer") S3method("diagonals<-", "ltMatrices") S3method("diagonals<-", "syMatrices") S3method("chol", "syMatrices") +S3method("aperm", "chol") +S3method("aperm", "invchol") S3method("aperm", "ltMatrices") +S3method("aperm", "syMatrices") +S3method("aperm", "mvnorm") +S3method("names", "mvnorm") +S3method("margDist", "mvnorm") +S3method("condDist", "mvnorm") +S3method("logLik", "mvnorm") +S3method("lLgrad", "mvnorm") +S3method("simulate", "mvnorm") S3method("Mult", "ltMatrices") S3method("Mult", "syMatrices") S3method("Mult", "default") +S3method("as.ltMatrices", "default") +S3method("as.ltMatrices", "ltMatrices") +S3method("as.ltMatrices", "syMatrices") ### internal methods S3method("probval", "GenzBretz") S3method("probval", "Miwa") diff --git a/R/interface.R b/R/interface.R new file mode 100644 index 0000000..5e8d878 --- /dev/null +++ b/R/interface.R @@ -0,0 +1,409 @@ + +# mvnorm + +### allow more than one distribution +mvnorm <- function(mean, chol, invchol) { + + # mvnorm chol invchol + + if (missing(chol) && missing(invchol)) + chol <- as.chol(ltMatrices(1, diag = TRUE)) + stopifnot(xor(missing(chol), missing(invchol))) + + if (!missing(chol)) { + if (!is.ltMatrices(chol)) + chol <- as.ltMatrices(chol) + scale <- as.chol(chol) + } + + if (!missing(invchol)) { + if (!is.ltMatrices(invchol)) + invchol <- as.ltMatrices(invchol) + scale <- as.invchol(invchol) + } + ret <- list(scale = scale) + + # mvnorm mean + + if (!missing(mean)) { + stopifnot(is.numeric(mean)) + stopifnot(NROW(mean) == dim(scale)[2L]) + if (!is.matrix(mean)) { + mean <- matrix(mean, nrow = NROW(mean)) + rownames(mean) <- names(mean) + } + nm <- dimnames(scale)[[2L]] + if (is.null(rownames(mean))) + rownames(mean) <- nm + if (!isTRUE(all.equal(rownames(mean), nm))) + stop("rownames of mean do not match") + nm <- dimnames(scale)[[1L]] + if (!is.null(nm) && dim(scale)[[2L]] == ncol(mean)) { + if (is.null(colnames(mean))) + colnames(mean) <- nm + if (!isTRUE(all.equal(colnames(mean), nm))) + stop("colnames of mean do not match") + } + ret$mean <- mean + } + + class(ret) <- "mvnorm" + return(ret) +} + +# mvnorm methods + +names.mvnorm <- function(x) + dimnames(x$scale)[[2L]] + +aperm.mvnorm <- function(a, perm, ...) { + + ret <- list(scale = aperm(a$scale, perm = perm, ...)) + if (!is.null(a$mean)) + ret$mean <- a$mean[perm,,drop = FALSE] + class(ret) <- "mvnorm" + ret +} + +# mvnorm simulate + +simulate.mvnorm <- function(object, nsim = dim(object$scale)[1L], seed = NULL, + standardize = FALSE, as.data.frame = FALSE, ...) { + + J <- dim(object$scale)[2L] + N <- dim(object$scale)[1L] + if (N > 1) + stopifnot(nsim == N) + if (standardize) { + if (is.chol(object$scale)) { + object$scale <- standardize(chol = object$scale) + } else { + object$scale <- standardize(invchol = object$scale) + } + } + Z <- matrix(rnorm(nsim * J), nrow = J) + if (is.chol(object$scale)) { + Y <- Mult(object$scale, Z) + } else { + Y <- solve(object$scale, Z) + } + ret <- Y + c(object$mean) + rownames(ret) <- dimnames(object$scale)[[2L]] + if (!as.data.frame) + return(ret) + return(as.data.frame(t(ret))) +} + +# mvnorm margDist + +margDist <- function(object, which, ...) + UseMethod("margDist") + +margDist.mvnorm <- function(object, which, ...) { + + if (is.chol(object$scale)) { + ret <- list(scale = as.chol(marg_mvnorm(chol = object$scale, + which = which)$chol)) + } else { + ret <- list(scale = as.invchol(marg_mvnorm(invchol = object$scale, + which = which)$invchol)) + } + if (!is.null(object$mean)) + ret$mean <- object$mean[which,,drop = FALSE] + class(ret) <- "mvnorm" + return(ret) +} + +# mvnorm condDist + +condDist <- function(object, which_given, given, ...) + UseMethod("condDist") + +condDist.mvnorm <- function(object, which_given = 1L, given, ...) { + + if (is.chol(object$scale)) { + ret <- cond_mvnorm(chol = object$scale, which_given = which_given, + given = given, ...) + ret$scale <- as.chol(ret$chol) + ret$chol <- NULL + } else { + ret <- cond_mvnorm(invchol = object$scale, which_given = which_given, + given = given, ...) + ret$invchol <- as.chol(ret$invchol) + ret$invchol <- NULL + } + if (!is.null(object$mean)) { + if (is.character(which_given)) + which_given <- match(which_given, dimnames(object$scale)[[2L]]) + if (ncol(object$mean) > 1L && ncol(ret$mean) > 1) + stop("dimensions do not match") + if (ncol(object$mean) == 1L && ncol(ret$mean) > 1L) { + ret$mean <- object$mean[-which_given,,drop = TRUE] + ret$mean + } else { + ret$mean <- object$mean[-which_given,,drop = FALSE] + c(ret$mean) + } + + } + class(ret) <- "mvnorm" + return(ret) +} + +# mvnorm logLik + +logLik.mvnorm <- function(object, obs, lower, upper, standardize = FALSE, + ...) { + # argchecks + + args <- c(object, list(...)) + nargs <- missing(obs) + missing(lower) + missing(upper) + stopifnot(nargs < 3L) + + nmobs <- NULL + if (!missing(obs)) { + if (!is.null(obs)) { + stopifnot(is.matrix(obs)) + nmobs <- rownames(obs) + } + } + nmlower <- nmupper <- nmlu <- NULL + if (!missing(lower)) { + if (!is.null(lower)) { + stopifnot(is.matrix(lower)) + nmlu <- nmlower <- rownames(lower) + } + } + if (!missing(upper)) { + if (!is.null(lower)) { + stopifnot(is.matrix(upper)) + nmupper <- rownames(upper) + if (!missing(lower)) { + stopifnot(isTRUE(all.equal(nmlower, nmupper))) + } else { + nmlu <- nmupper + } + } + } + + nm <- c(nmobs, nmlu) + no <- names(object) + stopifnot(nm %in% no) + perm <- NULL + if (!isTRUE(all.equal(nm, no))) + perm <- c(nm, no[!no %in% nm]) + + if (!missing(obs)) args$obs <- obs + if (!missing(lower)) args$lower <- lower + if (!missing(upper)) args$upper <- upper + + if (is.chol(object$scale)) { + # logLik chol + + names(args)[names(args) == "scale"] <- "chol" + if (standardize) + args$chol <- standardize(chol = args$chol) + if (!is.null(perm)) { + args$chol <- aperm(as.chol(args$chol), perm = perm) + if (length(nm) < length(no)) + args$chol <- marg_mvnorm(chol = args$chol, which = nm)$chol + args$mean <- args$mean[nm,,drop = FALSE] + } + return(do.call("ldpmvnorm", args)) + + } + # logLik invchol + + names(args)[names(args) == "scale"] <- "invchol" + if (standardize) + args$invchol <- standardize(invchol = args$invchol) + if (!is.null(perm)) { + args$invchol <- aperm(as.invchol(args$invchol), perm = perm) + if (length(nm) < length(no)) + args$invchol <- marg_mvnorm(invchol = args$invchol, + which = nm)$invchol + args$mean <- args$mean[nm,,drop = FALSE] + } + return(do.call("ldpmvnorm", args)) + +} + +# mvnorm lLgrad + +lLgrad <- function(object, ...) + UseMethod("lLgrad") + +lLgrad.mvnorm <- function(object, obs, lower, upper, standardize = FALSE, + ...) { + # argchecks + + args <- c(object, list(...)) + nargs <- missing(obs) + missing(lower) + missing(upper) + stopifnot(nargs < 3L) + + nmobs <- NULL + if (!missing(obs)) { + if (!is.null(obs)) { + stopifnot(is.matrix(obs)) + nmobs <- rownames(obs) + } + } + nmlower <- nmupper <- nmlu <- NULL + if (!missing(lower)) { + if (!is.null(lower)) { + stopifnot(is.matrix(lower)) + nmlu <- nmlower <- rownames(lower) + } + } + if (!missing(upper)) { + if (!is.null(lower)) { + stopifnot(is.matrix(upper)) + nmupper <- rownames(upper) + if (!missing(lower)) { + stopifnot(isTRUE(all.equal(nmlower, nmupper))) + } else { + nmlu <- nmupper + } + } + } + + nm <- c(nmobs, nmlu) + no <- names(object) + stopifnot(nm %in% no) + perm <- NULL + if (!isTRUE(all.equal(nm, no))) + perm <- c(nm, no[!no %in% nm]) + + if (!missing(obs)) args$obs <- obs + if (!missing(lower)) args$lower <- lower + if (!missing(upper)) args$upper <- upper + + if (is.chol(object$scale)) { + # lLgrad chol + + names(args)[names(args) == "scale"] <- "chol" + sc <- args$chol + if (standardize) + args$chol <- sc <- standardize(chol = args$chol) + if (!is.null(perm)) { + if (!attr(args$chol, "diag")) { + diagonals(args$chol) <- 1 + sc <- args$chol + } + args$chol <- pc <- aperm(as.chol(args$chol), perm = perm) + if (length(nm) < length(no)) + args$chol <- marg_mvnorm(chol = args$chol, which = nm)$chol + args$mean <- args$mean[nm,,drop = FALSE] + } + ret <- do.call("sldpmvnorm", args) + # lLgrad mean + + ### sldmvnorm returns mean score as -obs + if (is.null(ret$mean)) ret$mean <- - ret$obs + + # lLgrad marginalisation + + om <- length(no) - length(nm) + if (om > 0) { + am <- matrix(0, nrow = om, ncol = ncol(ret$mean)) + rownames(am) <- no[!no %in% nm] + ret$mean <- rbind(ret$mean, am) + Jo <- dim(object$scale)[[2L]] + pJ <- dim(args$invchol)[[2L]] + am <- matrix(0, nrow = Jo * (Jo + 1) / 2 - pJ * (pJ + 1) / 2, + ncol = dim(ret$invchol)[1L]) + byrow_orig <- attr(ret$chol, "byrow") + ret$chol <- ltMatrices(ret$chol, byrow = TRUE) + ### rbind only works for byrow = TRUE + ret$chol <- ltMatrices(rbind(unclass(ret$chol), am), + byrow = TRUE, + diag = TRUE, + names = perm) + ret$chol <- ltMatrices(ret$chol, byrow = byrow_orig) + } + + # lLgrad deperma + + if (!is.null(perm)) + ret$chol <- deperma(chol = sc, permuted_chol = pc, + perm = match(perm, no), + score_schol = ret$chol) + + # lLgrad destandarized + + if (standardize) + ret$chol <- destandardize(chol = object$scale, + score_schol = ret$chol) + + # lLgrad diagonals + + if (!attr(sc, "diag")) + ret$chol <- ltMatrices(Lower_tri(ret$chol, diag = FALSE), + diag = FALSE, + byrow = attr(ret$chol, "byrow"), + names = dimnames(ret$chol)[[2L]]) + + # lLgrad return + + ret$scale <- ret$chol + ret$chol <- NULL + ret$mean <- ret$mean[no,,drop = FALSE] + return(ret) + + + } + # lLgrad invchol + + names(args)[names(args) == "scale"] <- "invchol" + si <- args$invchol + if (standardize) + args$invchol <- si <- standardize(invchol = args$invchol) + if (!is.null(perm)) { + if (!attr(args$invchol, "diag")) { + diagonals(args$invchol) <- 1 + si <- args$invchol + } + args$invchol <- pi <- aperm(as.invchol(args$invchol), perm = perm) + if (length(nm) < length(no)) + args$invchol <- marg_mvnorm(invchol = args$invchol, + which = nm)$invchol + args$mean <- args$mean[nm,,drop = FALSE] + } + ret <- do.call("sldpmvnorm", args) + ### sldmvnorm returns mean score as -obs + if (is.null(ret$mean)) ret$mean <- - ret$obs + om <- length(no) - length(nm) + if (om > 0) { + am <- matrix(0, nrow = om, ncol = ncol(ret$mean)) + rownames(am) <- no[!no %in% nm] + ret$mean <- rbind(ret$mean, am) + Jo <- dim(object$scale)[[2L]] + pJ <- dim(args$invchol)[[2L]] + am <- matrix(0, nrow = Jo * (Jo + 1) / 2 - pJ * (pJ + 1) / 2, + ncol = dim(ret$invchol)[1L]) + byrow_orig <- attr(ret$invchol, "byrow") + ret$invchol <- ltMatrices(ret$invchol, byrow = TRUE) + ### rbind only works for byrow = TRUE + ret$invchol <- ltMatrices(rbind(unclass(ret$invchol), am), + byrow = TRUE, + diag = TRUE, + names = perm) + ret$invchol <- ltMatrices(ret$invchol, byrow = byrow_orig) + } + if (!is.null(perm)) + ret$invchol <- deperma(invchol = si, permuted_invchol = pi, + perm = match(perm, no), + score_schol = -vectrick(pi, ret$invchol)) + if (standardize) + ret$invchol <- destandardize(invchol = object$scale, + score_schol = -vectrick(si, ret$invchol)) + if (!attr(si, "diag")) + ret$invchol <- ltMatrices(Lower_tri(ret$invchol, diag = FALSE), + diag = FALSE, + byrow = attr(ret$invchol, "byrow"), + names = dimnames(ret$invchol)[[2L]]) + ret$scale <- ret$invchol + ret$invchol <- NULL + ret$mean <- ret$mean[no,,drop = FALSE] + return(ret) + +} + diff --git a/R/lpmvnorm.R b/R/lpmvnorm.R index 9039d53..d59fb5b 100644 --- a/R/lpmvnorm.R +++ b/R/lpmvnorm.R @@ -53,7 +53,7 @@ lpmvnorm <- function(lower, upper, mean = 0, center = NULL, chol, invchol, if (!is.matrix(upper)) upper <- matrix(upper, ncol = 1) stopifnot(isTRUE(all.equal(dim(lower), dim(upper)))) - stopifnot(inherits(chol, "ltMatrices")) + stopifnot(is.ltMatrices(chol)) ### NOTE: replace with is.chol byrow_orig <- attr(chol, "byrow") chol <- ltMatrices(chol, byrow = TRUE) d <- dim(chol) @@ -63,8 +63,11 @@ lpmvnorm <- function(lower, upper, mean = 0, center = NULL, chol, invchol, stopifnot(nrow(lower) == J && ncol(lower) == N) stopifnot(nrow(upper) == J && ncol(upper) == N) - if (is.matrix(mean)) + if (is.matrix(mean)) { + if (ncol(mean) == 1L) + mean <- mean[,rep(1, N),drop = FALSE] stopifnot(nrow(mean) == J && ncol(mean) == N) + } lower <- lower - mean upper <- upper - mean @@ -122,8 +125,10 @@ lpmvnorm <- function(lower, upper, mean = 0, center = NULL, chol, invchol, # slpmvnorm -slpmvnorm <- function(lower, upper, mean = 0, center = NULL, chol, invchol, logLik = TRUE, M = NULL, - w = NULL, seed = NULL, tol = .Machine$double.eps, fast = FALSE) { +slpmvnorm <- function(lower, upper, mean = 0, center = NULL, + chol, invchol, logLik = TRUE, M = NULL, + w = NULL, seed = NULL, tol = .Machine$double.eps, + fast = FALSE) { # init random seed, reset on exit @@ -150,7 +155,7 @@ slpmvnorm <- function(lower, upper, mean = 0, center = NULL, chol, invchol, logL if (!is.matrix(upper)) upper <- matrix(upper, ncol = 1) stopifnot(isTRUE(all.equal(dim(lower), dim(upper)))) - stopifnot(inherits(chol, "ltMatrices")) + stopifnot(is.ltMatrices(chol)) ### NOTE: replace with is.chol byrow_orig <- attr(chol, "byrow") chol <- ltMatrices(chol, byrow = TRUE) d <- dim(chol) @@ -160,8 +165,11 @@ slpmvnorm <- function(lower, upper, mean = 0, center = NULL, chol, invchol, logL stopifnot(nrow(lower) == J && ncol(lower) == N) stopifnot(nrow(upper) == J && ncol(upper) == N) - if (is.matrix(mean)) + if (is.matrix(mean)) { + if (ncol(mean) == 1L) + mean <- mean[,rep(1, N),drop = FALSE] stopifnot(nrow(mean) == J && ncol(mean) == N) + } lower <- lower - mean upper <- upper - mean @@ -257,7 +265,8 @@ slpmvnorm <- function(lower, upper, mean = 0, center = NULL, chol, invchol, logL # post differentiate invchol score if (!missing(invchol)) { - ret <- ltMatrices(ret, diag = TRUE, byrow = TRUE) + ret <- ltMatrices(ret, diag = TRUE, byrow = TRUE, + names = dimnames(chol)[[2L]]) ### this means vectrick(chol, ret, chol) ret <- - unclass(vectrick(chol, ret)) } @@ -267,11 +276,15 @@ slpmvnorm <- function(lower, upper, mean = 0, center = NULL, chol, invchol, logL if (!attr(chol, "diag")) ### remove scores for constant diagonal elements ret[idx,] <- 0 - ret <- ltMatrices(ret, diag = TRUE, byrow = TRUE) + ret <- ltMatrices(ret, diag = TRUE, byrow = TRUE, + names = dimnames(chol)[[2L]]) ret <- ltMatrices(ret, byrow = byrow_orig) + rownames(smean) <- rownames(slower) <- + rownames(supper) <- dimnames(chol)[[2L]] + if (logLik) { ret <- list(logLik = ll, mean = smean, @@ -285,3 +298,406 @@ slpmvnorm <- function(lower, upper, mean = 0, center = NULL, chol, invchol, logL return(ret) } +# ldmvnorm + +ldmvnorm <- function(obs, mean = 0, chol, invchol, logLik = TRUE) { + + stopifnot(xor(missing(chol), missing(invchol))) + if (!is.matrix(obs)) obs <- matrix(obs, ncol = 1L) + p <- ncol(obs) + + if (!missing(chol)) { + # ldmvnorm chol + + if (missing(chol)) + stop("either chol or invchol must be given") + ## chol is given + if (!is.ltMatrices(chol)) ### NOTE: replace with is.chol + stop("chol is not an object of class ltMatrices") + N <- dim(chol)[1L] + N <- ifelse(N == 1, p, N) + J <- dim(chol)[2L] + obs <- .check_obs(obs = obs, mean = mean, J = J, N = N) + z <- solve(chol, obs) + logretval <- .colSumsdnorm(z) + if (attr(chol, "diag")) + logretval <- logretval - logdet(chol) + + } else { + # ldmvnorm invchol + + ## invchol is given + if (!is.ltMatrices(invchol)) ### NOTE: replace with is.invchol + stop("invchol is not an object of class ltMatrices") + N <- dim(invchol)[1L] + N <- ifelse(N == 1, p, N) + J <- dim(invchol)[2L] + obs <- .check_obs(obs = obs, mean = mean, J = J, N = N) + ## NOTE: obs is (J x N) + ## dnorm takes rather long + z <- Mult(invchol, obs) + logretval <- .colSumsdnorm(z) + ## note that the second summand gets recycled the correct number + ## of times in case dim(invchol)[1L] == 1 but ncol(obs) > 1 + if (attr(invchol, "diag")) + logretval <- logretval + logdet(invchol) + + } + + names(logretval) <- colnames(obs) + if (logLik) return(sum(logretval)) + return(logretval) +} + +# sldmvnorm + +sldmvnorm <- function(obs, mean = 0, chol, invchol, logLik = TRUE) { + + stopifnot(xor(missing(chol), missing(invchol))) + if (!is.matrix(obs)) obs <- matrix(obs, ncol = 1L) + + if (!missing(invchol)) { + + N <- dim(invchol)[1L] + N <- ifelse(N == 1, ncol(obs), N) + J <- dim(invchol)[2L] + obs <- .check_obs(obs = obs, mean = mean, J = J, N = N) + + Mix <- Mult(invchol, obs) + sobs <- - Mult(invchol, Mix, transpose = TRUE) + + Y <- matrix(obs, byrow = TRUE, nrow = J, ncol = N * J) + ret <- - matrix(Mix[, rep(1:N, each = J)] * Y, ncol = N) + + M <- matrix(1:(J^2), nrow = J, byrow = FALSE) + ret <- ret[M[lower.tri(M, diag = attr(invchol, "diag"))],,drop = FALSE] + if (!is.null(dimnames(invchol)[[1L]])) + colnames(ret) <- dimnames(invchol)[[1]] + ret <- ltMatrices(ret, + diag = attr(invchol, "diag"), byrow = FALSE, + names = dimnames(invchol)[[2L]]) + ret <- ltMatrices(ret, diag = attr(invchol, "diag"), + byrow = attr(invchol, "byrow")) + if (attr(invchol, "diag")) { + ### recycle properly + diagonals(ret) <- diagonals(ret) + c(1 / diagonals(invchol)) + } else { + diagonals(ret) <- 0 + } + ret <- list(obs = sobs, invchol = ret) + if (logLik) + ret$logLik <- ldmvnorm(obs = obs, mean = mean, + invchol = invchol, logLik = FALSE) + return(ret) + } + + invchol <- solve(chol) + ret <- sldmvnorm(obs = obs, mean = mean, invchol = invchol) + ### this means: ret$chol <- - vectrick(invchol, ret$invchol, invchol) + ret$chol <- as.chol(- vectrick(invchol, ret$invchol)) + ret$invchol <- NULL + return(ret) +} + +# ldpmvnorm + +ldpmvnorm <- function(obs, lower, upper, mean = 0, chol, invchol, + logLik = TRUE, ...) { + + if (missing(obs) || is.null(obs)) + return(lpmvnorm(lower = lower, upper = upper, mean = mean, + chol = chol, invchol = invchol, logLik = logLik, ...)) + if (missing(lower) && missing(upper) || is.null(lower) && is.null(upper)) + return(ldmvnorm(obs = obs, mean = mean, + chol = chol, invchol = invchol, logLik = logLik)) + + # dp input checks + + stopifnot(xor(missing(chol), missing(invchol))) + cJ <- nrow(obs) + dJ <- nrow(lower) + N <- ncol(obs) + stopifnot(N == ncol(lower)) + stopifnot(N == ncol(upper)) + if (all(mean == 0)) { + cmean <- 0 + dmean <- 0 + } else { + if (!is.matrix(mean) || NCOL(mean) == 1L) + mean <- matrix(mean, nrow = cJ + dJ, ncol = N) + stopifnot(nrow(mean) == cJ + dJ) + stopifnot(ncol(mean) == N) + cmean <- mean[1:cJ,, drop = FALSE] + dmean <- mean[-(1:cJ),, drop = FALSE] + } + + + if (!missing(invchol)) { + J <- dim(invchol)[2L] + stopifnot(cJ + dJ == J) + + md <- marg_mvnorm(invchol = invchol, which = 1:cJ) + ret <- ldmvnorm(obs = obs, mean = cmean, invchol = md$invchol, + logLik = logLik) + + cd <- cond_mvnorm(invchol = invchol, which_given = 1:cJ, + given = obs - cmean, center = TRUE) + ret <- ret + lpmvnorm(lower = lower, upper = upper, mean = dmean, + invchol = cd$invchol, center = cd$center, + logLik = logLik, ...) + return(ret) + } + + J <- dim(chol)[2L] + stopifnot(cJ + dJ == J) + + md <- marg_mvnorm(chol = chol, which = 1:cJ) + ret <- ldmvnorm(obs = obs, mean = cmean, chol = md$chol, logLik = logLik) + + cd <- cond_mvnorm(chol = chol, which_given = 1:cJ, + given = obs - cmean, center = TRUE) + ret <- ret + lpmvnorm(lower = lower, upper = upper, mean = dmean, + chol = cd$chol, center = cd$center, + logLik = logLik, ...) + return(ret) +} + +# sldpmvnorm + +sldpmvnorm <- function(obs, lower, upper, mean = 0, chol, invchol, + logLik = TRUE, ...) { + + if (missing(obs) || is.null(obs)) + return(slpmvnorm(lower = lower, upper = upper, mean = mean, + chol = chol, invchol = invchol, logLik = logLik, ...)) + if (missing(lower) && missing(upper) || is.null(lower) && is.null(upper)) + return(sldmvnorm(obs = obs, mean = mean, + chol = chol, invchol = invchol, logLik = logLik)) + + # dp input checks + + stopifnot(xor(missing(chol), missing(invchol))) + cJ <- nrow(obs) + dJ <- nrow(lower) + N <- ncol(obs) + stopifnot(N == ncol(lower)) + stopifnot(N == ncol(upper)) + if (all(mean == 0)) { + cmean <- 0 + dmean <- 0 + } else { + if (!is.matrix(mean) || NCOL(mean) == 1L) + mean <- matrix(mean, nrow = cJ + dJ, ncol = N) + stopifnot(nrow(mean) == cJ + dJ) + stopifnot(ncol(mean) == N) + cmean <- mean[1:cJ,, drop = FALSE] + dmean <- mean[-(1:cJ),, drop = FALSE] + } + + + if (!missing(invchol)) { + # sldpmvnorm invchol + + byrow_orig <- attr(invchol, "byrow") + invchol <- ltMatrices(invchol, byrow = TRUE) + + J <- dim(invchol)[2L] + stopifnot(cJ + dJ == J) + + md <- marg_mvnorm(invchol = invchol, which = 1:cJ) + cs <- sldmvnorm(obs = obs, mean = cmean, invchol = md$invchol) + + obs_cmean <- obs - cmean + cd <- cond_mvnorm(invchol = invchol, which_given = 1:cJ, + given = obs_cmean, center = TRUE) + ds <- slpmvnorm(lower = lower, upper = upper, mean = dmean, + center = cd$center, invchol = cd$invchol, + logLik = logLik, ...) + + tmp0 <- solve(cd$invchol, ds$mean, transpose = TRUE) + tmp <- - tmp0[rep(1:dJ, each = cJ),,drop = FALSE] * + obs_cmean[rep(1:cJ, dJ),,drop = FALSE] + + Jp <- nrow(unclass(invchol)) + diag <- attr(invchol, "diag") + M <- as.array(ltMatrices(1:Jp, diag = diag, byrow = TRUE))[,,1] + ret <- matrix(0, nrow = Jp, ncol = ncol(obs)) + M1 <- M[1:cJ, 1:cJ] + idx <- t(M1)[upper.tri(M1, diag = diag)] + ret[idx,] <- Lower_tri(cs$invchol, diag = diag) + + idx <- c(t(M[-(1:cJ), 1:cJ])) + ret[idx,] <- tmp + + M3 <- M[-(1:cJ), -(1:cJ)] + idx <- t(M3)[upper.tri(M3, diag = diag)] + ret[idx,] <- Lower_tri(ds$invchol, diag = diag) + + ret <- ltMatrices(ret, diag = diag, byrow = TRUE) + if (!diag) diagonals(ret) <- 0 + ret <- ltMatrices(ret, byrow = byrow_orig) + + ### post differentiate mean + aL <- as.array(invchol)[-(1:cJ), 1:cJ,,drop = FALSE] + lst <- tmp0[rep(1:dJ, cJ),,drop = FALSE] + if (dim(aL)[3] == 1) + aL <- aL[,,rep(1, ncol(lst)), drop = FALSE] + dim <- dim(aL) + dobs <- -margin.table(aL * array(lst, dim = dim), 2:3) + + ret <- c(list(invchol = ret, obs = cs$obs + dobs), + ds[c("lower", "upper")]) + ret$mean <- rbind(-ret$obs, ds$mean) + return(ret) + + } + + invchol <- solve(chol) + ret <- sldpmvnorm(obs = obs, lower = lower, upper = upper, + mean = mean, invchol = invchol, logLik = logLik, ...) + ### this means: ret$chol <- - vectrick(invchol, ret$invchol, invchol) + ret$chol <- as.chol(- vectrick(invchol, ret$invchol)) + ret$invchol <- NULL + return(ret) +} + +# deperma + +deperma <- function(chol = solve(invchol), + permuted_chol = solve(permuted_invchol), + invchol, permuted_invchol, perm, score_schol) { + + # deperma input checks chol + + stopifnot(is.ltMatrices(chol)) ### NOTE: replace with is.chol + byrow_orig <- attr(chol, "byrow") + chol <- ltMatrices(chol, byrow = FALSE) + stopifnot(is.ltMatrices(permuted_chol)) ### NOTE: replace with is.chol + permuted_chol <- ltMatrices(permuted_chol, byrow = FALSE) + stopifnot(max(abs(dim(chol) - dim(permuted_chol))) == 0) + J <- dim(chol)[2L] + stopifnot(attr(chol, "diag")) + INVCHOL <- !missing(invchol) + + # deperma input checks perm + + if (missing(perm)) return(score_schol) + stopifnot(isTRUE(all.equal(sort(perm), 1:J))) + if (max(abs(perm - 1:J)) == 0) return(score_schol) + + # deperma input checks schol + + if (is.ltMatrices(score_schol)) { + byrow_orig_s <- attr(score_schol, "byrow") + score_schol <- ltMatrices(score_schol, byrow = FALSE) + ### don't do this here! + ### if (INVCHOL) score_schol <- -vectrick(permuted_invchol, score_schol) + score_schol <- unclass(score_schol) ### this preserves byrow + } + stopifnot(is.matrix(score_schol)) + N <- ncol(score_schol) + stopifnot(J * (J + 1) / 2 == nrow(score_schol)) + + + # deperma indices + + idx <- matrix(1:J^2, nrow = J, ncol = J) ### assuming byrow = TRUE + tidx <- c(t(idx)) + ltT <- idx[lower.tri(idx, diag = TRUE)] + P <- matrix(0, nrow = J, ncol = J) + P[cbind(1:J, perm)] <- 1 + ID <- diag(J) + IDP <- (ID %x% P) + + + Nc <- dim(chol)[1L] + mC <- as.array(chol)[perm,,,drop = FALSE] + Ct <- as.array(permuted_chol) + ret <- lapply(1:Nc, function(i) { + B1 <- (mC[,,i] %x% ID) + (ID %x% mC[,,i])[,tidx] + # ^^^^^^^ <- d t(A) / d A + B1 <- B1 %*% IDP + B1 <- B1[,ltT] ### relevant columns of B1 + B2 <- (Ct[,,i] %x% ID) + (ID %x% Ct[,,i])[,tidx] + B2 <- B2[,ltT] ### relevant columns of B2 + B3 <- try(solve(crossprod(B2), crossprod(B2, B1))) + if (inherits(B3, "try-error")) + stop("failure computing permutation score") + if (Nc == 1L) + return(crossprod(score_schol, B3)) + return(crossprod(score_schol[,i,drop = FALSE], B3)) + }) + ret <- do.call("rbind", ret) + ret <-ltMatrices(t(ret), diag = TRUE, byrow = FALSE) + if (INVCHOL) + ret <- -vectrick(chol, ret) + ret <- ltMatrices(ret, byrow = byrow_orig_s) + return(ret) +} + +# standardize + +standardize <- function(chol, invchol) { + stopifnot(xor(missing(chol), missing(invchol))) + if (!missing(invchol)) { + stopifnot(!attr(invchol, "diag")) + return(invcholD(invchol)) + } + stopifnot(!attr(chol, "diag")) + return(Dchol(chol)) +} + +# destandardize + +destandardize <- function(chol = solve(invchol), invchol, score_schol) +{ + stopifnot(is.ltMatrices(chol)) ### NOTE: replace with is.chol + J <- dim(chol)[2L] + stopifnot(!attr(chol, "diag")) + byrow_orig <- attr(chol, "byrow") + chol <- ltMatrices(chol, byrow = FALSE) + + ### TODO: check byrow in score_schol? + + if (is.ltMatrices(score_schol)) + score_schol <- matrix(as.array(score_schol), + nrow = dim(score_schol)[2L]^2) + stopifnot(is.matrix(score_schol)) + N <- ncol(score_schol) + stopifnot(J^2 == nrow(score_schol)) + + CCt <- Tcrossprod(chol, diag_only = TRUE) + DC <- Dchol(chol, D = Dinv <- 1 / sqrt(CCt)) + SDC <- solve(DC) + + IDX <- t(M <- matrix(1:J^2, nrow = J, ncol = J)) + i <- cumsum(c(1, rep(J + 1, J - 1))) + ID <- diagonals(as.integer(J), byrow = FALSE) + if (dim(ID)[1L] != dim(chol)[1L]) + ID <- ID[rep(1, dim(chol)[1L]),] + + B <- vectrick(ID, score_schol, chol) + B[i,] <- B[i,] * (-.5) * c(CCt)^(-3/2) + B[-i,] <- 0 + + Dtmp <- Dchol(ID, D = Dinv) + + ret <- vectrick(ID, B, chol, transpose = c(TRUE, FALSE)) + + vectrick(chol, B, ID)[IDX,] + + vectrick(Dtmp, score_schol, ID) + + if (!missing(invchol)) { + ### this means: ret <- - vectrick(chol, ret, chol) + ret <- - vectrick(chol, ret) + } + ret <- ret[M[lower.tri(M)],,drop = FALSE] + if (!is.null(dimnames(chol)[[1L]])) + colnames(ret) <- dimnames(chol)[[1L]] + ret <- ltMatrices(ret, + diag = FALSE, byrow = FALSE, + names = dimnames(chol)[[2L]]) + ret <- ltMatrices(ret, byrow = byrow_orig) + diagonals(ret) <- 0 + return(ret) +} + diff --git a/R/ltMatrices.R b/R/ltMatrices.R index ea5b568..ed8c015 100644 --- a/R/ltMatrices.R +++ b/R/ltMatrices.R @@ -31,8 +31,10 @@ ltMatrices <- function(object, diag = FALSE, byrow = FALSE, names = TRUE) { # ltMatrices input - if (inherits(object, "ltMatrices")) { + if (is.ltMatrices(object)) { + cls <- class(object) ### keep inheriting classes ret <- .reorder(object, byrow = byrow) + class(ret) <- class(object) return(ret) } @@ -64,7 +66,9 @@ ltMatrices <- function(object, diag = FALSE, byrow = FALSE, names = TRUE) { rownames(object) <- t(L)[upper.tri(L, diag = diag)] else rownames(object) <- L[lower.tri(L, diag = diag)] - } + } # else { ### add later + # warning("ltMatrices objects should be properly named") + # } attr(object, "J") <- J @@ -78,13 +82,17 @@ ltMatrices <- function(object, diag = FALSE, byrow = FALSE, names = TRUE) { # syMatrices -as.syMatrices <- function(object) { - stopifnot(inherits(object, "ltMatrices")) - class(object)[1L] <- "syMatrices" - return(object) +as.syMatrices <- function(x) { + if (is.syMatrices(x)) + return(x) + x <- as.ltMatrices(x) ### make sure "ltMatrices" + ### is first class + class(x)[1L] <- "syMatrices" + return(x) } syMatrices <- function(object, diag = FALSE, byrow = FALSE, names = TRUE) - as.syMatrices(ltMatrices(object = object, diag = diag, byrow = byrow, names = names)) + as.syMatrices(ltMatrices(object = object, diag = diag, byrow = byrow, + names = names)) # dim ltMatrices @@ -107,6 +115,39 @@ names.ltMatrices <- function(x) { } names.syMatrices <- names.ltMatrices +# is.ltMatrices + +is.ltMatrices <- function(x) inherits(x, "ltMatrices") +is.syMatrices <- function(x) inherits(x, "syMatrices") +as.ltMatrices <- function(x) UseMethod("as.ltMatrices") +as.ltMatrices.syMatrices <- function(x) { + cls <- class(x) + class(x) <- cls[which(cls == "syMatrices"):length(cls)] + class(x)[1L] <- "ltMatrices" + return(x) +} +as.ltMatrices.ltMatrices <- function(x) { + cls <- class(x) + class(x) <- cls[which(cls == "ltMatrices"):length(cls)] + return(x) +} + +# as.ltMatrices + +as.ltMatrices.default <- function(x) { + stopifnot(is.numeric(x)) + if (!is.matrix(x)) x <- matrix(x) + DIAG <- max(abs(diag(x) - 1)) > .Machine$double.eps + DIAG <- DIAG & (nrow(x) > 1) + lt <- x[lower.tri(x, diag = DIAG)] + up <- x[upper.tri(x, diag = FALSE)] + stopifnot(max(abs(up)) < .Machine$double.eps) + nm <- rownames(x) + if (!is.null(nm)) + return(ltMatrices(lt, diag = DIAG, names = nm)) + return(ltMatrices(lt, diag = DIAG)) +} + # print ltMatrices as.array.ltMatrices <- function(x, symmetric = FALSE, ...) { @@ -156,7 +197,7 @@ print.syMatrices <- function(x, ...) .reorder <- function(x, byrow = FALSE) { - stopifnot(inherits(x, "ltMatrices")) + stopifnot(is.ltMatrices(x)) if (attr(x, "byrow") == byrow) return(x) # extract slots @@ -203,6 +244,11 @@ print.syMatrices <- function(x, ...) if (!missing(j)) { + if (is.character(j)) { + stopifnot(all(j %in% dn[[2L]])) + j <- match(j, dn[[2L]]) + } + j <- (1:J)[j] ### get rid of negative indices if (length(j) == 1L && !diag) { @@ -238,6 +284,10 @@ print.syMatrices <- function(x, ...) ### if j is not ordered, result is not a lower triangular matrix "[.ltMatrices" <- function(x, i, j, ..., drop = FALSE) { if (!missing(j)) { + if (is.character(j)) { + stopifnot(all(j %in% dimnames(x)[[2L]])) + j <- match(j, dimnames(x)[[2L]]) + } if (all(j > 0)) { if (any(diff(j) < 0)) stop("invalid subset argument j") } @@ -247,7 +297,7 @@ print.syMatrices <- function(x, ...) } "[.syMatrices" <- function(x, i, j, ..., drop = FALSE) { - class(x)[1L] <- "ltMatrices" + x <- as.syMatrices(x) ret <- .subset_ltMatrices(x = x, i = i, j = j, ..., drop = drop) class(ret)[1L] <- "syMatrices" ret @@ -257,9 +307,8 @@ print.syMatrices <- function(x, ...) Lower_tri <- function(x, diag = FALSE, byrow = attr(x, "byrow")) { - if (inherits(x, "syMatrices")) - class(x)[1L] <- "ltMatrices" - stopifnot(inherits(x, "ltMatrices")) + if (is.syMatrices(x)) + x <- as.ltMatrices(x) adiag <- diag x <- ltMatrices(x, byrow = byrow) @@ -273,11 +322,11 @@ Lower_tri <- function(x, diag = FALSE, byrow = attr(x, "byrow")) { if (diag == adiag) - return(unclass(x)) + return(unclass(x)[,,drop = FALSE]) ### remove attributes if (!diag && adiag) { diagonals(x) <- 1 - return(unclass(x)) + return(unclass(x)[,,drop = FALSE]) ### remove attributes } x <- unclass(x) @@ -406,7 +455,7 @@ Mult.syMatrices <- function(x, y, ...) { dn <- dimnames(x) - class(x)[1L] <- "ltMatrices" + x <- as.ltMatrices(x) stopifnot(is.numeric(y)) if (!is.matrix(y)) y <- matrix(y, nrow = d[2L], ncol = d[1L]) N <- ifelse(d[1L] == 1, ncol(y), d[1L]) @@ -469,7 +518,7 @@ solve.ltMatrices <- function(a, b, transpose = FALSE, ...) { logdet <- function(x) { - if (!inherits(x, "ltMatrices")) + if (!is.ltMatrices(x)) stop("x is not an ltMatrices object") byrow <- attr(x, "byrow") @@ -492,7 +541,7 @@ logdet <- function(x) { ### diag(C %*% t(C)) => returns matrix of diagonal elements .Tcrossprod <- function(x, diag_only = FALSE, transpose = FALSE) { - if (!inherits(x, "ltMatrices")) { + if (!is.ltMatrices(x)) { ret <- tcrossprod(x) if (diag_only) ret <- diag(ret) return(ret) @@ -559,7 +608,7 @@ chol.syMatrices <- function(x, ...) { .adddiag <- function(x) { - stopifnot(inherits(x, "ltMatrices")) + stopifnot(is.ltMatrices(x)) if (attr(x, "diag")) return(x) @@ -638,7 +687,7 @@ chol.syMatrices <- function(x, ...) { "diagonals<-.syMatrices" <- function(x, value) { - class(x)[1L] <- "ltMatrices" + x <- as.ltMatrices(x) diagonals(x) <- value class(x)[1L] <- "syMatrices" @@ -654,7 +703,7 @@ vectrick <- function(C, S, A, transpose = c(TRUE, TRUE)) { # check C argument - stopifnot(inherits(C, "ltMatrices")) + C <- as.ltMatrices(C) if (!attr(C, "diag")) diagonals(C) <- 1 C_byrow_orig <- attr(C, "byrow") C <- ltMatrices(C, byrow = FALSE) @@ -662,12 +711,12 @@ vectrick <- function(C, S, A, transpose = c(TRUE, TRUE)) { nm <- attr(C, "rcnames") N <- dC[1L] J <- dC[2L] - class(C) <- class(C)[-1L] + class(C) <- class(C)[-1L] ### works because of as.ltMatrices(c) if (!is.double(C)) storage.mode(C) <- "double" # check S argument - SltM <- inherits(S, "ltMatrices") + SltM <- is.ltMatrices(S) if (SltM) { if (!attr(S, "diag")) diagonals(S) <- 1 S_byrow_orig <- attr(S, "byrow") @@ -699,7 +748,7 @@ vectrick <- function(C, S, A, transpose = c(TRUE, TRUE)) { if (missing(A)) { A <- C } else { - stopifnot(inherits(A, "ltMatrices")) + A <- as.ltMatrices(A) if (!attr(A, "diag")) diagonals(A) <- 1 A_byrow_orig <- attr(A, "byrow") stopifnot(C_byrow_orig == A_byrow_orig) @@ -732,10 +781,33 @@ vectrick <- function(C, S, A, transpose = c(TRUE, TRUE)) { # convenience functions +# chol classes + +is.chol <- function(x) inherits(x, "chol") +as.chol <- function(x) { + stopifnot(is.ltMatrices(x)) + if (is.chol(x)) return(x) + if (is.invchol(x)) + return(invchol2chol(x)) + class(x) <- c("chol", class(x)) + return(x) +} +is.invchol <- function(x) inherits(x, "invchol") +as.invchol <- function(x) { + stopifnot(is.ltMatrices(x)) + if (is.invchol(x)) return(x) + if (is.chol(x)) + return(chol2invchol(x)) + class(x) <- c("invchol", class(x)) + return(x) +} + # D times C Dchol <- function(x, D = 1 / sqrt(Tcrossprod(x, diag_only = TRUE))) { + if (is.invchol(x)) stop("Dchol cannot work with invchol objects") + x <- .adddiag(x) byrow_orig <- attr(x, "byrow") @@ -746,10 +818,15 @@ Dchol <- function(x, D = 1 / sqrt(Tcrossprod(x, diag_only = TRUE))) { J <- dim(x)[2L] nm <- dimnames(x)[[2L]] + ### for some parameter configurations logdet(ret) would + ### be -Inf; make sure this does't happen + if (any(D < .Machine$double.eps)) + D[D < .Machine$double.eps] <- 2 * .Machine$double.eps + x <- unclass(x) * D[rep(1:J, 1:J),,drop = FALSE] ret <- ltMatrices(x, diag = TRUE, byrow = TRUE, names = nm) - ret <- ltMatrices(ret, byrow = byrow_orig) + ret <- as.chol(ltMatrices(ret, byrow = byrow_orig)) return(ret) } @@ -758,6 +835,8 @@ Dchol <- function(x, D = 1 / sqrt(Tcrossprod(x, diag_only = TRUE))) { ### invcholD = solve(Dchol) invcholD <- function(x, D = sqrt(Tcrossprod(solve(x), diag_only = TRUE))) { + if (is.chol(x)) stop("invcholD cannot work with chol objects") + x <- .adddiag(x) byrow_orig <- attr(x, "byrow") @@ -768,10 +847,15 @@ invcholD <- function(x, D = sqrt(Tcrossprod(solve(x), diag_only = TRUE))) { J <- dim(x)[2L] nm <- dimnames(x)[[2L]] + ### for some parameter configurations logdet(ret) would + ### be -Inf; make sure this does't happen + if (any(D < .Machine$double.eps)) + D[D < .Machine$double.eps] <- 2 * .Machine$double.eps + x <- unclass(x) * D[rep(1:J, J:1),,drop = FALSE] ret <- ltMatrices(x, diag = TRUE, byrow = FALSE, names = nm) - ret <- ltMatrices(ret, byrow = byrow_orig) + ret <- as.invchol(ltMatrices(ret, byrow = byrow_orig)) return(ret) } @@ -782,11 +866,11 @@ chol2cov <- function(x) ### L -> C invchol2chol <- function(x) - solve(x) + as.chol(solve(x)) ### C -> L chol2invchol <- function(x) - solve(x) + as.invchol(solve(x)) ### L -> Sigma invchol2cov <- function(x) @@ -827,16 +911,47 @@ chol2pc <- function(x) # aperm -aperm.ltMatrices <- function(a, perm, is_chol = FALSE, ...) { +aperm.chol <- function(a, perm, ...) { - if (is_chol) { ### a is Cholesky of covariance - Sperm <- chol2cov(a)[,perm] - return(chol(Sperm)) - } + # aperm checks + + J <- dim(a)[2L] + if (missing(perm)) return(a) + if (is.character(perm)) + perm <- match(perm, dimnames(a)[[2L]]) + stopifnot(all(perm %in% 1:J)) + + args <- list(...) + if (length(args) > 0L) + warning("Additional arguments", names(args), "ignored") + - Sperm <- invchol2cov(a)[,perm] - chol2invchol(chol(Sperm)) + return(as.chol(chol(chol2cov(a)[,perm]))) } +aperm.invchol <- function(a, perm, ...) { + + # aperm checks + + J <- dim(a)[2L] + if (missing(perm)) return(a) + if (is.character(perm)) + perm <- match(perm, dimnames(a)[[2L]]) + stopifnot(all(perm %in% 1:J)) + + args <- list(...) + if (length(args) > 0L) + warning("Additional arguments", names(args), "ignored") + + + return(chol2invchol(chol(invchol2cov(a)[,perm]))) +} + +aperm.ltMatrices <- function(a, perm, ...) + stop("Cannot permute objects of class ltMatrices, + consider calling as.chol() or as.invchol() first") + +aperm.syMatrices <- function(a, perm, ...) + return(a[,perm]) # marginal @@ -847,10 +962,13 @@ marg_mvnorm <- function(chol, invchol, which = 1L) { stopifnot(xor(missing(chol), missing(invchol))) x <- if (missing(chol)) invchol else chol - stopifnot(inherits(x, "ltMatrices")) + stopifnot(is.ltMatrices(x)) N <- dim(x)[1L] J <- dim(x)[2L] + + if (missing(which)) return(x) + if (is.character(which)) which <- match(which, dimnames(x)[[2L]]) stopifnot(all(which %in% 1:J)) @@ -860,9 +978,12 @@ marg_mvnorm <- function(chol, invchol, which = 1L) { ### which is 1:j tmp <- x[,which] } else { - if (missing(chol)) x <- solve(x) - tmp <- base::chol(Tcrossprod(x)[,which]) - if (missing(chol)) tmp <- solve(tmp) + if (missing(chol)) x <- invchol2chol(x) + ### note: aperm would work but computes + ### Cholesky of J^2, here only length(which)^2 + ### is needed + tmp <- base::chol(chol2cov(x)[,which]) + if (missing(chol)) tmp <- chol2invchol(tmp) } if (missing(chol)) @@ -883,10 +1004,13 @@ cond_mvnorm <- function(chol, invchol, which_given = 1L, given, center = FALSE) stopifnot(xor(missing(chol), missing(invchol))) x <- if (missing(chol)) invchol else chol - stopifnot(inherits(x, "ltMatrices")) + stopifnot(is.ltMatrices(x)) N <- dim(x)[1L] J <- dim(x)[2L] + + if (missing(which)) return(x) + if (is.character(which)) which <- match(which, dimnames(x)[[2L]]) stopifnot(all(which %in% 1:J)) @@ -901,18 +1025,48 @@ cond_mvnorm <- function(chol, invchol, which_given = 1L, given, center = FALSE) ### which is 1:j L <- if (missing(invchol)) solve(chol) else invchol tmp <- matrix(0, ncol = ncol(given), nrow = J - length(which)) - centerm <- Mult(L, rbind(given, tmp))[-which,,drop = FALSE] + centerm <- Mult(L, rbind(given, tmp)) + ### if ncol(given) is not N = dim(L)[1L] > 1, then + ### solve() below won't work and we loop over + ### columns of centerm + if (dim(L)[1L] > 1 && ncol(given) != N) { + centerm <- lapply(1:ncol(centerm), function(j) + matrix(centerm[,j], nrow = J, ncol = N)[-which,,drop = FALSE] + ) + } else { + centerm <- centerm[-which,,drop = FALSE] + } L <- L[,-which] + ct <- centerm + if (!is.matrix(ct)) ct <- do.call("rbind", ct) + if (is.matrix(centerm)) { + m <- -solve(L, centerm) + } else { + m <- do.call("rbind", lapply(centerm, function(cm) -solve(L, cm))) + } if (missing(invchol)) { if (center) - return(list(center = centerm, chol = solve(L))) - return(list(mean = -solve(L, centerm), chol = solve(L))) + return(list(center = ct, chol = solve(L))) + return(list(mean = m, chol = solve(L))) } if (center) - return(list(center = centerm, invchol = L)) - return(list(mean = -solve(L, centerm), invchol = L)) + return(list(center = ct, invchol = L)) + return(list(mean = m, invchol = L)) } + + ### general with center = TRUE => permute first and go simple + if (center) { + perm <- c(which, (1:J)[!(1:J) %in% which]) + if (!missing(chol)) + return(cond_mvnorm(chol = aperm(as.chol(chol), perm = perm), + which_given = 1:length(which), given = given, + center = center)) + return(cond_mvnorm(invchol = aperm(as.invchol(invchol), perm = perm), + which_given = 1:length(which), given = given, + center = center)) + } + # cond general stopifnot(!center) @@ -970,57 +1124,6 @@ cond_mvnorm <- function(chol, invchol, which_given = 1L, given, center = FALSE) return(obs - mean) } -# ldmvnorm - -ldmvnorm <- function(obs, mean = 0, chol, invchol, logLik = TRUE) { - - stopifnot(xor(missing(chol), missing(invchol))) - if (!is.matrix(obs)) obs <- matrix(obs, ncol = 1L) - p <- ncol(obs) - - if (!missing(chol)) { - # ldmvnorm chol - - if (missing(chol)) - stop("either chol or invchol must be given") - ## chol is given - if (!inherits(chol, "ltMatrices")) - stop("chol is not an object of class ltMatrices") - N <- dim(chol)[1L] - N <- ifelse(N == 1, p, N) - J <- dim(chol)[2L] - obs <- .check_obs(obs = obs, mean = mean, J = J, N = N) - z <- solve(chol, obs) - logretval <- .colSumsdnorm(z) - if (attr(chol, "diag")) - logretval <- logretval - logdet(chol) - - } else { - # ldmvnorm invchol - - ## invchol is given - if (!inherits(invchol, "ltMatrices")) - stop("invchol is not an object of class ltMatrices") - N <- dim(invchol)[1L] - N <- ifelse(N == 1, p, N) - J <- dim(invchol)[2L] - obs <- .check_obs(obs = obs, mean = mean, J = J, N = N) - ## NOTE: obs is (J x N) - ## dnorm takes rather long - z <- Mult(invchol, obs) - logretval <- .colSumsdnorm(z) - ## note that the second summand gets recycled the correct number - ## of times in case dim(invchol)[1L] == 1 but ncol(obs) > 1 - if (attr(invchol, "diag")) - logretval <- logretval + logdet(invchol) - - } - - names(logretval) <- colnames(obs) - if (logLik) return(sum(logretval)) - return(logretval) -} - # colSumsdnorm ltMatrices .colSumsdnorm <- function(z) { @@ -1032,269 +1135,3 @@ ldmvnorm <- function(obs, mean = 0, chol, invchol, logLik = TRUE) { return(ret) } -# sldmvnorm - -sldmvnorm <- function(obs, mean = 0, chol, invchol, logLik = TRUE) { - - stopifnot(xor(missing(chol), missing(invchol))) - if (!is.matrix(obs)) obs <- matrix(obs, ncol = 1L) - - if (!missing(invchol)) { - - N <- dim(invchol)[1L] - N <- ifelse(N == 1, ncol(obs), N) - J <- dim(invchol)[2L] - obs <- .check_obs(obs = obs, mean = mean, J = J, N = N) - - Mix <- Mult(invchol, obs) - sobs <- - Mult(invchol, Mix, transpose = TRUE) - - Y <- matrix(obs, byrow = TRUE, nrow = J, ncol = N * J) - ret <- - matrix(Mix[, rep(1:N, each = J)] * Y, ncol = N) - - M <- matrix(1:(J^2), nrow = J, byrow = FALSE) - ret <- ltMatrices(ret[M[lower.tri(M, diag = attr(invchol, "diag"))],,drop = FALSE], - diag = attr(invchol, "diag"), byrow = FALSE) - ret <- ltMatrices(ret, - diag = attr(invchol, "diag"), byrow = attr(invchol, "byrow")) - if (attr(invchol, "diag")) { - ### recycle properly - diagonals(ret) <- diagonals(ret) + c(1 / diagonals(invchol)) - } else { - diagonals(ret) <- 0 - } - ret <- list(obs = sobs, invchol = ret) - if (logLik) - ret$logLik <- ldmvnorm(obs = obs, mean = mean, invchol = invchol, logLik = FALSE) - return(ret) - } - - invchol <- solve(chol) - ret <- sldmvnorm(obs = obs, mean = mean, invchol = invchol) - ### this means: ret$chol <- - vectrick(invchol, ret$invchol, invchol) - ret$chol <- - vectrick(invchol, ret$invchol) - ret$invchol <- NULL - return(ret) -} - -# ldpmvnorm - -ldpmvnorm <- function(obs, lower, upper, mean = 0, chol, invchol, - logLik = TRUE, ...) { - - if (missing(obs) || is.null(obs)) - return(lpmvnorm(lower = lower, upper = upper, mean = mean, - chol = chol, invchol = invchol, logLik = logLik, ...)) - if (missing(lower) && missing(upper) || is.null(lower) && is.null(upper)) - return(ldmvnorm(obs = obs, mean = mean, - chol = chol, invchol = invchol, logLik = logLik)) - - # dp input checks - - stopifnot(xor(missing(chol), missing(invchol))) - cJ <- nrow(obs) - dJ <- nrow(lower) - N <- ncol(obs) - stopifnot(N == ncol(lower)) - stopifnot(N == ncol(upper)) - if (all(mean == 0)) { - cmean <- 0 - dmean <- 0 - } else { - if (!is.matrix(mean)) - mean <- matrix(mean, nrow = cJ + dJ, ncol = N) - stopifnot(nrow(mean) == cJ + dJ) - stopifnot(ncol(mean) == N) - cmean <- mean[1:cJ,, drop = FALSE] - dmean <- mean[-(1:cJ),, drop = FALSE] - } - - - if (!missing(invchol)) { - J <- dim(invchol)[2L] - stopifnot(cJ + dJ == J) - - md <- marg_mvnorm(invchol = invchol, which = 1:cJ) - ret <- ldmvnorm(obs = obs, mean = cmean, invchol = md$invchol, - logLik = logLik) - - cd <- cond_mvnorm(invchol = invchol, which_given = 1:cJ, - given = obs - cmean, center = TRUE) - ret <- ret + lpmvnorm(lower = lower, upper = upper, mean = dmean, - invchol = cd$invchol, center = cd$center, - logLik = logLik, ...) - return(ret) - } - - J <- dim(chol)[2L] - stopifnot(cJ + dJ == J) - - md <- marg_mvnorm(chol = chol, which = 1:cJ) - ret <- ldmvnorm(obs = obs, mean = cmean, chol = md$chol, logLik = logLik) - - cd <- cond_mvnorm(chol = chol, which_given = 1:cJ, - given = obs - cmean, center = TRUE) - ret <- ret + lpmvnorm(lower = lower, upper = upper, mean = dmean, - chol = cd$chol, center = cd$center, - logLik = logLik, ...) - return(ret) -} - -# sldpmvnorm - -sldpmvnorm <- function(obs, lower, upper, mean = 0, chol, invchol, logLik = TRUE, ...) { - - if (missing(obs) || is.null(obs)) - return(slpmvnorm(lower = lower, upper = upper, mean = mean, - chol = chol, invchol = invchol, logLik = logLik, ...)) - if (missing(lower) && missing(upper) || is.null(lower) && is.null(upper)) - return(sldmvnorm(obs = obs, mean = mean, - chol = chol, invchol = invchol, logLik = logLik)) - - # dp input checks - - stopifnot(xor(missing(chol), missing(invchol))) - cJ <- nrow(obs) - dJ <- nrow(lower) - N <- ncol(obs) - stopifnot(N == ncol(lower)) - stopifnot(N == ncol(upper)) - if (all(mean == 0)) { - cmean <- 0 - dmean <- 0 - } else { - if (!is.matrix(mean)) - mean <- matrix(mean, nrow = cJ + dJ, ncol = N) - stopifnot(nrow(mean) == cJ + dJ) - stopifnot(ncol(mean) == N) - cmean <- mean[1:cJ,, drop = FALSE] - dmean <- mean[-(1:cJ),, drop = FALSE] - } - - - if (!missing(invchol)) { - # sldpmvnorm invchol - - byrow_orig <- attr(invchol, "byrow") - invchol <- ltMatrices(invchol, byrow = TRUE) - - J <- dim(invchol)[2L] - stopifnot(cJ + dJ == J) - - md <- marg_mvnorm(invchol = invchol, which = 1:cJ) - cs <- sldmvnorm(obs = obs, mean = cmean, invchol = md$invchol) - - obs_cmean <- obs - cmean - cd <- cond_mvnorm(invchol = invchol, which_given = 1:cJ, - given = obs_cmean, center = TRUE) - ds <- slpmvnorm(lower = lower, upper = upper, mean = dmean, - center = cd$center, invchol = cd$invchol, - logLik = logLik, ...) - - tmp0 <- solve(cd$invchol, ds$mean, transpose = TRUE) - tmp <- - tmp0[rep(1:dJ, each = cJ),,drop = FALSE] * - obs_cmean[rep(1:cJ, dJ),,drop = FALSE] - - Jp <- nrow(unclass(invchol)) - diag <- attr(invchol, "diag") - M <- as.array(ltMatrices(1:Jp, diag = diag, byrow = TRUE))[,,1] - ret <- matrix(0, nrow = Jp, ncol = ncol(obs)) - M1 <- M[1:cJ, 1:cJ] - idx <- t(M1)[upper.tri(M1, diag = diag)] - ret[idx,] <- Lower_tri(cs$invchol, diag = diag) - - idx <- c(t(M[-(1:cJ), 1:cJ])) - ret[idx,] <- tmp - - M3 <- M[-(1:cJ), -(1:cJ)] - idx <- t(M3)[upper.tri(M3, diag = diag)] - ret[idx,] <- Lower_tri(ds$invchol, diag = diag) - - ret <- ltMatrices(ret, diag = diag, byrow = TRUE) - if (!diag) diagonals(ret) <- 0 - ret <- ltMatrices(ret, byrow = byrow_orig) - - ### post differentiate mean - aL <- as.array(invchol)[-(1:cJ), 1:cJ,,drop = FALSE] - lst <- tmp0[rep(1:dJ, cJ),,drop = FALSE] - if (dim(aL)[3] == 1) - aL <- aL[,,rep(1, ncol(lst)), drop = FALSE] - dim <- dim(aL) - dobs <- -margin.table(aL * array(lst, dim = dim), 2:3) - - ret <- c(list(invchol = ret, obs = cs$obs + dobs), - ds[c("lower", "upper")]) - ret$mean <- rbind(-ret$obs, ds$mean) - return(ret) - - } - - invchol <- solve(chol) - ret <- sldpmvnorm(obs = obs, lower = lower, upper = upper, - mean = mean, invchol = invchol, logLik = logLik, ...) - ### this means: ret$chol <- - vectrick(invchol, ret$invchol, invchol) - ret$chol <- - vectrick(invchol, ret$invchol) - ret$invchol <- NULL - return(ret) -} - -# standardize - -standardize <- function(chol, invchol) { - stopifnot(xor(missing(chol), missing(invchol))) - if (!missing(invchol)) { - stopifnot(!attr(invchol, "diag")) - return(invcholD(invchol)) - } - stopifnot(!attr(chol, "diag")) - return(Dchol(chol)) -} - -# destandardize - -destandardize <- function(chol = solve(invchol), invchol, score_schol) -{ - stopifnot(inherits(chol, "ltMatrices")) - J <- dim(chol)[2L] - stopifnot(!attr(chol, "diag")) - byrow_orig <- attr(chol, "byrow") - chol <- ltMatrices(chol, byrow = FALSE) - - if (inherits(score_schol, "ltMatrices")) - score_schol <- matrix(as.array(score_schol), - nrow = dim(score_schol)[2L]^2) - stopifnot(is.matrix(score_schol)) - N <- ncol(score_schol) - stopifnot(J^2 == nrow(score_schol)) - - CCt <- Tcrossprod(chol, diag_only = TRUE) - DC <- Dchol(chol, D = Dinv <- 1 / sqrt(CCt)) - SDC <- solve(DC) - - IDX <- t(M <- matrix(1:J^2, nrow = J, ncol = J)) - i <- cumsum(c(1, rep(J + 1, J - 1))) - ID <- diagonals(as.integer(J), byrow = FALSE) - if (dim(ID)[1L] != dim(chol)[1L]) - ID <- ID[rep(1, dim(chol)[1L]),] - - B <- vectrick(ID, score_schol, chol) - B[i,] <- B[i,] * (-.5) * c(CCt)^(-3/2) - B[-i,] <- 0 - - Dtmp <- Dchol(ID, D = Dinv) - - ret <- vectrick(ID, B, chol, transpose = c(TRUE, FALSE)) + - vectrick(chol, B, ID)[IDX,] + - vectrick(Dtmp, score_schol, ID) - - if (!missing(invchol)) { - ### this means: ret <- - vectrick(chol, ret, chol) - ret <- - vectrick(chol, ret) - } - ret <- ltMatrices(ret[M[lower.tri(M)],,drop = FALSE], - diag = FALSE, byrow = FALSE) - ret <- ltMatrices(ret, byrow = byrow_orig) - diagonals(ret) <- 0 - return(ret) -} - diff --git a/build/partial.rdb b/build/partial.rdb index dedb9de..562deb3 100644 Binary files a/build/partial.rdb and b/build/partial.rdb differ diff --git a/build/vignette.rds b/build/vignette.rds index 608b136..81b2c3c 100644 Binary files a/build/vignette.rds and b/build/vignette.rds differ diff --git a/cleanup b/cleanup index fc2e3a3..5e41fc4 100755 --- a/cleanup +++ b/cleanup @@ -12,6 +12,9 @@ rm -rf *out rm -rf *toc rm -rf lpmvnorm* rm -rf ltMatrices* +rm -rf interface* +rm -rf lmvnorm_src.R* + for f in ./R/*~; do rm -f $f diff --git a/inst/NEWS.Rd b/inst/NEWS.Rd index cae7d8f..02ea094 100644 --- a/inst/NEWS.Rd +++ b/inst/NEWS.Rd @@ -2,6 +2,28 @@ \name{NEWS} \title{NEWS file for the \pkg{mvtnorm} package} +\section{Changes in Version 1.3-0 (2024-08-28)}{ + \subsection{Features}{ + \itemize{ + \item New (but still experimental) user interface for computing + on multivariate normal distributions. + \item Explain \code{cond\_mvnorm} a bit better in the vignette. + \item Add the possibility to compute log-likelihood and score + functions for permutations of variables (function \code{deperma}) + and explain the derivation of the gradient in the vignette. + \item Add \code{chol} and \code{invchol} classes, mainly to avoid + confusion. + \item Make sure \code{logdet(standardize())} is finite, always. + } + } + \subsection{Bugfixes}{ + \itemize{ + \item Names didn't propagate properly in several places. + \item Allow character subsets. + } + } +} + \section{Changes in Version 1.2-6 (2024-08-17)}{ \subsection{Features}{ \itemize{ @@ -19,15 +41,6 @@ } } -\section{Changes in Version 1.2-7 (2024-07-11)}{ - \subsection{Bugfixes}{ - \itemize{ - \item Fix typos in package vignette. - } - } -} - - \section{Changes in Version 1.2-5 (2024-05-18)}{ \subsection{Features}{ \itemize{ diff --git a/inst/doc/MVT_Rnews.pdf b/inst/doc/MVT_Rnews.pdf index 3da6928..fe5bc0a 100644 Binary files a/inst/doc/MVT_Rnews.pdf and b/inst/doc/MVT_Rnews.pdf differ diff --git a/inst/doc/lmvnorm_src.R b/inst/doc/lmvnorm_src.R index 7bb7f21..d25ab04 100644 --- a/inst/doc/lmvnorm_src.R +++ b/inst/doc/lmvnorm_src.R @@ -66,85 +66,177 @@ chk(a, b) ################################################### -### code chunk number 5: ex-subset -################################################### +### code chunk number 5: ex-subset (eval = FALSE) +################################################### +## ## subset +## a <- as.array(ltMatrices(xn, byrow = FALSE, names = nm)[i, j]) +## b <- as.array(ltMatrices(xn, byrow = FALSE, names = nm))[j, j, i] +## chk(a, b) +## +## a <- as.array(ltMatrices(xn, byrow = TRUE, names = nm)[i, j]) +## b <- as.array(ltMatrices(xn, byrow = TRUE, names = nm))[j, j, i] +## chk(a, b) +## +## a <- as.array(ltMatrices(xd, byrow = FALSE, +## diag = TRUE, names = nm)[i, j]) +## b <- as.array(ltMatrices(xd, byrow = FALSE, +## diag = TRUE, names = nm))[j, j, i] +## chk(a, b) +## +## a <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE, +## names = nm)[i, j]) +## b <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE, +## names = nm))[j, j, i] +## chk(a, b) + + +################################################### +### code chunk number 6: ex-subset-1 +################################################### +i <- colnames(xn)[1:2] +j <- 2:4 ## subset -a <- as.array(ltMatrices(xn, byrow = FALSE)[1:2, 2:4]) -b <- as.array(ltMatrices(xn, byrow = FALSE))[2:4, 2:4, 1:2] +a <- as.array(ltMatrices(xn, byrow = FALSE, names = nm)[i, j]) +b <- as.array(ltMatrices(xn, byrow = FALSE, names = nm))[j, j, i] chk(a, b) -a <- as.array(ltMatrices(xn, byrow = TRUE)[1:2, 2:4]) -b <- as.array(ltMatrices(xn, byrow = TRUE))[2:4, 2:4, 1:2] +a <- as.array(ltMatrices(xn, byrow = TRUE, names = nm)[i, j]) +b <- as.array(ltMatrices(xn, byrow = TRUE, names = nm))[j, j, i] chk(a, b) -a <- as.array(ltMatrices(xd, byrow = FALSE, diag = TRUE)[1:2, 2:4]) -b <- as.array(ltMatrices(xd, byrow = FALSE, diag = TRUE))[2:4, 2:4, 1:2] +a <- as.array(ltMatrices(xd, byrow = FALSE, + diag = TRUE, names = nm)[i, j]) +b <- as.array(ltMatrices(xd, byrow = FALSE, + diag = TRUE, names = nm))[j, j, i] chk(a, b) -a <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE)[1:2, 2:4]) -b <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE))[2:4, 2:4, 1:2] +a <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE, + names = nm)[i, j]) +b <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE, + names = nm))[j, j, i] chk(a, b) ################################################### -### code chunk number 6: ex-subset-2 +### code chunk number 7: ex-subset-2 ################################################### +i <- 1:2 +j <- nm[2:4] ## subset +a <- as.array(ltMatrices(xn, byrow = FALSE, names = nm)[i, j]) +b <- as.array(ltMatrices(xn, byrow = FALSE, names = nm))[j, j, i] +chk(a, b) + +a <- as.array(ltMatrices(xn, byrow = TRUE, names = nm)[i, j]) +b <- as.array(ltMatrices(xn, byrow = TRUE, names = nm))[j, j, i] +chk(a, b) + +a <- as.array(ltMatrices(xd, byrow = FALSE, + diag = TRUE, names = nm)[i, j]) +b <- as.array(ltMatrices(xd, byrow = FALSE, + diag = TRUE, names = nm))[j, j, i] +chk(a, b) + +a <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE, + names = nm)[i, j]) +b <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE, + names = nm))[j, j, i] +chk(a, b) + + +################################################### +### code chunk number 8: ex-subset-3 +################################################### j <- c(1, 3, 5) -a <- as.array(ltMatrices(xn, byrow = FALSE)[1:2, j]) -b <- as.array(ltMatrices(xn, byrow = FALSE))[j, j, 1:2] +## subset +a <- as.array(ltMatrices(xn, byrow = FALSE, names = nm)[i, j]) +b <- as.array(ltMatrices(xn, byrow = FALSE, names = nm))[j, j, i] chk(a, b) -a <- as.array(ltMatrices(xn, byrow = TRUE)[1:2, j]) -b <- as.array(ltMatrices(xn, byrow = TRUE))[j, j, 1:2] +a <- as.array(ltMatrices(xn, byrow = TRUE, names = nm)[i, j]) +b <- as.array(ltMatrices(xn, byrow = TRUE, names = nm))[j, j, i] chk(a, b) -a <- as.array(ltMatrices(xd, byrow = FALSE, diag = TRUE)[1:2, j]) -b <- as.array(ltMatrices(xd, byrow = FALSE, diag = TRUE))[j, j, 1:2] +a <- as.array(ltMatrices(xd, byrow = FALSE, + diag = TRUE, names = nm)[i, j]) +b <- as.array(ltMatrices(xd, byrow = FALSE, + diag = TRUE, names = nm))[j, j, i] chk(a, b) -a <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE)[1:2, j]) -b <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE))[j, j, 1:2] +a <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE, + names = nm)[i, j]) +b <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE, + names = nm))[j, j, i] chk(a, b) ################################################### -### code chunk number 7: ex-subset-3 +### code chunk number 9: ex-subset-4 ################################################### +j <- nm[c(1, 3, 5)] ## subset +a <- as.array(ltMatrices(xn, byrow = FALSE, names = nm)[i, j]) +b <- as.array(ltMatrices(xn, byrow = FALSE, names = nm))[j, j, i] +chk(a, b) + +a <- as.array(ltMatrices(xn, byrow = TRUE, names = nm)[i, j]) +b <- as.array(ltMatrices(xn, byrow = TRUE, names = nm))[j, j, i] +chk(a, b) + +a <- as.array(ltMatrices(xd, byrow = FALSE, + diag = TRUE, names = nm)[i, j]) +b <- as.array(ltMatrices(xd, byrow = FALSE, + diag = TRUE, names = nm))[j, j, i] +chk(a, b) + +a <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE, + names = nm)[i, j]) +b <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE, + names = nm))[j, j, i] +chk(a, b) + + +################################################### +### code chunk number 10: ex-subset-5 +################################################### j <- -c(1, 3, 5) -a <- as.array(ltMatrices(xn, byrow = FALSE)[1:2, j]) -b <- as.array(ltMatrices(xn, byrow = FALSE))[j, j, 1:2] +## subset +a <- as.array(ltMatrices(xn, byrow = FALSE, names = nm)[i, j]) +b <- as.array(ltMatrices(xn, byrow = FALSE, names = nm))[j, j, i] chk(a, b) -a <- as.array(ltMatrices(xn, byrow = TRUE)[1:2, j]) -b <- as.array(ltMatrices(xn, byrow = TRUE))[j, j, 1:2] +a <- as.array(ltMatrices(xn, byrow = TRUE, names = nm)[i, j]) +b <- as.array(ltMatrices(xn, byrow = TRUE, names = nm))[j, j, i] chk(a, b) -a <- as.array(ltMatrices(xd, byrow = FALSE, diag = TRUE)[1:2, j]) -b <- as.array(ltMatrices(xd, byrow = FALSE, diag = TRUE))[j, j, 1:2] +a <- as.array(ltMatrices(xd, byrow = FALSE, + diag = TRUE, names = nm)[i, j]) +b <- as.array(ltMatrices(xd, byrow = FALSE, + diag = TRUE, names = nm))[j, j, i] chk(a, b) -a <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE)[1:2, j]) -b <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE))[j, j, 1:2] +a <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE, + names = nm)[i, j]) +b <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE, + names = nm))[j, j, i] chk(a, b) ################################################### -### code chunk number 8: ex-subset-4 +### code chunk number 11: ex-subset-6 ################################################### ## subset -j <- sample(1:J) -ltM <- ltMatrices(xn, byrow = FALSE) -try(ltM[1:2, j]) +j <- nm[sample(1:J)] +ltM <- ltMatrices(xn, byrow = FALSE, names = nm) +try(ltM[i, j]) ltM <- as.syMatrices(ltM) -a <- as.array(ltM[1:2, j]) -b <- as.array(ltM)[j, j, 1:2] +a <- as.array(ltM[i, j]) +b <- as.array(ltM)[j, j, i] chk(a, b) ################################################### -### code chunk number 9: ex-Lower_tri +### code chunk number 12: ex-Lower_tri ################################################### ## J <- 4 M <- ltMatrices(matrix(1:10, nrow = 10, ncol = 2), diag = TRUE) @@ -158,13 +250,13 @@ Lower_tri(invchol2cor(M)) ################################################### -### code chunk number 10: ex-diag +### code chunk number 13: ex-diag ################################################### all(diagonals(ltMatrices(xn, byrow = TRUE)) == 1L) ################################################### -### code chunk number 11: ex-addiag +### code chunk number 14: ex-addiag ################################################### lxd2 <- lxn diagonals(lxd2) <- 1 @@ -172,7 +264,7 @@ chk(as.array(lxd2), as.array(lxn)) ################################################### -### code chunk number 12: ex-diagJ +### code chunk number 15: ex-diagJ ################################################### (I5 <- diagonals(5L)) diagonals(I5) <- 1:5 @@ -180,7 +272,7 @@ I5 ################################################### -### code chunk number 13: ex-mult +### code chunk number 16: ex-mult ################################################### lxn <- ltMatrices(xn, byrow = TRUE) lxd <- ltMatrices(xd, byrow = TRUE, diag = TRUE) @@ -213,7 +305,7 @@ chk(a, b, check.attributes = FALSE) ################################################### -### code chunk number 14: ex-tmult +### code chunk number 17: ex-tmult ################################################### a <- Mult(lxn, y, transpose = TRUE) A <- as.array(lxn) @@ -237,12 +329,13 @@ chk(Mult(lxn, y[,1], transpose = TRUE), ################################################### -### code chunk number 15: ex-symult +### code chunk number 18: ex-symult ################################################### J <- 5 N1 <- 10 ex <- expression({ - C <- syMatrices(matrix(runif(N2 * J * (J + c(-1, 1)[DIAG + 1L] ) / 2), ncol = N2), + C <- syMatrices(matrix(runif(N2 * J * (J + c(-1, 1)[DIAG + 1L] ) / 2), + ncol = N2), diag = DIAG) x <- matrix(runif(N1 * J), nrow = J) Ca <- as.array(C) @@ -267,7 +360,7 @@ eval(ex) ################################################### -### code chunk number 16: ex-solve +### code chunk number 19: ex-solve ################################################### ## solve A <- as.array(lxn) @@ -295,14 +388,14 @@ chk(solve(lxn, y[,1]), solve(lxn, y[,rep(1, N)])) ################################################### -### code chunk number 17: ex-tsolve +### code chunk number 20: ex-tsolve ################################################### chk(solve(lxn[1,], y, transpose = TRUE), t(as.array(solve(lxn[1,]))[,,1]) %*% y) ################################################### -### code chunk number 18: ex-logdet +### code chunk number 21: ex-logdet ################################################### chk(logdet(lxn), colSums(log(diagonals(lxn)))) chk(logdet(lxd[1,]), colSums(log(diagonals(lxd[1,])))) @@ -312,7 +405,7 @@ chk(logdet(lxd2), colSums(log(diagonals(lxd2)))) ################################################### -### code chunk number 19: ex-tcrossprod +### code chunk number 22: ex-tcrossprod ################################################### ## Tcrossprod a <- as.array(Tcrossprod(lxn)) @@ -337,7 +430,7 @@ chk(d, diagonals(Tcrossprod(lxd))) ################################################### -### code chunk number 20: ex-crossprod +### code chunk number 23: ex-crossprod ################################################### ## Crossprod a <- as.array(Crossprod(lxn)) @@ -362,7 +455,7 @@ chk(d, diagonals(Crossprod(lxd))) ################################################### -### code chunk number 21: chol +### code chunk number 24: chol ################################################### Sigma <- Tcrossprod(lxd) chk(chol(Sigma), lxd) @@ -372,7 +465,7 @@ chk(as.array(chol(Sigma)), as.array(lxn)) ################################################### -### code chunk number 22: kronecker +### code chunk number 25: kronecker ################################################### J <- 10 @@ -428,7 +521,7 @@ chk(A, B) ################################################### -### code chunk number 23: conv-ex-1 +### code chunk number 26: conv-ex-1 ################################################### prec2pc <- function(x) { ret <- -cov2cor(x) @@ -455,7 +548,7 @@ chk(unlist(PC), c(as.array(invchol2pc(L))), ################################################### -### code chunk number 24: conv-ex-2 +### code chunk number 27: conv-ex-2 ################################################### C <- lxn Sigma <- apply(as.array(C), 3, @@ -477,7 +570,7 @@ chk(unlist(PC), c(as.array(chol2pc(C))), ################################################### -### code chunk number 25: conv-ex-3 +### code chunk number 28: conv-ex-3 ################################################### L <- lxd Sigma <- apply(as.array(L), 3, @@ -499,7 +592,7 @@ chk(unlist(PC), c(as.array(invchol2pc(L))), ################################################### -### code chunk number 26: conv-ex-4 +### code chunk number 29: conv-ex-4 ################################################### C <- lxd Sigma <- apply(as.array(C), 3, @@ -521,21 +614,21 @@ chk(unlist(PC), c(as.array(chol2pc(C))), ################################################### -### code chunk number 27: aperm-tests +### code chunk number 30: aperm-tests ################################################### -L <- lxn +L <- as.invchol(lxn) J <- dim(L)[2L] -Lp <- aperm(a = L, perm = p <- sample(1:J), is_chol = FALSE) +Lp <- aperm(a = L, perm = p <- sample(1:J)) chk(invchol2cov(L)[,p], invchol2cov(Lp)) -C <- lxn +C <- as.chol(lxn) J <- dim(C)[2L] -Cp <- aperm(a = C, perm = p <- sample(1:J), is_chol = TRUE) +Cp <- aperm(a = C, perm = p <- sample(1:J)) chk(chol2cov(C)[,p], chol2cov(Cp)) ################################################### -### code chunk number 28: marg +### code chunk number 31: marg ################################################### Sigma <- Tcrossprod(lxd) j <- 1:3 @@ -551,7 +644,7 @@ chk(Sigma[,j], Tcrossprod(solve(marg_mvnorm(invchol = lxd, which = j)$invchol))) ################################################### -### code chunk number 29: cond-general +### code chunk number 32: cond-general ################################################### Sigma <- as.array(Tcrossprod(lxd))[,,1] j <- 2:4 @@ -581,7 +674,7 @@ chk(cS, as.array(Tcrossprod(solve(cmv$invchol)))[,,1]) ################################################### -### code chunk number 30: cond-simple +### code chunk number 33: cond-simple ################################################### Sigma <- as.array(Tcrossprod(lxd))[,,1] j <- 1:3 @@ -611,7 +704,7 @@ chk(cS, as.array(Tcrossprod(solve(cmv$invchol)))[,,1]) ################################################### -### code chunk number 31: ex-MV +### code chunk number 34: ex-MV ################################################### N <- 1000L J <- 50L @@ -622,19 +715,20 @@ Y <- solve(lt, Z) ll1 <- sum(dnorm(Mult(lt, Y), log = TRUE)) + sum(log(diagonals(lt))) S <- as.array(Tcrossprod(solve(lt))) -ll2 <- sum(sapply(1:N, function(i) dmvnorm(x = Y[,i], sigma = S[,,i], log = TRUE))) +ll2 <- sum(sapply(1:N, function(i) + dmvnorm(x = Y[,i], sigma = S[,,i], log = TRUE))) chk(ll1, ll2) ################################################### -### code chunk number 32: ex-MV-d +### code chunk number 35: ex-MV-d ################################################### ll3 <- ldmvnorm(obs = Y, invchol = lt) chk(ll1, ll3) ################################################### -### code chunk number 33: ex-MV-mc +### code chunk number 36: ex-MV-mc ################################################### ## marginal of and conditional on these (j <- 1:5 * 10) @@ -649,13 +743,13 @@ chk(ll1, ll3) ################################################### -### code chunk number 34: chapterseed +### code chunk number 37: chapterseed ################################################### set.seed(270312) ################################################### -### code chunk number 35: fct-lpmvnormR +### code chunk number 38: fct-lpmvnormR ################################################### lpmvnormR <- function(lower, upper, mean = 0, center = NULL, chol, logLik = TRUE, ...) { @@ -665,7 +759,7 @@ lpmvnormR <- function(lower, upper, mean = 0, center = NULL, chol, logLik = TRUE if (!is.matrix(upper)) upper <- matrix(upper, ncol = 1) stopifnot(isTRUE(all.equal(dim(lower), dim(upper)))) - stopifnot(inherits(chol, "ltMatrices")) + stopifnot(is.ltMatrices(chol)) ### NOTE: replace with is.chol byrow_orig <- attr(chol, "byrow") chol <- ltMatrices(chol, byrow = TRUE) d <- dim(chol) @@ -675,8 +769,11 @@ lpmvnormR <- function(lower, upper, mean = 0, center = NULL, chol, logLik = TRUE stopifnot(nrow(lower) == J && ncol(lower) == N) stopifnot(nrow(upper) == J && ncol(upper) == N) - if (is.matrix(mean)) + if (is.matrix(mean)) { + if (ncol(mean) == 1L) + mean <- mean[,rep(1, N),drop = FALSE] stopifnot(nrow(mean) == J && ncol(mean) == N) + } lower <- lower - mean upper <- upper - mean @@ -709,7 +806,7 @@ lpmvnormR <- function(lower, upper, mean = 0, center = NULL, chol, logLik = TRUE ################################################### -### code chunk number 36: ex-lpmvnorm_R +### code chunk number 39: ex-lpmvnorm_R ################################################### J <- 5L N <- 10L @@ -726,7 +823,7 @@ b[sample(J * N)[1:2]] <- Inf ################################################### -### code chunk number 37: ex-again +### code chunk number 40: ex-again ################################################### phat exp(lpmvnorm(a, b, chol = lx, M = 25000, logLik = FALSE, fast = TRUE)) @@ -734,7 +831,7 @@ exp(lpmvnorm(a, b, chol = lx, M = 25000, logLik = FALSE, fast = FALSE)) ################################################### -### code chunk number 38: ex-lpmvnorm +### code chunk number 41: ex-lpmvnorm ################################################### M <- 10000L if (require("qrng", quietly = TRUE)) { @@ -745,7 +842,7 @@ if (require("qrng", quietly = TRUE)) { W <- matrix(runif(M * (J - 1)), nrow = J - 1) } -### Genz & Bretz, 2001, without early stopping (really?) +### Genz & Bretz, 2002, without early stopping (really?) pGB <- lpmvnormR(a, b, chol = lx, logLik = FALSE, algorithm = GenzBretz(maxpts = M, abseps = 0, releps = 0)) ### Genz 1992 with quasi-Monte-Carlo, fast pnorm @@ -765,7 +862,7 @@ cbind(pGB, pGqf, pGf, pGqs, pGs) ################################################### -### code chunk number 39: ex-uni +### code chunk number 42: ex-uni ################################################### ### test univariate problem ### call pmvnorm @@ -782,7 +879,7 @@ cbind(c(ptr), pGB, pGq) ################################################### -### code chunk number 40: ex-score +### code chunk number 43: ex-score ################################################### J <- 5L N <- 4L @@ -813,11 +910,12 @@ sC <- slpmvnorm(a, b, chol = mC, w = W, M = M) chk(lli, sC$logLik) if (require("numDeriv", quietly = TRUE)) - chk(grad(fC, unclass(mC)), rowSums(unclass(sC$chol)), check.attributes = FALSE) + chk(grad(fC, unclass(mC)), rowSums(unclass(sC$chol)), + check.attributes = FALSE) ################################################### -### code chunk number 41: ex-Lscore +### code chunk number 44: ex-Lscore ################################################### mL <- solve(mC) @@ -840,25 +938,25 @@ if (require("numDeriv", quietly = TRUE)) ################################################### -### code chunk number 42: ex-uni-score +### code chunk number 45: ex-uni-score ################################################### ptr <- pnorm(b[1,] / c(unclass(mC[,1]))) - pnorm(a[1,] / c(unclass(mC[,1]))) log(ptr) lpmvnorm(a[1,,drop = FALSE], b[1,,drop = FALSE], chol = mC[,1], logLik = FALSE) -lapply(slpmvnorm(a[1,,drop = FALSE], b[1,,drop = FALSE], chol = mC[,1], logLik = -TRUE), unclass) +lapply(slpmvnorm(a[1,,drop = FALSE], b[1,,drop = FALSE], chol = mC[,1], + logLik = TRUE), unclass) sd1 <- c(unclass(mC[,1])) (dnorm(b[1,] / sd1) * b[1,] - dnorm(a[1,] / sd1) * a[1,]) * (-1) / sd1^2 / ptr ################################################### -### code chunk number 43: chapterseed +### code chunk number 46: chapterseed ################################################### set.seed(110515) ################################################### -### code chunk number 44: ex-ML-dgp +### code chunk number 47: ex-ML-dgp ################################################### J <- 4 R <- diag(J) @@ -871,7 +969,7 @@ round(Sigma <- diag(sqrt(1:J / 2)) %*% R %*% diag(sqrt(1:J / 2)), 7) ################################################### -### code chunk number 45: ex-ML-C +### code chunk number 48: ex-ML-C ################################################### prm <- C[lower.tri(C, diag = TRUE)] lt <- ltMatrices(matrix(prm, ncol = 1L), @@ -885,7 +983,7 @@ chk(Sigma, as.array(Tcrossprod(lt))[,,1], check.attributes = FALSE) ################################################### -### code chunk number 46: ex-ML-data +### code chunk number 49: ex-ML-data ################################################### N <- 100L Z <- matrix(rnorm(N * J), nrow = J) @@ -893,14 +991,14 @@ Y <- Mult(lt, Z) + (mn <- 1:J) ################################################### -### code chunk number 47: ex-ML-mu-vcov +### code chunk number 50: ex-ML-mu-vcov ################################################### rowMeans(Y) (Shat <- var(t(Y)) * (N - 1) / N) ################################################### -### code chunk number 48: ex-ML-clogLik +### code chunk number 51: ex-ML-clogLik ################################################### Yc <- Y - rowMeans(Y) @@ -916,14 +1014,14 @@ sc <- function(parm) { ################################################### -### code chunk number 49: ex-ML-const +### code chunk number 52: ex-ML-const ################################################### llim <- rep(-Inf, J * (J + 1) / 2) llim[which(rownames(unclass(lt)) %in% paste(1:J, 1:J, sep = "."))] <- 1e-4 ################################################### -### code chunk number 50: ex-ML-c +### code chunk number 53: ex-ML-c ################################################### if (BYROW) { cML <- chol(Shat)[upper.tri(Shat, diag = TRUE)] @@ -937,7 +1035,7 @@ if (require("numDeriv", quietly = TRUE)) ################################################### -### code chunk number 51: ex-ML-coptim +### code chunk number 54: ex-ML-coptim ################################################### op <- optim(start, fn = ll, gr = sc, method = "L-BFGS-B", lower = llim, control = list(trace = TRUE)) @@ -952,7 +1050,7 @@ lt ################################################### -### code chunk number 52: ex-ML-cens +### code chunk number 55: ex-ML-cens ################################################### prb <- 1:9 / 10 sds <- sqrt(diag(Sigma)) @@ -966,7 +1064,7 @@ for (j in 1:J) { ################################################### -### code chunk number 53: ex-ML-chk (eval = FALSE) +### code chunk number 56: ex-ML-chk (eval = FALSE) ################################################### ## M <- floor(exp(0:25/10) * 1000) ## lGB <- sapply(M, function(m) { @@ -994,7 +1092,7 @@ for (j in 1:J) { ################################################### -### code chunk number 54: ex-ML-fig-data +### code chunk number 57: ex-ML-fig-data ################################################### ### use pre-computed data, otherwise CRAN complains. M <- @@ -1031,7 +1129,7 @@ rownames(lHf) <- c("user.self", "ll") ################################################### -### code chunk number 55: ex-ML-fig +### code chunk number 58: ex-ML-fig ################################################### layout(matrix(1:2, nrow = 1)) plot(M, lGB["ll",], ylim = range(c(lGB["ll",], lH["ll",], lHf["ll",])), ylab = "Log-likelihood") @@ -1044,7 +1142,7 @@ legend("bottomright", legend = c("pmvnorm", "lpmvnorm", "lpmvnorm(fast)"), pch = ################################################### -### code chunk number 56: ex-ML-ll +### code chunk number 59: ex-ML-ll ################################################### M <- 500 if (require("qrng", quietly = TRUE)) { @@ -1055,8 +1153,8 @@ if (require("qrng", quietly = TRUE)) { W <- matrix(runif(M * (J - 1)), nrow = J - 1) } ll <- function(parm, J) { - m <- parm[1:J] ### mean parameters - parm <- parm[-(1:J)] ### chol parameters + m <- parm[1:J] ### mean parameters + parm <- parm[-(1:J)] ### chol parameters C <- matrix(c(parm), ncol = 1L) C <- ltMatrices(C, diag = TRUE, byrow = BYROW) -lpmvnorm(lower = lwr, upper = upr, mean = m, chol = C, @@ -1065,7 +1163,7 @@ ll <- function(parm, J) { ################################################### -### code chunk number 57: ex-ML-check +### code chunk number 60: ex-ML-check ################################################### prm <- c(mn, unclass(lt)) ll(prm, J = J) @@ -1078,7 +1176,7 @@ chk(llprm, sum(lpmvnorm(lwr, upr, mean = mn, chol = lt, w = W, ################################################### -### code chunk number 58: ex-ML-sc +### code chunk number 61: ex-ML-sc ################################################### sc <- function(parm, J) { m <- parm[1:J] ### mean parameters @@ -1092,14 +1190,14 @@ sc <- function(parm, J) { ################################################### -### code chunk number 59: ex-ML-sc-chk +### code chunk number 62: ex-ML-sc-chk ################################################### if (require("numDeriv", quietly = TRUE)) chk(grad(ll, prm, J = J), sc(prm, J = J), check.attributes = FALSE) ################################################### -### code chunk number 60: ex-ML +### code chunk number 63: ex-ML ################################################### llim <- rep(-Inf, J + J * (J + 1) / 2) llim[J + which(rownames(unclass(lt)) %in% paste(1:J, 1:J, sep = "."))] <- 1e-4 @@ -1120,7 +1218,7 @@ ll(prm, J = J) ################################################### -### code chunk number 61: ex-ML-C +### code chunk number 64: ex-ML-C ################################################### (C <- ltMatrices(matrix(op$par[-(1:J)], ncol = 1), diag = TRUE, byrow = BYROW)) @@ -1128,14 +1226,14 @@ lt ################################################### -### code chunk number 62: ex-ML-mu +### code chunk number 65: ex-ML-mu ################################################### op$par[1:J] mn ################################################### -### code chunk number 63: ex-ML-Shat +### code chunk number 66: ex-ML-Shat ################################################### ### ATLAS print issues round(Tcrossprod(lt), 7) ### true Sigma @@ -1144,13 +1242,27 @@ round(Shat, 7) ### "exact" obs ################################################### -### code chunk number 64: regressions +### code chunk number 67: regressions ################################################### c(cond_mvnorm(chol = C, which = 2:J, given = diag(J - 1))$mean) ################################################### -### code chunk number 65: lm-ex +### code chunk number 68: regressionsC +################################################### +c(cond_mvnorm(chol = aperm(as.chol(C), perm = c(2:J, 1)), + which = 1:(J - 1), given = diag(J - 1))$mean) + + +################################################### +### code chunk number 69: regressionsP +################################################### +x <- as.array(chol2pre(aperm(as.chol(C), perm = c(2:J, 1))))[J,,1] +c(-x[-J] / x[J]) + + +################################################### +### code chunk number 70: lm-ex ################################################### dY <- as.data.frame(t(Y)) colnames(dY) <- paste0("Y", 1:J) @@ -1158,14 +1270,14 @@ coef(m1 <- lm(Y1 ~ ., data = dY))[-1L] ################################################### -### code chunk number 66: hessian +### code chunk number 71: hessian ################################################### H <- optim(op$par, fn = ll, gr = sc, J = J, method = "L-BFGS-B", lower = llim, hessian = TRUE)$hessian ################################################### -### code chunk number 67: ML-sample +### code chunk number 72: ML-sample ################################################### L <- try(t(chol(H))) ### some check on r-oldrel-macos-arm64 @@ -1178,57 +1290,59 @@ rC <- solve(L, Z)[-(1:J),] + op$par[-(1:J)] ### remove mean parameters ################################################### -### code chunk number 68: ML-check +### code chunk number 73: ML-check ################################################### c(sqrt(rowMeans((rC - rowMeans(rC))^2))) c(sqrt(diagonals(Crossprod(solve(L))))) ################################################### -### code chunk number 69: rC +### code chunk number 74: rC ################################################### rC <- ltMatrices(rC, diag = TRUE) ################################################### -### code chunk number 70: ML-beta +### code chunk number 75: ML-beta ################################################### rbeta <- cond_mvnorm(chol = rC, which = 2:J, given = diag(J - 1))$mean sqrt(rowMeans((rbeta - rowMeans(rbeta))^2)) ################################################### -### code chunk number 71: se-ex +### code chunk number 76: se-ex ################################################### sqrt(diag(vcov(m1)))[-1L] ################################################### -### code chunk number 72: ex-ML-cd +### code chunk number 77: ex-ML-cd ################################################### +ic <- 1:2 ### position of continuous variables ll_cd <- function(parm, J) { m <- parm[1:J] ### mean parameters parm <- parm[-(1:J)] ### chol parameters C <- matrix(c(parm), ncol = 1L) C <- ltMatrices(C, diag = TRUE, byrow = BYROW) - -ldpmvnorm(obs = Y[1:2,], lower = lwr[-(1:2),], - upper = upr[-(1:2),], mean = m, chol = C, - w = W[-(1:2),,drop = FALSE], M = M) + -ldpmvnorm(obs = Y[ic,], lower = lwr[-ic,], + upper = upr[-ic,], mean = m, chol = C, + w = W[-ic,,drop = FALSE], M = M) } sc_cd <- function(parm, J) { m <- parm[1:J] ### mean parameters parm <- parm[-(1:J)] ### chol parameters C <- matrix(c(parm), ncol = 1L) C <- ltMatrices(C, diag = TRUE, byrow = BYROW) - ret <- sldpmvnorm(obs = Y[1:2,], lower = lwr[-(1:2),], - upper = upr[-(1:2),], mean = m, chol = C, - w = W[-(1:2),,drop = FALSE], M = M) - return(-c(rowSums(ret$mean), rowSums(unclass(ret$chol)))) + ret <- sldpmvnorm(obs = Y[ic,], lower = lwr[-ic,], + upper = upr[-ic,], mean = m, chol = C, + w = W[-ic,,drop = FALSE], M = M) + return(-c(rowSums(ret$mean), + rowSums(Lower_tri(ret$chol, diag = TRUE)))) } ################################################### -### code chunk number 73: ex-ML-cd-score +### code chunk number 78: ex-ML-cd-score ################################################### if (require("numDeriv", quietly = TRUE)) chk(grad(ll_cd, start, J = J), sc_cd(start, J = J), @@ -1236,7 +1350,7 @@ if (require("numDeriv", quietly = TRUE)) ################################################### -### code chunk number 74: ex-ML-cd-optim +### code chunk number 79: ex-ML-cd-optim ################################################### op <- optim(start, fn = ll_cd, gr = sc_cd, J = J, method = "L-BFGS-B", lower = llim, @@ -1253,7 +1367,66 @@ mn ################################################### -### code chunk number 75: ex-stand +### code chunk number 80: ex-ML-ap +################################################### +### discrete variables first +perm <- c((1:J)[-ic], ic) +ll_ap <- function(parm, J) { + m <- parm[1:J] ### mean parameters; NOT permuted + parm <- parm[-(1:J)] ### chol parameters + C <- matrix(c(parm), ncol = 1L) + C <- ltMatrices(C, diag = TRUE, byrow = BYROW) + Ct <- aperm(as.chol(C), perm = perm) + -ldpmvnorm(obs = Y[ic,], lower = lwr[-ic,], + upper = upr[-ic,], mean = m, chol = Ct, + w = W[-ic,,drop = FALSE], M = M) +} + + +################################################### +### code chunk number 81: ex-ML-ap-score +################################################### +sc_ap <- function(parm, J) { + m <- parm[1:J] ### mean parameters; NOT permuted + parm <- parm[-(1:J)] ### chol parameters + C <- matrix(c(parm), ncol = 1L) + C <- ltMatrices(C, diag = TRUE, byrow = BYROW) + ### permutation + Ct <- aperm(as.chol(C), perm = perm) + ret <- sldpmvnorm(obs = Y[ic,], lower = lwr[-ic,], + upper = upr[-ic,], mean = m, chol = Ct, + w = W[-ic,,drop = FALSE], M = M) + ### undo permutation for chol + retC <- deperma(chol = C, permuted_chol = Ct, + perm = perm, score_schol = ret$chol) + return(-c(rowSums(ret$mean), + rowSums(Lower_tri(retC, diag = TRUE)))) +} + + +################################################### +### code chunk number 82: ex-ML-ap-grad +################################################### +if (require("numDeriv", quietly = TRUE)) + chk(grad(ll_ap, start, J = J), sc_ap(start, J = J), + check.attributes = FALSE, tol = 1e-6) + + +################################################### +### code chunk number 83: ex-ML-ap-optim- +################################################### +op <- optim(start, fn = ll_ap, gr = sc_ap, J = J, + method = "L-BFGS-B", lower = llim, + control = list(trace = TRUE)) +## estimated C for (X, Y) +ltMatrices(matrix(op$par[-(1:J)], ncol = 1), + diag = TRUE, byrow = BYROW) +## compare with true _permuted_ C for (X, Y) +aperm(as.chol(lt), perm = perm) + + +################################################### +### code chunk number 84: ex-stand ################################################### C <- ltMatrices(runif(10)) all.equal(as.array(chol2cov(standardize(chol = C))), @@ -1264,9 +1437,9 @@ all.equal(as.array(invchol2cov(standardize(invchol = L))), ################################################### -### code chunk number 76: gc-classical +### code chunk number 85: gc-classical ################################################### -data("iris") +data("iris", package = "datasets") J <- 4 Z <- t(qnorm(do.call("cbind", lapply(iris[1:J], rank)) / (nrow(iris) + 1))) (CR <- cor(t(Z))) @@ -1291,7 +1464,7 @@ S_ML <- chol2cov(standardize(ltMatrices(op$par))) ################################################### -### code chunk number 77: gc-NPML +### code chunk number 86: gc-NPML ################################################### lwr <- do.call("cbind", lapply(iris[1:J], rank, ties.method = "min")) - 1L upr <- do.call("cbind", lapply(iris[1:J], rank, ties.method = "max")) @@ -1326,14 +1499,14 @@ S_NPML <- chol2cov(standardize(ltMatrices(op2$par))) ################################################### -### code chunk number 78: gc +### code chunk number 87: gc ################################################### S_ML S_NPML ################################################### -### code chunk number 79: gc-se +### code chunk number 88: gc-se ################################################### sd_ML <- ltMatrices(sqrt(diag(solve(op$hessian)))) diagonals(sd_ML) <- 0 @@ -1345,3 +1518,114 @@ if (!inherits(sd_NPML, "try-error")) { } +################################################### +### code chunk number 89: iris-model +################################################### +data("iris", package = "datasets") +vars <- names(iris)[-5L] +m <- colMeans(iris[,vars]) +V <- var(iris[,vars]) +iris_mvn <- mvnorm(mean = m, chol = t(chol(V))) +iris_var <- simulate(iris_mvn, nsim = nrow(iris)) + + +################################################### +### code chunk number 90: iris-mc +################################################### +j <- 3:4 +margDist(iris_mvn, which = vars[j]) +gm <- t(iris[,vars[-(j)]]) +iris_cmvn <- condDist(iris_mvn, which = vars[j], given = gm) + + +################################################### +### code chunk number 91: iris-ll +################################################### +logLik(object = iris_cmvn, obs = t(iris[,vars[-j]])) + + +################################################### +### code chunk number 92: iris-ll-perm +################################################### +logLik(object = iris_cmvn, obs = t(iris[,rev(vars[-j])])) + + +################################################### +### code chunk number 93: iris-lLgrad +################################################### +J <- length(vars) +obs <- t(iris[, vars]) +lower <- upper <- NULL +ll <- function(parm) { + C <- ltMatrices(parm[-(1:J)], diag = TRUE, names = vars) + x <- mvnorm(mean = parm[1:J], chol = C) + -logLik(object = x, obs = obs, lower = lower, upper = upper) +} +sc <- function(parm) { + C <- ltMatrices(parm[-(1:J)], diag = TRUE, names = vars) + x <- mvnorm(mean = parm[1:J], chol = C) + ret <- lLgrad(object = x, obs = obs, lower = lower, upper = upper) + -c(rowSums(ret$mean), rowSums(Lower_tri(ret$scale, diag = TRUE))) +} + + +################################################### +### code chunk number 94: iris-ML +################################################### +start <- c(c(iris_mvn$mean), Lower_tri(iris_mvn$scale, diag = TRUE)) +if (require("numDeriv", quietly = TRUE)) + chk(grad(ll, start), sc(start), check.attributes = FALSE) +op <- optim(start, fn = ll, gr = sc, method = "L-BFGS-B", + lower = llim, control = list(trace = TRUE)) +Chat <- ltMatrices(op$par[-(1:J)], diag = TRUE, names = vars) +ML <- mvnorm(mean = op$par[1:J], chol = Chat) + + +################################################### +### code chunk number 95: iris-ML-hat +################################################### +### covariance +round(chol2cov(ML$scale), 2) +N <- nrow(iris) +round(V * (N - 1) / N, 2) +### mean +ML$mean[,,drop = TRUE] +m + + +################################################### +### code chunk number 96: iris-interval +################################################### +v1 <- vars[1] +q1 <- quantile(iris[[v1]], prob = 1:4 / 5) +head(f1 <- cut(iris[[v1]], breaks = c(-Inf, q1, Inf))) + + +################################################### +### code chunk number 97: iris-MLi +################################################### +lower <- matrix(c(-Inf, q1)[f1], nrow = 1) +upper <- matrix(c(q1, Inf)[f1], nrow = 1) +rownames(lower) <- rownames(upper) <- v1 +obs <- obs[!rownames(obs) %in% v1,,drop = FALSE] +if (require("numDeriv", quietly = TRUE)) + chk(grad(ll, start), sc(start), check.attributes = FALSE) +opi <- optim(start, fn = ll, gr = sc, method = "L-BFGS-B", + lower = llim, control = list(trace = TRUE)) +Chati <- ltMatrices(opi$par[-(1:J)], diag = TRUE, names = vars) +MLi <- mvnorm(mean = opi$par[1:J], chol = Chati) + + +################################################### +### code chunk number 98: iris-MLi-hat +################################################### +op$value +opi$value +### covariance +round(chol2cov(MLi$scale), 2) +round(chol2cov(ML$scale), 2) +### mean +MLi$mean[,,drop = TRUE] +ML$mean[,,drop = TRUE] + + diff --git a/inst/doc/lmvnorm_src.Rnw b/inst/doc/lmvnorm_src.Rnw index 3dc0678..969244d 100644 --- a/inst/doc/lmvnorm_src.Rnw +++ b/inst/doc/lmvnorm_src.Rnw @@ -22,7 +22,7 @@ %% packages \usepackage{amsfonts,amstext,amsmath,amssymb,amsthm,nicefrac} -%\VignetteIndexEntry{Multivariate Normal Log-likelihoods} +%\VignetteIndexEntry{Multivariate Normal Log-likelihoods in the mvtnorm Package} %\VignetteDepends{mvtnorm,qrng,numDeriv} %\VignetteKeywords{multivariate normal distribution} %\VignettePackage{mvtnorm} @@ -122,7 +122,7 @@ version <- packageDescription("mvtnorm")$Version \footnote{Please cite this document as: Torsten Hothorn (\Sexpr{year}) Multivariate Normal Log-likelihoods in the \pkg{mvtnorm} Package. \textsf{R} package vignette version \Sexpr{version}, -URL \url{https://CRAN.R-project.org/package=mvtnorm}.} +URL \href{https://doi.org/10.32614/CRAN.package.mvtnorm}{DOI:10.32614/CRAN.package.mvtnorm}.} } \begin{document} @@ -162,7 +162,7 @@ partially, of \cite{Genz_Bretz_2002}, for the evaluation of $N$ multivariate $\J$-dimensional normal probabilities \begin{eqnarray} \label{pmvnorm} p_i(\mC_i \mid \avec_i, \bvec_i) = \Prob(\avec_i < \rY_i \le \bvec_i \mid \mC_i ) - = (2 \pi)^{-\frac{\J}{2}} \text{det}(\mC_i)^{-\frac{1}{2}} + = (2 \pi)^{-\frac{\J}{2}} \text{det}(\mC_i)^{-1} \int_{\avec_i}^{\bvec_i} \exp\left(-\frac{1}{2} \yvec^\top \mC_i^{-\top} \mC_i^{-1} \yvec\right) \, d \yvec \end{eqnarray} where $\avec_i = (a^{(i)}_1, \dots, a^{(i)}_\J)^\top \in \R^\J$ and @@ -181,8 +181,9 @@ In other applications, the Cholesky factor might also depend on $i$ in some structured way. Function \code{pmvnorm} in package \code{mvtnorm} computes $p_i$ based on -the covariance matrix $\mC_i \mC_i^\top$. However, the Cholesky factor $\mC_i$ is -computed in \proglang{FORTRAN}. Function \code{pmvnorm} is not vectorised +the covariance matrix $\mC_i \mC_i^\top$. However, the Cholesky factor $\mC_i$ +of the given covariance matrix is computed in \proglang{FORTRAN} first each +time this function is called. Function \code{pmvnorm} is not vectorised over $i = 1, \dots, N$ and thus separate calls to this function are necessary in order to compute likelihood contributions. @@ -202,7 +203,8 @@ developed here to implement the log-likelihood and score function for situations where some variables have been observed exactly and others only in form of interval-censoring in Chapter~\ref{cdl} and for nonparametric maximum-likelihood estimation in unstructured Gaussian copulae in -Chapter~\ref{copula}. +Chapter~\ref{copula}. An attempt to provide useRs with a simple and +(hopefully) bullet proof interface is documented in Chapter~\ref{inter}. \chapter{Lower Triangular Matrices} \label{ltMatrices} @@ -212,40 +214,36 @@ Chapter~\ref{copula}. \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape R Header}\nobreak\ {\footnotesize \NWlink{nuweb104}{104}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape R Header}\nobreak\ {\footnotesize \NWlink{nuweb131}{131}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\hbox{$\langle\,${\itshape ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb6a}{6a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\hbox{$\langle\,${\itshape syMatrices}\nobreak\ {\footnotesize \NWlink{nuweb6b}{6b}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\hbox{$\langle\,${\itshape dim ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb6c}{6c}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\hbox{$\langle\,${\itshape dimnames ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb7a}{7a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\hbox{$\langle\,${\itshape names ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb7b}{7b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape print ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb10}{10}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape reorder ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb11}{11}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape subset ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb13}{13}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape lower triangular elements}\nobreak\ {\footnotesize \NWlink{nuweb15}{15}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape diagonals ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb17}{17}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape diagonal matrix}\nobreak\ {\footnotesize \NWlink{nuweb20}{20}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape mult ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb21a}{21a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape mult syMatrices}\nobreak\ {\footnotesize \NWlink{nuweb25}{25}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape solve ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb29}{29}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape logdet ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb31b}{31b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape tcrossprod ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb35}{35}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape crossprod ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb36}{36}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape chol syMatrices}\nobreak\ {\footnotesize \NWlink{nuweb37}{37}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape add diagonal elements}\nobreak\ {\footnotesize \NWlink{nuweb18}{18}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape assign diagonal elements}\nobreak\ {\footnotesize \NWlink{nuweb19}{19}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape kronecker vec trick}\nobreak\ {\footnotesize \NWlink{nuweb42}{42}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape convenience functions}\nobreak\ {\footnotesize \NWlink{nuweb45}{45}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape aperm}\nobreak\ {\footnotesize \NWlink{nuweb47}{47}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape marginal}\nobreak\ {\footnotesize \NWlink{nuweb48b}{48b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape conditional}\nobreak\ {\footnotesize \NWlink{nuweb50b}{50b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape check obs}\nobreak\ {\footnotesize \NWlink{nuweb52b}{52b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape ldmvnorm}\nobreak\ {\footnotesize \NWlink{nuweb52a}{52a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape colSumsdnorm ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb53b}{53b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape sldmvnorm}\nobreak\ {\footnotesize \NWlink{nuweb56}{56}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape ldpmvnorm}\nobreak\ {\footnotesize \NWlink{nuweb94}{94}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape sldpmvnorm}\nobreak\ {\footnotesize \NWlink{nuweb96}{96}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape standardize}\nobreak\ {\footnotesize \NWlink{nuweb98}{98}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape destandardize}\nobreak\ {\footnotesize \NWlink{nuweb100}{100}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape is.ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb7c}{7c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape as.ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb115b}{115b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape print ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb11}{11}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape reorder ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb12}{12}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape subset ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb14}{14}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape lower triangular elements}\nobreak\ {\footnotesize \NWlink{nuweb17}{17}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape diagonals ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb19}{19}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape diagonal matrix}\nobreak\ {\footnotesize \NWlink{nuweb22}{22}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape mult ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb23a}{23a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape mult syMatrices}\nobreak\ {\footnotesize \NWlink{nuweb27}{27}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape solve ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb31}{31}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape logdet ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb33b}{33b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape tcrossprod ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb37}{37}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape crossprod ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb38}{38}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape chol syMatrices}\nobreak\ {\footnotesize \NWlink{nuweb39}{39}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape add diagonal elements}\nobreak\ {\footnotesize \NWlink{nuweb20}{20}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape assign diagonal elements}\nobreak\ {\footnotesize \NWlink{nuweb21}{21}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape kronecker vec trick}\nobreak\ {\footnotesize \NWlink{nuweb44}{44}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape convenience functions}\nobreak\ {\footnotesize \NWlink{nuweb48}{48}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape aperm}\nobreak\ {\footnotesize \NWlink{nuweb51a}{51a}, \ldots\ }$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape marginal}\nobreak\ {\footnotesize \NWlink{nuweb52b}{52b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape conditional}\nobreak\ {\footnotesize \NWlink{nuweb55}{55}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape check obs}\nobreak\ {\footnotesize \NWlink{nuweb57b}{57b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape colSumsdnorm ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb58b}{58b}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@{\NWsep} \end{list} \vspace{-1.5ex} @@ -262,7 +260,7 @@ Chapter~\ref{copula}. \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape C Header}\nobreak\ {\footnotesize \NWlink{nuweb105}{105}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape C Header}\nobreak\ {\footnotesize \NWlink{nuweb132}{132}}$\,\rangle$}\verb@@\\ \mbox{}\verb@#ifndef USE_FC_LEN_T@\\ \mbox{}\verb@# define USE_FC_LEN_T@\\ \mbox{}\verb@#endif@\\ @@ -275,15 +273,15 @@ Chapter~\ref{copula}. \mbox{}\verb@#include @\\ \mbox{}\verb@#include @\\ \mbox{}\verb@#include @\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape colSumsdnorm}\nobreak\ {\footnotesize \NWlink{nuweb53a}{53a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape solve}\nobreak\ {\footnotesize \NWlink{nuweb27}{27}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape solve C}\nobreak\ {\footnotesize \NWlink{nuweb28}{28}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape logdet}\nobreak\ {\footnotesize \NWlink{nuweb31a}{31a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape tcrossprod}\nobreak\ {\footnotesize \NWlink{nuweb34}{34}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape mult}\nobreak\ {\footnotesize \NWlink{nuweb22b}{22b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape mult transpose}\nobreak\ {\footnotesize \NWlink{nuweb24}{24}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape chol}\nobreak\ {\footnotesize \NWlink{nuweb38}{38}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape vec trick}\nobreak\ {\footnotesize \NWlink{nuweb40a}{40a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape colSumsdnorm}\nobreak\ {\footnotesize \NWlink{nuweb58a}{58a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape solve}\nobreak\ {\footnotesize \NWlink{nuweb29}{29}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape solve C}\nobreak\ {\footnotesize \NWlink{nuweb30}{30}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape logdet}\nobreak\ {\footnotesize \NWlink{nuweb33a}{33a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape tcrossprod}\nobreak\ {\footnotesize \NWlink{nuweb36}{36}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape mult}\nobreak\ {\footnotesize \NWlink{nuweb24b}{24b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape mult transpose}\nobreak\ {\footnotesize \NWlink{nuweb26}{26}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape chol}\nobreak\ {\footnotesize \NWlink{nuweb40}{40}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape vec trick}\nobreak\ {\footnotesize \NWlink{nuweb42a}{42a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@{\NWsep} \end{list} \vspace{-1.5ex} @@ -303,7 +301,7 @@ diagonal elements are one (that is, $c^{(i)}_{jj} \equiv 1, j = 1, \dots, \section{Multiple Lower Triangular Matrices} We can store $N$ such matrices in an $\J (\J + 1) / 2 \times N$ matrix -(\code{diag = TRUE}) or, for \code{diag = FALSE}, the $\J (\J +(\code{diag = TRUE}) or, for \code{diag = FALSE}, in an $\J (\J - 1) / 2 \times N$ matrix. Each vector might define the corresponding lower triangular matrix @@ -385,7 +383,9 @@ order on request (for later printing) \mbox{}\verb@ rownames(object) <- t(L)[upper.tri(L, diag = diag)]@\\ \mbox{}\verb@ else@\\ \mbox{}\verb@ rownames(object) <- L[lower.tri(L, diag = diag)]@\\ -\mbox{}\verb@}@\\ +\mbox{}\verb@} # else { ### add later@\\ +\mbox{}\verb@ # warning("ltMatrices objects should be properly named")@\\ +\mbox{}\verb@# }@\\ \mbox{}\verb@@{\NWsep} \end{list} \vspace{-1.5ex} @@ -407,8 +407,10 @@ change the storage form from row- to column-major or the other way round. \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ -\mbox{}\verb@if (inherits(object, "ltMatrices")) {@\\ +\mbox{}\verb@if (is.ltMatrices(object)) {@\\ +\mbox{}\verb@ cls <- class(object) ### keep inheriting classes@\\ \mbox{}\verb@ ret <- .reorder(object, byrow = byrow)@\\ +\mbox{}\verb@ class(ret) <- class(object)@\\ \mbox{}\verb@ return(ret)@\\ \mbox{}\verb@}@\\ \mbox{}\verb@@{\NWsep} @@ -459,7 +461,7 @@ possibly after some reordering / transposing \end{list} \end{minipage}\vspace{4ex} \end{flushleft} -For the sake of completeness, we also add a constructor for symmetric +For the sake of completeness, we also add a constructor for multiple symmetric matrices \begin{flushleft} \small @@ -468,13 +470,17 @@ multiple symmetric matrices \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ -\mbox{}\verb@as.syMatrices <- function(object) {@\\ -\mbox{}\verb@ stopifnot(inherits(object, "ltMatrices"))@\\ -\mbox{}\verb@ class(object)[1L] <- "syMatrices"@\\ -\mbox{}\verb@ return(object)@\\ +\mbox{}\verb@as.syMatrices <- function(x) {@\\ +\mbox{}\verb@ if (is.syMatrices(x))@\\ +\mbox{}\verb@ return(x)@\\ +\mbox{}\verb@ x <- as.ltMatrices(x) ### make sure "ltMatrices"@\\ +\mbox{}\verb@ ### is first class@\\ +\mbox{}\verb@ class(x)[1L] <- "syMatrices"@\\ +\mbox{}\verb@ return(x)@\\ \mbox{}\verb@}@\\ \mbox{}\verb@syMatrices <- function(object, diag = FALSE, byrow = FALSE, names = TRUE)@\\ -\mbox{}\verb@ as.syMatrices(ltMatrices(object = object, diag = diag, byrow = byrow, names = names))@\\ +\mbox{}\verb@ as.syMatrices(ltMatrices(object = object, diag = diag, byrow = byrow, @\\ +\mbox{}\verb@ names = names))@\\ \mbox{}\verb@@{\NWsep} \end{list} \vspace{-1.5ex} @@ -551,6 +557,45 @@ The names identifying rows and columns in each $\mC_i$ are \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} \item \NWtxtMacroRefIn\ \NWlink{nuweb2}{2}. +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +Finally, let's add two functions for checking the class and a function for +coersing classes inheriting from \code{ltMatrices} to the latter, the same +for \code{syMatrices}. Furthermode, \code{as.ltMatrices} coerces objects +inheriting from \code{syMatrices} or \code{ltMatrices} to class +\code{ltMatrices} (that is, \code{chol} or \code{invchol} is removed from +the class list, unlike a call to the constructor \code{ltMatrices}). A +\code{default} method is added in Chapter~\ref{inter}. + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap11}\raggedright\small +\NWtarget{nuweb7c}{} $\langle\,${\itshape is.ltMatrices}\nobreak\ {\footnotesize {7c}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@is.ltMatrices <- function(x) inherits(x, "ltMatrices")@\\ +\mbox{}\verb@is.syMatrices <- function(x) inherits(x, "syMatrices")@\\ +\mbox{}\verb@as.ltMatrices <- function(x) UseMethod("as.ltMatrices")@\\ +\mbox{}\verb@as.ltMatrices.syMatrices <- function(x) {@\\ +\mbox{}\verb@ cls <- class(x)@\\ +\mbox{}\verb@ class(x) <- cls[which(cls == "syMatrices"):length(cls)]@\\ +\mbox{}\verb@ class(x)[1L] <- "ltMatrices"@\\ +\mbox{}\verb@ return(x)@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@as.ltMatrices.ltMatrices <- function(x) {@\\ +\mbox{}\verb@ cls <- class(x)@\\ +\mbox{}\verb@ class(x) <- cls[which(cls == "ltMatrices"):length(cls)]@\\ +\mbox{}\verb@ return(x)@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb2}{2}. + \item{} \end{list} \end{minipage}\vspace{4ex} @@ -597,8 +642,8 @@ For pretty printing, we coerse objects of class \code{ltMatrices} to triangular matrix to by interpreted as a symmetric matrix. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap11}\raggedright\small -\NWtarget{nuweb9}{} $\langle\,${\itshape extract slots}\nobreak\ {\footnotesize {9}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap12}\raggedright\small +\NWtarget{nuweb10}{} $\langle\,${\itshape extract slots}\nobreak\ {\footnotesize {10}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -612,21 +657,21 @@ triangular matrix to by interpreted as a symmetric matrix. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb10}{10}\NWlink{nuweb11}{, 11}\NWlink{nuweb12}{, 12}\NWlink{nuweb15}{, 15}\NWlink{nuweb17}{, 17}\NWlink{nuweb19}{, 19}\NWlink{nuweb21a}{, 21a}\NWlink{nuweb25}{, 25}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb11}{11}\NWlink{nuweb12}{, 12}\NWlink{nuweb13}{, 13}\NWlink{nuweb17}{, 17}\NWlink{nuweb19}{, 19}\NWlink{nuweb21}{, 21}\NWlink{nuweb23a}{, 23a}\NWlink{nuweb27}{, 27}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap12}\raggedright\small -\NWtarget{nuweb10}{} $\langle\,${\itshape print ltMatrices}\nobreak\ {\footnotesize {10}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap13}\raggedright\small +\NWtarget{nuweb11}{} $\langle\,${\itshape print ltMatrices}\nobreak\ {\footnotesize {11}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@as.array.ltMatrices <- function(x, symmetric = FALSE, ...) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape extract slots}\nobreak\ {\footnotesize \NWlink{nuweb9}{9}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape extract slots}\nobreak\ {\footnotesize \NWlink{nuweb10}{10}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ x <- unclass(x)@\\ \mbox{}\verb@@\\ @@ -681,17 +726,17 @@ either column- or row-major order and this little helper function switches between the two forms \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap13}\raggedright\small -\NWtarget{nuweb11}{} $\langle\,${\itshape reorder ltMatrices}\nobreak\ {\footnotesize {11}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap14}\raggedright\small +\NWtarget{nuweb12}{} $\langle\,${\itshape reorder ltMatrices}\nobreak\ {\footnotesize {12}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@.reorder <- function(x, byrow = FALSE) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ stopifnot(inherits(x, "ltMatrices"))@\\ +\mbox{}\verb@ stopifnot(is.ltMatrices(x))@\\ \mbox{}\verb@ if (attr(x, "byrow") == byrow) return(x)@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape extract slots}\nobreak\ {\footnotesize \NWlink{nuweb9}{9}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape extract slots}\nobreak\ {\footnotesize \NWlink{nuweb10}{10}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ x <- unclass(x)@\\ \mbox{}\verb@@\\ @@ -748,8 +793,8 @@ We might want to select subsets of observations $i \in \{1, \dots, N\}$ or rows/columns $j \in \{1, \dots, \J\}$ of the corresponding matrices $\mC_i$. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap14}\raggedright\small -\NWtarget{nuweb12}{} $\langle\,${\itshape .subset ltMatrices}\nobreak\ {\footnotesize {12}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap15}\raggedright\small +\NWtarget{nuweb13}{} $\langle\,${\itshape .subset ltMatrices}\nobreak\ {\footnotesize {13}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -758,12 +803,17 @@ rows/columns $j \in \{1, \dots, \J\}$ of the corresponding matrices $\mC_i$. \mbox{}\verb@ if (drop) warning("argument drop is ignored")@\\ \mbox{}\verb@ if (missing(i) && missing(j)) return(x)@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape extract slots}\nobreak\ {\footnotesize \NWlink{nuweb9}{9}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape extract slots}\nobreak\ {\footnotesize \NWlink{nuweb10}{10}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ x <- unclass(x) @\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (!missing(j)) {@\\ \mbox{}\verb@@\\ +\mbox{}\verb@ if (is.character(j)) {@\\ +\mbox{}\verb@ stopifnot(all(j %in% dn[[2L]]))@\\ +\mbox{}\verb@ j <- match(j, dn[[2L]])@\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@@\\ \mbox{}\verb@ j <- (1:J)[j] ### get rid of negative indices@\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (length(j) == 1L && !diag) {@\\ @@ -800,22 +850,26 @@ rows/columns $j \in \{1, \dots, \J\}$ of the corresponding matrices $\mC_i$. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb13}{13}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb14}{14}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap15}\raggedright\small -\NWtarget{nuweb13}{} $\langle\,${\itshape subset ltMatrices}\nobreak\ {\footnotesize {13}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap16}\raggedright\small +\NWtarget{nuweb14}{} $\langle\,${\itshape subset ltMatrices}\nobreak\ {\footnotesize {14}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape .subset ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb12}{12}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape .subset ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb13}{13}}$\,\rangle$}\verb@@\\ \mbox{}\verb@### if j is not ordered, result is not a lower triangular matrix@\\ \mbox{}\verb@"[.ltMatrices" <- function(x, i, j, ..., drop = FALSE) {@\\ \mbox{}\verb@ if (!missing(j)) {@\\ +\mbox{}\verb@ if (is.character(j)) {@\\ +\mbox{}\verb@ stopifnot(all(j %in% dimnames(x)[[2L]]))@\\ +\mbox{}\verb@ j <- match(j, dimnames(x)[[2L]])@\\ +\mbox{}\verb@ }@\\ \mbox{}\verb@ if (all(j > 0)) {@\\ \mbox{}\verb@ if (any(diff(j) < 0)) stop("invalid subset argument j")@\\ \mbox{}\verb@ }@\\ @@ -825,7 +879,7 @@ rows/columns $j \in \{1, \dots, \J\}$ of the corresponding matrices $\mC_i$. \mbox{}\verb@}@\\ \mbox{}\verb@@\\ \mbox{}\verb@"[.syMatrices" <- function(x, i, j, ..., drop = FALSE) {@\\ -\mbox{}\verb@ class(x)[1L] <- "ltMatrices"@\\ +\mbox{}\verb@ x <- as.syMatrices(x)@\\ \mbox{}\verb@ ret <- .subset_ltMatrices(x = x, i = i, j = j, ..., drop = drop)@\\ \mbox{}\verb@ class(ret)[1L] <- "syMatrices"@\\ \mbox{}\verb@ ret@\\ @@ -845,109 +899,107 @@ We check if this works by first subsetting the \code{ltMatrices} object. Second, we coerse the object to an array and do the subset for the latter object. Both results must agree. -<>= +<>= ## subset -a <- as.array(ltMatrices(xn, byrow = FALSE)[1:2, 2:4]) -b <- as.array(ltMatrices(xn, byrow = FALSE))[2:4, 2:4, 1:2] +a <- as.array(ltMatrices(xn, byrow = FALSE, names = nm)[i, j]) +b <- as.array(ltMatrices(xn, byrow = FALSE, names = nm))[j, j, i] chk(a, b) -a <- as.array(ltMatrices(xn, byrow = TRUE)[1:2, 2:4]) -b <- as.array(ltMatrices(xn, byrow = TRUE))[2:4, 2:4, 1:2] +a <- as.array(ltMatrices(xn, byrow = TRUE, names = nm)[i, j]) +b <- as.array(ltMatrices(xn, byrow = TRUE, names = nm))[j, j, i] chk(a, b) -a <- as.array(ltMatrices(xd, byrow = FALSE, diag = TRUE)[1:2, 2:4]) -b <- as.array(ltMatrices(xd, byrow = FALSE, diag = TRUE))[2:4, 2:4, 1:2] +a <- as.array(ltMatrices(xd, byrow = FALSE, + diag = TRUE, names = nm)[i, j]) +b <- as.array(ltMatrices(xd, byrow = FALSE, + diag = TRUE, names = nm))[j, j, i] chk(a, b) -a <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE)[1:2, 2:4]) -b <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE))[2:4, 2:4, 1:2] +a <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE, + names = nm)[i, j]) +b <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE, + names = nm))[j, j, i] chk(a, b) @ -With a different subset +We start with both indices being positive integers -<>= -## subset -j <- c(1, 3, 5) -a <- as.array(ltMatrices(xn, byrow = FALSE)[1:2, j]) -b <- as.array(ltMatrices(xn, byrow = FALSE))[j, j, 1:2] -chk(a, b) - -a <- as.array(ltMatrices(xn, byrow = TRUE)[1:2, j]) -b <- as.array(ltMatrices(xn, byrow = TRUE))[j, j, 1:2] -chk(a, b) +<>= +i <- colnames(xn)[1:2] +j <- 2:4 +<> +@ -a <- as.array(ltMatrices(xd, byrow = FALSE, diag = TRUE)[1:2, j]) -b <- as.array(ltMatrices(xd, byrow = FALSE, diag = TRUE))[j, j, 1:2] -chk(a, b) +proceed with characters -a <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE)[1:2, j]) -b <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE))[j, j, 1:2] -chk(a, b) +<>= +i <- 1:2 +j <- nm[2:4] +<> @ -with negative subsets +a different subset <>= -## subset -j <- -c(1, 3, 5) -a <- as.array(ltMatrices(xn, byrow = FALSE)[1:2, j]) -b <- as.array(ltMatrices(xn, byrow = FALSE))[j, j, 1:2] -chk(a, b) +j <- c(1, 3, 5) +<> +@ -a <- as.array(ltMatrices(xn, byrow = TRUE)[1:2, j]) -b <- as.array(ltMatrices(xn, byrow = TRUE))[j, j, 1:2] -chk(a, b) +and characters again -a <- as.array(ltMatrices(xd, byrow = FALSE, diag = TRUE)[1:2, j]) -b <- as.array(ltMatrices(xd, byrow = FALSE, diag = TRUE))[j, j, 1:2] -chk(a, b) +<>= +j <- nm[c(1, 3, 5)] +<> +@ -a <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE)[1:2, j]) -b <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE))[j, j, 1:2] -chk(a, b) +and finally with with negative subsets + +<>= +j <- -c(1, 3, 5) +<> @ and with non-increasing argument \code{j} (this won't work for lower triangular matrices, only for symmetric matrices) -<>= +<>= ## subset -j <- sample(1:J) -ltM <- ltMatrices(xn, byrow = FALSE) -try(ltM[1:2, j]) +j <- nm[sample(1:J)] +ltM <- ltMatrices(xn, byrow = FALSE, names = nm) +try(ltM[i, j]) ltM <- as.syMatrices(ltM) -a <- as.array(ltM[1:2, j]) -b <- as.array(ltM)[j, j, 1:2] +a <- as.array(ltM[i, j]) +b <- as.array(ltM)[j, j, i] chk(a, b) @ Extracting the lower triangular elements from an \code{ltMatrices} object (or from an object of class \code{syMatrices}) returns a matrix with $N$ -columns, undoing the effect of \code{ltMatrices} +columns, undoing the effect of \code{ltMatrices}. Note that ordering of the +rows of this matrix depend on the \code{byrow} attribute of \code{x}, unless +the \code{byrow} to this function is used to overwrite it explicitly \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap16}\raggedright\small -\NWtarget{nuweb15}{} $\langle\,${\itshape lower triangular elements}\nobreak\ {\footnotesize {15}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap17}\raggedright\small +\NWtarget{nuweb17}{} $\langle\,${\itshape lower triangular elements}\nobreak\ {\footnotesize {17}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@Lower_tri <- function(x, diag = FALSE, byrow = attr(x, "byrow")) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ if (inherits(x, "syMatrices"))@\\ -\mbox{}\verb@ class(x)[1L] <- "ltMatrices"@\\ -\mbox{}\verb@ stopifnot(inherits(x, "ltMatrices"))@\\ +\mbox{}\verb@ if (is.syMatrices(x))@\\ +\mbox{}\verb@ x <- as.ltMatrices(x)@\\ \mbox{}\verb@ adiag <- diag@\\ \mbox{}\verb@ x <- ltMatrices(x, byrow = byrow)@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape extract slots}\nobreak\ {\footnotesize \NWlink{nuweb9}{9}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape extract slots}\nobreak\ {\footnotesize \NWlink{nuweb10}{10}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (diag == adiag)@\\ -\mbox{}\verb@ return(unclass(x))@\\ +\mbox{}\verb@ return(unclass(x)[,,drop = FALSE]) ### remove attributes@\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (!diag && adiag) {@\\ \mbox{}\verb@ diagonals(x) <- 1@\\ -\mbox{}\verb@ return(unclass(x))@\\ +\mbox{}\verb@ return(unclass(x)[,,drop = FALSE]) ### remove attributes@\\ \mbox{}\verb@ }@\\ \mbox{}\verb@@\\ \mbox{}\verb@ x <- unclass(x)@\\ @@ -990,8 +1042,8 @@ The diagonal elements of each matrix $\mC_i$ can be extracted and are always returned as an $\J \times N$ matrix. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap17}\raggedright\small -\NWtarget{nuweb17}{} $\langle\,${\itshape diagonals ltMatrices}\nobreak\ {\footnotesize {17}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap18}\raggedright\small +\NWtarget{nuweb19}{} $\langle\,${\itshape diagonals ltMatrices}\nobreak\ {\footnotesize {19}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -1000,7 +1052,7 @@ always returned as an $\J \times N$ matrix. \mbox{}\verb@@\\ \mbox{}\verb@diagonals.ltMatrices <- function(x, ...) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape extract slots}\nobreak\ {\footnotesize \NWlink{nuweb9}{9}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape extract slots}\nobreak\ {\footnotesize \NWlink{nuweb10}{10}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ x <- unclass(x)@\\ \mbox{}\verb@@\\ @@ -1040,17 +1092,17 @@ all(diagonals(ltMatrices(xn, byrow = TRUE)) == 1L) @ Sometimes we need to add diagonal elements to an \code{ltMatrices} object -defined without diagonal elements. +which was set-up with constant $c_{jj} = 1$ diagonal elements. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap18}\raggedright\small -\NWtarget{nuweb18}{} $\langle\,${\itshape add diagonal elements}\nobreak\ {\footnotesize {18}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap19}\raggedright\small +\NWtarget{nuweb20}{} $\langle\,${\itshape add diagonal elements}\nobreak\ {\footnotesize {20}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@.adddiag <- function(x) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ stopifnot(inherits(x, "ltMatrices")) @\\ +\mbox{}\verb@ stopifnot(is.ltMatrices(x))@\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (attr(x, "diag")) return(x)@\\ \mbox{}\verb@@\\ @@ -1088,8 +1140,8 @@ defined without diagonal elements. \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap19}\raggedright\small -\NWtarget{nuweb19}{} $\langle\,${\itshape assign diagonal elements}\nobreak\ {\footnotesize {19}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap20}\raggedright\small +\NWtarget{nuweb21}{} $\langle\,${\itshape assign diagonal elements}\nobreak\ {\footnotesize {21}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -1098,7 +1150,7 @@ defined without diagonal elements. \mbox{}\verb@@\\ \mbox{}\verb@"diagonals<-.ltMatrices" <- function(x, value) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape extract slots}\nobreak\ {\footnotesize \NWlink{nuweb9}{9}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape extract slots}\nobreak\ {\footnotesize \NWlink{nuweb10}{10}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (byrow)@\\ \mbox{}\verb@ idx <- cumsum(c(1, 2:J))@\\ @@ -1136,7 +1188,7 @@ defined without diagonal elements. \mbox{}\verb@@\\ \mbox{}\verb@"diagonals<-.syMatrices" <- function(x, value) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ class(x)[1L] <- "ltMatrices"@\\ +\mbox{}\verb@ x <- as.ltMatrices(x)@\\ \mbox{}\verb@ diagonals(x) <- value@\\ \mbox{}\verb@ class(x)[1L] <- "syMatrices"@\\ \mbox{}\verb@@\\ @@ -1163,8 +1215,8 @@ A unit diagonal matrix is not treated as a special case but as an \code{ltMatrices} object with all lower triangular elements being zero \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap20}\raggedright\small -\NWtarget{nuweb20}{} $\langle\,${\itshape diagonal matrix}\nobreak\ {\footnotesize {20}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap21}\raggedright\small +\NWtarget{nuweb22}{} $\langle\,${\itshape diagonal matrix}\nobreak\ {\footnotesize {22}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -1188,7 +1240,7 @@ I5 @ -\section{Multiplication} +\section{Multiplication} \label{sec:multiplication} Products $\mC_i \yvec_i$ or $\mC^\top_i \yvec_i$ with $\yvec_i \in \R^\J$ for $i = 1, \dots, N$ can be computed with $\code{y}$ being an $J \times N$ matrix of @@ -1197,16 +1249,16 @@ columns-wise stacked vectors $(\yvec_1 \mid \yvec_2 \mid \dots \mid If the number of columns of a matrix \code{y} is neither one nor $N$, we compute $\mC_i \yvec_j$ for all $i = 1, \dots, N$ and $j$. This is -dangerous but needed in \code{cond\_mvnorm} later on. +dangerous but needed in Section~\ref{sec:margcond} for defining \code{cond\_mvnorm} later on. For $\mC_i \yvec_i$, we call \proglang{C} code computing the product efficiently without copying data by leveraging the lower triangular structure of -\code{x} +\code{x}$=\mC_i$ \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap21}\raggedright\small -\NWtarget{nuweb21a}{} $\langle\,${\itshape mult ltMatrices}\nobreak\ {\footnotesize {21a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap22}\raggedright\small +\NWtarget{nuweb23a}{} $\langle\,${\itshape mult ltMatrices}\nobreak\ {\footnotesize {23a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -1219,7 +1271,7 @@ efficiently without copying data by leveraging the lower triangular structure of \mbox{}\verb@}@\\ \mbox{}\verb@Mult.ltMatrices <- function(x, y, transpose = FALSE, ...) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape extract slots}\nobreak\ {\footnotesize \NWlink{nuweb9}{9}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape extract slots}\nobreak\ {\footnotesize \NWlink{nuweb10}{10}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ stopifnot(is.numeric(y))@\\ \mbox{}\verb@ if (!is.matrix(y)) y <- matrix(y, nrow = d[2L], ncol = d[1L])@\\ @@ -1228,7 +1280,7 @@ efficiently without copying data by leveraging the lower triangular structure of \mbox{}\verb@ if (ncol(y) != N)@\\ \mbox{}\verb@ return(sapply(1:ncol(y), function(i) Mult(x, y[,i], transpose = transpose)))@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape mult ltMatrices transpose}\nobreak\ {\footnotesize \NWlink{nuweb23}{23}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape mult ltMatrices transpose}\nobreak\ {\footnotesize \NWlink{nuweb25}{25}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ x <- ltMatrices(x, byrow = TRUE)@\\ \mbox{}\verb@ if (!is.double(x)) storage.mode(x) <- "double"@\\ @@ -1257,8 +1309,8 @@ The underlying \proglang{C} code assumes $\mC_i$ (here called \code{C}) to be in row-major order. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap22}\raggedright\small -\NWtarget{nuweb21b}{} $\langle\,${\itshape RC input}\nobreak\ {\footnotesize {21b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap23}\raggedright\small +\NWtarget{nuweb23b}{} $\langle\,${\itshape RC input}\nobreak\ {\footnotesize {23b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -1277,7 +1329,7 @@ be in row-major order. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb22b}{22b}\NWlink{nuweb24}{, 24}\NWlink{nuweb27}{, 27}\NWlink{nuweb28}{, 28}\NWlink{nuweb31a}{, 31a}\NWlink{nuweb34}{, 34}\NWlink{nuweb40a}{, 40a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb24b}{24b}\NWlink{nuweb26}{, 26}\NWlink{nuweb29}{, 29}\NWlink{nuweb30}{, 30}\NWlink{nuweb33a}{, 33a}\NWlink{nuweb36}{, 36}\NWlink{nuweb42a}{, 42a}. \item{} \end{list} @@ -1288,8 +1340,8 @@ We also allow $\mC_i$ to be constant ($N$ is then determined from $\mC_i$ if \code{dim(x)[1L] > 1} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap23}\raggedright\small -\NWtarget{nuweb22a}{} $\langle\,${\itshape C length}\nobreak\ {\footnotesize {22a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap24}\raggedright\small +\NWtarget{nuweb24a}{} $\langle\,${\itshape C length}\nobreak\ {\footnotesize {24a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -1305,7 +1357,7 @@ $\mC_i$ if \code{dim(x)[1L] > 1} \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb22b}{22b}\NWlink{nuweb24}{, 24}\NWlink{nuweb27}{, 27}\NWlink{nuweb28}{, 28}\NWlink{nuweb31a}{, 31a}\NWlink{nuweb40a}{, 40a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb24b}{24b}\NWlink{nuweb26}{, 26}\NWlink{nuweb29}{, 29}\NWlink{nuweb33a}{, 33a}\NWlink{nuweb42a}{, 42a}. \item{} \end{list} @@ -1314,8 +1366,8 @@ $\mC_i$ if \code{dim(x)[1L] > 1} The \proglang{C} workhorse is now \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap24}\raggedright\small -\NWtarget{nuweb22b}{} $\langle\,${\itshape mult}\nobreak\ {\footnotesize {22b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap25}\raggedright\small +\NWtarget{nuweb24b}{} $\langle\,${\itshape mult}\nobreak\ {\footnotesize {24b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -1325,8 +1377,8 @@ The \proglang{C} workhorse is now \mbox{}\verb@ double *dans, *dy = REAL(y);@\\ \mbox{}\verb@ int i, j, k, start;@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape RC input}\nobreak\ {\footnotesize \NWlink{nuweb21b}{21b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape C length}\nobreak\ {\footnotesize \NWlink{nuweb22a}{22a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape RC input}\nobreak\ {\footnotesize \NWlink{nuweb23b}{23b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape C length}\nobreak\ {\footnotesize \NWlink{nuweb24a}{24a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ PROTECT(ans = allocMatrix(REALSXP, iJ, iN));@\\ \mbox{}\verb@ dans = REAL(ans);@\\ @@ -1398,12 +1450,12 @@ chk(a, b, check.attributes = FALSE) For $\mC^\top_i \yvec_i$ (\code{transpose = TRUE}), we add a dedicated \proglang{C} function paying attention to the lower triangular structure of -\code{x}. This function assumes \code{x} in column-major order, so we +\code{x}$= \mC_i$. This function assumes \code{x} in column-major order, so we coerce this object when necessary: \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap25}\raggedright\small -\NWtarget{nuweb23}{} $\langle\,${\itshape mult ltMatrices transpose}\nobreak\ {\footnotesize {23}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap26}\raggedright\small +\NWtarget{nuweb25}{} $\langle\,${\itshape mult ltMatrices transpose}\nobreak\ {\footnotesize {25}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -1425,7 +1477,7 @@ coerce this object when necessary: \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb21a}{21a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb23a}{23a}. \item{} \end{list} @@ -1434,8 +1486,8 @@ coerce this object when necessary: before moving to \proglang{C} for the low-level computations: \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap26}\raggedright\small -\NWtarget{nuweb24}{} $\langle\,${\itshape mult transpose}\nobreak\ {\footnotesize {24}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap27}\raggedright\small +\NWtarget{nuweb26}{} $\langle\,${\itshape mult transpose}\nobreak\ {\footnotesize {26}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -1445,8 +1497,8 @@ before moving to \proglang{C} for the low-level computations: \mbox{}\verb@ double *dans, *dy = REAL(y);@\\ \mbox{}\verb@ int i, j, k, start;@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape RC input}\nobreak\ {\footnotesize \NWlink{nuweb21b}{21b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape C length}\nobreak\ {\footnotesize \NWlink{nuweb22a}{22a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape RC input}\nobreak\ {\footnotesize \NWlink{nuweb23b}{23b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape C length}\nobreak\ {\footnotesize \NWlink{nuweb24a}{24a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ PROTECT(ans = allocMatrix(REALSXP, iJ, iN));@\\ \mbox{}\verb@ dans = REAL(ans);@\\ @@ -1508,21 +1560,21 @@ chk(Mult(lxn, y[,1], transpose = TRUE), @ Now we can add a \code{Mult} method for multiple symmetric matrices, noting -that for a symmetric matrix $\mC = \mA + \mA^\top - \text{diag}(\mA)$ with lower triangular -part $\mA$ (including the diagonal) we can compute $\mC \yvec = \mA \yvec + \mA^\top \yvec - \text{diag}(\mA) -\yvec$ using \code{Mult} applied to the lower trianular part: +that for a symmetric matrix $\mA = \mC + \mC^\top - \text{diag}(\mC)$ with lower triangular +part $\mC$ (including the diagonal) we can compute $\mA \yvec = \mC \yvec + +\mC^\top \yvec - \text{diag}(\mC) \yvec$ using \code{Mult} applied to the lower trianular part: \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap27}\raggedright\small -\NWtarget{nuweb25}{} $\langle\,${\itshape mult syMatrices}\nobreak\ {\footnotesize {25}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap28}\raggedright\small +\NWtarget{nuweb27}{} $\langle\,${\itshape mult syMatrices}\nobreak\ {\footnotesize {27}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@Mult.syMatrices <- function(x, y, ...) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape extract slots}\nobreak\ {\footnotesize \NWlink{nuweb9}{9}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape extract slots}\nobreak\ {\footnotesize \NWlink{nuweb10}{10}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ class(x)[1L] <- "ltMatrices"@\\ +\mbox{}\verb@ x <- as.ltMatrices(x)@\\ \mbox{}\verb@ stopifnot(is.numeric(y))@\\ \mbox{}\verb@ if (!is.matrix(y)) y <- matrix(y, nrow = d[2L], ncol = d[1L])@\\ \mbox{}\verb@ N <- ifelse(d[1L] == 1, ncol(y), d[1L])@\\ @@ -1547,7 +1599,8 @@ part $\mA$ (including the diagonal) we can compute $\mC \yvec = \mA \yvec + \mA^ J <- 5 N1 <- 10 ex <- expression({ - C <- syMatrices(matrix(runif(N2 * J * (J + c(-1, 1)[DIAG + 1L] ) / 2), ncol = N2), + C <- syMatrices(matrix(runif(N2 * J * (J + c(-1, 1)[DIAG + 1L] ) / 2), + ncol = N2), diag = DIAG) x <- matrix(runif(N1 * J), nrow = J) Ca <- as.array(C) @@ -1591,12 +1644,12 @@ We start with some options for the \proglang{LAPACK} workhorses \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap28}\raggedright\small -\NWtarget{nuweb26}{} $\langle\,${\itshape lapack options}\nobreak\ {\footnotesize {26}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap29}\raggedright\small +\NWtarget{nuweb28}{} $\langle\,${\itshape lapack options}\nobreak\ {\footnotesize {28}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ -\mbox{}\verb@char di, lo = 'L', tr = 'N';@\\ +\mbox{}\verb@char di, lo = 'L';@\\ \mbox{}\verb@if (Rdiag) {@\\ \mbox{}\verb@ /* non-unit diagonal elements */@\\ \mbox{}\verb@ di = 'N';@\\ @@ -1605,22 +1658,12 @@ We start with some options for the \proglang{LAPACK} workhorses \mbox{}\verb@ ignored in the computations */@\\ \mbox{}\verb@ di = 'U';@\\ \mbox{}\verb@}@\\ -\mbox{}\verb@@\\ -\mbox{}\verb@/* t(C) instead of C */@\\ -\mbox{}\verb@Rboolean Rtranspose = asLogical(transpose);@\\ -\mbox{}\verb@if (Rtranspose) {@\\ -\mbox{}\verb@ /* t(C) */@\\ -\mbox{}\verb@ tr = 'T';@\\ -\mbox{}\verb@} else {@\\ -\mbox{}\verb@ /* C */@\\ -\mbox{}\verb@ tr = 'N';@\\ -\mbox{}\verb@}@\\ \mbox{}\verb@@{\NWsep} \end{list} \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb27}{27}\NWlink{nuweb28}{, 28}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb29}{29}\NWlink{nuweb30}{, 30}. \item{} \end{list} @@ -1629,8 +1672,8 @@ We start with some options for the \proglang{LAPACK} workhorses and set-up a dedicated \proglang{C} function for computing $\mC_i \xvec_i = \yvec_i$ \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap29}\raggedright\small -\NWtarget{nuweb27}{} $\langle\,${\itshape solve}\nobreak\ {\footnotesize {27}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap30}\raggedright\small +\NWtarget{nuweb29}{} $\langle\,${\itshape solve}\nobreak\ {\footnotesize {29}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -1639,13 +1682,24 @@ and set-up a dedicated \proglang{C} function for computing $\mC_i \xvec_i = \yve \mbox{}\verb@@\\ \mbox{}\verb@ SEXP ans;@\\ \mbox{}\verb@ double *dans, *dy;@\\ -\mbox{}\verb@ int i, j, info, ONE = 1;@\\ +\mbox{}\verb@ int i, ONE = 1;@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape RC input}\nobreak\ {\footnotesize \NWlink{nuweb21b}{21b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape RC input}\nobreak\ {\footnotesize \NWlink{nuweb23b}{23b}}$\,\rangle$}\verb@@\\ \mbox{}\verb@ /* diagonal elements are always present */@\\ \mbox{}\verb@ if (!Rdiag) len += iJ;@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape C length}\nobreak\ {\footnotesize \NWlink{nuweb22a}{22a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape lapack options}\nobreak\ {\footnotesize \NWlink{nuweb26}{26}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape C length}\nobreak\ {\footnotesize \NWlink{nuweb24a}{24a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape lapack options}\nobreak\ {\footnotesize \NWlink{nuweb28}{28}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@ char tr = 'N';@\\ +\mbox{}\verb@ /* t(C) instead of C */@\\ +\mbox{}\verb@ Rboolean Rtranspose = asLogical(transpose);@\\ +\mbox{}\verb@ if (Rtranspose) {@\\ +\mbox{}\verb@ /* t(C) */@\\ +\mbox{}\verb@ tr = 'T';@\\ +\mbox{}\verb@ } else {@\\ +\mbox{}\verb@ /* C */@\\ +\mbox{}\verb@ tr = 'N';@\\ +\mbox{}\verb@ }@\\ \mbox{}\verb@@\\ \mbox{}\verb@ dy = REAL(y);@\\ \mbox{}\verb@ PROTECT(ans = allocMatrix(REALSXP, iJ, iN));@\\ @@ -1678,8 +1732,8 @@ and set-up a dedicated \proglang{C} function for computing $\mC_i \xvec_i = \yve and then for computing $\mC_i^{-1}$ explicitly \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap30}\raggedright\small -\NWtarget{nuweb28}{} $\langle\,${\itshape solve C}\nobreak\ {\footnotesize {28}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap31}\raggedright\small +\NWtarget{nuweb30}{} $\langle\,${\itshape solve C}\nobreak\ {\footnotesize {30}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -1688,13 +1742,12 @@ and then for computing $\mC_i^{-1}$ explicitly \mbox{}\verb@@\\ \mbox{}\verb@ SEXP ans;@\\ \mbox{}\verb@ double *dans;@\\ -\mbox{}\verb@ int i, j, info, jj, idx, ONE = 1;@\\ +\mbox{}\verb@ int i, info;@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape RC input}\nobreak\ {\footnotesize \NWlink{nuweb21b}{21b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape RC input}\nobreak\ {\footnotesize \NWlink{nuweb23b}{23b}}$\,\rangle$}\verb@@\\ \mbox{}\verb@ /* diagonal elements are always present */@\\ \mbox{}\verb@ if (!Rdiag) len += iJ;@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape C length}\nobreak\ {\footnotesize \NWlink{nuweb22a}{22a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape lapack options}\nobreak\ {\footnotesize \NWlink{nuweb26}{26}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape lapack options}\nobreak\ {\footnotesize \NWlink{nuweb28}{28}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ PROTECT(ans = allocMatrix(REALSXP, len, iN));@\\ \mbox{}\verb@ dans = REAL(ans);@\\ @@ -1729,8 +1782,8 @@ and then for computing $\mC_i^{-1}$ explicitly with \proglang{R} interface \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap31}\raggedright\small -\NWtarget{nuweb29}{} $\langle\,${\itshape solve ltMatrices}\nobreak\ {\footnotesize {29}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap32}\raggedright\small +\NWtarget{nuweb31}{} $\langle\,${\itshape solve ltMatrices}\nobreak\ {\footnotesize {31}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -1832,8 +1885,8 @@ we sum over the log-diagonal entries of a lower triangular matrix in \proglang{C}, both when the data are stored in row- and column-major order: \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap32}\raggedright\small -\NWtarget{nuweb31a}{} $\langle\,${\itshape logdet}\nobreak\ {\footnotesize {31a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap33}\raggedright\small +\NWtarget{nuweb33a}{} $\langle\,${\itshape logdet}\nobreak\ {\footnotesize {33a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -1843,9 +1896,9 @@ we sum over the log-diagonal entries of a lower triangular matrix in \mbox{}\verb@ double *dans;@\\ \mbox{}\verb@ int i, j, k;@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape RC input}\nobreak\ {\footnotesize \NWlink{nuweb21b}{21b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape RC input}\nobreak\ {\footnotesize \NWlink{nuweb23b}{23b}}$\,\rangle$}\verb@@\\ \mbox{}\verb@ Rboolean Rbyrow = asLogical(byrow);@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape C length}\nobreak\ {\footnotesize \NWlink{nuweb22a}{22a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape C length}\nobreak\ {\footnotesize \NWlink{nuweb24a}{24a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ PROTECT(ans = allocVector(REALSXP, iN));@\\ \mbox{}\verb@ dans = REAL(ans);@\\ @@ -1879,14 +1932,14 @@ we sum over the log-diagonal entries of a lower triangular matrix in The \proglang{R} interface now simply calls this low-level function \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap33}\raggedright\small -\NWtarget{nuweb31b}{} $\langle\,${\itshape logdet ltMatrices}\nobreak\ {\footnotesize {31b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap34}\raggedright\small +\NWtarget{nuweb33b}{} $\langle\,${\itshape logdet ltMatrices}\nobreak\ {\footnotesize {33b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@logdet <- function(x) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ if (!inherits(x, "ltMatrices"))@\\ +\mbox{}\verb@ if (!is.ltMatrices(x))@\\ \mbox{}\verb@ stop("x is not an ltMatrices object")@\\ \mbox{}\verb@@\\ \mbox{}\verb@ byrow <- attr(x, "byrow")@\\ @@ -1926,7 +1979,7 @@ chk(logdet(lxd2), colSums(log(diagonals(lxd2)))) \section{Crossproducts} -Compute $\mC_i \mC_i^\top$ or $\text{diag}(\mC_i \mC_i^\top)$ +We want to ompute $\mC_i \mC_i^\top$ or $\text{diag}(\mC_i \mC_i^\top)$ (\code{diag\_only = TRUE}) for $i = 1, \dots, N$. These are symmetric matrices, so we store them as a lower triangular matrix using a different class name \code{syMatrices}. We write one \proglang{C} function for @@ -1937,8 +1990,8 @@ We differentiate between computation of the diagonal elements of the crossproduct \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap34}\raggedright\small -\NWtarget{nuweb32a}{} $\langle\,${\itshape first element}\nobreak\ {\footnotesize {32a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap35}\raggedright\small +\NWtarget{nuweb34a}{} $\langle\,${\itshape first element}\nobreak\ {\footnotesize {34a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -1954,22 +2007,22 @@ crossproduct \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb32b}{32b}\NWlink{nuweb33a}{, 33a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb34b}{34b}\NWlink{nuweb35a}{, 35a}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap35}\raggedright\small -\NWtarget{nuweb32b}{} $\langle\,${\itshape tcrossprod diagonal only}\nobreak\ {\footnotesize {32b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap36}\raggedright\small +\NWtarget{nuweb34b}{} $\langle\,${\itshape tcrossprod diagonal only}\nobreak\ {\footnotesize {34b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@PROTECT(ans = allocMatrix(REALSXP, iJ, iN));@\\ \mbox{}\verb@dans = REAL(ans);@\\ \mbox{}\verb@for (n = 0; n < iN; n++) {@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape first element}\nobreak\ {\footnotesize \NWlink{nuweb32a}{32a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape first element}\nobreak\ {\footnotesize \NWlink{nuweb34a}{34a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@ for (i = 1; i < iJ; i++) {@\\ \mbox{}\verb@ dans[i] = 0.0;@\\ \mbox{}\verb@ if (Rtranspose) { // crossprod@\\ @@ -1993,7 +2046,7 @@ crossproduct \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb34}{34}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb36}{36}. \item{} \end{list} @@ -2002,8 +2055,8 @@ crossproduct and computation of the full $\J \times \J$ crossproduct matrix \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap36}\raggedright\small -\NWtarget{nuweb33a}{} $\langle\,${\itshape tcrossprod full}\nobreak\ {\footnotesize {33a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap37}\raggedright\small +\NWtarget{nuweb35a}{} $\langle\,${\itshape tcrossprod full}\nobreak\ {\footnotesize {35a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -2011,7 +2064,7 @@ and computation of the full $\J \times \J$ crossproduct matrix \mbox{}\verb@PROTECT(ans = allocMatrix(REALSXP, nrow, iN)); @\\ \mbox{}\verb@dans = REAL(ans);@\\ \mbox{}\verb@for (n = 0; n < INTEGER(N)[0]; n++) {@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape first element}\nobreak\ {\footnotesize \NWlink{nuweb32a}{32a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape first element}\nobreak\ {\footnotesize \NWlink{nuweb34a}{34a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@ for (i = 1; i < iJ; i++) {@\\ \mbox{}\verb@ for (j = 0; j <= i; j++) {@\\ \mbox{}\verb@ ix = IDX(i + 1, j + 1, iJ, 1);@\\ @@ -2053,7 +2106,7 @@ and computation of the full $\J \times \J$ crossproduct matrix \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb34}{34}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb36}{36}. \item{} \end{list} @@ -2062,8 +2115,8 @@ and computation of the full $\J \times \J$ crossproduct matrix and put both cases together \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap37}\raggedright\small -\NWtarget{nuweb33b}{} $\langle\,${\itshape IDX}\nobreak\ {\footnotesize {33b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap38}\raggedright\small +\NWtarget{nuweb35b}{} $\langle\,${\itshape IDX}\nobreak\ {\footnotesize {35b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -2073,20 +2126,20 @@ and put both cases together \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb34}{34}\NWlink{nuweb40a}{, 40a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb36}{36}\NWlink{nuweb42a}{, 42a}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap38}\raggedright\small -\NWtarget{nuweb34}{} $\langle\,${\itshape tcrossprod}\nobreak\ {\footnotesize {34}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap39}\raggedright\small +\NWtarget{nuweb36}{} $\langle\,${\itshape tcrossprod}\nobreak\ {\footnotesize {36}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape IDX}\nobreak\ {\footnotesize \NWlink{nuweb33b}{33b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape IDX}\nobreak\ {\footnotesize \NWlink{nuweb35b}{35b}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@SEXP R_ltMatrices_tcrossprod (SEXP C, SEXP N, SEXP J, SEXP diag, @\\ \mbox{}\verb@ SEXP diag_only, SEXP transpose) {@\\ @@ -2095,15 +2148,15 @@ and put both cases together \mbox{}\verb@ double *dans;@\\ \mbox{}\verb@ int i, j, n, k, ix, nrow;@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape RC input}\nobreak\ {\footnotesize \NWlink{nuweb21b}{21b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape RC input}\nobreak\ {\footnotesize \NWlink{nuweb23b}{23b}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ Rboolean Rdiag_only = asLogical(diag_only);@\\ \mbox{}\verb@ Rboolean Rtranspose = asLogical(transpose);@\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (Rdiag_only) {@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape tcrossprod diagonal only}\nobreak\ {\footnotesize \NWlink{nuweb32b}{32b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape tcrossprod diagonal only}\nobreak\ {\footnotesize \NWlink{nuweb34b}{34b}}$\,\rangle$}\verb@@\\ \mbox{}\verb@ } else {@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape tcrossprod full}\nobreak\ {\footnotesize \NWlink{nuweb33a}{33a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape tcrossprod full}\nobreak\ {\footnotesize \NWlink{nuweb35a}{35a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@ }@\\ \mbox{}\verb@ UNPROTECT(1);@\\ \mbox{}\verb@ return(ans);@\\ @@ -2122,8 +2175,8 @@ and put both cases together with \proglang{R} interface \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap39}\raggedright\small -\NWtarget{nuweb35}{} $\langle\,${\itshape tcrossprod ltMatrices}\nobreak\ {\footnotesize {35}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap40}\raggedright\small +\NWtarget{nuweb37}{} $\langle\,${\itshape tcrossprod ltMatrices}\nobreak\ {\footnotesize {37}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -2131,7 +2184,7 @@ with \proglang{R} interface \mbox{}\verb@### diag(C %*% t(C)) => returns matrix of diagonal elements@\\ \mbox{}\verb@.Tcrossprod <- function(x, diag_only = FALSE, transpose = FALSE) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ if (!inherits(x, "ltMatrices")) {@\\ +\mbox{}\verb@ if (!is.ltMatrices(x)) {@\\ \mbox{}\verb@ ret <- tcrossprod(x)@\\ \mbox{}\verb@ if (diag_only) ret <- diag(ret)@\\ \mbox{}\verb@ return(ret)@\\ @@ -2202,8 +2255,8 @@ We also add \code{Crossprod}, which is a call to \code{Tcrossprod} with the \code{transpose} switch turned on \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap40}\raggedright\small -\NWtarget{nuweb36}{} $\langle\,${\itshape crossprod ltMatrices}\nobreak\ {\footnotesize {36}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap41}\raggedright\small +\NWtarget{nuweb38}{} $\langle\,${\itshape crossprod ltMatrices}\nobreak\ {\footnotesize {38}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -2253,8 +2306,8 @@ One might want to compute the Cholesky factorisations $\mSigma_i = \mC_i in class \code{syMatrices}. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap41}\raggedright\small -\NWtarget{nuweb37}{} $\langle\,${\itshape chol syMatrices}\nobreak\ {\footnotesize {37}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap42}\raggedright\small +\NWtarget{nuweb39}{} $\langle\,${\itshape chol syMatrices}\nobreak\ {\footnotesize {39}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -2299,8 +2352,8 @@ so we swiftly loop over $i = 1, \dots, N$ in \proglang{C} and hand over to \code{LAPACK} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap42}\raggedright\small -\NWtarget{nuweb38}{} $\langle\,${\itshape chol}\nobreak\ {\footnotesize {38}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap43}\raggedright\small +\NWtarget{nuweb40}{} $\langle\,${\itshape chol}\nobreak\ {\footnotesize {40}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -2373,8 +2426,8 @@ trick'', we have $\text{vec}(\mS)^\top (\mA^\top \otimes \mC) = matrices, so we simply call this function looping over $i = 1, \dots, N$. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap43}\raggedright\small -\NWtarget{nuweb39}{} $\langle\,${\itshape t(C) S t(A)}\nobreak\ {\footnotesize {39}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap44}\raggedright\small +\NWtarget{nuweb41}{} $\langle\,${\itshape t(C) S t(A)}\nobreak\ {\footnotesize {41}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -2427,20 +2480,20 @@ matrices, so we simply call this function looping over $i = 1, \dots, N$. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb40a}{40a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb42a}{42a}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap44}\raggedright\small -\NWtarget{nuweb40a}{} $\langle\,${\itshape vec trick}\nobreak\ {\footnotesize {40a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap45}\raggedright\small +\NWtarget{nuweb42a}{} $\langle\,${\itshape vec trick}\nobreak\ {\footnotesize {42a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape IDX}\nobreak\ {\footnotesize \NWlink{nuweb33b}{33b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape IDX}\nobreak\ {\footnotesize \NWlink{nuweb35b}{35b}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@SEXP R_vectrick(SEXP C, SEXP N, SEXP J, SEXP S, SEXP A, SEXP diag, SEXP trans) {@\\ \mbox{}\verb@@\\ @@ -2449,15 +2502,15 @@ matrices, so we simply call this function looping over $i = 1, \dots, N$. \mbox{}\verb@ double *dS, *dans, *dA;@\\ \mbox{}\verb@@\\ \mbox{}\verb@ /* note: diag is needed by this chunk but has no consequences */@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape RC input}\nobreak\ {\footnotesize \NWlink{nuweb21b}{21b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape C length}\nobreak\ {\footnotesize \NWlink{nuweb22a}{22a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape RC input}\nobreak\ {\footnotesize \NWlink{nuweb23b}{23b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape C length}\nobreak\ {\footnotesize \NWlink{nuweb24a}{24a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@ dS = REAL(S);@\\ \mbox{}\verb@ dA = REAL(A);@\\ \mbox{}\verb@@\\ \mbox{}\verb@ Rboolean RtC = LOGICAL(trans)[0];@\\ \mbox{}\verb@ Rboolean RtA = LOGICAL(trans)[1];@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape t(C) S t(A)}\nobreak\ {\footnotesize \NWlink{nuweb39}{39}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape t(C) S t(A)}\nobreak\ {\footnotesize \NWlink{nuweb41}{41}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ UNPROTECT(1);@\\ \mbox{}\verb@ return(ans);@\\ @@ -2479,12 +2532,12 @@ argument in \code{vectrick}. Argument \code{C} is an \code{ltMatrices} object \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap45}\raggedright\small -\NWtarget{nuweb40b}{} $\langle\,${\itshape check C argument}\nobreak\ {\footnotesize {40b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap46}\raggedright\small +\NWtarget{nuweb42b}{} $\langle\,${\itshape check C argument}\nobreak\ {\footnotesize {42b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ -\mbox{}\verb@stopifnot(inherits(C, "ltMatrices"))@\\ +\mbox{}\verb@C <- as.ltMatrices(C)@\\ \mbox{}\verb@if (!attr(C, "diag")) diagonals(C) <- 1@\\ \mbox{}\verb@C_byrow_orig <- attr(C, "byrow")@\\ \mbox{}\verb@C <- ltMatrices(C, byrow = FALSE)@\\ @@ -2492,14 +2545,14 @@ object \mbox{}\verb@nm <- attr(C, "rcnames")@\\ \mbox{}\verb@N <- dC[1L]@\\ \mbox{}\verb@J <- dC[2L]@\\ -\mbox{}\verb@class(C) <- class(C)[-1L]@\\ +\mbox{}\verb@class(C) <- class(C)[-1L] ### works because of as.ltMatrices(c)@\\ \mbox{}\verb@if (!is.double(C)) storage.mode(C) <- "double"@\\ \mbox{}\verb@@{\NWsep} \end{list} \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb42}{42}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb44}{44}. \item{} \end{list} @@ -2509,12 +2562,12 @@ object featuring columns of vectorised $\J \times \J$ matrices \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap46}\raggedright\small -\NWtarget{nuweb41a}{} $\langle\,${\itshape check S argument}\nobreak\ {\footnotesize {41a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap47}\raggedright\small +\NWtarget{nuweb43a}{} $\langle\,${\itshape check S argument}\nobreak\ {\footnotesize {43a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ -\mbox{}\verb@SltM <- inherits(S, "ltMatrices")@\\ +\mbox{}\verb@SltM <- is.ltMatrices(S)@\\ \mbox{}\verb@if (SltM) {@\\ \mbox{}\verb@ if (!attr(S, "diag")) diagonals(S) <- 1@\\ \mbox{}\verb@ S_byrow_orig <- attr(S, "byrow")@\\ @@ -2545,7 +2598,7 @@ featuring columns of vectorised $\J \times \J$ matrices \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb42}{42}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb44}{44}. \item{} \end{list} @@ -2554,15 +2607,15 @@ featuring columns of vectorised $\J \times \J$ matrices \code{A} is an \code{ltMatrices} object \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap47}\raggedright\small -\NWtarget{nuweb41b}{} $\langle\,${\itshape check A argument}\nobreak\ {\footnotesize {41b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap48}\raggedright\small +\NWtarget{nuweb43b}{} $\langle\,${\itshape check A argument}\nobreak\ {\footnotesize {43b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@if (missing(A)) {@\\ \mbox{}\verb@ A <- C@\\ \mbox{}\verb@} else {@\\ -\mbox{}\verb@ stopifnot(inherits(A, "ltMatrices"))@\\ +\mbox{}\verb@ A <- as.ltMatrices(A)@\\ \mbox{}\verb@ if (!attr(A, "diag")) diagonals(A) <- 1@\\ \mbox{}\verb@ A_byrow_orig <- attr(A, "byrow")@\\ \mbox{}\verb@ stopifnot(C_byrow_orig == A_byrow_orig)@\\ @@ -2584,7 +2637,7 @@ featuring columns of vectorised $\J \times \J$ matrices \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb42}{42}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb44}{44}. \item{} \end{list} @@ -2593,8 +2646,8 @@ featuring columns of vectorised $\J \times \J$ matrices We put everything together in function \code{vectrick} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap48}\raggedright\small -\NWtarget{nuweb42}{} $\langle\,${\itshape kronecker vec trick}\nobreak\ {\footnotesize {42}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap49}\raggedright\small +\NWtarget{nuweb44}{} $\langle\,${\itshape kronecker vec trick}\nobreak\ {\footnotesize {44}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -2603,9 +2656,9 @@ We put everything together in function \code{vectrick} \mbox{}\verb@ stopifnot(all(is.logical(transpose)))@\\ \mbox{}\verb@ stopifnot(length(transpose) == 2L)@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape check C argument}\nobreak\ {\footnotesize \NWlink{nuweb40b}{40b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape check S argument}\nobreak\ {\footnotesize \NWlink{nuweb41a}{41a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape check A argument}\nobreak\ {\footnotesize \NWlink{nuweb41b}{41b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape check C argument}\nobreak\ {\footnotesize \NWlink{nuweb42b}{42b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape check S argument}\nobreak\ {\footnotesize \NWlink{nuweb43a}{43a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape check A argument}\nobreak\ {\footnotesize \NWlink{nuweb43b}{43b}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ ret <- .Call(mvtnorm_R_vectrick, C, as.integer(N), as.integer(J), S, A, @\\ \mbox{}\verb@ as.logical(TRUE), as.logical(transpose))@\\ @@ -2686,7 +2739,7 @@ chk(A, B) @ -\section{Convenience Functions} +\section{Convenience Functions} \label{sec:conv} We add a few convenience functions for computing covariance matrices @@ -2698,15 +2751,55 @@ $\tilde{\mL}_i = \mL_i \text{diag}(\mL_i^\top \mL_i)^{-\frac{1}{2}}$ from $\mL_i$ (\code{invchol}) or $\mC_i = \mL_i^{-1}$ (\code{chol}) for $i = 1, \dots, N$. +Before we start, let us put a label on lower triangular matrices, such that +we can differentiate between $\mC$ and $\mL$. + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap50}\raggedright\small +\NWtarget{nuweb45}{} $\langle\,${\itshape chol classes}\nobreak\ {\footnotesize {45}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@is.chol <- function(x) inherits(x, "chol")@\\ +\mbox{}\verb@as.chol <- function(x) {@\\ +\mbox{}\verb@ stopifnot(is.ltMatrices(x))@\\ +\mbox{}\verb@ if (is.chol(x)) return(x)@\\ +\mbox{}\verb@ if (is.invchol(x))@\\ +\mbox{}\verb@ return(invchol2chol(x))@\\ +\mbox{}\verb@ class(x) <- c("chol", class(x))@\\ +\mbox{}\verb@ return(x)@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@is.invchol <- function(x) inherits(x, "invchol")@\\ +\mbox{}\verb@as.invchol <- function(x) {@\\ +\mbox{}\verb@ stopifnot(is.ltMatrices(x))@\\ +\mbox{}\verb@ if (is.invchol(x)) return(x)@\\ +\mbox{}\verb@ if (is.chol(x))@\\ +\mbox{}\verb@ return(chol2invchol(x))@\\ +\mbox{}\verb@ class(x) <- c("invchol", class(x))@\\ +\mbox{}\verb@ return(x)@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb48}{48}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} First, we set-up functions for computing $\tilde{\mC}_i$ \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap49}\raggedright\small -\NWtarget{nuweb43}{} $\langle\,${\itshape D times C}\nobreak\ {\footnotesize {43}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap51}\raggedright\small +\NWtarget{nuweb46}{} $\langle\,${\itshape D times C}\nobreak\ {\footnotesize {46}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@Dchol <- function(x, D = 1 / sqrt(Tcrossprod(x, diag_only = TRUE))) {@\\ \mbox{}\verb@@\\ +\mbox{}\verb@ if (is.invchol(x)) stop("Dchol cannot work with invchol objects")@\\ +\mbox{}\verb@@\\ \mbox{}\verb@ x <- .adddiag(x)@\\ \mbox{}\verb@@\\ \mbox{}\verb@ byrow_orig <- attr(x, "byrow")@\\ @@ -2717,10 +2810,15 @@ First, we set-up functions for computing $\tilde{\mC}_i$ \mbox{}\verb@ J <- dim(x)[2L]@\\ \mbox{}\verb@ nm <- dimnames(x)[[2L]]@\\ \mbox{}\verb@@\\ +\mbox{}\verb@ ### for some parameter configurations logdet(ret) would@\\ +\mbox{}\verb@ ### be -Inf; make sure this does't happen@\\ +\mbox{}\verb@ if (any(D < .Machine$double.eps))@\\ +\mbox{}\verb@ D[D < .Machine$double.eps] <- 2 * .Machine$double.eps@\\ +\mbox{}\verb@@\\ \mbox{}\verb@ x <- unclass(x) * D[rep(1:J, 1:J),,drop = FALSE]@\\ \mbox{}\verb@@\\ \mbox{}\verb@ ret <- ltMatrices(x, diag = TRUE, byrow = TRUE, names = nm)@\\ -\mbox{}\verb@ ret <- ltMatrices(ret, byrow = byrow_orig)@\\ +\mbox{}\verb@ ret <- as.chol(ltMatrices(ret, byrow = byrow_orig))@\\ \mbox{}\verb@ return(ret)@\\ \mbox{}\verb@}@\\ \mbox{}\verb@@{\NWsep} @@ -2728,7 +2826,7 @@ First, we set-up functions for computing $\tilde{\mC}_i$ \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb45}{45}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb48}{48}. \item{} \end{list} @@ -2737,14 +2835,16 @@ First, we set-up functions for computing $\tilde{\mC}_i$ and $\tilde{\mC}_i^{-1} = \mL_i \text{diag}(\mL_i^{-1} \mL_i^{-\top})^{\frac{1}{2}}$ \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap50}\raggedright\small -\NWtarget{nuweb44}{} $\langle\,${\itshape L times D}\nobreak\ {\footnotesize {44}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap52}\raggedright\small +\NWtarget{nuweb47}{} $\langle\,${\itshape L times D}\nobreak\ {\footnotesize {47}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@### invcholD = solve(Dchol)@\\ \mbox{}\verb@invcholD <- function(x, D = sqrt(Tcrossprod(solve(x), diag_only = TRUE))) {@\\ \mbox{}\verb@@\\ +\mbox{}\verb@ if (is.chol(x)) stop("invcholD cannot work with chol objects")@\\ +\mbox{}\verb@@\\ \mbox{}\verb@ x <- .adddiag(x)@\\ \mbox{}\verb@@\\ \mbox{}\verb@ byrow_orig <- attr(x, "byrow")@\\ @@ -2755,10 +2855,15 @@ and $\tilde{\mC}_i^{-1} = \mL_i \text{diag}(\mL_i^{-1} \mL_i^{-\top})^{\frac{1}{ \mbox{}\verb@ J <- dim(x)[2L]@\\ \mbox{}\verb@ nm <- dimnames(x)[[2L]]@\\ \mbox{}\verb@@\\ +\mbox{}\verb@ ### for some parameter configurations logdet(ret) would@\\ +\mbox{}\verb@ ### be -Inf; make sure this does't happen@\\ +\mbox{}\verb@ if (any(D < .Machine$double.eps))@\\ +\mbox{}\verb@ D[D < .Machine$double.eps] <- 2 * .Machine$double.eps@\\ +\mbox{}\verb@@\\ \mbox{}\verb@ x <- unclass(x) * D[rep(1:J, J:1),,drop = FALSE]@\\ \mbox{}\verb@@\\ \mbox{}\verb@ ret <- ltMatrices(x, diag = TRUE, byrow = FALSE, names = nm)@\\ -\mbox{}\verb@ ret <- ltMatrices(ret, byrow = byrow_orig)@\\ +\mbox{}\verb@ ret <- as.invchol(ltMatrices(ret, byrow = byrow_orig))@\\ \mbox{}\verb@ return(ret)@\\ \mbox{}\verb@}@\\ \mbox{}\verb@@{\NWsep} @@ -2766,7 +2871,7 @@ and $\tilde{\mC}_i^{-1} = \mL_i \text{diag}(\mL_i^{-1} \mL_i^{-\top})^{\frac{1}{ \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb45}{45}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb48}{48}. \item{} \end{list} @@ -2775,13 +2880,14 @@ and $\tilde{\mC}_i^{-1} = \mL_i \text{diag}(\mL_i^{-1} \mL_i^{-\top})^{\frac{1}{ and now the convenience functions are one-liners: \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap51}\raggedright\small -\NWtarget{nuweb45}{} $\langle\,${\itshape convenience functions}\nobreak\ {\footnotesize {45}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap53}\raggedright\small +\NWtarget{nuweb48}{} $\langle\,${\itshape convenience functions}\nobreak\ {\footnotesize {48}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape D times C}\nobreak\ {\footnotesize \NWlink{nuweb43}{43}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape L times D}\nobreak\ {\footnotesize \NWlink{nuweb44}{44}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape chol classes}\nobreak\ {\footnotesize \NWlink{nuweb45}{45}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape D times C}\nobreak\ {\footnotesize \NWlink{nuweb46}{46}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape L times D}\nobreak\ {\footnotesize \NWlink{nuweb47}{47}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@### C -> Sigma@\\ \mbox{}\verb@chol2cov <- function(x)@\\ @@ -2789,11 +2895,11 @@ and now the convenience functions are one-liners: \mbox{}\verb@@\\ \mbox{}\verb@### L -> C@\\ \mbox{}\verb@invchol2chol <- function(x)@\\ -\mbox{}\verb@ solve(x)@\\ +\mbox{}\verb@ as.chol(solve(x))@\\ \mbox{}\verb@@\\ \mbox{}\verb@### C -> L@\\ \mbox{}\verb@chol2invchol <- function(x)@\\ -\mbox{}\verb@ solve(x)@\\ +\mbox{}\verb@ as.invchol(solve(x))@\\ \mbox{}\verb@@\\ \mbox{}\verb@### L -> Sigma@\\ \mbox{}\verb@invchol2cov <- function(x)@\\ @@ -2929,29 +3035,73 @@ chk(unlist(PC), c(as.array(chol2pc(C))), check.attributes = FALSE) @ -We also add an \code{aperm} method for class \code{ltMatrices} +We also add an \code{aperm} method for class \code{ltMatrices}, +implementing the parameters ($\tilde{\mC}_i$ or $\tilde{\mL}_i$) +for permuted versions of the +random vectors $\rY_i$. Let $\pi$ denote a permutation of $1, \dots, J$ and +$\Pi$ the corresponding permutation matrix. Then, we have +$\Pi \rY_i \sim \ND_\J(\mathbf{0}_\J, \Pi \mC_i \mC_i^\top \Pi^\top)$. +Unfortunately, $\Pi \mC_i$ is no longer lower triangular, so we have to find +the Cholesky decompositon $\tilde{\mC}_i \tilde{\mC}_i^\top$ of $\Pi \mC_i \mC_i^\top +\Pi^\top$. Of course, $\tilde{\mL}_i = \tilde{\mC}_i^{-1}$. + +The function \code{aperm}, with argument \code{perm} $=\pi$, +now computes the Cholesky factor $\tilde{\mC}_i$ +of the permuted covariance matrix, or the inverse thereof (in case +\code{x} is of class \code{invchol}). We start with some tests \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap52}\raggedright\small -\NWtarget{nuweb47}{} $\langle\,${\itshape aperm}\nobreak\ {\footnotesize {47}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap54}\raggedright\small +\NWtarget{nuweb50}{} $\langle\,${\itshape aperm checks}\nobreak\ {\footnotesize {50}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ -\mbox{}\verb@aperm.ltMatrices <- function(a, perm, is_chol = FALSE, ...) {@\\ +\mbox{}\verb@J <- dim(a)[2L]@\\ +\mbox{}\verb@if (missing(perm)) return(a)@\\ +\mbox{}\verb@if (is.character(perm)) @\\ +\mbox{}\verb@ perm <- match(perm, dimnames(a)[[2L]])@\\ +\mbox{}\verb@stopifnot(all(perm %in% 1:J))@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ if (is_chol) { ### a is Cholesky of covariance@\\ -\mbox{}\verb@ Sperm <- chol2cov(a)[,perm]@\\ -\mbox{}\verb@ return(chol(Sperm))@\\ -\mbox{}\verb@ }@\\ +\mbox{}\verb@args <- list(...)@\\ +\mbox{}\verb@if (length(args) > 0L)@\\ +\mbox{}\verb@ warning("Additional arguments", names(args), "ignored")@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb51a}{51a}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +and then implement the two methods + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap55}\raggedright\small +\NWtarget{nuweb51a}{} $\langle\,${\itshape aperm}\nobreak\ {\footnotesize {51a}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@aperm.chol <- function(a, perm, ...) {@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape aperm checks}\nobreak\ {\footnotesize \NWlink{nuweb50}{50}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@ return(as.chol(chol(chol2cov(a)[,perm])))@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@aperm.invchol <- function(a, perm, ...) {@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape aperm checks}\nobreak\ {\footnotesize \NWlink{nuweb50}{50}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ Sperm <- invchol2cov(a)[,perm]@\\ -\mbox{}\verb@ chol2invchol(chol(Sperm))@\\ +\mbox{}\verb@ return(chol2invchol(chol(invchol2cov(a)[,perm])))@\\ \mbox{}\verb@}@\\ \mbox{}\verb@@{\NWsep} \end{list} \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroDefBy\ \NWlink{nuweb51a}{51a}\NWlink{nuweb51b}{b}. \item \NWtxtMacroRefIn\ \NWlink{nuweb2}{2}. \item{} @@ -2959,37 +3109,69 @@ We also add an \code{aperm} method for class \code{ltMatrices} \end{minipage}\vspace{4ex} \end{flushleft} <>= -L <- lxn +L <- as.invchol(lxn) J <- dim(L)[2L] -Lp <- aperm(a = L, perm = p <- sample(1:J), is_chol = FALSE) +Lp <- aperm(a = L, perm = p <- sample(1:J)) chk(invchol2cov(L)[,p], invchol2cov(Lp)) -C <- lxn +C <- as.chol(lxn) J <- dim(C)[2L] -Cp <- aperm(a = C, perm = p <- sample(1:J), is_chol = TRUE) +Cp <- aperm(a = C, perm = p <- sample(1:J)) chk(chol2cov(C)[,p], chol2cov(Cp)) @ -\section{Marginal and Conditional Normal Distributions} +We finally add a method for class \code{ltMatrices}, for which we actually cannot +provide a reasonable result, and for symmetric matrices, where we simply +fall-back on subsetting + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap56}\raggedright\small +\NWtarget{nuweb51b}{} $\langle\,${\itshape aperm}\nobreak\ {\footnotesize {51b}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@aperm.ltMatrices <- function(a, perm, ...)@\\ +\mbox{}\verb@ stop("Cannot permute objects of class ltMatrices, @\\ +\mbox{}\verb@ consider calling as.chol() or as.invchol() first")@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@aperm.syMatrices <- function(a, perm, ...)@\\ +\mbox{}\verb@ return(a[,perm])@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroDefBy\ \NWlink{nuweb51a}{51a}\NWlink{nuweb51b}{b}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb2}{2}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +\section{Marginal and Conditional Normal Distributions} \label{sec:margcond} Marginal and conditional distributions from distributions $\rY_i \sim \ND_\J(\mathbf{0}_\J, \mC_i \mC_i^\top)$ (\code{chol} argument for $\mC_i$ for $i = 1, \dots, N$) or $\rY_i \sim \ND_\J(\mathbf{0}_\J, \mL_i^{-1} \mL_i^{-\top})$ (\code{invchol} argument for $\mL_i$ for $i = 1, \dots, N$) shall be computed. + \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap53}\raggedright\small -\NWtarget{nuweb48a}{} $\langle\,${\itshape mc input checks}\nobreak\ {\footnotesize {48a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap57}\raggedright\small +\NWtarget{nuweb52a}{} $\langle\,${\itshape mc input checks}\nobreak\ {\footnotesize {52a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@stopifnot(xor(missing(chol), missing(invchol)))@\\ \mbox{}\verb@x <- if (missing(chol)) invchol else chol@\\ \mbox{}\verb@@\\ -\mbox{}\verb@stopifnot(inherits(x, "ltMatrices"))@\\ +\mbox{}\verb@stopifnot(is.ltMatrices(x))@\\ \mbox{}\verb@@\\ \mbox{}\verb@N <- dim(x)[1L]@\\ \mbox{}\verb@J <- dim(x)[2L]@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@if (missing(which)) return(x)@\\ +\mbox{}\verb@@\\ \mbox{}\verb@if (is.character(which)) which <- match(which, dimnames(x)[[2L]])@\\ \mbox{}\verb@stopifnot(all(which %in% 1:J))@\\ \mbox{}\verb@@{\NWsep} @@ -2997,7 +3179,7 @@ computed. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb48b}{48b}\NWlink{nuweb50b}{, 50b}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb52b}{52b}\NWlink{nuweb55}{, 55}. \item{} \end{list} @@ -3010,23 +3192,26 @@ corresponding Cholesky factor (such that we can use \code{lpmvnorm} later on). \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap54}\raggedright\small -\NWtarget{nuweb48b}{} $\langle\,${\itshape marginal}\nobreak\ {\footnotesize {48b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap58}\raggedright\small +\NWtarget{nuweb52b}{} $\langle\,${\itshape marginal}\nobreak\ {\footnotesize {52b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@marg_mvnorm <- function(chol, invchol, which = 1L) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape mc input checks}\nobreak\ {\footnotesize \NWlink{nuweb48a}{48a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape mc input checks}\nobreak\ {\footnotesize \NWlink{nuweb52a}{52a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (which[1] == 1L && (length(which) == 1L || @\\ \mbox{}\verb@ all(diff(which) == 1L))) {@\\ \mbox{}\verb@ ### which is 1:j@\\ \mbox{}\verb@ tmp <- x[,which]@\\ \mbox{}\verb@ } else {@\\ -\mbox{}\verb@ if (missing(chol)) x <- solve(x)@\\ -\mbox{}\verb@ tmp <- base::chol(Tcrossprod(x)[,which])@\\ -\mbox{}\verb@ if (missing(chol)) tmp <- solve(tmp)@\\ +\mbox{}\verb@ if (missing(chol)) x <- invchol2chol(x)@\\ +\mbox{}\verb@ ### note: aperm would work but computes@\\ +\mbox{}\verb@ ### Cholesky of J^2, here only length(which)^2@\\ +\mbox{}\verb@ ### is needed@\\ +\mbox{}\verb@ tmp <- base::chol(chol2cov(x)[,which])@\\ +\mbox{}\verb@ if (missing(chol)) tmp <- chol2invchol(tmp)@\\ \mbox{}\verb@ }@\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (missing(chol))@\\ @@ -3063,8 +3248,8 @@ given) or $\tilde{\mL} = \tilde{\mC}^{-1}$ (if \code{invchol} was given). We can implement this as \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap55}\raggedright\small -\NWtarget{nuweb49}{} $\langle\,${\itshape cond general}\nobreak\ {\footnotesize {49}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap59}\raggedright\small +\NWtarget{nuweb53}{} $\langle\,${\itshape cond general}\nobreak\ {\footnotesize {53}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -3097,7 +3282,7 @@ We can implement this as \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb50b}{50b}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb55}{55}. \item{} \end{list} @@ -3125,8 +3310,8 @@ be returned. The implementation reads \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap56}\raggedright\small -\NWtarget{nuweb50a}{} $\langle\,${\itshape cond simple}\nobreak\ {\footnotesize {50a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap60}\raggedright\small +\NWtarget{nuweb54}{} $\langle\,${\itshape cond simple}\nobreak\ {\footnotesize {54}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -3135,44 +3320,82 @@ The implementation reads \mbox{}\verb@ ### which is 1:j@\\ \mbox{}\verb@ L <- if (missing(invchol)) solve(chol) else invchol@\\ \mbox{}\verb@ tmp <- matrix(0, ncol = ncol(given), nrow = J - length(which))@\\ -\mbox{}\verb@ centerm <- Mult(L, rbind(given, tmp))[-which,,drop = FALSE]@\\ +\mbox{}\verb@ centerm <- Mult(L, rbind(given, tmp)) @\\ +\mbox{}\verb@ ### if ncol(given) is not N = dim(L)[1L] > 1, then@\\ +\mbox{}\verb@ ### solve() below won't work and we loop over@\\ +\mbox{}\verb@ ### columns of centerm@\\ +\mbox{}\verb@ if (dim(L)[1L] > 1 && ncol(given) != N) {@\\ +\mbox{}\verb@ centerm <- lapply(1:ncol(centerm), function(j)@\\ +\mbox{}\verb@ matrix(centerm[,j], nrow = J, ncol = N)[-which,,drop = FALSE]@\\ +\mbox{}\verb@ )@\\ +\mbox{}\verb@ } else {@\\ +\mbox{}\verb@ centerm <- centerm[-which,,drop = FALSE]@\\ +\mbox{}\verb@ }@\\ \mbox{}\verb@ L <- L[,-which]@\\ +\mbox{}\verb@ ct <- centerm@\\ +\mbox{}\verb@ if (!is.matrix(ct)) ct <- do.call("rbind", ct)@\\ +\mbox{}\verb@ if (is.matrix(centerm)) {@\\ +\mbox{}\verb@ m <- -solve(L, centerm)@\\ +\mbox{}\verb@ } else {@\\ +\mbox{}\verb@ m <- do.call("rbind", lapply(centerm, function(cm) -solve(L, cm)))@\\ +\mbox{}\verb@ }@\\ \mbox{}\verb@ if (missing(invchol)) {@\\ \mbox{}\verb@ if (center)@\\ -\mbox{}\verb@ return(list(center = centerm, chol = solve(L)))@\\ -\mbox{}\verb@ return(list(mean = -solve(L, centerm), chol = solve(L)))@\\ +\mbox{}\verb@ return(list(center = ct, chol = solve(L)))@\\ +\mbox{}\verb@ return(list(mean = m, chol = solve(L)))@\\ \mbox{}\verb@ }@\\ \mbox{}\verb@ if (center)@\\ -\mbox{}\verb@ return(list(center = centerm, invchol = L))@\\ -\mbox{}\verb@ return(list(mean = -solve(L, centerm), invchol = L))@\\ +\mbox{}\verb@ return(list(center = ct, invchol = L))@\\ +\mbox{}\verb@ return(list(mean = m, invchol = L))@\\ \mbox{}\verb@}@\\ \mbox{}\verb@@{\NWsep} \end{list} \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb50b}{50b}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb55}{55}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} +Note that we could have avoided the general case altogether by first +computing a Cholesky decomposition of the permuted covariance matrix (such +that the conditioning variables come first). The code above only +decomposes the marginal (and thus lower-dimensional) covariance. However, we +didn't implement the \code{center = TRUE} case, so we can fall back on the +permuted version if this option is requested. Putting everything together +gives + \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap57}\raggedright\small -\NWtarget{nuweb50b}{} $\langle\,${\itshape conditional}\nobreak\ {\footnotesize {50b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap61}\raggedright\small +\NWtarget{nuweb55}{} $\langle\,${\itshape conditional}\nobreak\ {\footnotesize {55}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@cond_mvnorm <- function(chol, invchol, which_given = 1L, given, center = FALSE) {@\\ \mbox{}\verb@@\\ \mbox{}\verb@ which <- which_given@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape mc input checks}\nobreak\ {\footnotesize \NWlink{nuweb48a}{48a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape mc input checks}\nobreak\ {\footnotesize \NWlink{nuweb52a}{52a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (N == 1) N <- NCOL(given)@\\ \mbox{}\verb@ stopifnot(is.matrix(given) && nrow(given) == length(which))@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape cond simple}\nobreak\ {\footnotesize \NWlink{nuweb50a}{50a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape cond general}\nobreak\ {\footnotesize \NWlink{nuweb49}{49}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape cond simple}\nobreak\ {\footnotesize \NWlink{nuweb54}{54}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@ ### general with center = TRUE => permute first and go simple@\\ +\mbox{}\verb@ if (center) {@\\ +\mbox{}\verb@ perm <- c(which, (1:J)[!(1:J) %in% which])@\\ +\mbox{}\verb@ if (!missing(chol))@\\ +\mbox{}\verb@ return(cond_mvnorm(chol = aperm(as.chol(chol), perm = perm),@\\ +\mbox{}\verb@ which_given = 1:length(which), given = given,@\\ +\mbox{}\verb@ center = center))@\\ +\mbox{}\verb@ return(cond_mvnorm(invchol = aperm(as.invchol(invchol), perm = perm),@\\ +\mbox{}\verb@ which_given = 1:length(which), given = given,@\\ +\mbox{}\verb@ center = center))@\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape cond general}\nobreak\ {\footnotesize \NWlink{nuweb53}{53}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ chol <- base::chol(S)@\\ \mbox{}\verb@ if (missing(invchol)) @\\ @@ -3276,8 +3499,8 @@ log-likelihood contributions for observations $\yvec_1, \dots, \yvec_N$ in a function called \code{ldmvnorm} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap58}\raggedright\small -\NWtarget{nuweb52a}{} $\langle\,${\itshape ldmvnorm}\nobreak\ {\footnotesize {52a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap62}\raggedright\small +\NWtarget{nuweb57a}{} $\langle\,${\itshape ldmvnorm}\nobreak\ {\footnotesize {57a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -3288,9 +3511,9 @@ function called \code{ldmvnorm} \mbox{}\verb@ p <- ncol(obs)@\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (!missing(chol)) {@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape ldmvnorm chol}\nobreak\ {\footnotesize \NWlink{nuweb54a}{54a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape ldmvnorm chol}\nobreak\ {\footnotesize \NWlink{nuweb59a}{59a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@ } else {@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape ldmvnorm invchol}\nobreak\ {\footnotesize \NWlink{nuweb54b}{54b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape ldmvnorm invchol}\nobreak\ {\footnotesize \NWlink{nuweb59b}{59b}}$\,\rangle$}\verb@@\\ \mbox{}\verb@ }@\\ \mbox{}\verb@@\\ \mbox{}\verb@ names(logretval) <- colnames(obs)@\\ @@ -3302,7 +3525,7 @@ function called \code{ldmvnorm} \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb2}{2}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb64}{64}. \item{} \end{list} @@ -3313,8 +3536,8 @@ $\J \times N$ matrix \code{obs} with corresponding means $\muvec_1, \dots, \muvec_N$ in \code{means}. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap59}\raggedright\small -\NWtarget{nuweb52b}{} $\langle\,${\itshape check obs}\nobreak\ {\footnotesize {52b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap63}\raggedright\small +\NWtarget{nuweb57b}{} $\langle\,${\itshape check obs}\nobreak\ {\footnotesize {57b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -3366,8 +3589,8 @@ turns out to be time-consuming and memory intensive, so we provide a small internal helper function focusing on the necessary computations. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap60}\raggedright\small -\NWtarget{nuweb53a}{} $\langle\,${\itshape colSumsdnorm}\nobreak\ {\footnotesize {53a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap64}\raggedright\small +\NWtarget{nuweb58a}{} $\langle\,${\itshape colSumsdnorm}\nobreak\ {\footnotesize {58a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -3379,7 +3602,7 @@ internal helper function focusing on the necessary computations. \mbox{}\verb@ SEXP ans;@\\ \mbox{}\verb@ double *dans, Jl2pi, *dz;@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ Jl2pi = iJ * log(2 * PI);@\\ +\mbox{}\verb@ Jl2pi = iJ * log(2 * M_PI);@\\ \mbox{}\verb@ PROTECT(ans = allocVector(REALSXP, iN));@\\ \mbox{}\verb@ dans = REAL(ans);@\\ \mbox{}\verb@ dz = REAL(z);@\\ @@ -3407,8 +3630,8 @@ internal helper function focusing on the necessary computations. \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap61}\raggedright\small -\NWtarget{nuweb53b}{} $\langle\,${\itshape colSumsdnorm ltMatrices}\nobreak\ {\footnotesize {53b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap65}\raggedright\small +\NWtarget{nuweb58b}{} $\langle\,${\itshape colSumsdnorm ltMatrices}\nobreak\ {\footnotesize {58b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -3434,15 +3657,15 @@ internal helper function focusing on the necessary computations. The main part is now \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap62}\raggedright\small -\NWtarget{nuweb54a}{} $\langle\,${\itshape ldmvnorm chol}\nobreak\ {\footnotesize {54a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap66}\raggedright\small +\NWtarget{nuweb59a}{} $\langle\,${\itshape ldmvnorm chol}\nobreak\ {\footnotesize {59a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@if (missing(chol))@\\ \mbox{}\verb@ stop("either chol or invchol must be given")@\\ \mbox{}\verb@## chol is given@\\ -\mbox{}\verb@if (!inherits(chol, "ltMatrices"))@\\ +\mbox{}\verb@if (!is.ltMatrices(chol)) ### NOTE: replace with is.chol@\\ \mbox{}\verb@ stop("chol is not an object of class ltMatrices")@\\ \mbox{}\verb@N <- dim(chol)[1L]@\\ \mbox{}\verb@N <- ifelse(N == 1, p, N)@\\ @@ -3457,7 +3680,7 @@ The main part is now \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb52a}{52a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb57a}{57a}. \item{} \end{list} @@ -3473,13 +3696,13 @@ If $\mL_i = \mC_i^{-1}$ is given, we obtain \end{eqnarray*} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap63}\raggedright\small -\NWtarget{nuweb54b}{} $\langle\,${\itshape ldmvnorm invchol}\nobreak\ {\footnotesize {54b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap67}\raggedright\small +\NWtarget{nuweb59b}{} $\langle\,${\itshape ldmvnorm invchol}\nobreak\ {\footnotesize {59b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@## invchol is given@\\ -\mbox{}\verb@if (!inherits(invchol, "ltMatrices"))@\\ +\mbox{}\verb@if (!is.ltMatrices(invchol)) ### NOTE: replace with is.invchol@\\ \mbox{}\verb@ stop("invchol is not an object of class ltMatrices")@\\ \mbox{}\verb@N <- dim(invchol)[1L]@\\ \mbox{}\verb@N <- ifelse(N == 1, p, N)@\\ @@ -3498,7 +3721,7 @@ If $\mL_i = \mC_i^{-1}$ is given, we obtain \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb52a}{52a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb57a}{57a}. \item{} \end{list} @@ -3533,8 +3756,8 @@ In \code{sldmvnorm}, we compute the score with respect to $\mL_i$ and use the above relationship to compute the score with respect to $\mC_i$. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap64}\raggedright\small -\NWtarget{nuweb56}{} $\langle\,${\itshape sldmvnorm}\nobreak\ {\footnotesize {56}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap68}\raggedright\small +\NWtarget{nuweb61}{} $\langle\,${\itshape sldmvnorm}\nobreak\ {\footnotesize {61}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -3557,10 +3780,14 @@ the above relationship to compute the score with respect to $\mC_i$. \mbox{}\verb@ ret <- - matrix(Mix[, rep(1:N, each = J)] * Y, ncol = N)@\\ \mbox{}\verb@@\\ \mbox{}\verb@ M <- matrix(1:(J^2), nrow = J, byrow = FALSE)@\\ -\mbox{}\verb@ ret <- ltMatrices(ret[M[lower.tri(M, diag = attr(invchol, "diag"))],,drop = FALSE], @\\ -\mbox{}\verb@ diag = attr(invchol, "diag"), byrow = FALSE)@\\ -\mbox{}\verb@ ret <- ltMatrices(ret, @\\ -\mbox{}\verb@ diag = attr(invchol, "diag"), byrow = attr(invchol, "byrow"))@\\ +\mbox{}\verb@ ret <- ret[M[lower.tri(M, diag = attr(invchol, "diag"))],,drop = FALSE]@\\ +\mbox{}\verb@ if (!is.null(dimnames(invchol)[[1L]]))@\\ +\mbox{}\verb@ colnames(ret) <- dimnames(invchol)[[1]]@\\ +\mbox{}\verb@ ret <- ltMatrices(ret,@\\ +\mbox{}\verb@ diag = attr(invchol, "diag"), byrow = FALSE,@\\ +\mbox{}\verb@ names = dimnames(invchol)[[2L]])@\\ +\mbox{}\verb@ ret <- ltMatrices(ret, diag = attr(invchol, "diag"), @\\ +\mbox{}\verb@ byrow = attr(invchol, "byrow"))@\\ \mbox{}\verb@ if (attr(invchol, "diag")) {@\\ \mbox{}\verb@ ### recycle properly@\\ \mbox{}\verb@ diagonals(ret) <- diagonals(ret) + c(1 / diagonals(invchol))@\\ @@ -3569,14 +3796,15 @@ the above relationship to compute the score with respect to $\mC_i$. \mbox{}\verb@ }@\\ \mbox{}\verb@ ret <- list(obs = sobs, invchol = ret)@\\ \mbox{}\verb@ if (logLik) @\\ -\mbox{}\verb@ ret$logLik <- ldmvnorm(obs = obs, mean = mean, invchol = invchol, logLik = FALSE)@\\ +\mbox{}\verb@ ret$logLik <- ldmvnorm(obs = obs, mean = mean, @\\ +\mbox{}\verb@ invchol = invchol, logLik = FALSE)@\\ \mbox{}\verb@ return(ret)@\\ \mbox{}\verb@ }@\\ \mbox{}\verb@@\\ \mbox{}\verb@ invchol <- solve(chol)@\\ \mbox{}\verb@ ret <- sldmvnorm(obs = obs, mean = mean, invchol = invchol)@\\ \mbox{}\verb@ ### this means: ret$chol <- - vectrick(invchol, ret$invchol, invchol)@\\ -\mbox{}\verb@ ret$chol <- - vectrick(invchol, ret$invchol)@\\ +\mbox{}\verb@ ret$chol <- as.chol(- vectrick(invchol, ret$invchol))@\\ \mbox{}\verb@ ret$invchol <- NULL@\\ \mbox{}\verb@ return(ret)@\\ \mbox{}\verb@}@\\ @@ -3585,7 +3813,7 @@ the above relationship to compute the score with respect to $\mC_i$. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb2}{2}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb64}{64}. \item{} \end{list} @@ -3595,7 +3823,7 @@ the above relationship to compute the score with respect to $\mC_i$. Let's say we have $\rY_i \sim \ND_\J(\mathbf{0}_J, \mC_i \mC_i^{\top})$ for $i = 1, \dots, N$ and we know the Cholesky factors $\mL_i = \mC_i^{-1}$ of the $N$ -precision matrices $\Sigma^{-1} = \mL_i \mL_i^{\top}$. We generate $\rY_i = \mL_i^{-1} +precision matrices $\Sigma^{-1}_i = \mL_i \mL_i^{\top}$. We generate $\rY_i = \mL_i^{-1} \rZ_i$ from $\rZ_i \sim \ND_\J(\mathbf{0}_\J, \mI_\J)$. Evaluating the corresponding log-likelihood is now straightforward and fast, compared to repeated calls to \code{dmvnorm} @@ -3610,7 +3838,8 @@ Y <- solve(lt, Z) ll1 <- sum(dnorm(Mult(lt, Y), log = TRUE)) + sum(log(diagonals(lt))) S <- as.array(Tcrossprod(solve(lt))) -ll2 <- sum(sapply(1:N, function(i) dmvnorm(x = Y[,i], sigma = S[,,i], log = TRUE))) +ll2 <- sum(sapply(1:N, function(i) + dmvnorm(x = Y[,i], sigma = S[,,i], log = TRUE))) chk(ll1, ll2) @ @@ -3661,14 +3890,14 @@ This is relatively simple to achieve using the existing \code{pmvnorm} function, so a prototype might look like \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap65}\raggedright\small -\NWtarget{nuweb58}{} $\langle\,${\itshape lpmvnormR}\nobreak\ {\footnotesize {58}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap69}\raggedright\small +\NWtarget{nuweb63}{} $\langle\,${\itshape lpmvnormR}\nobreak\ {\footnotesize {63}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@lpmvnormR <- function(lower, upper, mean = 0, center = NULL, chol, logLik = TRUE, ...) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape input checks}\nobreak\ {\footnotesize \NWlink{nuweb60a}{60a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape input checks}\nobreak\ {\footnotesize \NWlink{nuweb66}{66}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ sigma <- Tcrossprod(chol)@\\ \mbox{}\verb@ S <- as.array(sigma)@\\ @@ -3708,7 +3937,7 @@ lpmvnormR <- function(lower, upper, mean = 0, center = NULL, chol, logLik = TRUE if (!is.matrix(upper)) upper <- matrix(upper, ncol = 1) stopifnot(isTRUE(all.equal(dim(lower), dim(upper)))) - stopifnot(inherits(chol, "ltMatrices")) + stopifnot(is.ltMatrices(chol)) ### NOTE: replace with is.chol byrow_orig <- attr(chol, "byrow") chol <- ltMatrices(chol, byrow = TRUE) d <- dim(chol) @@ -3718,8 +3947,11 @@ lpmvnormR <- function(lower, upper, mean = 0, center = NULL, chol, logLik = TRUE stopifnot(nrow(lower) == J && ncol(lower) == N) stopifnot(nrow(upper) == J && ncol(upper) == N) - if (is.matrix(mean)) + if (is.matrix(mean)) { + if (ncol(mean) == 1L) + mean <- mean[,rep(1, N),drop = FALSE] stopifnot(nrow(mean) == J && ncol(mean) == N) + } lower <- lower - mean upper <- upper - mean @@ -3784,14 +4016,21 @@ functions for all arguments $\avec_i$, $\bvec_i$, and $\mC_i$. \section{Algorithm} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap66}\raggedright\small -\NWtarget{nuweb59a}{} \verb@"lpmvnorm.R"@\nobreak\ {\footnotesize {59a}}$\equiv$ +\begin{minipage}{\linewidth}\label{scrap70}\raggedright\small +\NWtarget{nuweb64}{} \verb@"lpmvnorm.R"@\nobreak\ {\footnotesize {64}}$\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape R Header}\nobreak\ {\footnotesize \NWlink{nuweb104}{104}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape lpmvnorm}\nobreak\ {\footnotesize \NWlink{nuweb69}{69}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape slpmvnorm}\nobreak\ {\footnotesize \NWlink{nuweb82}{82}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape R Header}\nobreak\ {\footnotesize \NWlink{nuweb131}{131}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape lpmvnorm}\nobreak\ {\footnotesize \NWlink{nuweb75}{75}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape slpmvnorm}\nobreak\ {\footnotesize \NWlink{nuweb87}{87}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape ldmvnorm}\nobreak\ {\footnotesize \NWlink{nuweb57a}{57a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape sldmvnorm}\nobreak\ {\footnotesize \NWlink{nuweb61}{61}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape ldpmvnorm}\nobreak\ {\footnotesize \NWlink{nuweb100}{100}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape sldpmvnorm}\nobreak\ {\footnotesize \NWlink{nuweb102}{102}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape deperma}\nobreak\ {\footnotesize \NWlink{nuweb107}{107}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape standardize}\nobreak\ {\footnotesize \NWlink{nuweb109}{109}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape destandardize}\nobreak\ {\footnotesize \NWlink{nuweb111}{111}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@{\NWsep} \end{list} \vspace{-1.5ex} @@ -3803,12 +4042,12 @@ functions for all arguments $\avec_i$, $\bvec_i$, and $\mC_i$. \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap67}\raggedright\small -\NWtarget{nuweb59b}{} \verb@"lpmvnorm.c"@\nobreak\ {\footnotesize {59b}}$\equiv$ +\begin{minipage}{\linewidth}\label{scrap71}\raggedright\small +\NWtarget{nuweb65}{} \verb@"lpmvnorm.c"@\nobreak\ {\footnotesize {65}}$\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape C Header}\nobreak\ {\footnotesize \NWlink{nuweb105}{105}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape C Header}\nobreak\ {\footnotesize \NWlink{nuweb132}{132}}$\,\rangle$}\verb@@\\ \mbox{}\verb@#ifndef USE_FC_LEN_T@\\ \mbox{}\verb@# define USE_FC_LEN_T@\\ \mbox{}\verb@#endif@\\ @@ -3821,10 +4060,10 @@ functions for all arguments $\avec_i$, $\bvec_i$, and $\mC_i$. \mbox{}\verb@#include @\\ \mbox{}\verb@#include @\\ \mbox{}\verb@#include @\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape pnorm fast}\nobreak\ {\footnotesize \NWlink{nuweb64a}{64a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape pnorm slow}\nobreak\ {\footnotesize \NWlink{nuweb64b}{64b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape R lpmvnorm}\nobreak\ {\footnotesize \NWlink{nuweb67}{67}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape R slpmvnorm}\nobreak\ {\footnotesize \NWlink{nuweb79}{79}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape pnorm fast}\nobreak\ {\footnotesize \NWlink{nuweb70b}{70b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape pnorm slow}\nobreak\ {\footnotesize \NWlink{nuweb70c}{70c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape R lpmvnorm}\nobreak\ {\footnotesize \NWlink{nuweb73}{73}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape R slpmvnorm}\nobreak\ {\footnotesize \NWlink{nuweb84}{84}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@{\NWsep} \end{list} \vspace{-1.5ex} @@ -3846,8 +4085,8 @@ For each $i = 1, \dots, N$, do (\code{upper}), and control parameters $\alpha$, $\epsilon$, and $M_\text{max}$ (\code{M}). \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap68}\raggedright\small -\NWtarget{nuweb60a}{} $\langle\,${\itshape input checks}\nobreak\ {\footnotesize {60a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap72}\raggedright\small +\NWtarget{nuweb66}{} $\langle\,${\itshape input checks}\nobreak\ {\footnotesize {66}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -3855,7 +4094,7 @@ For each $i = 1, \dots, N$, do \mbox{}\verb@if (!is.matrix(upper)) upper <- matrix(upper, ncol = 1)@\\ \mbox{}\verb@stopifnot(isTRUE(all.equal(dim(lower), dim(upper))))@\\ \mbox{}\verb@@\\ -\mbox{}\verb@stopifnot(inherits(chol, "ltMatrices"))@\\ +\mbox{}\verb@stopifnot(is.ltMatrices(chol)) ### NOTE: replace with is.chol@\\ \mbox{}\verb@byrow_orig <- attr(chol, "byrow")@\\ \mbox{}\verb@chol <- ltMatrices(chol, byrow = TRUE)@\\ \mbox{}\verb@d <- dim(chol)@\\ @@ -3865,8 +4104,11 @@ For each $i = 1, \dots, N$, do \mbox{}\verb@@\\ \mbox{}\verb@stopifnot(nrow(lower) == J && ncol(lower) == N)@\\ \mbox{}\verb@stopifnot(nrow(upper) == J && ncol(upper) == N)@\\ -\mbox{}\verb@if (is.matrix(mean))@\\ +\mbox{}\verb@if (is.matrix(mean)) {@\\ +\mbox{}\verb@ if (ncol(mean) == 1L) @\\ +\mbox{}\verb@ mean <- mean[,rep(1, N),drop = FALSE]@\\ \mbox{}\verb@ stopifnot(nrow(mean) == J && ncol(mean) == N)@\\ +\mbox{}\verb@}@\\ \mbox{}\verb@@\\ \mbox{}\verb@lower <- lower - mean@\\ \mbox{}\verb@upper <- upper - mean@\\ @@ -3880,7 +4122,7 @@ For each $i = 1, \dots, N$, do \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb58}{58}\NWlink{nuweb69}{, 69}\NWlink{nuweb82}{, 82}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb63}{63}\NWlink{nuweb75}{, 75}\NWlink{nuweb87}{, 87}. \item{} \end{list} @@ -3890,8 +4132,8 @@ For each $i = 1, \dots, N$, do \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap69}\raggedright\small -\NWtarget{nuweb60b}{} $\langle\,${\itshape standardise}\nobreak\ {\footnotesize {60b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap73}\raggedright\small +\NWtarget{nuweb67a}{} $\langle\,${\itshape standardise}\nobreak\ {\footnotesize {67a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -3919,7 +4161,7 @@ For each $i = 1, \dots, N$, do \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb69}{69}\NWlink{nuweb82}{, 82}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb75}{75}\NWlink{nuweb87}{, 87}. \item{} \end{list} @@ -3930,8 +4172,8 @@ For each $i = 1, \dots, N$, do \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap70}\raggedright\small -\NWtarget{nuweb61a}{} $\langle\,${\itshape initialisation}\nobreak\ {\footnotesize {61a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap74}\raggedright\small +\NWtarget{nuweb67b}{} $\langle\,${\itshape initialisation}\nobreak\ {\footnotesize {67b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -3948,7 +4190,7 @@ For each $i = 1, \dots, N$, do \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb67}{67}\NWlink{nuweb79}{, 79}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb73}{73}\NWlink{nuweb84}{, 84}. \item{} \end{list} @@ -3957,8 +4199,8 @@ For each $i = 1, \dots, N$, do \item Repeat \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap71}\raggedright\small -\NWtarget{nuweb61b}{} $\langle\,${\itshape init logLik loop}\nobreak\ {\footnotesize {61b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap75}\raggedright\small +\NWtarget{nuweb67c}{} $\langle\,${\itshape init logLik loop}\nobreak\ {\footnotesize {67c}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -3971,7 +4213,7 @@ For each $i = 1, \dots, N$, do \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb67}{67}\NWlink{nuweb73b}{, 73b}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb73}{73}\NWlink{nuweb79b}{, 79b}. \item{} \end{list} @@ -3990,8 +4232,8 @@ We either generate $w_{j - 1}$ on the fly or use pre-computed weights (\code{w}). \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap72}\raggedright\small -\NWtarget{nuweb61c}{} $\langle\,${\itshape compute y}\nobreak\ {\footnotesize {61c}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap76}\raggedright\small +\NWtarget{nuweb68a}{} $\langle\,${\itshape compute y}\nobreak\ {\footnotesize {68a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4010,7 +4252,7 @@ We either generate $w_{j - 1}$ on the fly or use pre-computed weights \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb62d}{62d}\NWlink{nuweb77a}{, 77a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb69b}{69b}\NWlink{nuweb83a}{, 83a}. \item{} \end{list} @@ -4021,8 +4263,8 @@ We either generate $w_{j - 1}$ on the fly or use pre-computed weights \end{eqnarray*} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap73}\raggedright\small -\NWtarget{nuweb62a}{} $\langle\,${\itshape compute x}\nobreak\ {\footnotesize {62a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap77}\raggedright\small +\NWtarget{nuweb68b}{} $\langle\,${\itshape compute x}\nobreak\ {\footnotesize {68b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4040,7 +4282,7 @@ We either generate $w_{j - 1}$ on the fly or use pre-computed weights \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb62d}{62d}\NWlink{nuweb77a}{, 77a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb69b}{69b}\NWlink{nuweb83a}{, 83a}. \item{} \end{list} @@ -4052,8 +4294,8 @@ We either generate $w_{j - 1}$ on the fly or use pre-computed weights \end{eqnarray*} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap74}\raggedright\small -\NWtarget{nuweb62b}{} $\langle\,${\itshape update d, e}\nobreak\ {\footnotesize {62b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap78}\raggedright\small +\NWtarget{nuweb68c}{} $\langle\,${\itshape update d, e}\nobreak\ {\footnotesize {68c}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4065,7 +4307,7 @@ We either generate $w_{j - 1}$ on the fly or use pre-computed weights \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb62d}{62d}\NWlink{nuweb77a}{, 77a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb69b}{69b}\NWlink{nuweb83a}{, 83a}. \item{} \end{list} @@ -4076,8 +4318,8 @@ We either generate $w_{j - 1}$ on the fly or use pre-computed weights \end{eqnarray*} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap75}\raggedright\small -\NWtarget{nuweb62c}{} $\langle\,${\itshape update f}\nobreak\ {\footnotesize {62c}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap79}\raggedright\small +\NWtarget{nuweb69a}{} $\langle\,${\itshape update f}\nobreak\ {\footnotesize {69a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4088,7 +4330,7 @@ We either generate $w_{j - 1}$ on the fly or use pre-computed weights \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb62d}{62d}\NWlink{nuweb77a}{, 77a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb69b}{69b}\NWlink{nuweb83a}{, 83a}. \item{} \end{list} @@ -4097,24 +4339,24 @@ We either generate $w_{j - 1}$ on the fly or use pre-computed weights We put everything together in a loop starting with the second dimension \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap76}\raggedright\small -\NWtarget{nuweb62d}{} $\langle\,${\itshape inner logLik loop}\nobreak\ {\footnotesize {62d}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap80}\raggedright\small +\NWtarget{nuweb69b}{} $\langle\,${\itshape inner logLik loop}\nobreak\ {\footnotesize {69b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@for (j = 1; j < iJ; j++) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape compute y}\nobreak\ {\footnotesize \NWlink{nuweb61c}{61c}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape compute x}\nobreak\ {\footnotesize \NWlink{nuweb62a}{62a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape update d, e}\nobreak\ {\footnotesize \NWlink{nuweb62b}{62b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape update f}\nobreak\ {\footnotesize \NWlink{nuweb62c}{62c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape compute y}\nobreak\ {\footnotesize \NWlink{nuweb68a}{68a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape compute x}\nobreak\ {\footnotesize \NWlink{nuweb68b}{68b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape update d, e}\nobreak\ {\footnotesize \NWlink{nuweb68c}{68c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape update f}\nobreak\ {\footnotesize \NWlink{nuweb69a}{69a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@}@\\ \mbox{}\verb@@{\NWsep} \end{list} \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb67}{67}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb73}{73}. \item{} \end{list} @@ -4124,8 +4366,8 @@ We put everything together in a loop starting with the second dimension and $\text{error} = \sqrt{(\text{varsum}/M - (\text{intsum}/M)^2) / M}$. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap77}\raggedright\small -\NWtarget{nuweb63a}{} $\langle\,${\itshape increment}\nobreak\ {\footnotesize {63a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap81}\raggedright\small +\NWtarget{nuweb69c}{} $\langle\,${\itshape increment}\nobreak\ {\footnotesize {69c}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4135,7 +4377,7 @@ We put everything together in a loop starting with the second dimension \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb67}{67}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb73}{73}. \item{} \end{list} @@ -4151,8 +4393,8 @@ We refrain from early stopping and error estimation. We return $\log{\hat{p}_i}$ for each $i$, or we immediately sum-up over $i$. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap78}\raggedright\small -\NWtarget{nuweb63b}{} $\langle\,${\itshape output}\nobreak\ {\footnotesize {63b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap82}\raggedright\small +\NWtarget{nuweb69d}{} $\langle\,${\itshape output}\nobreak\ {\footnotesize {69d}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4164,7 +4406,7 @@ We return $\log{\hat{p}_i}$ for each $i$, or we immediately sum-up over $i$. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb67}{67}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb73}{73}. \item{} \end{list} @@ -4174,8 +4416,8 @@ and move on to the next observation (note that \code{p} might be $0$ in case $\mC_i \equiv \mC$). \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap79}\raggedright\small -\NWtarget{nuweb63c}{} $\langle\,${\itshape move on}\nobreak\ {\footnotesize {63c}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap83}\raggedright\small +\NWtarget{nuweb70a}{} $\langle\,${\itshape move on}\nobreak\ {\footnotesize {70a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4188,7 +4430,7 @@ $\mC_i \equiv \mC$). \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb67}{67}\NWlink{nuweb79}{, 79}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb73}{73}\NWlink{nuweb84}{, 84}. \item{} \end{list} @@ -4197,12 +4439,13 @@ $\mC_i \equiv \mC$). \end{enumerate} It turned out that calls to \code{pnorm} are expensive, so a slightly faster -alternative \citep[suggested by][]{Matic_Radoicic_Stefanica_2018} can be used +alternative \citep[suggested by][]{Matic_Radoicic_Stefanica_2018} might +provide an alternative which can be requested from using (\code{fast = TRUE} in the calls to \code{lpmvnorm} and \code{slpmvnorm}): \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap80}\raggedright\small -\NWtarget{nuweb64a}{} $\langle\,${\itshape pnorm fast}\nobreak\ {\footnotesize {64a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap84}\raggedright\small +\NWtarget{nuweb70b}{} $\langle\,${\itshape pnorm fast}\nobreak\ {\footnotesize {70b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4239,15 +4482,15 @@ alternative \citep[suggested by][]{Matic_Radoicic_Stefanica_2018} can be used \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb59b}{59b}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb65}{65}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap81}\raggedright\small -\NWtarget{nuweb64b}{} $\langle\,${\itshape pnorm slow}\nobreak\ {\footnotesize {64b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap85}\raggedright\small +\NWtarget{nuweb70c}{} $\langle\,${\itshape pnorm slow}\nobreak\ {\footnotesize {70c}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4259,7 +4502,7 @@ alternative \citep[suggested by][]{Matic_Radoicic_Stefanica_2018} can be used \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb59b}{59b}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb65}{65}. \item{} \end{list} @@ -4269,8 +4512,8 @@ The \code{fast} argument can be used to switch on the faster but less accurate version of \code{pnorm} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap82}\raggedright\small -\NWtarget{nuweb64c}{} $\langle\,${\itshape pnorm}\nobreak\ {\footnotesize {64c}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap86}\raggedright\small +\NWtarget{nuweb71a}{} $\langle\,${\itshape pnorm}\nobreak\ {\footnotesize {71a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4283,7 +4526,7 @@ accurate version of \code{pnorm} \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb67}{67}\NWlink{nuweb79}{, 79}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb73}{73}\NWlink{nuweb84}{, 84}. \item{} \end{list} @@ -4294,8 +4537,8 @@ observations. In the former case, the number of columns is $M \times N$ and in the latter just $M$. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap83}\raggedright\small -\NWtarget{nuweb65a}{} $\langle\,${\itshape W length}\nobreak\ {\footnotesize {65a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap87}\raggedright\small +\NWtarget{nuweb71b}{} $\langle\,${\itshape W length}\nobreak\ {\footnotesize {71b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4315,15 +4558,15 @@ in the latter just $M$. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb67}{67}\NWlink{nuweb79}{, 79}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb73}{73}\NWlink{nuweb84}{, 84}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap84}\raggedright\small -\NWtarget{nuweb65b}{} $\langle\,${\itshape dimensions}\nobreak\ {\footnotesize {65b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap88}\raggedright\small +\NWtarget{nuweb71c}{} $\langle\,${\itshape dimensions}\nobreak\ {\footnotesize {71c}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4345,15 +4588,15 @@ in the latter just $M$. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb67}{67}\NWlink{nuweb79}{, 79}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb73}{73}\NWlink{nuweb84}{, 84}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap85}\raggedright\small -\NWtarget{nuweb65c}{} $\langle\,${\itshape setup return object}\nobreak\ {\footnotesize {65c}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap89}\raggedright\small +\NWtarget{nuweb72a}{} $\langle\,${\itshape setup return object}\nobreak\ {\footnotesize {72a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4367,7 +4610,7 @@ in the latter just $M$. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb67}{67}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb73}{73}. \item{} \end{list} @@ -4376,8 +4619,8 @@ in the latter just $M$. The case $\J = 1$ does not loop over $M$ \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap86}\raggedright\small -\NWtarget{nuweb66a}{} $\langle\,${\itshape univariate problem}\nobreak\ {\footnotesize {66a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap90}\raggedright\small +\NWtarget{nuweb72b}{} $\langle\,${\itshape univariate problem}\nobreak\ {\footnotesize {72b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4392,15 +4635,15 @@ The case $\J = 1$ does not loop over $M$ \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb67}{67}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb73}{73}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap87}\raggedright\small -\NWtarget{nuweb66b}{} $\langle\,${\itshape init center}\nobreak\ {\footnotesize {66b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap91}\raggedright\small +\NWtarget{nuweb72c}{} $\langle\,${\itshape init center}\nobreak\ {\footnotesize {72c}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4414,7 +4657,7 @@ The case $\J = 1$ does not loop over $M$ \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb67}{67}\NWlink{nuweb79}{, 79}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb73}{73}\NWlink{nuweb84}{, 84}. \item{} \end{list} @@ -4423,8 +4666,8 @@ The case $\J = 1$ does not loop over $M$ We put the code together in a dedicated \proglang{C} function \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap88}\raggedright\small -\NWtarget{nuweb66c}{} $\langle\,${\itshape R slpmvnorm variables}\nobreak\ {\footnotesize {66c}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap92}\raggedright\small +\NWtarget{nuweb72d}{} $\langle\,${\itshape R slpmvnorm variables}\nobreak\ {\footnotesize {72d}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4438,41 +4681,41 @@ We put the code together in a dedicated \proglang{C} function \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb67}{67}\NWlink{nuweb79}{, 79}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb73}{73}\NWlink{nuweb84}{, 84}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap89}\raggedright\small -\NWtarget{nuweb67}{} $\langle\,${\itshape R lpmvnorm}\nobreak\ {\footnotesize {67}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap93}\raggedright\small +\NWtarget{nuweb73}{} $\langle\,${\itshape R lpmvnorm}\nobreak\ {\footnotesize {73}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@SEXP R_lpmvnorm(SEXP a, SEXP b, SEXP C, SEXP center, SEXP N, SEXP J, @\\ \mbox{}\verb@ SEXP W, SEXP M, SEXP tol, SEXP logLik, SEXP fast) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape R slpmvnorm variables}\nobreak\ {\footnotesize \NWlink{nuweb66c}{66c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape R slpmvnorm variables}\nobreak\ {\footnotesize \NWlink{nuweb72d}{72d}}$\,\rangle$}\verb@@\\ \mbox{}\verb@ double l0, lM, x0, intsum;@\\ \mbox{}\verb@ int p, len;@\\ \mbox{}\verb@@\\ \mbox{}\verb@ Rboolean RlogLik = asLogical(logLik);@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape pnorm}\nobreak\ {\footnotesize \NWlink{nuweb64c}{64c}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape dimensions}\nobreak\ {\footnotesize \NWlink{nuweb65b}{65b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape W length}\nobreak\ {\footnotesize \NWlink{nuweb65a}{65a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape init center}\nobreak\ {\footnotesize \NWlink{nuweb66b}{66b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape pnorm}\nobreak\ {\footnotesize \NWlink{nuweb71a}{71a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape dimensions}\nobreak\ {\footnotesize \NWlink{nuweb71c}{71c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape W length}\nobreak\ {\footnotesize \NWlink{nuweb71b}{71b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape init center}\nobreak\ {\footnotesize \NWlink{nuweb72c}{72c}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ int start, j, k;@\\ \mbox{}\verb@ double tmp, Wtmp, e, d, f, emd, x, y[(iJ > 1 ? iJ - 1 : 1)];@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape setup return object}\nobreak\ {\footnotesize \NWlink{nuweb65c}{65c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape setup return object}\nobreak\ {\footnotesize \NWlink{nuweb72a}{72a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ q0 = qnorm(dtol, 0.0, 1.0, 1L, 0L);@\\ \mbox{}\verb@ l0 = log(dtol);@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape univariate problem}\nobreak\ {\footnotesize \NWlink{nuweb66a}{66a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape univariate problem}\nobreak\ {\footnotesize \NWlink{nuweb72b}{72b}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (W == R_NilValue)@\\ \mbox{}\verb@ GetRNGstate();@\\ @@ -4480,23 +4723,23 @@ We put the code together in a dedicated \proglang{C} function \mbox{}\verb@ for (int i = 0; i < iN; i++) {@\\ \mbox{}\verb@@\\ \mbox{}\verb@ x0 = 0;@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape initialisation}\nobreak\ {\footnotesize \NWlink{nuweb61a}{61a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape initialisation}\nobreak\ {\footnotesize \NWlink{nuweb67b}{67b}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (W != R_NilValue && pW == 0)@\\ \mbox{}\verb@ dW = REAL(W);@\\ \mbox{}\verb@@\\ \mbox{}\verb@ for (int m = 0; m < iM; m++) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape init logLik loop}\nobreak\ {\footnotesize \NWlink{nuweb61b}{61b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape inner logLik loop}\nobreak\ {\footnotesize \NWlink{nuweb62d}{62d}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape increment}\nobreak\ {\footnotesize \NWlink{nuweb63a}{63a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape init logLik loop}\nobreak\ {\footnotesize \NWlink{nuweb67c}{67c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape inner logLik loop}\nobreak\ {\footnotesize \NWlink{nuweb69b}{69b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape increment}\nobreak\ {\footnotesize \NWlink{nuweb69c}{69c}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (W != R_NilValue)@\\ \mbox{}\verb@ dW += iJ - 1;@\\ \mbox{}\verb@ }@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape output}\nobreak\ {\footnotesize \NWlink{nuweb63b}{63b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape move on}\nobreak\ {\footnotesize \NWlink{nuweb63c}{63c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape output}\nobreak\ {\footnotesize \NWlink{nuweb69d}{69d}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape move on}\nobreak\ {\footnotesize \NWlink{nuweb70a}{70a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@ }@\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (W == R_NilValue)@\\ @@ -4510,7 +4753,7 @@ We put the code together in a dedicated \proglang{C} function \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb59b}{59b}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb65}{65}. \item{} \end{list} @@ -4521,8 +4764,8 @@ The \proglang{R} user interface consists of some checks and a call to case we want a new set of weights for each observation. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap90}\raggedright\small -\NWtarget{nuweb68a}{} $\langle\,${\itshape init random seed, reset on exit}\nobreak\ {\footnotesize {68a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap94}\raggedright\small +\NWtarget{nuweb74a}{} $\langle\,${\itshape init random seed, reset on exit}\nobreak\ {\footnotesize {74a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4542,15 +4785,15 @@ case we want a new set of weights for each observation. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb69}{69}\NWlink{nuweb82}{, 82}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb75}{75}\NWlink{nuweb87}{, 87}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap91}\raggedright\small -\NWtarget{nuweb68b}{} $\langle\,${\itshape check and / or set integration weights}\nobreak\ {\footnotesize {68b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap95}\raggedright\small +\NWtarget{nuweb74b}{} $\langle\,${\itshape check and / or set integration weights}\nobreak\ {\footnotesize {74b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4573,20 +4816,20 @@ case we want a new set of weights for each observation. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb69}{69}\NWlink{nuweb82}{, 82}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb75}{75}\NWlink{nuweb87}{, 87}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} Sometimes we want to evaluate the log-likelihood based on $\mL = \mC^{-1}$, -the Cholesky factor of the precision (not the covariance) matrix. In this +the inverse Cholesky factor of the covariance matrix. In this case, we explicitly invert $\mL$ to give $\mC$ (both matrices are lower triangular, so this is fast). \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap92}\raggedright\small -\NWtarget{nuweb68c}{} $\langle\,${\itshape Cholesky of precision}\nobreak\ {\footnotesize {68c}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap96}\raggedright\small +\NWtarget{nuweb74c}{} $\langle\,${\itshape Cholesky of precision}\nobreak\ {\footnotesize {74c}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4597,15 +4840,15 @@ triangular, so this is fast). \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb69}{69}\NWlink{nuweb82}{, 82}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb75}{75}\NWlink{nuweb87}{, 87}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap93}\raggedright\small -\NWtarget{nuweb69}{} $\langle\,${\itshape lpmvnorm}\nobreak\ {\footnotesize {69}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap97}\raggedright\small +\NWtarget{nuweb75}{} $\langle\,${\itshape lpmvnorm}\nobreak\ {\footnotesize {75}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4613,11 +4856,11 @@ triangular, so this is fast). \mbox{}\verb@ logLik = TRUE, M = NULL, w = NULL, seed = NULL, @\\ \mbox{}\verb@ tol = .Machine$double.eps, fast = FALSE) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape init random seed, reset on exit}\nobreak\ {\footnotesize \NWlink{nuweb68a}{68a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape Cholesky of precision}\nobreak\ {\footnotesize \NWlink{nuweb68c}{68c}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape input checks}\nobreak\ {\footnotesize \NWlink{nuweb60a}{60a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape standardise}\nobreak\ {\footnotesize \NWlink{nuweb60b}{60b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape check and / or set integration weights}\nobreak\ {\footnotesize \NWlink{nuweb68b}{68b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape init random seed, reset on exit}\nobreak\ {\footnotesize \NWlink{nuweb74a}{74a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape Cholesky of precision}\nobreak\ {\footnotesize \NWlink{nuweb74c}{74c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape input checks}\nobreak\ {\footnotesize \NWlink{nuweb66}{66}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape standardise}\nobreak\ {\footnotesize \NWlink{nuweb67a}{67a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape check and / or set integration weights}\nobreak\ {\footnotesize \NWlink{nuweb74b}{74b}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ ret <- .Call(mvtnorm_R_lpmvnorm, ac, bc, uC, as.double(center), @\\ \mbox{}\verb@ as.integer(N), as.integer(J), w, as.integer(M), as.double(tol), @\\ @@ -4629,7 +4872,7 @@ triangular, so this is fast). \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb59a}{59a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb64}{64}. \item{} \end{list} @@ -4648,7 +4891,7 @@ using quasi-Monte-Carlo integration. The \code{pmvnorm} function uses randomised Korobov rules. The experiment here applies generalised Halton sequences. Plain Monte-Carlo (\code{w = NULL}) will also work but produces more variable results. Results -will depend a lot on appropriate choices and it is the users +will depend a lot on appropriate choices and it is the user's responsibility to make sure things work as intended. If you are unsure, you should use \code{pmvnorm} which provides a well-tested configuration. @@ -4662,7 +4905,7 @@ if (require("qrng", quietly = TRUE)) { W <- matrix(runif(M * (J - 1)), nrow = J - 1) } -### Genz & Bretz, 2001, without early stopping (really?) +### Genz & Bretz, 2002, without early stopping (really?) pGB <- lpmvnormR(a, b, chol = lx, logLik = FALSE, algorithm = GenzBretz(maxpts = M, abseps = 0, releps = 0)) ### Genz 1992 with quasi-Monte-Carlo, fast pnorm @@ -4711,8 +4954,8 @@ once, the chain rule rules, so to speak. We need the derivatives of $d$, $e$, $y$, and $f$ with respect to the $c$ parameters \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap94}\raggedright\small -\NWtarget{nuweb71a}{} $\langle\,${\itshape chol scores}\nobreak\ {\footnotesize {71a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap98}\raggedright\small +\NWtarget{nuweb77a}{} $\langle\,${\itshape chol scores}\nobreak\ {\footnotesize {77a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4722,7 +4965,7 @@ parameters \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb72a}{72a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb78a}{78a}. \item{} \end{list} @@ -4731,8 +4974,8 @@ parameters and the derivates with respect to the mean \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap95}\raggedright\small -\NWtarget{nuweb71b}{} $\langle\,${\itshape mean scores}\nobreak\ {\footnotesize {71b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap99}\raggedright\small +\NWtarget{nuweb77b}{} $\langle\,${\itshape mean scores}\nobreak\ {\footnotesize {77b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4742,7 +4985,7 @@ and the derivates with respect to the mean \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb72a}{72a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb78a}{78a}. \item{} \end{list} @@ -4751,8 +4994,8 @@ and the derivates with respect to the mean and the derivates with respect to lower (\code{a}) \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap96}\raggedright\small -\NWtarget{nuweb71c}{} $\langle\,${\itshape lower scores}\nobreak\ {\footnotesize {71c}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap100}\raggedright\small +\NWtarget{nuweb77c}{} $\langle\,${\itshape lower scores}\nobreak\ {\footnotesize {77c}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4762,7 +5005,7 @@ and the derivates with respect to lower (\code{a}) \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb72a}{72a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb78a}{78a}. \item{} \end{list} @@ -4771,8 +5014,8 @@ and the derivates with respect to lower (\code{a}) and the derivates with respect to upper (\code{b}) \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap97}\raggedright\small -\NWtarget{nuweb71d}{} $\langle\,${\itshape upper scores}\nobreak\ {\footnotesize {71d}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap101}\raggedright\small +\NWtarget{nuweb77d}{} $\langle\,${\itshape upper scores}\nobreak\ {\footnotesize {77d}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4782,7 +5025,7 @@ and the derivates with respect to upper (\code{b}) \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb72a}{72a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb78a}{78a}. \item{} \end{list} @@ -4796,16 +5039,16 @@ finally with respect to the off-diagonal elements of the Cholesky factor (last $\J (\J - 1) / 2$ rows). \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap98}\raggedright\small -\NWtarget{nuweb72a}{} $\langle\,${\itshape score output object}\nobreak\ {\footnotesize {72a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap102}\raggedright\small +\NWtarget{nuweb78a}{} $\langle\,${\itshape score output object}\nobreak\ {\footnotesize {78a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@int Jp = iJ * (iJ + 1) / 2;@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape chol scores}\nobreak\ {\footnotesize \NWlink{nuweb71a}{71a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape mean scores}\nobreak\ {\footnotesize \NWlink{nuweb71b}{71b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape lower scores}\nobreak\ {\footnotesize \NWlink{nuweb71c}{71c}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape upper scores}\nobreak\ {\footnotesize \NWlink{nuweb71d}{71d}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape chol scores}\nobreak\ {\footnotesize \NWlink{nuweb77a}{77a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape mean scores}\nobreak\ {\footnotesize \NWlink{nuweb77b}{77b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape lower scores}\nobreak\ {\footnotesize \NWlink{nuweb77c}{77c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape upper scores}\nobreak\ {\footnotesize \NWlink{nuweb77d}{77d}}$\,\rangle$}\verb@@\\ \mbox{}\verb@double dtmp, etmp, Wtmp, ytmp, xx;@\\ \mbox{}\verb@@\\ \mbox{}\verb@PROTECT(ans = allocMatrix(REALSXP, Jp + 1 + 3 * iJ, iN));@\\ @@ -4816,7 +5059,7 @@ finally with respect to the off-diagonal elements of the Cholesky factor \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb79}{79}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb84}{84}. \item{} \end{list} @@ -4840,8 +5083,8 @@ We start initialised the score wrt to $c^{(i)}_{11}$ (the parameter is non-exist here due to standardisation) \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap99}\raggedright\small -\NWtarget{nuweb72b}{} $\langle\,${\itshape score c11}\nobreak\ {\footnotesize {72b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap103}\raggedright\small +\NWtarget{nuweb78b}{} $\langle\,${\itshape score c11}\nobreak\ {\footnotesize {78b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4858,15 +5101,15 @@ here due to standardisation) \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb73b}{73b}\NWlink{nuweb79}{, 79}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb79b}{79b}\NWlink{nuweb84}{, 84}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap100}\raggedright\small -\NWtarget{nuweb73a}{} $\langle\,${\itshape score a, b}\nobreak\ {\footnotesize {73a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap104}\raggedright\small +\NWtarget{nuweb79a}{} $\langle\,${\itshape score a, b}\nobreak\ {\footnotesize {79a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4884,7 +5127,7 @@ here due to standardisation) \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb73b}{73b}\NWlink{nuweb79}{, 79}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb79b}{79b}\NWlink{nuweb84}{, 84}. \item{} \end{list} @@ -4893,20 +5136,20 @@ here due to standardisation) \item Repeat \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap101}\raggedright\small -\NWtarget{nuweb73b}{} $\langle\,${\itshape init score loop}\nobreak\ {\footnotesize {73b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap105}\raggedright\small +\NWtarget{nuweb79b}{} $\langle\,${\itshape init score loop}\nobreak\ {\footnotesize {79b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape init logLik loop}\nobreak\ {\footnotesize \NWlink{nuweb61b}{61b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape score c11}\nobreak\ {\footnotesize \NWlink{nuweb72b}{72b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape score a, b}\nobreak\ {\footnotesize \NWlink{nuweb73a}{73a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape init logLik loop}\nobreak\ {\footnotesize \NWlink{nuweb67c}{67c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape score c11}\nobreak\ {\footnotesize \NWlink{nuweb78b}{78b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape score a, b}\nobreak\ {\footnotesize \NWlink{nuweb79a}{79a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@{\NWsep} \end{list} \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb79}{79}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb84}{84}. \item{} \end{list} @@ -4926,8 +5169,8 @@ We again either generate $w_{j - 1}$ on the fly or use pre-computed weights parameters. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap102}\raggedright\small -\NWtarget{nuweb73c}{} $\langle\,${\itshape update yp for chol}\nobreak\ {\footnotesize {73c}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap106}\raggedright\small +\NWtarget{nuweb79c}{} $\langle\,${\itshape update yp for chol}\nobreak\ {\footnotesize {79c}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4944,15 +5187,15 @@ parameters. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb77a}{77a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb83a}{83a}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap103}\raggedright\small -\NWtarget{nuweb74}{} $\langle\,${\itshape update yp for means, lower and upper}\nobreak\ {\footnotesize {74}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap107}\raggedright\small +\NWtarget{nuweb80}{} $\langle\,${\itshape update yp for means, lower and upper}\nobreak\ {\footnotesize {80}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4982,7 +5225,7 @@ parameters. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb77a}{77a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb83a}{83a}. \item{} \end{list} @@ -5004,8 +5247,8 @@ parameters. The scores with respect to $c^{(i)}_{j\jmath}, \jmath = 1, \dots, j - 1$ are \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap104}\raggedright\small -\NWtarget{nuweb75a}{} $\langle\,${\itshape score wrt new chol off-diagonals}\nobreak\ {\footnotesize {75a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap108}\raggedright\small +\NWtarget{nuweb81a}{} $\langle\,${\itshape score wrt new chol off-diagonals}\nobreak\ {\footnotesize {81a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -5028,7 +5271,7 @@ The scores with respect to $c^{(i)}_{j\jmath}, \jmath = 1, \dots, j - 1$ are \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb77a}{77a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb83a}{83a}. \item{} \end{list} @@ -5037,8 +5280,8 @@ The scores with respect to $c^{(i)}_{j\jmath}, \jmath = 1, \dots, j - 1$ are and the score with respect to (the here non-existing) $c^{(i)}_{jj}$ is \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap105}\raggedright\small -\NWtarget{nuweb75b}{} $\langle\,${\itshape score wrt new chol diagonal}\nobreak\ {\footnotesize {75b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap109}\raggedright\small +\NWtarget{nuweb81b}{} $\langle\,${\itshape score wrt new chol diagonal}\nobreak\ {\footnotesize {81b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -5056,15 +5299,15 @@ and the score with respect to (the here non-existing) $c^{(i)}_{jj}$ is \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb77a}{77a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb83a}{83a}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap106}\raggedright\small -\NWtarget{nuweb75c}{} $\langle\,${\itshape new score means, lower and upper}\nobreak\ {\footnotesize {75c}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap110}\raggedright\small +\NWtarget{nuweb81c}{} $\langle\,${\itshape new score means, lower and upper}\nobreak\ {\footnotesize {81c}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -5082,7 +5325,7 @@ and the score with respect to (the here non-existing) $c^{(i)}_{jj}$ is \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb77a}{77a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb83a}{83a}. \item{} \end{list} @@ -5091,8 +5334,8 @@ and the score with respect to (the here non-existing) $c^{(i)}_{jj}$ is We next update scores for parameters introduced for smaller $j$ \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap107}\raggedright\small -\NWtarget{nuweb76a}{} $\langle\,${\itshape update score for chol}\nobreak\ {\footnotesize {76a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap111}\raggedright\small +\NWtarget{nuweb82a}{} $\langle\,${\itshape update score for chol}\nobreak\ {\footnotesize {82a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -5110,15 +5353,15 @@ We next update scores for parameters introduced for smaller $j$ \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb77a}{77a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb83a}{83a}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap108}\raggedright\small -\NWtarget{nuweb76b}{} $\langle\,${\itshape update score means, lower and upper}\nobreak\ {\footnotesize {76b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap112}\raggedright\small +\NWtarget{nuweb82b}{} $\langle\,${\itshape update score means, lower and upper}\nobreak\ {\footnotesize {82b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -5156,7 +5399,7 @@ We next update scores for parameters introduced for smaller $j$ \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb77a}{77a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb83a}{83a}. \item{} \end{list} @@ -5165,24 +5408,24 @@ We next update scores for parameters introduced for smaller $j$ We put everything together in a loop starting with the second dimension \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap109}\raggedright\small -\NWtarget{nuweb77a}{} $\langle\,${\itshape inner score loop}\nobreak\ {\footnotesize {77a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap113}\raggedright\small +\NWtarget{nuweb83a}{} $\langle\,${\itshape inner score loop}\nobreak\ {\footnotesize {83a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@for (j = 1; j < iJ; j++) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape compute y}\nobreak\ {\footnotesize \NWlink{nuweb61c}{61c}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape compute x}\nobreak\ {\footnotesize \NWlink{nuweb62a}{62a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape update d, e}\nobreak\ {\footnotesize \NWlink{nuweb62b}{62b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape update yp for chol}\nobreak\ {\footnotesize \NWlink{nuweb73c}{73c}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape update yp for means, lower and upper}\nobreak\ {\footnotesize \NWlink{nuweb74}{74}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape score wrt new chol off-diagonals}\nobreak\ {\footnotesize \NWlink{nuweb75a}{75a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape score wrt new chol diagonal}\nobreak\ {\footnotesize \NWlink{nuweb75b}{75b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape new score means, lower and upper}\nobreak\ {\footnotesize \NWlink{nuweb75c}{75c}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape update score for chol}\nobreak\ {\footnotesize \NWlink{nuweb76a}{76a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape update score means, lower and upper}\nobreak\ {\footnotesize \NWlink{nuweb76b}{76b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape update f}\nobreak\ {\footnotesize \NWlink{nuweb62c}{62c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape compute y}\nobreak\ {\footnotesize \NWlink{nuweb68a}{68a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape compute x}\nobreak\ {\footnotesize \NWlink{nuweb68b}{68b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape update d, e}\nobreak\ {\footnotesize \NWlink{nuweb68c}{68c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape update yp for chol}\nobreak\ {\footnotesize \NWlink{nuweb79c}{79c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape update yp for means, lower and upper}\nobreak\ {\footnotesize \NWlink{nuweb80}{80}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape score wrt new chol off-diagonals}\nobreak\ {\footnotesize \NWlink{nuweb81a}{81a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape score wrt new chol diagonal}\nobreak\ {\footnotesize \NWlink{nuweb81b}{81b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape new score means, lower and upper}\nobreak\ {\footnotesize \NWlink{nuweb81c}{81c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape update score for chol}\nobreak\ {\footnotesize \NWlink{nuweb82a}{82a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape update score means, lower and upper}\nobreak\ {\footnotesize \NWlink{nuweb82b}{82b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape update f}\nobreak\ {\footnotesize \NWlink{nuweb69a}{69a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@}@\\ \mbox{}\verb@@{\NWsep} @@ -5190,7 +5433,7 @@ We put everything together in a loop starting with the second dimension \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb79}{79}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb84}{84}. \item{} \end{list} @@ -5210,8 +5453,8 @@ We return $\log{\hat{p}_i}$ for each $i$, or we immediately sum-up over $i$. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap110}\raggedright\small -\NWtarget{nuweb77b}{} $\langle\,${\itshape score output}\nobreak\ {\footnotesize {77b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap114}\raggedright\small +\NWtarget{nuweb83b}{} $\langle\,${\itshape score output}\nobreak\ {\footnotesize {83b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -5229,7 +5472,7 @@ We return $\log{\hat{p}_i}$ for each $i$, or we immediately sum-up over $i$. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb79}{79}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb84}{84}. \item{} \end{list} @@ -5238,8 +5481,8 @@ We return $\log{\hat{p}_i}$ for each $i$, or we immediately sum-up over $i$. \end{enumerate} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap111}\raggedright\small -\NWtarget{nuweb77c}{} $\langle\,${\itshape init dans}\nobreak\ {\footnotesize {77c}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap115}\raggedright\small +\NWtarget{nuweb83c}{} $\langle\,${\itshape init dans}\nobreak\ {\footnotesize {83c}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -5255,7 +5498,7 @@ We return $\log{\hat{p}_i}$ for each $i$, or we immediately sum-up over $i$. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb79}{79}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb84}{84}. \item{} \end{list} @@ -5264,27 +5507,25 @@ We return $\log{\hat{p}_i}$ for each $i$, or we immediately sum-up over $i$. We put everything together in \proglang{C} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap112}\raggedright\small -\NWtarget{nuweb79}{} $\langle\,${\itshape R slpmvnorm}\nobreak\ {\footnotesize {79}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap116}\raggedright\small +\NWtarget{nuweb84}{} $\langle\,${\itshape R slpmvnorm}\nobreak\ {\footnotesize {84}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@SEXP R_slpmvnorm(SEXP a, SEXP b, SEXP C, SEXP center, SEXP N, SEXP J, SEXP W, @\\ \mbox{}\verb@ SEXP M, SEXP tol, SEXP fast) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape R slpmvnorm variables}\nobreak\ {\footnotesize \NWlink{nuweb66c}{66c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape R slpmvnorm variables}\nobreak\ {\footnotesize \NWlink{nuweb72d}{72d}}$\,\rangle$}\verb@@\\ \mbox{}\verb@ double intsum;@\\ \mbox{}\verb@ int p, idx;@\\ -\mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape dimensions}\nobreak\ {\footnotesize \NWlink{nuweb65b}{65b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape pnorm}\nobreak\ {\footnotesize \NWlink{nuweb64c}{64c}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape W length}\nobreak\ {\footnotesize \NWlink{nuweb65a}{65a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape init center}\nobreak\ {\footnotesize \NWlink{nuweb66b}{66b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape dimensions}\nobreak\ {\footnotesize \NWlink{nuweb71c}{71c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape pnorm}\nobreak\ {\footnotesize \NWlink{nuweb71a}{71a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape W length}\nobreak\ {\footnotesize \NWlink{nuweb71b}{71b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape init center}\nobreak\ {\footnotesize \NWlink{nuweb72c}{72c}}$\,\rangle$}\verb@@\\ \mbox{}\verb@ int start, j, k;@\\ \mbox{}\verb@ double tmp, e, d, f, emd, x, x0, y[(iJ > 1 ? iJ - 1 : 1)];@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape score output object}\nobreak\ {\footnotesize \NWlink{nuweb72a}{72a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape score output object}\nobreak\ {\footnotesize \NWlink{nuweb78a}{78a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ q0 = qnorm(dtol, 0.0, 1.0, 1L, 0L);@\\ \mbox{}\verb@@\\ @@ -5296,26 +5537,23 @@ We put everything together in \proglang{C} \mbox{}\verb@@\\ \mbox{}\verb@ for (int i = 0; i < iN; i++) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape initialisation}\nobreak\ {\footnotesize \NWlink{nuweb61a}{61a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape score c11}\nobreak\ {\footnotesize \NWlink{nuweb72b}{72b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape score a, b}\nobreak\ {\footnotesize \NWlink{nuweb73a}{73a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape init dans}\nobreak\ {\footnotesize \NWlink{nuweb77c}{77c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape initialisation}\nobreak\ {\footnotesize \NWlink{nuweb67b}{67b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape score c11}\nobreak\ {\footnotesize \NWlink{nuweb78b}{78b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape score a, b}\nobreak\ {\footnotesize \NWlink{nuweb79a}{79a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape init dans}\nobreak\ {\footnotesize \NWlink{nuweb83c}{83c}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (W != R_NilValue && pW == 0)@\\ \mbox{}\verb@ dW = REAL(W);@\\ \mbox{}\verb@@\\ \mbox{}\verb@ for (int m = 0; m < iM; m++) {@\\ -\mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape init score loop}\nobreak\ {\footnotesize \NWlink{nuweb73b}{73b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape inner score loop}\nobreak\ {\footnotesize \NWlink{nuweb77a}{77a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape score output}\nobreak\ {\footnotesize \NWlink{nuweb77b}{77b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape init score loop}\nobreak\ {\footnotesize \NWlink{nuweb79b}{79b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape inner score loop}\nobreak\ {\footnotesize \NWlink{nuweb83a}{83a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape score output}\nobreak\ {\footnotesize \NWlink{nuweb83b}{83b}}$\,\rangle$}\verb@@\\ \mbox{}\verb@ if (W != R_NilValue)@\\ \mbox{}\verb@ dW += iJ - 1;@\\ \mbox{}\verb@ }@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape move on}\nobreak\ {\footnotesize \NWlink{nuweb63c}{63c}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape move on}\nobreak\ {\footnotesize \NWlink{nuweb70a}{70a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@ dans += Jp + 1 + 3 * iJ;@\\ \mbox{}\verb@ }@\\ \mbox{}\verb@@\\ @@ -5330,7 +5568,7 @@ We put everything together in \proglang{C} \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb59b}{59b}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb65}{65}. \item{} \end{list} @@ -5341,8 +5579,8 @@ however, we need to undo the effect of standardisation once the scores have been computed \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap113}\raggedright\small -\NWtarget{nuweb80a}{} $\langle\,${\itshape post differentiate mean score}\nobreak\ {\footnotesize {80a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap117}\raggedright\small +\NWtarget{nuweb85a}{} $\langle\,${\itshape post differentiate mean score}\nobreak\ {\footnotesize {85a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -5355,15 +5593,15 @@ been computed \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb82}{82}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb87}{87}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap114}\raggedright\small -\NWtarget{nuweb80b}{} $\langle\,${\itshape post differentiate lower score}\nobreak\ {\footnotesize {80b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap118}\raggedright\small +\NWtarget{nuweb85b}{} $\langle\,${\itshape post differentiate lower score}\nobreak\ {\footnotesize {85b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -5375,15 +5613,15 @@ been computed \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb82}{82}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb87}{87}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap115}\raggedright\small -\NWtarget{nuweb80c}{} $\langle\,${\itshape post differentiate upper score}\nobreak\ {\footnotesize {80c}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap119}\raggedright\small +\NWtarget{nuweb85c}{} $\langle\,${\itshape post differentiate upper score}\nobreak\ {\footnotesize {85c}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -5395,15 +5633,15 @@ been computed \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb82}{82}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb87}{87}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap116}\raggedright\small -\NWtarget{nuweb80d}{} $\langle\,${\itshape post differentiate chol score}\nobreak\ {\footnotesize {80d}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap120}\raggedright\small +\NWtarget{nuweb85d}{} $\langle\,${\itshape post differentiate chol score}\nobreak\ {\footnotesize {85d}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -5421,7 +5659,7 @@ been computed \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb82}{82}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb87}{87}. \item{} \end{list} @@ -5441,13 +5679,14 @@ implemented by the ``vec trick''~(Section~\ref{sec:vectrick}) where $\svec = \text{vec}(\mS)$. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap117}\raggedright\small -\NWtarget{nuweb81a}{} $\langle\,${\itshape post differentiate invchol score}\nobreak\ {\footnotesize {81a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap121}\raggedright\small +\NWtarget{nuweb86a}{} $\langle\,${\itshape post differentiate invchol score}\nobreak\ {\footnotesize {86a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@if (!missing(invchol)) {@\\ -\mbox{}\verb@ ret <- ltMatrices(ret, diag = TRUE, byrow = TRUE)@\\ +\mbox{}\verb@ ret <- ltMatrices(ret, diag = TRUE, byrow = TRUE,@\\ +\mbox{}\verb@ names = dimnames(chol)[[2L]])@\\ \mbox{}\verb@ ### this means vectrick(chol, ret, chol)@\\ \mbox{}\verb@ ret <- - unclass(vectrick(chol, ret))@\\ \mbox{}\verb@}@\\ @@ -5456,7 +5695,7 @@ where $\svec = \text{vec}(\mS)$. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb82}{82}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb87}{87}. \item{} \end{list} @@ -5468,21 +5707,22 @@ elements (use \code{Lower\_tri(, diag = FALSE)} to extract the lower triangular elements such that the scores match the input) \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap118}\raggedright\small -\NWtarget{nuweb81b}{} $\langle\,${\itshape post process score}\nobreak\ {\footnotesize {81b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap122}\raggedright\small +\NWtarget{nuweb86b}{} $\langle\,${\itshape post process score}\nobreak\ {\footnotesize {86b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@if (!attr(chol, "diag"))@\\ \mbox{}\verb@ ### remove scores for constant diagonal elements@\\ \mbox{}\verb@ ret[idx,] <- 0@\\ -\mbox{}\verb@ret <- ltMatrices(ret, diag = TRUE, byrow = TRUE)@\\ +\mbox{}\verb@ret <- ltMatrices(ret, diag = TRUE, byrow = TRUE, @\\ +\mbox{}\verb@ names = dimnames(chol)[[2L]])@\\ \mbox{}\verb@@{\NWsep} \end{list} \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb82}{82}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb87}{87}. \item{} \end{list} @@ -5491,19 +5731,21 @@ triangular elements such that the scores match the input) We can now finally put everything together in a single score function. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap119}\raggedright\small -\NWtarget{nuweb82}{} $\langle\,${\itshape slpmvnorm}\nobreak\ {\footnotesize {82}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap123}\raggedright\small +\NWtarget{nuweb87}{} $\langle\,${\itshape slpmvnorm}\nobreak\ {\footnotesize {87}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ -\mbox{}\verb@slpmvnorm <- function(lower, upper, mean = 0, center = NULL, chol, invchol, logLik = TRUE, M = NULL, @\\ -\mbox{}\verb@ w = NULL, seed = NULL, tol = .Machine$double.eps, fast = FALSE) {@\\ +\mbox{}\verb@slpmvnorm <- function(lower, upper, mean = 0, center = NULL, @\\ +\mbox{}\verb@ chol, invchol, logLik = TRUE, M = NULL, @\\ +\mbox{}\verb@ w = NULL, seed = NULL, tol = .Machine$double.eps, @\\ +\mbox{}\verb@ fast = FALSE) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape init random seed, reset on exit}\nobreak\ {\footnotesize \NWlink{nuweb68a}{68a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape Cholesky of precision}\nobreak\ {\footnotesize \NWlink{nuweb68c}{68c}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape input checks}\nobreak\ {\footnotesize \NWlink{nuweb60a}{60a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape standardise}\nobreak\ {\footnotesize \NWlink{nuweb60b}{60b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape check and / or set integration weights}\nobreak\ {\footnotesize \NWlink{nuweb68b}{68b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape init random seed, reset on exit}\nobreak\ {\footnotesize \NWlink{nuweb74a}{74a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape Cholesky of precision}\nobreak\ {\footnotesize \NWlink{nuweb74c}{74c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape input checks}\nobreak\ {\footnotesize \NWlink{nuweb66}{66}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape standardise}\nobreak\ {\footnotesize \NWlink{nuweb67a}{67a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape check and / or set integration weights}\nobreak\ {\footnotesize \NWlink{nuweb74b}{74b}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ ret <- .Call(mvtnorm_R_slpmvnorm, ac, bc, uC, as.double(center), as.integer(N), @\\ \mbox{}\verb@ as.integer(J), w, as.integer(M), as.double(tol), as.logical(fast));@\\ @@ -5514,18 +5756,21 @@ We can now finally put everything together in a single score function. \mbox{}\verb@ ret <- ret[-1L,,drop = FALSE] / m ### NOTE: division by zero MAY happen,@\\ \mbox{}\verb@ ### catch outside@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape post differentiate mean score}\nobreak\ {\footnotesize \NWlink{nuweb80a}{80a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape post differentiate lower score}\nobreak\ {\footnotesize \NWlink{nuweb80b}{80b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape post differentiate upper score}\nobreak\ {\footnotesize \NWlink{nuweb80c}{80c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape post differentiate mean score}\nobreak\ {\footnotesize \NWlink{nuweb85a}{85a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape post differentiate lower score}\nobreak\ {\footnotesize \NWlink{nuweb85b}{85b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape post differentiate upper score}\nobreak\ {\footnotesize \NWlink{nuweb85c}{85c}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ ret <- ret[1:Jp, , drop = FALSE]@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape post differentiate chol score}\nobreak\ {\footnotesize \NWlink{nuweb80d}{80d}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape post differentiate invchol score}\nobreak\ {\footnotesize \NWlink{nuweb81a}{81a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape post process score}\nobreak\ {\footnotesize \NWlink{nuweb81b}{81b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape post differentiate chol score}\nobreak\ {\footnotesize \NWlink{nuweb85d}{85d}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape post differentiate invchol score}\nobreak\ {\footnotesize \NWlink{nuweb86a}{86a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape post process score}\nobreak\ {\footnotesize \NWlink{nuweb86b}{86b}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ ret <- ltMatrices(ret, byrow = byrow_orig)@\\ \mbox{}\verb@@\\ +\mbox{}\verb@ rownames(smean) <- rownames(slower) <- @\\ +\mbox{}\verb@ rownames(supper) <- dimnames(chol)[[2L]]@\\ +\mbox{}\verb@@\\ \mbox{}\verb@ if (logLik) {@\\ \mbox{}\verb@ ret <- list(logLik = ll, @\\ \mbox{}\verb@ mean = smean, @\\ @@ -5543,14 +5788,15 @@ We can now finally put everything together in a single score function. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb59a}{59a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb64}{64}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} Let's look at an example, where we use \code{numDeriv::grad} to check the -results +results (this functionality from package \pkg{numDeriv} was absolutely +instrumental for this project) <>= J <- 5L @@ -5582,7 +5828,8 @@ sC <- slpmvnorm(a, b, chol = mC, w = W, M = M) chk(lli, sC$logLik) if (require("numDeriv", quietly = TRUE)) - chk(grad(fC, unclass(mC)), rowSums(unclass(sC$chol)), check.attributes = FALSE) + chk(grad(fC, unclass(mC)), rowSums(unclass(sC$chol)), + check.attributes = FALSE) @ We can do the same when $\mL$ (and not $\mC$) is given @@ -5612,8 +5859,8 @@ The score function also works for univariate problems ptr <- pnorm(b[1,] / c(unclass(mC[,1]))) - pnorm(a[1,] / c(unclass(mC[,1]))) log(ptr) lpmvnorm(a[1,,drop = FALSE], b[1,,drop = FALSE], chol = mC[,1], logLik = FALSE) -lapply(slpmvnorm(a[1,,drop = FALSE], b[1,,drop = FALSE], chol = mC[,1], logLik = -TRUE), unclass) +lapply(slpmvnorm(a[1,,drop = FALSE], b[1,,drop = FALSE], chol = mC[,1], + logLik = TRUE), unclass) sd1 <- c(unclass(mC[,1])) (dnorm(b[1,] / sd1) * b[1,] - dnorm(a[1,] / sd1) * a[1,]) * (-1) / sd1^2 / ptr @ @@ -5749,7 +5996,8 @@ for (j in 1:J) { Let's do some sanity and performance checks first. For different values of $M$, we evaluate the log-likelihood using \code{pmvnorm} (called in -\code{lpmvnormR}) and the simplified implementation (fast and slow). The comparion is a bit +\code{lpmvnormR}) and the simplified implementation (fast and slow). The +comparison is a bit unfair, because we do not add the time needed to setup Halton sequences, but we would do this only once and use the stored values for repeated evaluations of a log-likelihood (because the optimiser expects a @@ -5851,8 +6099,8 @@ if (require("qrng", quietly = TRUE)) { W <- matrix(runif(M * (J - 1)), nrow = J - 1) } ll <- function(parm, J) { - m <- parm[1:J] ### mean parameters - parm <- parm[-(1:J)] ### chol parameters + m <- parm[1:J] ### mean parameters + parm <- parm[-(1:J)] ### chol parameters C <- matrix(c(parm), ncol = 1L) C <- ltMatrices(C, diag = TRUE, byrow = BYROW) -lpmvnorm(lower = lwr, upper = upr, mean = m, chol = C, @@ -5957,10 +6205,26 @@ Interval-censoring in the response could have been handled by some Tobit model, what about interval-censoring in the explanatory variables? Based on the multivariate distribution just estimated, we can obtain the regression coefficients $\beta_j$ as - <>= c(cond_mvnorm(chol = C, which = 2:J, given = diag(J - 1))$mean) @ +Alternatively, we can compute these regressions from a permuted Cholesky +factor (this goes into the ``simple'' conditional distribution in Section~\ref{sec:margcond}) +<>= +c(cond_mvnorm(chol = aperm(as.chol(C), perm = c(2:J, 1)), + which = 1:(J - 1), given = diag(J - 1))$mean) +@ +or, as a third option, from the last row of the precision matrix of the +permuted Cholesky factor +<>= +x <- as.array(chol2pre(aperm(as.chol(C), perm = c(2:J, 1))))[J,,1] +c(-x[-J] / x[J]) +@ +In higher dimensions, the first option is to be preferred, because it +only involves computing the Cholesky decomposition of a $(\J - 1) \times (\J - +1)$ matrix, whereas the latter two options are based on a decomposition of +the full $\J \times \J$ covariance matrix. + We can compare these estimated regression coefficients with those obtained from a linear model fitted to the exact observations <>= @@ -6026,8 +6290,12 @@ $\avec_i < \rX_i \le \bvec_i$ (that is, interval-censored observations for $\rX_i$). We define the log-likelihood based on the joint normal distribution $(\rY_i, \rX_i) \sim \ND_J((\muvec_i, \etavec_i)^\top, \mC_i \mC_i^\top)$ as \begin{eqnarray*} -\ell_i(\muvec_i, \etavec_i, \mC_i) = \ell_i(\muvec_i, \mC_i) + \log(\Prob(\avec_i < \rX_i \le \bvec_i \mid \mC_i, \etavec_i, \rY_i = \yvec_i)). +\ell_i(\muvec_i, \etavec_i, \mC_i) = \ell_i(\muvec_i, \mC_{\rY,i}) + + \log(\Prob(\avec_i < \rX_i \le \bvec_i \mid \mC_i, \muvec_i, \etavec_i, \rY_i = \yvec_i)). \end{eqnarray*} +where $\mC_{\rY,i}$ is the upper part of $\mC_i$ corresponding to the +marginal distribution of $\rY_i$. The conditional probability of $\rX$ given +$\rY$ depends on all parameters, as explained in Section~\ref{sec:margcond}. The trick here is to decompose the joint likelihood into a product of the marginal Lebesque density of $\rY_i$ and the conditional probability of $\rX_i$ given $\rY_i = \yvec_i$. @@ -6035,8 +6303,8 @@ $\rX_i$ given $\rY_i = \yvec_i$. We first check the data \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap120}\raggedright\small -\NWtarget{nuweb93}{} $\langle\,${\itshape dp input checks}\nobreak\ {\footnotesize {93}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap124}\raggedright\small +\NWtarget{nuweb99}{} $\langle\,${\itshape dp input checks}\nobreak\ {\footnotesize {99}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -6050,7 +6318,7 @@ We first check the data \mbox{}\verb@ cmean <- 0@\\ \mbox{}\verb@ dmean <- 0@\\ \mbox{}\verb@} else {@\\ -\mbox{}\verb@ if (!is.matrix(mean)) @\\ +\mbox{}\verb@ if (!is.matrix(mean) || NCOL(mean) == 1L) @\\ \mbox{}\verb@ mean <- matrix(mean, nrow = cJ + dJ, ncol = N)@\\ \mbox{}\verb@ stopifnot(nrow(mean) == cJ + dJ)@\\ \mbox{}\verb@ stopifnot(ncol(mean) == N)@\\ @@ -6062,7 +6330,7 @@ We first check the data \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb94}{94}\NWlink{nuweb96}{, 96}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb100}{100}\NWlink{nuweb102}{, 102}. \item{} \end{list} @@ -6073,8 +6341,8 @@ marginal and the conditional normal distributions and the joint log-likelihood is simply the sum of the two corresponding log-likelihoods. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap121}\raggedright\small -\NWtarget{nuweb94}{} $\langle\,${\itshape ldpmvnorm}\nobreak\ {\footnotesize {94}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap125}\raggedright\small +\NWtarget{nuweb100}{} $\langle\,${\itshape ldpmvnorm}\nobreak\ {\footnotesize {100}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -6088,7 +6356,7 @@ is simply the sum of the two corresponding log-likelihoods. \mbox{}\verb@ return(ldmvnorm(obs = obs, mean = mean,@\\ \mbox{}\verb@ chol = chol, invchol = invchol, logLik = logLik))@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape dp input checks}\nobreak\ {\footnotesize \NWlink{nuweb93}{93}}$\,\rangle$}\verb@ @\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape dp input checks}\nobreak\ {\footnotesize \NWlink{nuweb99}{99}}$\,\rangle$}\verb@ @\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (!missing(invchol)) {@\\ \mbox{}\verb@ J <- dim(invchol)[2L]@\\ @@ -6124,7 +6392,7 @@ is simply the sum of the two corresponding log-likelihoods. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb2}{2}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb64}{64}. \item{} \end{list} @@ -6134,8 +6402,8 @@ The score function requires a little extra work. We start with the case when \code{invchol} is given \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap122}\raggedright\small -\NWtarget{nuweb95}{} $\langle\,${\itshape sldpmvnorm invchol}\nobreak\ {\footnotesize {95}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap126}\raggedright\small +\NWtarget{nuweb101}{} $\langle\,${\itshape sldpmvnorm invchol}\nobreak\ {\footnotesize {101}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -6195,7 +6463,7 @@ The score function requires a little extra work. We start with the case when \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb96}{96}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb102}{102}. \item{} \end{list} @@ -6205,12 +6473,13 @@ For \code{chol}, we compute the above code for its inverse and post-differentiate using the vec-trick \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap123}\raggedright\small -\NWtarget{nuweb96}{} $\langle\,${\itshape sldpmvnorm}\nobreak\ {\footnotesize {96}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap127}\raggedright\small +\NWtarget{nuweb102}{} $\langle\,${\itshape sldpmvnorm}\nobreak\ {\footnotesize {102}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ -\mbox{}\verb@sldpmvnorm <- function(obs, lower, upper, mean = 0, chol, invchol, logLik = TRUE, ...) {@\\ +\mbox{}\verb@sldpmvnorm <- function(obs, lower, upper, mean = 0, chol, invchol, @\\ +\mbox{}\verb@ logLik = TRUE, ...) {@\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (missing(obs) || is.null(obs))@\\ \mbox{}\verb@ return(slpmvnorm(lower = lower, upper = upper, mean = mean,@\\ @@ -6219,17 +6488,17 @@ post-differentiate using the vec-trick \mbox{}\verb@ return(sldmvnorm(obs = obs, mean = mean,@\\ \mbox{}\verb@ chol = chol, invchol = invchol, logLik = logLik))@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape dp input checks}\nobreak\ {\footnotesize \NWlink{nuweb93}{93}}$\,\rangle$}\verb@ @\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape dp input checks}\nobreak\ {\footnotesize \NWlink{nuweb99}{99}}$\,\rangle$}\verb@ @\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (!missing(invchol)) {@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape sldpmvnorm invchol}\nobreak\ {\footnotesize \NWlink{nuweb95}{95}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape sldpmvnorm invchol}\nobreak\ {\footnotesize \NWlink{nuweb101}{101}}$\,\rangle$}\verb@@\\ \mbox{}\verb@ }@\\ \mbox{}\verb@@\\ \mbox{}\verb@ invchol <- solve(chol)@\\ \mbox{}\verb@ ret <- sldpmvnorm(obs = obs, lower = lower, upper = upper, @\\ \mbox{}\verb@ mean = mean, invchol = invchol, logLik = logLik, ...)@\\ \mbox{}\verb@ ### this means: ret$chol <- - vectrick(invchol, ret$invchol, invchol)@\\ -\mbox{}\verb@ ret$chol <- - vectrick(invchol, ret$invchol)@\\ +\mbox{}\verb@ ret$chol <- as.chol(- vectrick(invchol, ret$invchol))@\\ \mbox{}\verb@ ret$invchol <- NULL@\\ \mbox{}\verb@ return(ret)@\\ \mbox{}\verb@}@\\ @@ -6238,7 +6507,7 @@ post-differentiate using the vec-trick \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb2}{2}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb64}{64}. \item{} \end{list} @@ -6249,24 +6518,26 @@ example, and the remaining two dimensions are only known in intervals. The log-likelihood and score function for $\muvec$ and $\mC$ are <>= +ic <- 1:2 ### position of continuous variables ll_cd <- function(parm, J) { m <- parm[1:J] ### mean parameters parm <- parm[-(1:J)] ### chol parameters C <- matrix(c(parm), ncol = 1L) C <- ltMatrices(C, diag = TRUE, byrow = BYROW) - -ldpmvnorm(obs = Y[1:2,], lower = lwr[-(1:2),], - upper = upr[-(1:2),], mean = m, chol = C, - w = W[-(1:2),,drop = FALSE], M = M) + -ldpmvnorm(obs = Y[ic,], lower = lwr[-ic,], + upper = upr[-ic,], mean = m, chol = C, + w = W[-ic,,drop = FALSE], M = M) } sc_cd <- function(parm, J) { m <- parm[1:J] ### mean parameters parm <- parm[-(1:J)] ### chol parameters C <- matrix(c(parm), ncol = 1L) C <- ltMatrices(C, diag = TRUE, byrow = BYROW) - ret <- sldpmvnorm(obs = Y[1:2,], lower = lwr[-(1:2),], - upper = upr[-(1:2),], mean = m, chol = C, - w = W[-(1:2),,drop = FALSE], M = M) - return(-c(rowSums(ret$mean), rowSums(unclass(ret$chol)))) + ret <- sldpmvnorm(obs = Y[ic,], lower = lwr[-ic,], + upper = upr[-ic,], mean = m, chol = C, + w = W[-ic,,drop = FALSE], M = M) + return(-c(rowSums(ret$mean), + rowSums(Lower_tri(ret$chol, diag = TRUE)))) } @ and the score function seems to be correct @@ -6292,6 +6563,311 @@ op$par[1:J] mn @ +The one restriction in both \code{ldpmvnorm} and \code{sldpmvnorm} is that the +continuous variables $\rY$ are ranked before the discrete variables $\rX$ in +the observation $(\rY_i, \rX_i)$, and thus also in $(\muvec, \etavec)$ and $\mC$ +(the subscript $i$ is dropped from the parameters in the following paragraph +to keep the notational complexity in check). + +While the means can be simply permuted, this is not the case for the +Cholesky factor $\mC$ (see function \code{aperm} in +Section~\ref{sec:conv}). Of course, we can simply permute $\hat{\mC}_i$, but +we loose standard errors in this process. Alternatively, we can permute the +order of variables in $\mC$ to our liking in the log-likelihood function (while +keeping the original order of the observations and for the mean parameters) + +<>= +### discrete variables first +perm <- c((1:J)[-ic], ic) +ll_ap <- function(parm, J) { + m <- parm[1:J] ### mean parameters; NOT permuted + parm <- parm[-(1:J)] ### chol parameters + C <- matrix(c(parm), ncol = 1L) + C <- ltMatrices(C, diag = TRUE, byrow = BYROW) + Ct <- aperm(as.chol(C), perm = perm) + -ldpmvnorm(obs = Y[ic,], lower = lwr[-ic,], + upper = upr[-ic,], mean = m, chol = Ct, + w = W[-ic,,drop = FALSE], M = M) +} +@ + +Unfortunately, this distorts the score function and we need to +``de-permute'' the scores. We start with $\mSigma = \mC \mC^\top$, the +Cholesky decomposition of a quadratic positive definite $\J \times \J$ covariance +matrix. There are $\J \times (\J + 1) / 2$ parameters in the lower +triagular part (including the diagonal) of $\mC$. Changing the order of the +variables by a permutation $\pi$ with permutation matrix $\Pi$ gives a +covariance $\Pi \mC \mC^\top \Pi^\top$. This is no longer a Cholesky +decomposition, because $\Pi \mC$ is not lower triangular. The new +decomposition is +\begin{eqnarray*} +\Pi \mC \mC^\top \Pi^\top = \tilde{\mC} \tilde{\mC}^\top +\end{eqnarray*} +($\tilde{\mC}$ is what \code{aperm} computes). As $\mC$, the Cholesky factor +$\tilde{\mC}$ is lower triangular with $\J \times (\J + 1) / 2$ parameters. +We could write this operation as a function +\begin{eqnarray*} +& & f_3: \R^{\J \times (\J + 1) / 2} \rightarrow \R^{\J \times (\J + 1) / 2} \\ +& & f_3(\mC) = \tilde{\mC}, +\end{eqnarray*} +where in fact $f_3 = $\code{aperm}, and we are interested in its gradient. Deriving the gradient of a Cholesky +decomposition might seem hopeless (it certainly did, at least to me, for a +very long time), but there is a trick. Let us define two other functions: +\begin{eqnarray*} +& & f_1: \R^{\J \times (\J + 1) / 2} \rightarrow \R^{\J \times \J} \\ +& & f_1(\mC) = \Pi \mC \mC^\top \Pi^\top \\ +& & f_2: \R^{\J \times (\J + 1) / 2} \rightarrow \R^{\J \times \J} \\ +& & f_2(\tilde{\mC}) = \tilde{\mC} \tilde{\mC}^\top. +\end{eqnarray*} +Exploiting the chain rule for the composition $f_1 = f_2 \circ f_3$, +we can write the gradient of $f_1$ as the product +of the gradients of $f_2$ and $f_3$: +\begin{eqnarray} \label{fm:chain} +\frac{\partial f_1(\mC)}{\partial \mC} = +\frac{\partial f_2(\tilde{\mC})}{\partial \tilde{\mC}} \frac{\partial f_3(\mC)}{\partial \mC}. +\end{eqnarray} +The last factor is what we want to compute. It turns out that it is simpler +to compute the first two gradients first and, in a second step, to derive +the last factor. In more detail +\begin{eqnarray*} +\frac{\partial f_1(\mC)}{\partial \mC} & = & \frac{\partial \Pi \mC \mC^\top \Pi^\top}{\partial \mC} \\ +& = & \frac{\partial \Pi \mC \mC^\top \Pi^\top}{\partial \Pi \mC} \frac{\partial \Pi \mC}{\mC} \\ +& = & \left( (\Pi \mC \otimes \mI_\J) + (\mI_\J \otimes \Pi \mC) \frac{\partial \mA^\top}{\partial \mA} \right) (\mI_\J \otimes \Pi). +\end{eqnarray*} +($\mA$ is a quadratic matrix and the gradient of its transpose is a +permutation matrix). This analytic expression only contains known elements +and can be computed. The same applies to +\begin{eqnarray*} +\frac{\partial f_2(\tilde{\mC})}{\partial \tilde{\mC}} & = & \frac{\partial \tilde{\mC} \tilde{\mC}^\top \Pi}{\partial \tilde{\mC}} \\ +&= & (\tilde{\mC} \otimes \mI_\J) + (\mI_\J \otimes \tilde{\mC}) \frac{\partial \mA^\top}{\partial \mA} +\end{eqnarray*} +Both expressions treat $\mC$ or $\tilde{\mC}$ as full matrices, we are only +interested in the score contributions by the $\J \times (\J + 1) / 2$ lower +triangular elements. Using sloppy notation, we collect the relevant columns +in matrices $\mB_1 = \frac{\partial f_1(\mC)}{\partial \mC} \in \R^{\J^2 \times \J \times (\J + 1) / 2}$ +and $\mB_2 = \frac{\partial f_2(\tilde{\mC})}{\partial \tilde{\mC}} \in \R^{\J^2 \times \J \times (\J + 1) / +2}$. For the last, unknown, factor, we write $\mB_3 = \frac{\partial f_3(\tilde{\mC})}{\partial \tilde{\mC}} \in +\R^{\J \times (\J + 1) / 2 \times \J \times (\J + 1) / 2}$ and, with +formula~(\ref{fm:chain}), $\mB_1 = \mB_2 \mB_3$. We can then solve for +$\mB_3$ in the system $\mB_1^\top \mB_1 = \mB_1^\top \mB_2 \mB_3$. + +With \code{chol} $ = \mC$, \code{permuted\_chol} $ = \tilde{\mC}$, +\code{perm} $ = \pi$ and score \code{score\_schol} of the log-likelihood $\ell(\tilde{\mC})$ +with respect to the parameters in $\tilde{\mC}$, we can now implement this +de-permutation of the scores. Starting with some basic sanity checks, we +require lower triangular matrix objects as inputs, with diagonal elements, +and check if the dimensions match + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap128}\raggedright\small +\NWtarget{nuweb105a}{} $\langle\,${\itshape deperma input checks chol}\nobreak\ {\footnotesize {105a}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@stopifnot(is.ltMatrices(chol)) ### NOTE: replace with is.chol@\\ +\mbox{}\verb@byrow_orig <- attr(chol, "byrow")@\\ +\mbox{}\verb@chol <- ltMatrices(chol, byrow = FALSE)@\\ +\mbox{}\verb@stopifnot(is.ltMatrices(permuted_chol)) ### NOTE: replace with is.chol@\\ +\mbox{}\verb@permuted_chol <- ltMatrices(permuted_chol, byrow = FALSE)@\\ +\mbox{}\verb@stopifnot(max(abs(dim(chol) - dim(permuted_chol))) == 0)@\\ +\mbox{}\verb@J <- dim(chol)[2L]@\\ +\mbox{}\verb@stopifnot(attr(chol, "diag"))@\\ +\mbox{}\verb@INVCHOL <- !missing(invchol)@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb107}{107}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +Regarding \code{perm}, we check if this is an actual permutation + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap129}\raggedright\small +\NWtarget{nuweb105b}{} $\langle\,${\itshape deperma input checks perm}\nobreak\ {\footnotesize {105b}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@if (missing(perm)) return(score_schol)@\\ +\mbox{}\verb@stopifnot(isTRUE(all.equal(sort(perm), 1:J)))@\\ +\mbox{}\verb@if (max(abs(perm - 1:J)) == 0) return(score_schol)@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb107}{107}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +The scores with respect to $\tilde{\mC}$ have been computed elsewhere, we +just check the dimensions. In case we were given the scores with respect to +$\mL$, we first compute the scores with respect to $\mC$ (as we were lazy +and only derived the results for $\mC$). As in \code{standardize}, the +argument \code{score\_schol} gives the score with respect to $\mC$ and it is +the user's responsibility to provide this quantity (even when \code{invchol} +is given). + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap130}\raggedright\small +\NWtarget{nuweb106a}{} $\langle\,${\itshape deperma input checks schol}\nobreak\ {\footnotesize {106a}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@if (is.ltMatrices(score_schol)) { @\\ +\mbox{}\verb@ byrow_orig_s <- attr(score_schol, "byrow")@\\ +\mbox{}\verb@ score_schol <- ltMatrices(score_schol, byrow = FALSE)@\\ +\mbox{}\verb@ ### don't do this here!@\\ +\mbox{}\verb@ ### if (INVCHOL) score_schol <- -vectrick(permuted_invchol, score_schol)@\\ +\mbox{}\verb@ score_schol <- unclass(score_schol) ### this preserves byrow@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@stopifnot(is.matrix(score_schol))@\\ +\mbox{}\verb@N <- ncol(score_schol)@\\ +\mbox{}\verb@stopifnot(J * (J + 1) / 2 == nrow(score_schol))@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb107}{107}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +We'll have to loop over $i = 1, \dots, N$ eventually and therefore coerce +all objects to objects of class \code{array}, there is no need to worry +about row or column storage order. We set-up indices matrices and the +permutation matrix $\Pi$ + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap131}\raggedright\small +\NWtarget{nuweb106b}{} $\langle\,${\itshape deperma indices}\nobreak\ {\footnotesize {106b}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@idx <- matrix(1:J^2, nrow = J, ncol = J) ### assuming byrow = TRUE@\\ +\mbox{}\verb@tidx <- c(t(idx))@\\ +\mbox{}\verb@ltT <- idx[lower.tri(idx, diag = TRUE)]@\\ +\mbox{}\verb@P <- matrix(0, nrow = J, ncol = J)@\\ +\mbox{}\verb@P[cbind(1:J, perm)] <- 1@\\ +\mbox{}\verb@ID <- diag(J)@\\ +\mbox{}\verb@IDP <- (ID %x% P)@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb107}{107}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +and are now ready for the main course. We are gentle and also allow +\code{invchol}$ = \mL$ as input, and we clean-up by post-differentiation at +the very end in this case. + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap132}\raggedright\small +\NWtarget{nuweb107}{} $\langle\,${\itshape deperma}\nobreak\ {\footnotesize {107}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@deperma <- function(chol = solve(invchol), @\\ +\mbox{}\verb@ permuted_chol = solve(permuted_invchol), @\\ +\mbox{}\verb@ invchol, permuted_invchol, perm, score_schol) {@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape deperma input checks chol}\nobreak\ {\footnotesize \NWlink{nuweb105a}{105a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape deperma input checks perm}\nobreak\ {\footnotesize \NWlink{nuweb105b}{105b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape deperma input checks schol}\nobreak\ {\footnotesize \NWlink{nuweb106a}{106a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape deperma indices}\nobreak\ {\footnotesize \NWlink{nuweb106b}{106b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@ Nc <- dim(chol)[1L]@\\ +\mbox{}\verb@ mC <- as.array(chol)[perm,,,drop = FALSE]@\\ +\mbox{}\verb@ Ct <- as.array(permuted_chol)@\\ +\mbox{}\verb@ ret <- lapply(1:Nc, function(i) {@\\ +\mbox{}\verb@ B1 <- (mC[,,i] %x% ID) + (ID %x% mC[,,i])[,tidx]@\\ +\mbox{}\verb@ # ^^^^^^^ <- d t(A) / d A@\\ +\mbox{}\verb@ B1 <- B1 %*% IDP@\\ +\mbox{}\verb@ B1 <- B1[,ltT] ### relevant columns of B1@\\ +\mbox{}\verb@ B2 <- (Ct[,,i] %x% ID) + (ID %x% Ct[,,i])[,tidx]@\\ +\mbox{}\verb@ B2 <- B2[,ltT] ### relevant columns of B2@\\ +\mbox{}\verb@ B3 <- try(solve(crossprod(B2), crossprod(B2, B1)))@\\ +\mbox{}\verb@ if (inherits(B3, "try-error")) @\\ +\mbox{}\verb@ stop("failure computing permutation score")@\\ +\mbox{}\verb@ if (Nc == 1L)@\\ +\mbox{}\verb@ return(crossprod(score_schol, B3))@\\ +\mbox{}\verb@ return(crossprod(score_schol[,i,drop = FALSE], B3))@\\ +\mbox{}\verb@ })@\\ +\mbox{}\verb@ ret <- do.call("rbind", ret)@\\ +\mbox{}\verb@ ret <-ltMatrices(t(ret), diag = TRUE, byrow = FALSE)@\\ +\mbox{}\verb@ if (INVCHOL)@\\ +\mbox{}\verb@ ret <- -vectrick(chol, ret)@\\ +\mbox{}\verb@ ret <- ltMatrices(ret, byrow = byrow_orig_s)@\\ +\mbox{}\verb@ return(ret)@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb64}{64}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +We can now use this function to estimate the Cholesky factor for $(\rX, \rY)$ +when the data comes as $(\rY, \rX)$ (which is needed because continuous +variables come first in our implementation of log-likehood and score +function). + +<>= +sc_ap <- function(parm, J) { + m <- parm[1:J] ### mean parameters; NOT permuted + parm <- parm[-(1:J)] ### chol parameters + C <- matrix(c(parm), ncol = 1L) + C <- ltMatrices(C, diag = TRUE, byrow = BYROW) + ### permutation + Ct <- aperm(as.chol(C), perm = perm) + ret <- sldpmvnorm(obs = Y[ic,], lower = lwr[-ic,], + upper = upr[-ic,], mean = m, chol = Ct, + w = W[-ic,,drop = FALSE], M = M) + ### undo permutation for chol + retC <- deperma(chol = C, permuted_chol = Ct, + perm = perm, score_schol = ret$chol) + return(-c(rowSums(ret$mean), + rowSums(Lower_tri(retC, diag = TRUE)))) +} +@ +and the score function seems to be correct +<>= +if (require("numDeriv", quietly = TRUE)) + chk(grad(ll_ap, start, J = J), sc_ap(start, J = J), + check.attributes = FALSE, tol = 1e-6) +@ + +We can now jointly estimate all model parameters via +<>= +op <- optim(start, fn = ll_ap, gr = sc_ap, J = J, + method = "L-BFGS-B", lower = llim, + control = list(trace = TRUE)) +## estimated C for (X, Y) +ltMatrices(matrix(op$par[-(1:J)], ncol = 1), + diag = TRUE, byrow = BYROW) +## compare with true _permuted_ C for (X, Y) +aperm(as.chol(lt), perm = perm) +@ + + \chapter{Unstructured Gaussian Copula Estimation} \label{copula} With $\rZ \sim \ND_\J(0, \mI_\J)$ and $\rY = \tilde{\mC} \rZ \sim \ND_\J(0, \tilde{\mC} @@ -6306,8 +6882,8 @@ $\diag(\mC \mC^\top)^{-\nicefrac{1}{2}}$ ensures that $\diag(\mSigma) \equiv 1$, that is, unconstained optimisation can be applied. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap124}\raggedright\small -\NWtarget{nuweb98}{} $\langle\,${\itshape standardize}\nobreak\ {\footnotesize {98}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap133}\raggedright\small +\NWtarget{nuweb109}{} $\langle\,${\itshape standardize}\nobreak\ {\footnotesize {109}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -6325,7 +6901,7 @@ $\diag(\mC \mC^\top)^{-\nicefrac{1}{2}}$ ensures that $\diag(\mSigma) \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb2}{2}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb64}{64}. \item{} \end{list} @@ -6379,7 +6955,8 @@ we can write \begin{eqnarray*} \vecop(\mI_\J \mT \mC^\top)^\top (-\frac{1}{2}) \diag(\vecop(\diag(\mC \mC^\top)^{-\nicefrac{3}{2}})) & = & - -\frac{1}{2} \times \vecop(\mI_\J \mT \mC^\top)^\top \times \vecop(\diag(\mC \mC^\top)^{-\nicefrac{3}{2}})^\top =: \bvec^\top + -\frac{1}{2} \times \vecop(\mI_\J \mT \mC^\top)^\top \times \vecop(\diag(\mC \mC^\top)^{-\nicefrac{3}{2}})^\top \\ +& =: & \bvec^\top \end{eqnarray*} thus \begin{eqnarray*} @@ -6393,24 +6970,27 @@ thus when $\bvec = \vecop(\mB)$. These scores are implemented in \code{destandardize} with \code{chol} $ = \mC$ and \code{score\_schol} $= \mT$. If the model was parameterised in $\mL = \mC^{-1}$, we have \code{invchol} $ -= \mL$, however, we would still need to compute $\mT$ (the score with -respect to $\mC$). += \mL$, however, we would still need to compute $\mT$ (\code{score\_schol}, the score with +respect to $\mC$, and it is the user's responsibility to provide this +quantity). \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap125}\raggedright\small -\NWtarget{nuweb100}{} $\langle\,${\itshape destandardize}\nobreak\ {\footnotesize {100}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap134}\raggedright\small +\NWtarget{nuweb111}{} $\langle\,${\itshape destandardize}\nobreak\ {\footnotesize {111}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@destandardize <- function(chol = solve(invchol), invchol, score_schol)@\\ \mbox{}\verb@{@\\ -\mbox{}\verb@ stopifnot(inherits(chol, "ltMatrices"))@\\ +\mbox{}\verb@ stopifnot(is.ltMatrices(chol)) ### NOTE: replace with is.chol@\\ \mbox{}\verb@ J <- dim(chol)[2L]@\\ \mbox{}\verb@ stopifnot(!attr(chol, "diag"))@\\ \mbox{}\verb@ byrow_orig <- attr(chol, "byrow")@\\ \mbox{}\verb@ chol <- ltMatrices(chol, byrow = FALSE)@\\ \mbox{}\verb@ @\\ -\mbox{}\verb@ if (inherits(score_schol, "ltMatrices"))@\\ +\mbox{}\verb@ ### TODO: check byrow in score_schol?@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@ if (is.ltMatrices(score_schol))@\\ \mbox{}\verb@ score_schol <- matrix(as.array(score_schol), @\\ \mbox{}\verb@ nrow = dim(score_schol)[2L]^2)@\\ \mbox{}\verb@ stopifnot(is.matrix(score_schol))@\\ @@ -6441,8 +7021,12 @@ respect to $\mC$). \mbox{}\verb@ ### this means: ret <- - vectrick(chol, ret, chol)@\\ \mbox{}\verb@ ret <- - vectrick(chol, ret)@\\ \mbox{}\verb@ }@\\ -\mbox{}\verb@ ret <- ltMatrices(ret[M[lower.tri(M)],,drop = FALSE],@\\ -\mbox{}\verb@ diag = FALSE, byrow = FALSE)@\\ +\mbox{}\verb@ ret <- ret[M[lower.tri(M)],,drop = FALSE]@\\ +\mbox{}\verb@ if (!is.null(dimnames(chol)[[1L]]))@\\ +\mbox{}\verb@ colnames(ret) <- dimnames(chol)[[1L]]@\\ +\mbox{}\verb@ ret <- ltMatrices(ret,@\\ +\mbox{}\verb@ diag = FALSE, byrow = FALSE, @\\ +\mbox{}\verb@ names = dimnames(chol)[[2L]])@\\ \mbox{}\verb@ ret <- ltMatrices(ret, byrow = byrow_orig)@\\ \mbox{}\verb@ diagonals(ret) <- 0@\\ \mbox{}\verb@ return(ret)@\\ @@ -6452,19 +7036,21 @@ respect to $\mC$). \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb2}{2}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb64}{64}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} We can now set-up the log-likelihood and score functions for a Gaussian -copula model. We start with the classical approach of generating the +copula model. We start with the classical approach of generating the marginal observations $\rY$ from the ECDF with denominator $N + 1$ and -subsequent use of the Lebesque density as likelihood. +subsequent use of the Lebesque density as likelihood. Because no stats text +on multivariate problems is complete without a reference to Edgar Anderson's +iris data, let's set up a model for these four classical variables <>= -data("iris") +data("iris", package = "datasets") J <- 4 Z <- t(qnorm(do.call("cbind", lapply(iris[1:J], rank)) / (nrow(iris) + 1))) (CR <- cor(t(Z))) @@ -6545,19 +7131,974 @@ if (!inherits(sd_NPML, "try-error")) { } @ - -\chapter{Package Infrastructure} +\chapter{(Experimental) User Interface} \label{inter} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap126}\raggedright\small -\NWtarget{nuweb104}{} $\langle\,${\itshape R Header}\nobreak\ {\footnotesize {104}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap135}\raggedright\small +\NWtarget{nuweb115a}{} \verb@"interface.R"@\nobreak\ {\footnotesize {115a}}$\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ -\mbox{}\verb@### Copyright (C) 2022- Torsten Hothorn@\\ -\mbox{}\verb@###@\\ -\mbox{}\verb@### This file is part of the 'mvtnorm' R add-on package.@\\ -\mbox{}\verb@###@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape mvnorm}\nobreak\ {\footnotesize \NWlink{nuweb117a}{117a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape mvnorm methods}\nobreak\ {\footnotesize \NWlink{nuweb117b}{117b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape mvnorm simulate}\nobreak\ {\footnotesize \NWlink{nuweb118}{118}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape mvnorm margDist}\nobreak\ {\footnotesize \NWlink{nuweb119}{119}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape mvnorm condDist}\nobreak\ {\footnotesize \NWlink{nuweb120}{120}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape mvnorm logLik}\nobreak\ {\footnotesize \NWlink{nuweb123c}{123c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape mvnorm lLgrad}\nobreak\ {\footnotesize \NWlink{nuweb128}{128}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +The tools provided in the previous chapters are rather low-level, so we will +invest some time into setting-up a more high-level interface for +representing normal models, either as $\ND_\J(\muvec, \mC \mC^\top)$ or +$\ND_\J(\muvec, \mL^{-1} \mL^{-\top})$, for simulating from such models, and +for evaluating the log-likelihood and corresponding score functions. The +latter functionality shall also work when only incomplete (variables are +missing) or censored (observations are only known as intervals) data is +available. + +We start with the conversion of a lower triangular matrix \code{x} to an +\code{ltMatrices} object + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap136}\raggedright\small +\NWtarget{nuweb115b}{} $\langle\,${\itshape as.ltMatrices}\nobreak\ {\footnotesize {115b}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@as.ltMatrices.default <- function(x) {@\\ +\mbox{}\verb@ stopifnot(is.numeric(x))@\\ +\mbox{}\verb@ if (!is.matrix(x)) x <- matrix(x) @\\ +\mbox{}\verb@ DIAG <- max(abs(diag(x) - 1)) > .Machine$double.eps@\\ +\mbox{}\verb@ DIAG <- DIAG & (nrow(x) > 1)@\\ +\mbox{}\verb@ lt <- x[lower.tri(x, diag = DIAG)]@\\ +\mbox{}\verb@ up <- x[upper.tri(x, diag = FALSE)]@\\ +\mbox{}\verb@ stopifnot(max(abs(up)) < .Machine$double.eps)@\\ +\mbox{}\verb@ nm <- rownames(x)@\\ +\mbox{}\verb@ if (!is.null(nm))@\\ +\mbox{}\verb@ return(ltMatrices(lt, diag = DIAG, names = nm))@\\ +\mbox{}\verb@ return(ltMatrices(lt, diag = DIAG))@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb2}{2}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +and proceed defining a constructor for object respresenting, potentially +multiple, multivariate normal distributions. If the Cholesky factor $\mC$ +(or multiple Cholesky factors $\mC_1, \dots, \mC_N$) are given as +\code{chol} argument, we label them as being such objects using \code{as.chol}. If +only a matrix is given, we convert it (if possible) to a single Cholesky +factor $\mC$. The same is done when $\mL$ is given as \code{invchol} +argument. Of course, only one of these arguments must be specified. + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap137}\raggedright\small +\NWtarget{nuweb116a}{} $\langle\,${\itshape mvnorm chol invchol}\nobreak\ {\footnotesize {116a}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@if (missing(chol) && missing(invchol))@\\ +\mbox{}\verb@ chol <- as.chol(ltMatrices(1, diag = TRUE))@\\ +\mbox{}\verb@stopifnot(xor(missing(chol), missing(invchol)))@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@if (!missing(chol)) {@\\ +\mbox{}\verb@ if (!is.ltMatrices(chol))@\\ +\mbox{}\verb@ chol <- as.ltMatrices(chol)@\\ +\mbox{}\verb@ scale <- as.chol(chol)@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@if (!missing(invchol)) {@\\ +\mbox{}\verb@ if (!is.ltMatrices(invchol))@\\ +\mbox{}\verb@ invchol <- as.ltMatrices(invchol)@\\ +\mbox{}\verb@ scale <- as.invchol(invchol)@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@ret <- list(scale = scale)@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb117a}{117a}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +The mean, or multiple means, is stored as a $\J \times 1$ or $\J \times N$ +matrix, and we check if dimensions and, possibly, names are in line with +what was specified as \code{chol} or \code{invchol} + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap138}\raggedright\small +\NWtarget{nuweb116b}{} $\langle\,${\itshape mvnorm mean}\nobreak\ {\footnotesize {116b}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@if (!missing(mean)) {@\\ +\mbox{}\verb@ stopifnot(is.numeric(mean))@\\ +\mbox{}\verb@ stopifnot(NROW(mean) == dim(scale)[2L])@\\ +\mbox{}\verb@ if (!is.matrix(mean)) {@\\ +\mbox{}\verb@ mean <- matrix(mean, nrow = NROW(mean))@\\ +\mbox{}\verb@ rownames(mean) <- names(mean)@\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@ nm <- dimnames(scale)[[2L]]@\\ +\mbox{}\verb@ if (is.null(rownames(mean)))@\\ +\mbox{}\verb@ rownames(mean) <- nm@\\ +\mbox{}\verb@ if (!isTRUE(all.equal(rownames(mean), nm)))@\\ +\mbox{}\verb@ stop("rownames of mean do not match") @\\ +\mbox{}\verb@ nm <- dimnames(scale)[[1L]]@\\ +\mbox{}\verb@ if (!is.null(nm) && dim(scale)[[2L]] == ncol(mean)) {@\\ +\mbox{}\verb@ if (is.null(colnames(mean)))@\\ +\mbox{}\verb@ colnames(mean) <- nm@\\ +\mbox{}\verb@ if (!isTRUE(all.equal(colnames(mean), nm)))@\\ +\mbox{}\verb@ stop("colnames of mean do not match") @\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@ ret$mean <- mean@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb117a}{117a}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +Finally, we put everything together and return an object of class +\code{mvnorm}, featuring \code{mean} and \code{scale}. The class of the +latter slot carries the information how this object is to be interpreted (as +Cholesky factor or inverse thereof) + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap139}\raggedright\small +\NWtarget{nuweb117a}{} $\langle\,${\itshape mvnorm}\nobreak\ {\footnotesize {117a}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@### allow more than one distribution@\\ +\mbox{}\verb@mvnorm <- function(mean, chol, invchol) {@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape mvnorm chol invchol}\nobreak\ {\footnotesize \NWlink{nuweb116a}{116a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape mvnorm mean}\nobreak\ {\footnotesize \NWlink{nuweb116b}{116b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ class(ret) <- "mvnorm"@\\ +\mbox{}\verb@ return(ret)@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb115a}{115a}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +It might have been smarter to specify the scaled mean $\etavec = \mL \muvec$ +because the log-density is then jointly convex in $\etavec$ and $\mL$ and +thus a convex problem would emerge \citep{Barrathh_Boyd_2023}. + +We add a \code{names} and \code{aperm} method. The latter returns a +multivariate normal distribution with permuted order of the variables + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap140}\raggedright\small +\NWtarget{nuweb117b}{} $\langle\,${\itshape mvnorm methods}\nobreak\ {\footnotesize {117b}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@names.mvnorm <- function(x)@\\ +\mbox{}\verb@ dimnames(x$scale)[[2L]]@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@aperm.mvnorm <- function(a, perm, ...) {@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@ ret <- list(scale = aperm(a$scale, perm = perm, ...))@\\ +\mbox{}\verb@ if (!is.null(a$mean))@\\ +\mbox{}\verb@ ret$mean <- a$mean[perm,,drop = FALSE]@\\ +\mbox{}\verb@ class(ret) <- "mvnorm"@\\ +\mbox{}\verb@ ret@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb115a}{115a}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +We are now ready to draw samples from such an object. If multiple normal +distributions are contained in \code{object}, we return one sample each, +otherwise, \code{nsim} samples are returned. Because most tools in this +package expect data as $\J \times N$ matrices, we return the data in this +format. If a classical \code{data.frame} is preferred, \code{as.data.frame = +TRUE} we provide one + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap141}\raggedright\small +\NWtarget{nuweb118}{} $\langle\,${\itshape mvnorm simulate}\nobreak\ {\footnotesize {118}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@simulate.mvnorm <- function(object, nsim = dim(object$scale)[1L], seed = NULL, @\\ +\mbox{}\verb@ standardize = FALSE, as.data.frame = FALSE, ...) {@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@ J <- dim(object$scale)[2L]@\\ +\mbox{}\verb@ N <- dim(object$scale)[1L]@\\ +\mbox{}\verb@ if (N > 1)@\\ +\mbox{}\verb@ stopifnot(nsim == N)@\\ +\mbox{}\verb@ if (standardize) {@\\ +\mbox{}\verb@ if (is.chol(object$scale)) {@\\ +\mbox{}\verb@ object$scale <- standardize(chol = object$scale)@\\ +\mbox{}\verb@ } else {@\\ +\mbox{}\verb@ object$scale <- standardize(invchol = object$scale)@\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@ Z <- matrix(rnorm(nsim * J), nrow = J)@\\ +\mbox{}\verb@ if (is.chol(object$scale)) {@\\ +\mbox{}\verb@ Y <- Mult(object$scale, Z)@\\ +\mbox{}\verb@ } else {@\\ +\mbox{}\verb@ Y <- solve(object$scale, Z)@\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@ ret <- Y + c(object$mean)@\\ +\mbox{}\verb@ rownames(ret) <- dimnames(object$scale)[[2L]]@\\ +\mbox{}\verb@ if (!as.data.frame)@\\ +\mbox{}\verb@ return(ret)@\\ +\mbox{}\verb@ return(as.data.frame(t(ret)))@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb115a}{115a}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +It is maybe time for a first example, and we return to the iris dataset, +ignoring the iris' species for the time being. We set-up a model +in terms of the sample estimates +<>= +data("iris", package = "datasets") +vars <- names(iris)[-5L] +m <- colMeans(iris[,vars]) +V <- var(iris[,vars]) +iris_mvn <- mvnorm(mean = m, chol = t(chol(V))) +iris_var <- simulate(iris_mvn, nsim = nrow(iris)) +@ + +Marginal and conditional distributions might be of interest, the +\code{margDist} and \code{condDist} methods are simple wrappers to +\code{marg\_mvnorm} and \code{cond\_mvnorm} + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap142}\raggedright\small +\NWtarget{nuweb119}{} $\langle\,${\itshape mvnorm margDist}\nobreak\ {\footnotesize {119}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@margDist <- function(object, which, ...)@\\ +\mbox{}\verb@ UseMethod("margDist")@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@margDist.mvnorm <- function(object, which, ...) {@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@ if (is.chol(object$scale)) {@\\ +\mbox{}\verb@ ret <- list(scale = as.chol(marg_mvnorm(chol = object$scale, @\\ +\mbox{}\verb@ which = which)$chol))@\\ +\mbox{}\verb@ } else {@\\ +\mbox{}\verb@ ret <- list(scale = as.invchol(marg_mvnorm(invchol = object$scale, @\\ +\mbox{}\verb@ which = which)$invchol))@\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@ if (!is.null(object$mean))@\\ +\mbox{}\verb@ ret$mean <- object$mean[which,,drop = FALSE]@\\ +\mbox{}\verb@ class(ret) <- "mvnorm"@\\ +\mbox{}\verb@ return(ret)@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb115a}{115a}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap143}\raggedright\small +\NWtarget{nuweb120}{} $\langle\,${\itshape mvnorm condDist}\nobreak\ {\footnotesize {120}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@condDist <- function(object, which_given, given, ...)@\\ +\mbox{}\verb@ UseMethod("condDist")@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@condDist.mvnorm <- function(object, which_given = 1L, given, ...) {@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@ if (is.chol(object$scale)) {@\\ +\mbox{}\verb@ ret <- cond_mvnorm(chol = object$scale, which_given = which_given, @\\ +\mbox{}\verb@ given = given, ...)@\\ +\mbox{}\verb@ ret$scale <- as.chol(ret$chol)@\\ +\mbox{}\verb@ ret$chol <- NULL@\\ +\mbox{}\verb@ } else {@\\ +\mbox{}\verb@ ret <- cond_mvnorm(invchol = object$scale, which_given = which_given, @\\ +\mbox{}\verb@ given = given, ...)@\\ +\mbox{}\verb@ ret$invchol <- as.chol(ret$invchol)@\\ +\mbox{}\verb@ ret$invchol <- NULL@\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@ if (!is.null(object$mean)) {@\\ +\mbox{}\verb@ if (is.character(which_given)) @\\ +\mbox{}\verb@ which_given <- match(which_given, dimnames(object$scale)[[2L]])@\\ +\mbox{}\verb@ if (ncol(object$mean) > 1L && ncol(ret$mean) > 1)@\\ +\mbox{}\verb@ stop("dimensions do not match")@\\ +\mbox{}\verb@ if (ncol(object$mean) == 1L && ncol(ret$mean) > 1L) {@\\ +\mbox{}\verb@ ret$mean <- object$mean[-which_given,,drop = TRUE] + ret$mean@\\ +\mbox{}\verb@ } else {@\\ +\mbox{}\verb@ ret$mean <- object$mean[-which_given,,drop = FALSE] + c(ret$mean)@\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@ @\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@ class(ret) <- "mvnorm"@\\ +\mbox{}\verb@ return(ret)@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb115a}{115a}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +We could now compute the marginal distribution of two Petal variables +or the bivariate regressions of the two Petal variables given the observed +Sepal variables. Note that the last object contains $N = \Sexpr{nrow(iris)}$ +different distributions + +<>= +j <- 3:4 +margDist(iris_mvn, which = vars[j]) +gm <- t(iris[,vars[-(j)]]) +iris_cmvn <- condDist(iris_mvn, which = vars[j], given = gm) +@ + +We now work towards implementating the corresponding log-likelihood +function. This is a trivial task as long as all variables for all +observations have been observed exactly (that is, we can interpret +the data as being continuous). Here, we also want to allow imprecise, that +is, interval-censored, measurements. The one constraint in \code{ldpmvnorm} +is that the continuous variables come first, followed by the censored ones. +This of course might not be in line with the variable ordering we have in +mind for our model. Our log-likelihood function shall be able to evaluate +the log-likelihood for arbitrary permutations of the variables and, +optionally, also based on marginal distributions in case observations are +missing. + +The following \code{logLik} method for objects of class \code{mvnorm} is +essentially a wrapper for \code{ldpmvnorm}, handling permutations, +marginalisation, and standardisation. We begin with some sanity checks + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap144}\raggedright\small +\NWtarget{nuweb122}{} $\langle\,${\itshape argchecks}\nobreak\ {\footnotesize {122}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@args <- c(object, list(...))@\\ +\mbox{}\verb@nargs <- missing(obs) + missing(lower) + missing(upper)@\\ +\mbox{}\verb@stopifnot(nargs < 3L)@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@nmobs <- NULL@\\ +\mbox{}\verb@if (!missing(obs)) {@\\ +\mbox{}\verb@ if (!is.null(obs)) {@\\ +\mbox{}\verb@ stopifnot(is.matrix(obs))@\\ +\mbox{}\verb@ nmobs <- rownames(obs)@\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@nmlower <- nmupper <- nmlu <- NULL@\\ +\mbox{}\verb@if (!missing(lower)) {@\\ +\mbox{}\verb@ if (!is.null(lower)) {@\\ +\mbox{}\verb@ stopifnot(is.matrix(lower))@\\ +\mbox{}\verb@ nmlu <- nmlower <- rownames(lower)@\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@if (!missing(upper)) {@\\ +\mbox{}\verb@ if (!is.null(lower)) {@\\ +\mbox{}\verb@ stopifnot(is.matrix(upper))@\\ +\mbox{}\verb@ nmupper <- rownames(upper)@\\ +\mbox{}\verb@ if (!missing(lower)) {@\\ +\mbox{}\verb@ stopifnot(isTRUE(all.equal(nmlower, nmupper)))@\\ +\mbox{}\verb@ } else {@\\ +\mbox{}\verb@ nmlu <- nmupper@\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@nm <- c(nmobs, nmlu)@\\ +\mbox{}\verb@no <- names(object)@\\ +\mbox{}\verb@stopifnot(nm %in% no)@\\ +\mbox{}\verb@perm <- NULL@\\ +\mbox{}\verb@if (!isTRUE(all.equal(nm, no)))@\\ +\mbox{}\verb@ perm <- c(nm, no[!no %in% nm])@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@if (!missing(obs)) args$obs <- obs@\\ +\mbox{}\verb@if (!missing(lower)) args$lower <- lower@\\ +\mbox{}\verb@if (!missing(upper)) args$upper <- upper@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb123c}{123c}\NWlink{nuweb128}{, 128}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +and proceed with the workhorse when $\mC$ was given + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap145}\raggedright\small +\NWtarget{nuweb123a}{} $\langle\,${\itshape logLik chol}\nobreak\ {\footnotesize {123a}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@names(args)[names(args) == "scale"] <- "chol"@\\ +\mbox{}\verb@if (standardize)@\\ +\mbox{}\verb@ args$chol <- standardize(chol = args$chol)@\\ +\mbox{}\verb@if (!is.null(perm)) {@\\ +\mbox{}\verb@ args$chol <- aperm(as.chol(args$chol), perm = perm)@\\ +\mbox{}\verb@ if (length(nm) < length(no))@\\ +\mbox{}\verb@ args$chol <- marg_mvnorm(chol = args$chol, which = nm)$chol@\\ +\mbox{}\verb@ args$mean <- args$mean[nm,,drop = FALSE]@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@return(do.call("ldpmvnorm", args))@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb123c}{123c}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +For inverse Cholesky factors $\mL$, the code is very similar, just the argument names change + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap146}\raggedright\small +\NWtarget{nuweb123b}{} $\langle\,${\itshape logLik invchol}\nobreak\ {\footnotesize {123b}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@names(args)[names(args) == "scale"] <- "invchol"@\\ +\mbox{}\verb@if (standardize)@\\ +\mbox{}\verb@ args$invchol <- standardize(invchol = args$invchol)@\\ +\mbox{}\verb@if (!is.null(perm)) {@\\ +\mbox{}\verb@ args$invchol <- aperm(as.invchol(args$invchol), perm = perm)@\\ +\mbox{}\verb@ if (length(nm) < length(no))@\\ +\mbox{}\verb@ args$invchol <- marg_mvnorm(invchol = args$invchol, @\\ +\mbox{}\verb@ which = nm)$invchol@\\ +\mbox{}\verb@ args$mean <- args$mean[nm,,drop = FALSE]@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@return(do.call("ldpmvnorm", args))@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb123c}{123c}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +Putting everything together in a corresponding \code{logLik} method + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap147}\raggedright\small +\NWtarget{nuweb123c}{} $\langle\,${\itshape mvnorm logLik}\nobreak\ {\footnotesize {123c}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@logLik.mvnorm <- function(object, obs, lower, upper, standardize = FALSE, @\\ +\mbox{}\verb@ ...) {@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape argchecks}\nobreak\ {\footnotesize \NWlink{nuweb122}{122}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ if (is.chol(object$scale)) {@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape logLik chol}\nobreak\ {\footnotesize \NWlink{nuweb123a}{123a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape logLik invchol}\nobreak\ {\footnotesize \NWlink{nuweb123b}{123b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb115a}{115a}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +allows us to evaluate the log-likelihood of the conditional models for iris + +<>= +logLik(object = iris_cmvn, obs = t(iris[,vars[-j]])) +@ + +This implementation of the log-likelihood silently handles the case when +variables have been specified in a different order than hard-wired into the +model + +<>= +logLik(object = iris_cmvn, obs = t(iris[,rev(vars[-j])])) +@ + +The hardest task is the implementation of a score function which features +the same options as the log-likelihood function and provides the gradients +with respect not only to the parameters ($\mu$ and $\mC$ or $\mL$), but also +with respect to the data objects \code{obs}, \code{lower}, and \code{upper}. + +In essence, we have to repair the damage imposed by a series of +transformations in \code{logLik.mvnorm}, that is, by standardisation, +permutation, and marginalisation. We start with the case when $\mC$ was +given. First, we repeat all the steps performed in \code{logLik}, but call +the score function \code{sldpmvnorm} instead of the log-likelihood function +\code{ldpmvnorm} + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap148}\raggedright\small +\NWtarget{nuweb124a}{} $\langle\,${\itshape lLgrad chol}\nobreak\ {\footnotesize {124a}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@names(args)[names(args) == "scale"] <- "chol"@\\ +\mbox{}\verb@sc <- args$chol@\\ +\mbox{}\verb@if (standardize)@\\ +\mbox{}\verb@ args$chol <- sc <- standardize(chol = args$chol)@\\ +\mbox{}\verb@if (!is.null(perm)) {@\\ +\mbox{}\verb@ if (!attr(args$chol, "diag")) {@\\ +\mbox{}\verb@ diagonals(args$chol) <- 1@\\ +\mbox{}\verb@ sc <- args$chol@\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@ args$chol <- pc <- aperm(as.chol(args$chol), perm = perm)@\\ +\mbox{}\verb@ if (length(nm) < length(no))@\\ +\mbox{}\verb@ args$chol <- marg_mvnorm(chol = args$chol, which = nm)$chol@\\ +\mbox{}\verb@ args$mean <- args$mean[nm,,drop = FALSE]@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@ret <- do.call("sldpmvnorm", args)@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape lLgrad mean}\nobreak\ {\footnotesize \NWlink{nuweb124b}{124b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape lLgrad marginalisation}\nobreak\ {\footnotesize \NWlink{nuweb125a}{125a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape lLgrad deperma}\nobreak\ {\footnotesize \NWlink{nuweb125b}{125b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape lLgrad destandarized}\nobreak\ {\footnotesize \NWlink{nuweb125c}{125c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape lLgrad diagonals}\nobreak\ {\footnotesize \NWlink{nuweb126a}{126a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape lLgrad return}\nobreak\ {\footnotesize \NWlink{nuweb126b}{126b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb128}{128}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +The next task is to post-differentiate all scores such that the gradients +with respect to the original arguments of \code{logLik} are obtained. We +start with the gradient with respect to $\muvec$, in case it was not given + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap149}\raggedright\small +\NWtarget{nuweb124b}{} $\langle\,${\itshape lLgrad mean}\nobreak\ {\footnotesize {124b}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@### sldmvnorm returns mean score as -obs@\\ +\mbox{}\verb@if (is.null(ret$mean)) ret$mean <- - ret$obs@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb124a}{124a}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +In case we marginalised over some variables, we have to set the omitted +parameters to zero + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap150}\raggedright\small +\NWtarget{nuweb125a}{} $\langle\,${\itshape lLgrad marginalisation}\nobreak\ {\footnotesize {125a}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@om <- length(no) - length(nm)@\\ +\mbox{}\verb@if (om > 0) {@\\ +\mbox{}\verb@ am <- matrix(0, nrow = om, ncol = ncol(ret$mean))@\\ +\mbox{}\verb@ rownames(am) <- no[!no %in% nm]@\\ +\mbox{}\verb@ ret$mean <- rbind(ret$mean, am)@\\ +\mbox{}\verb@ Jo <- dim(object$scale)[[2L]]@\\ +\mbox{}\verb@ pJ <- dim(args$invchol)[[2L]]@\\ +\mbox{}\verb@ am <- matrix(0, nrow = Jo * (Jo + 1) / 2 - pJ * (pJ + 1) / 2, @\\ +\mbox{}\verb@ ncol = dim(ret$invchol)[1L])@\\ +\mbox{}\verb@ byrow_orig <- attr(ret$chol, "byrow")@\\ +\mbox{}\verb@ ret$chol <- ltMatrices(ret$chol, byrow = TRUE)@\\ +\mbox{}\verb@ ### rbind only works for byrow = TRUE@\\ +\mbox{}\verb@ ret$chol <- ltMatrices(rbind(unclass(ret$chol), am), @\\ +\mbox{}\verb@ byrow = TRUE, @\\ +\mbox{}\verb@ diag = TRUE,@\\ +\mbox{}\verb@ names = perm)@\\ +\mbox{}\verb@ ret$chol <- ltMatrices(ret$chol, byrow = byrow_orig)@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb124a}{124a}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +If the order of the variables was permuted, we compute the scores for the +original ordering of the variables, as explained in Chapter~\ref{cdl} + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap151}\raggedright\small +\NWtarget{nuweb125b}{} $\langle\,${\itshape lLgrad deperma}\nobreak\ {\footnotesize {125b}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@if (!is.null(perm))@\\ +\mbox{}\verb@ ret$chol <- deperma(chol = sc, permuted_chol = pc, @\\ +\mbox{}\verb@ perm = match(perm, no), @\\ +\mbox{}\verb@ score_schol = ret$chol)@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb124a}{124a}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +The effect of standardization can be removed as discussed in +Chapter~\ref{copula} + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap152}\raggedright\small +\NWtarget{nuweb125c}{} $\langle\,${\itshape lLgrad destandarized}\nobreak\ {\footnotesize {125c}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@if (standardize)@\\ +\mbox{}\verb@ ret$chol <- destandardize(chol = object$scale, @\\ +\mbox{}\verb@ score_schol = ret$chol)@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb124a}{124a}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +and it remains to remove fix diagonal elements + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap153}\raggedright\small +\NWtarget{nuweb126a}{} $\langle\,${\itshape lLgrad diagonals}\nobreak\ {\footnotesize {126a}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@if (!attr(sc, "diag"))@\\ +\mbox{}\verb@ ret$chol <- ltMatrices(Lower_tri(ret$chol, diag = FALSE),@\\ +\mbox{}\verb@ diag = FALSE, @\\ +\mbox{}\verb@ byrow = attr(ret$chol, "byrow"), @\\ +\mbox{}\verb@ names = dimnames(ret$chol)[[2L]])@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb124a}{124a}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +and to return the results, with mean scores in the correct ordering + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap154}\raggedright\small +\NWtarget{nuweb126b}{} $\langle\,${\itshape lLgrad return}\nobreak\ {\footnotesize {126b}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@ret$scale <- ret$chol@\\ +\mbox{}\verb@ret$chol <- NULL@\\ +\mbox{}\verb@ret$mean <- ret$mean[no,,drop = FALSE]@\\ +\mbox{}\verb@return(ret)@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb124a}{124a}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +The steps are essentially the same when $\mL$ was given, but we have to +post-differentiate $\mC = \mL^{-1}$ with respect to $\mL$ + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap155}\raggedright\small +\NWtarget{nuweb127}{} $\langle\,${\itshape lLgrad invchol}\nobreak\ {\footnotesize {127}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@names(args)[names(args) == "scale"] <- "invchol"@\\ +\mbox{}\verb@si <- args$invchol@\\ +\mbox{}\verb@if (standardize)@\\ +\mbox{}\verb@ args$invchol <- si <- standardize(invchol = args$invchol)@\\ +\mbox{}\verb@if (!is.null(perm)) {@\\ +\mbox{}\verb@ if (!attr(args$invchol, "diag")) {@\\ +\mbox{}\verb@ diagonals(args$invchol) <- 1@\\ +\mbox{}\verb@ si <- args$invchol@\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@ args$invchol <- pi <- aperm(as.invchol(args$invchol), perm = perm)@\\ +\mbox{}\verb@ if (length(nm) < length(no))@\\ +\mbox{}\verb@ args$invchol <- marg_mvnorm(invchol = args$invchol,@\\ +\mbox{}\verb@ which = nm)$invchol@\\ +\mbox{}\verb@ args$mean <- args$mean[nm,,drop = FALSE]@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@ret <- do.call("sldpmvnorm", args)@\\ +\mbox{}\verb@### sldmvnorm returns mean score as -obs@\\ +\mbox{}\verb@if (is.null(ret$mean)) ret$mean <- - ret$obs@\\ +\mbox{}\verb@om <- length(no) - length(nm)@\\ +\mbox{}\verb@if (om > 0) {@\\ +\mbox{}\verb@ am <- matrix(0, nrow = om, ncol = ncol(ret$mean))@\\ +\mbox{}\verb@ rownames(am) <- no[!no %in% nm]@\\ +\mbox{}\verb@ ret$mean <- rbind(ret$mean, am)@\\ +\mbox{}\verb@ Jo <- dim(object$scale)[[2L]]@\\ +\mbox{}\verb@ pJ <- dim(args$invchol)[[2L]]@\\ +\mbox{}\verb@ am <- matrix(0, nrow = Jo * (Jo + 1) / 2 - pJ * (pJ + 1) / 2, @\\ +\mbox{}\verb@ ncol = dim(ret$invchol)[1L])@\\ +\mbox{}\verb@ byrow_orig <- attr(ret$invchol, "byrow")@\\ +\mbox{}\verb@ ret$invchol <- ltMatrices(ret$invchol, byrow = TRUE)@\\ +\mbox{}\verb@ ### rbind only works for byrow = TRUE@\\ +\mbox{}\verb@ ret$invchol <- ltMatrices(rbind(unclass(ret$invchol), am), @\\ +\mbox{}\verb@ byrow = TRUE,@\\ +\mbox{}\verb@ diag = TRUE,@\\ +\mbox{}\verb@ names = perm)@\\ +\mbox{}\verb@ ret$invchol <- ltMatrices(ret$invchol, byrow = byrow_orig)@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@if (!is.null(perm))@\\ +\mbox{}\verb@ ret$invchol <- deperma(invchol = si, permuted_invchol = pi, @\\ +\mbox{}\verb@ perm = match(perm, no), @\\ +\mbox{}\verb@ score_schol = -vectrick(pi, ret$invchol))@\\ +\mbox{}\verb@if (standardize)@\\ +\mbox{}\verb@ ret$invchol <- destandardize(invchol = object$scale, @\\ +\mbox{}\verb@ score_schol = -vectrick(si, ret$invchol))@\\ +\mbox{}\verb@if (!attr(si, "diag"))@\\ +\mbox{}\verb@ ret$invchol <- ltMatrices(Lower_tri(ret$invchol, diag = FALSE),@\\ +\mbox{}\verb@ diag = FALSE, @\\ +\mbox{}\verb@ byrow = attr(ret$invchol, "byrow"), @\\ +\mbox{}\verb@ names = dimnames(ret$invchol)[[2L]])@\\ +\mbox{}\verb@ret$scale <- ret$invchol@\\ +\mbox{}\verb@ret$invchol <- NULL@\\ +\mbox{}\verb@ret$mean <- ret$mean[no,,drop = FALSE]@\\ +\mbox{}\verb@return(ret)@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb128}{128}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +We can now provide the log-likelihood gradients + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap156}\raggedright\small +\NWtarget{nuweb128}{} $\langle\,${\itshape mvnorm lLgrad}\nobreak\ {\footnotesize {128}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@lLgrad <- function(object, ...)@\\ +\mbox{}\verb@ UseMethod("lLgrad")@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@lLgrad.mvnorm <- function(object, obs, lower, upper, standardize = FALSE, @\\ +\mbox{}\verb@ ...) {@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape argchecks}\nobreak\ {\footnotesize \NWlink{nuweb122}{122}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ if (is.chol(object$scale)) {@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape lLgrad chol}\nobreak\ {\footnotesize \NWlink{nuweb124a}{124a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape lLgrad invchol}\nobreak\ {\footnotesize \NWlink{nuweb127}{127}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb115a}{115a}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +Let's use this infrastructure to set-up maximum-likelihood estimation +procedures. We start implementing the log-likelihood and score functions for +the iris dataset + +<>= +J <- length(vars) +obs <- t(iris[, vars]) +lower <- upper <- NULL +ll <- function(parm) { + C <- ltMatrices(parm[-(1:J)], diag = TRUE, names = vars) + x <- mvnorm(mean = parm[1:J], chol = C) + -logLik(object = x, obs = obs, lower = lower, upper = upper) +} +sc <- function(parm) { + C <- ltMatrices(parm[-(1:J)], diag = TRUE, names = vars) + x <- mvnorm(mean = parm[1:J], chol = C) + ret <- lLgrad(object = x, obs = obs, lower = lower, upper = upper) + -c(rowSums(ret$mean), rowSums(Lower_tri(ret$scale, diag = TRUE))) +} +@ + +and can now estimate the mean and Cholesky factor of the covariance matrix + +<>= +start <- c(c(iris_mvn$mean), Lower_tri(iris_mvn$scale, diag = TRUE)) +if (require("numDeriv", quietly = TRUE)) + chk(grad(ll, start), sc(start), check.attributes = FALSE) +op <- optim(start, fn = ll, gr = sc, method = "L-BFGS-B", + lower = llim, control = list(trace = TRUE)) +Chat <- ltMatrices(op$par[-(1:J)], diag = TRUE, names = vars) +ML <- mvnorm(mean = op$par[1:J], chol = Chat) +@ + +Quit unsurprisingly, the results are practically equivalent to the +analytically available maximum-likelihood estimators in this case + +<>= +### covariance +round(chol2cov(ML$scale), 2) +N <- nrow(iris) +round(V * (N - 1) / N, 2) +### mean +ML$mean[,,drop = TRUE] +m +@ + +Now, this was a lot of work to replace \code{mean} and \code{var} with +something more fancy, and we would of course not go down this way in real +life. But how about a more complex situation where one (or more) variables +are only known up to intervals? Let's present the first variable is such a +case + +<>= +v1 <- vars[1] +q1 <- quantile(iris[[v1]], prob = 1:4 / 5) +head(f1 <- cut(iris[[v1]], breaks = c(-Inf, q1, Inf))) +@ + +The only necessary modification to our code is the specification of +\code{lower} and \code{upper} bounds for these intervals, and the removal of +the first variable from the ``exact continuous'' observations \code{obs}. +The rest of the machinery \emph{doesn't need any update at all}. Note that +the mean and covariance parameters are no longer orthogonal (as in the toy +example above), so we do have to optimise over both sets of parameters +simultaneously. + +<>= +lower <- matrix(c(-Inf, q1)[f1], nrow = 1) +upper <- matrix(c(q1, Inf)[f1], nrow = 1) +rownames(lower) <- rownames(upper) <- v1 +obs <- obs[!rownames(obs) %in% v1,,drop = FALSE] +if (require("numDeriv", quietly = TRUE)) + chk(grad(ll, start), sc(start), check.attributes = FALSE) +opi <- optim(start, fn = ll, gr = sc, method = "L-BFGS-B", + lower = llim, control = list(trace = TRUE)) +Chati <- ltMatrices(opi$par[-(1:J)], diag = TRUE, names = vars) +MLi <- mvnorm(mean = opi$par[1:J], chol = Chati) +@ + +Because the likelihood is a product of a continuous density and a +conditional probability as introduced in Chapter~\ref{cdl}, the two +in-sample log-likelihoods are not comparable. However, the parameters of the +two estimated normal distributions can be compared directly (and are rather +close in our case) + +<>= +op$value +opi$value +### covariance +round(chol2cov(MLi$scale), 2) +round(chol2cov(ML$scale), 2) +### mean +MLi$mean[,,drop = TRUE] +ML$mean[,,drop = TRUE] +@ + +We close this chapter with a word of warning: If more than one variable is +censored, the \code{M} and \code{w} arguments to \code{lpmvnorm} and +\code{slpmvnorm} have to be specified in \code{logLik} and \code{lLgrad} as +additional arguments (\code{...}) \emph{AND MUST BE IDENTICAL} in both calls. + +\chapter{Package Infrastructure} + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap157}\raggedright\small +\NWtarget{nuweb131}{} $\langle\,${\itshape R Header}\nobreak\ {\footnotesize {131}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@### Copyright (C) 2022- Torsten Hothorn@\\ +\mbox{}\verb@###@\\ +\mbox{}\verb@### This file is part of the 'mvtnorm' R add-on package.@\\ +\mbox{}\verb@###@\\ \mbox{}\verb@### 'mvtnorm' is free software: you can redistribute it and/or modify@\\ \mbox{}\verb@### it under the terms of the GNU General Public License as published by@\\ \mbox{}\verb@### the Free Software Foundation, version 2.@\\ @@ -6579,15 +8120,15 @@ if (!inherits(sd_NPML, "try-error")) { \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb2}{2}\NWlink{nuweb59a}{, 59a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb2}{2}\NWlink{nuweb64}{, 64}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap127}\raggedright\small -\NWtarget{nuweb105}{} $\langle\,${\itshape C Header}\nobreak\ {\footnotesize {105}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap158}\raggedright\small +\NWtarget{nuweb132}{} $\langle\,${\itshape C Header}\nobreak\ {\footnotesize {132}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -6618,7 +8159,7 @@ if (!inherits(sd_NPML, "try-error")) { \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb3}{3}\NWlink{nuweb59b}{, 59b}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb3}{3}\NWlink{nuweb65}{, 65}. \item{} \end{list} @@ -6635,7 +8176,8 @@ This document uses the following matrix derivatives & = & (\mA \otimes \mI_J) + (\mI_J \otimes \mA) \frac{\partial \mA^\top}{\partial \mA} \\ \frac{\partial \diag(\mA)}{\partial \mA} & = & \diag(\vecop(\mI_J)) \\ \frac{\partial \mA}{\partial \mA} & = & \diag(I_{J^2}) \\ -\frac{\yvec^\top \mA \yvec}{\partial \yvec} & = & \yvec^\top (\mA + \mA^\top) +\frac{\partial \yvec^\top \mA \yvec}{\partial \yvec} & = & \yvec^\top (\mA + \mA^\top) \\ +\frac{\partial \mB \mA}{\partial \mA} & = & (\mI_J \otimes \mB) \end{eqnarray*} and the ``vec trick'' $\vecop(\rX)^\top (\mB \otimes \mA^\top) = \vecop(\mA \rX \mB)^\top$. @@ -6647,8 +8189,9 @@ and the ``vec trick'' $\vecop(\rX)^\top (\mB \otimes \mA^\top) = \vecop(\mA {\small\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \verb@"lpmvnorm.c"@ {\footnotesize {\NWtxtDefBy} \NWlink{nuweb59b}{59b}.} -\item \verb@"lpmvnorm.R"@ {\footnotesize {\NWtxtDefBy} \NWlink{nuweb59a}{59a}.} +\item \verb@"interface.R"@ {\footnotesize {\NWtxtDefBy} \NWlink{nuweb115a}{115a}.} +\item \verb@"lpmvnorm.c"@ {\footnotesize {\NWtxtDefBy} \NWlink{nuweb65}{65}.} +\item \verb@"lpmvnorm.R"@ {\footnotesize {\NWtxtDefBy} \NWlink{nuweb64}{64}.} \item \verb@"ltMatrices.c"@ {\footnotesize {\NWtxtDefBy} \NWlink{nuweb3}{3}.} \item \verb@"ltMatrices.R"@ {\footnotesize {\NWtxtDefBy} \NWlink{nuweb2}{2}.} \end{list}} @@ -6657,157 +8200,187 @@ and the ``vec trick'' $\vecop(\rX)^\top (\mB \otimes \mA^\top) = \vecop(\mA {\small\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item $\langle\,$.subset ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb12}{12}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb13}{13}.} -\item $\langle\,$add diagonal elements\nobreak\ {\footnotesize \NWlink{nuweb18}{18}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$aperm\nobreak\ {\footnotesize \NWlink{nuweb47}{47}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$assign diagonal elements\nobreak\ {\footnotesize \NWlink{nuweb19}{19}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$C Header\nobreak\ {\footnotesize \NWlink{nuweb105}{105}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}\NWlink{nuweb59b}{, 59b}. +\item $\langle\,$.subset ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb13}{13}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb14}{14}.} +\item $\langle\,$add diagonal elements\nobreak\ {\footnotesize \NWlink{nuweb20}{20}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$aperm\nobreak\ {\footnotesize \NWlink{nuweb51a}{51a}\NWlink{nuweb51b}{b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$aperm checks\nobreak\ {\footnotesize \NWlink{nuweb50}{50}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb51a}{51a}.} +\item $\langle\,$argchecks\nobreak\ {\footnotesize \NWlink{nuweb122}{122}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb123c}{123c}\NWlink{nuweb128}{, 128}. +} +\item $\langle\,$as.ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb115b}{115b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$assign diagonal elements\nobreak\ {\footnotesize \NWlink{nuweb21}{21}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$C Header\nobreak\ {\footnotesize \NWlink{nuweb132}{132}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}\NWlink{nuweb65}{, 65}. } -\item $\langle\,$C length\nobreak\ {\footnotesize \NWlink{nuweb22a}{22a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb22b}{22b}\NWlink{nuweb24}{, 24}\NWlink{nuweb27}{, 27}\NWlink{nuweb28}{, 28}\NWlink{nuweb31a}{, 31a}\NWlink{nuweb40a}{, 40a}. +\item $\langle\,$C length\nobreak\ {\footnotesize \NWlink{nuweb24a}{24a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb24b}{24b}\NWlink{nuweb26}{, 26}\NWlink{nuweb29}{, 29}\NWlink{nuweb33a}{, 33a}\NWlink{nuweb42a}{, 42a}. } -\item $\langle\,$check A argument\nobreak\ {\footnotesize \NWlink{nuweb41b}{41b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb42}{42}.} -\item $\langle\,$check and / or set integration weights\nobreak\ {\footnotesize \NWlink{nuweb68b}{68b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb69}{69}\NWlink{nuweb82}{, 82}. +\item $\langle\,$check A argument\nobreak\ {\footnotesize \NWlink{nuweb43b}{43b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb44}{44}.} +\item $\langle\,$check and / or set integration weights\nobreak\ {\footnotesize \NWlink{nuweb74b}{74b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb75}{75}\NWlink{nuweb87}{, 87}. } -\item $\langle\,$check C argument\nobreak\ {\footnotesize \NWlink{nuweb40b}{40b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb42}{42}.} -\item $\langle\,$check obs\nobreak\ {\footnotesize \NWlink{nuweb52b}{52b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$check S argument\nobreak\ {\footnotesize \NWlink{nuweb41a}{41a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb42}{42}.} -\item $\langle\,$chol\nobreak\ {\footnotesize \NWlink{nuweb38}{38}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}.} -\item $\langle\,$chol scores\nobreak\ {\footnotesize \NWlink{nuweb71a}{71a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb72a}{72a}.} -\item $\langle\,$chol syMatrices\nobreak\ {\footnotesize \NWlink{nuweb37}{37}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$Cholesky of precision\nobreak\ {\footnotesize \NWlink{nuweb68c}{68c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb69}{69}\NWlink{nuweb82}{, 82}. +\item $\langle\,$check C argument\nobreak\ {\footnotesize \NWlink{nuweb42b}{42b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb44}{44}.} +\item $\langle\,$check obs\nobreak\ {\footnotesize \NWlink{nuweb57b}{57b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$check S argument\nobreak\ {\footnotesize \NWlink{nuweb43a}{43a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb44}{44}.} +\item $\langle\,$chol\nobreak\ {\footnotesize \NWlink{nuweb40}{40}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}.} +\item $\langle\,$chol classes\nobreak\ {\footnotesize \NWlink{nuweb45}{45}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb48}{48}.} +\item $\langle\,$chol scores\nobreak\ {\footnotesize \NWlink{nuweb77a}{77a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb78a}{78a}.} +\item $\langle\,$chol syMatrices\nobreak\ {\footnotesize \NWlink{nuweb39}{39}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$Cholesky of precision\nobreak\ {\footnotesize \NWlink{nuweb74c}{74c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb75}{75}\NWlink{nuweb87}{, 87}. } -\item $\langle\,$colSumsdnorm\nobreak\ {\footnotesize \NWlink{nuweb53a}{53a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}.} -\item $\langle\,$colSumsdnorm ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb53b}{53b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$compute x\nobreak\ {\footnotesize \NWlink{nuweb62a}{62a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb62d}{62d}\NWlink{nuweb77a}{, 77a}. +\item $\langle\,$colSumsdnorm\nobreak\ {\footnotesize \NWlink{nuweb58a}{58a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}.} +\item $\langle\,$colSumsdnorm ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb58b}{58b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$compute x\nobreak\ {\footnotesize \NWlink{nuweb68b}{68b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb69b}{69b}\NWlink{nuweb83a}{, 83a}. } -\item $\langle\,$compute y\nobreak\ {\footnotesize \NWlink{nuweb61c}{61c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb62d}{62d}\NWlink{nuweb77a}{, 77a}. +\item $\langle\,$compute y\nobreak\ {\footnotesize \NWlink{nuweb68a}{68a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb69b}{69b}\NWlink{nuweb83a}{, 83a}. } -\item $\langle\,$cond general\nobreak\ {\footnotesize \NWlink{nuweb49}{49}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb50b}{50b}.} -\item $\langle\,$cond simple\nobreak\ {\footnotesize \NWlink{nuweb50a}{50a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb50b}{50b}.} -\item $\langle\,$conditional\nobreak\ {\footnotesize \NWlink{nuweb50b}{50b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$convenience functions\nobreak\ {\footnotesize \NWlink{nuweb45}{45}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$crossprod ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb36}{36}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$D times C\nobreak\ {\footnotesize \NWlink{nuweb43}{43}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb45}{45}.} -\item $\langle\,$destandardize\nobreak\ {\footnotesize \NWlink{nuweb100}{100}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$diagonal matrix\nobreak\ {\footnotesize \NWlink{nuweb20}{20}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$diagonals ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb17}{17}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$cond general\nobreak\ {\footnotesize \NWlink{nuweb53}{53}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb55}{55}.} +\item $\langle\,$cond simple\nobreak\ {\footnotesize \NWlink{nuweb54}{54}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb55}{55}.} +\item $\langle\,$conditional\nobreak\ {\footnotesize \NWlink{nuweb55}{55}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$convenience functions\nobreak\ {\footnotesize \NWlink{nuweb48}{48}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$crossprod ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb38}{38}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$D times C\nobreak\ {\footnotesize \NWlink{nuweb46}{46}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb48}{48}.} +\item $\langle\,$deperma\nobreak\ {\footnotesize \NWlink{nuweb107}{107}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb64}{64}.} +\item $\langle\,$deperma indices\nobreak\ {\footnotesize \NWlink{nuweb106b}{106b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb107}{107}.} +\item $\langle\,$deperma input checks chol\nobreak\ {\footnotesize \NWlink{nuweb105a}{105a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb107}{107}.} +\item $\langle\,$deperma input checks perm\nobreak\ {\footnotesize \NWlink{nuweb105b}{105b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb107}{107}.} +\item $\langle\,$deperma input checks schol\nobreak\ {\footnotesize \NWlink{nuweb106a}{106a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb107}{107}.} +\item $\langle\,$destandardize\nobreak\ {\footnotesize \NWlink{nuweb111}{111}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb64}{64}.} +\item $\langle\,$diagonal matrix\nobreak\ {\footnotesize \NWlink{nuweb22}{22}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$diagonals ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb19}{19}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} \item $\langle\,$dim ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb6c}{6c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$dimensions\nobreak\ {\footnotesize \NWlink{nuweb65b}{65b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb67}{67}\NWlink{nuweb79}{, 79}. +\item $\langle\,$dimensions\nobreak\ {\footnotesize \NWlink{nuweb71c}{71c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb73}{73}\NWlink{nuweb84}{, 84}. } \item $\langle\,$dimnames ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb7a}{7a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$dp input checks\nobreak\ {\footnotesize \NWlink{nuweb93}{93}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb94}{94}\NWlink{nuweb96}{, 96}. +\item $\langle\,$dp input checks\nobreak\ {\footnotesize \NWlink{nuweb99}{99}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb100}{100}\NWlink{nuweb102}{, 102}. } -\item $\langle\,$extract slots\nobreak\ {\footnotesize \NWlink{nuweb9}{9}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb10}{10}\NWlink{nuweb11}{, 11}\NWlink{nuweb12}{, 12}\NWlink{nuweb15}{, 15}\NWlink{nuweb17}{, 17}\NWlink{nuweb19}{, 19}\NWlink{nuweb21a}{, 21a}\NWlink{nuweb25}{, 25}. +\item $\langle\,$extract slots\nobreak\ {\footnotesize \NWlink{nuweb10}{10}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb11}{11}\NWlink{nuweb12}{, 12}\NWlink{nuweb13}{, 13}\NWlink{nuweb17}{, 17}\NWlink{nuweb19}{, 19}\NWlink{nuweb21}{, 21}\NWlink{nuweb23a}{, 23a}\NWlink{nuweb27}{, 27}. } -\item $\langle\,$first element\nobreak\ {\footnotesize \NWlink{nuweb32a}{32a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb32b}{32b}\NWlink{nuweb33a}{, 33a}. +\item $\langle\,$first element\nobreak\ {\footnotesize \NWlink{nuweb34a}{34a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb34b}{34b}\NWlink{nuweb35a}{, 35a}. } -\item $\langle\,$IDX\nobreak\ {\footnotesize \NWlink{nuweb33b}{33b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb34}{34}\NWlink{nuweb40a}{, 40a}. +\item $\langle\,$IDX\nobreak\ {\footnotesize \NWlink{nuweb35b}{35b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb36}{36}\NWlink{nuweb42a}{, 42a}. } -\item $\langle\,$increment\nobreak\ {\footnotesize \NWlink{nuweb63a}{63a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb67}{67}.} -\item $\langle\,$init center\nobreak\ {\footnotesize \NWlink{nuweb66b}{66b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb67}{67}\NWlink{nuweb79}{, 79}. +\item $\langle\,$increment\nobreak\ {\footnotesize \NWlink{nuweb69c}{69c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb73}{73}.} +\item $\langle\,$init center\nobreak\ {\footnotesize \NWlink{nuweb72c}{72c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb73}{73}\NWlink{nuweb84}{, 84}. } -\item $\langle\,$init dans\nobreak\ {\footnotesize \NWlink{nuweb77c}{77c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb79}{79}.} -\item $\langle\,$init logLik loop\nobreak\ {\footnotesize \NWlink{nuweb61b}{61b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb67}{67}\NWlink{nuweb73b}{, 73b}. +\item $\langle\,$init dans\nobreak\ {\footnotesize \NWlink{nuweb83c}{83c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb84}{84}.} +\item $\langle\,$init logLik loop\nobreak\ {\footnotesize \NWlink{nuweb67c}{67c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb73}{73}\NWlink{nuweb79b}{, 79b}. } -\item $\langle\,$init random seed, reset on exit\nobreak\ {\footnotesize \NWlink{nuweb68a}{68a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb69}{69}\NWlink{nuweb82}{, 82}. +\item $\langle\,$init random seed, reset on exit\nobreak\ {\footnotesize \NWlink{nuweb74a}{74a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb75}{75}\NWlink{nuweb87}{, 87}. } -\item $\langle\,$init score loop\nobreak\ {\footnotesize \NWlink{nuweb73b}{73b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb79}{79}.} -\item $\langle\,$initialisation\nobreak\ {\footnotesize \NWlink{nuweb61a}{61a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb67}{67}\NWlink{nuweb79}{, 79}. +\item $\langle\,$init score loop\nobreak\ {\footnotesize \NWlink{nuweb79b}{79b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb84}{84}.} +\item $\langle\,$initialisation\nobreak\ {\footnotesize \NWlink{nuweb67b}{67b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb73}{73}\NWlink{nuweb84}{, 84}. } -\item $\langle\,$inner logLik loop\nobreak\ {\footnotesize \NWlink{nuweb62d}{62d}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb67}{67}.} -\item $\langle\,$inner score loop\nobreak\ {\footnotesize \NWlink{nuweb77a}{77a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb79}{79}.} -\item $\langle\,$input checks\nobreak\ {\footnotesize \NWlink{nuweb60a}{60a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb58}{58}\NWlink{nuweb69}{, 69}\NWlink{nuweb82}{, 82}. +\item $\langle\,$inner logLik loop\nobreak\ {\footnotesize \NWlink{nuweb69b}{69b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb73}{73}.} +\item $\langle\,$inner score loop\nobreak\ {\footnotesize \NWlink{nuweb83a}{83a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb84}{84}.} +\item $\langle\,$input checks\nobreak\ {\footnotesize \NWlink{nuweb66}{66}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb63}{63}\NWlink{nuweb75}{, 75}\NWlink{nuweb87}{, 87}. } -\item $\langle\,$kronecker vec trick\nobreak\ {\footnotesize \NWlink{nuweb42}{42}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$L times D\nobreak\ {\footnotesize \NWlink{nuweb44}{44}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb45}{45}.} -\item $\langle\,$lapack options\nobreak\ {\footnotesize \NWlink{nuweb26}{26}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb27}{27}\NWlink{nuweb28}{, 28}. +\item $\langle\,$is.ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb7c}{7c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$kronecker vec trick\nobreak\ {\footnotesize \NWlink{nuweb44}{44}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$L times D\nobreak\ {\footnotesize \NWlink{nuweb47}{47}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb48}{48}.} +\item $\langle\,$lapack options\nobreak\ {\footnotesize \NWlink{nuweb28}{28}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb29}{29}\NWlink{nuweb30}{, 30}. } -\item $\langle\,$ldmvnorm\nobreak\ {\footnotesize \NWlink{nuweb52a}{52a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$ldmvnorm chol\nobreak\ {\footnotesize \NWlink{nuweb54a}{54a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb52a}{52a}.} -\item $\langle\,$ldmvnorm invchol\nobreak\ {\footnotesize \NWlink{nuweb54b}{54b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb52a}{52a}.} -\item $\langle\,$ldpmvnorm\nobreak\ {\footnotesize \NWlink{nuweb94}{94}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$logdet\nobreak\ {\footnotesize \NWlink{nuweb31a}{31a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}.} -\item $\langle\,$logdet ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb31b}{31b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$lower scores\nobreak\ {\footnotesize \NWlink{nuweb71c}{71c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb72a}{72a}.} -\item $\langle\,$lower triangular elements\nobreak\ {\footnotesize \NWlink{nuweb15}{15}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$lpmvnorm\nobreak\ {\footnotesize \NWlink{nuweb69}{69}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb59a}{59a}.} -\item $\langle\,$lpmvnormR\nobreak\ {\footnotesize \NWlink{nuweb58}{58}}$\,\rangle$ {\footnotesize {\NWtxtNoRef}.} +\item $\langle\,$ldmvnorm\nobreak\ {\footnotesize \NWlink{nuweb57a}{57a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb64}{64}.} +\item $\langle\,$ldmvnorm chol\nobreak\ {\footnotesize \NWlink{nuweb59a}{59a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb57a}{57a}.} +\item $\langle\,$ldmvnorm invchol\nobreak\ {\footnotesize \NWlink{nuweb59b}{59b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb57a}{57a}.} +\item $\langle\,$ldpmvnorm\nobreak\ {\footnotesize \NWlink{nuweb100}{100}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb64}{64}.} +\item $\langle\,$lLgrad chol\nobreak\ {\footnotesize \NWlink{nuweb124a}{124a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb128}{128}.} +\item $\langle\,$lLgrad deperma\nobreak\ {\footnotesize \NWlink{nuweb125b}{125b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb124a}{124a}.} +\item $\langle\,$lLgrad destandarized\nobreak\ {\footnotesize \NWlink{nuweb125c}{125c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb124a}{124a}.} +\item $\langle\,$lLgrad diagonals\nobreak\ {\footnotesize \NWlink{nuweb126a}{126a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb124a}{124a}.} +\item $\langle\,$lLgrad invchol\nobreak\ {\footnotesize \NWlink{nuweb127}{127}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb128}{128}.} +\item $\langle\,$lLgrad marginalisation\nobreak\ {\footnotesize \NWlink{nuweb125a}{125a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb124a}{124a}.} +\item $\langle\,$lLgrad mean\nobreak\ {\footnotesize \NWlink{nuweb124b}{124b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb124a}{124a}.} +\item $\langle\,$lLgrad return\nobreak\ {\footnotesize \NWlink{nuweb126b}{126b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb124a}{124a}.} +\item $\langle\,$logdet\nobreak\ {\footnotesize \NWlink{nuweb33a}{33a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}.} +\item $\langle\,$logdet ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb33b}{33b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$logLik chol\nobreak\ {\footnotesize \NWlink{nuweb123a}{123a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb123c}{123c}.} +\item $\langle\,$logLik invchol\nobreak\ {\footnotesize \NWlink{nuweb123b}{123b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb123c}{123c}.} +\item $\langle\,$lower scores\nobreak\ {\footnotesize \NWlink{nuweb77c}{77c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb78a}{78a}.} +\item $\langle\,$lower triangular elements\nobreak\ {\footnotesize \NWlink{nuweb17}{17}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$lpmvnorm\nobreak\ {\footnotesize \NWlink{nuweb75}{75}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb64}{64}.} +\item $\langle\,$lpmvnormR\nobreak\ {\footnotesize \NWlink{nuweb63}{63}}$\,\rangle$ {\footnotesize {\NWtxtNoRef}.} \item $\langle\,$ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb6a}{6a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} \item $\langle\,$ltMatrices dim\nobreak\ {\footnotesize \NWlink{nuweb4}{4}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb6a}{6a}.} \item $\langle\,$ltMatrices input\nobreak\ {\footnotesize \NWlink{nuweb5b}{5b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb6a}{6a}.} \item $\langle\,$ltMatrices names\nobreak\ {\footnotesize \NWlink{nuweb5a}{5a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb6a}{6a}.} -\item $\langle\,$marginal\nobreak\ {\footnotesize \NWlink{nuweb48b}{48b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$mc input checks\nobreak\ {\footnotesize \NWlink{nuweb48a}{48a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb48b}{48b}\NWlink{nuweb50b}{, 50b}. +\item $\langle\,$marginal\nobreak\ {\footnotesize \NWlink{nuweb52b}{52b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$mc input checks\nobreak\ {\footnotesize \NWlink{nuweb52a}{52a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb52b}{52b}\NWlink{nuweb55}{, 55}. } -\item $\langle\,$mean scores\nobreak\ {\footnotesize \NWlink{nuweb71b}{71b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb72a}{72a}.} -\item $\langle\,$move on\nobreak\ {\footnotesize \NWlink{nuweb63c}{63c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb67}{67}\NWlink{nuweb79}{, 79}. +\item $\langle\,$mean scores\nobreak\ {\footnotesize \NWlink{nuweb77b}{77b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb78a}{78a}.} +\item $\langle\,$move on\nobreak\ {\footnotesize \NWlink{nuweb70a}{70a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb73}{73}\NWlink{nuweb84}{, 84}. } -\item $\langle\,$mult\nobreak\ {\footnotesize \NWlink{nuweb22b}{22b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}.} -\item $\langle\,$mult ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb21a}{21a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$mult ltMatrices transpose\nobreak\ {\footnotesize \NWlink{nuweb23}{23}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb21a}{21a}.} -\item $\langle\,$mult syMatrices\nobreak\ {\footnotesize \NWlink{nuweb25}{25}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$mult transpose\nobreak\ {\footnotesize \NWlink{nuweb24}{24}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}.} +\item $\langle\,$mult\nobreak\ {\footnotesize \NWlink{nuweb24b}{24b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}.} +\item $\langle\,$mult ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb23a}{23a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$mult ltMatrices transpose\nobreak\ {\footnotesize \NWlink{nuweb25}{25}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb23a}{23a}.} +\item $\langle\,$mult syMatrices\nobreak\ {\footnotesize \NWlink{nuweb27}{27}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$mult transpose\nobreak\ {\footnotesize \NWlink{nuweb26}{26}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}.} +\item $\langle\,$mvnorm\nobreak\ {\footnotesize \NWlink{nuweb117a}{117a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb115a}{115a}.} +\item $\langle\,$mvnorm chol invchol\nobreak\ {\footnotesize \NWlink{nuweb116a}{116a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb117a}{117a}.} +\item $\langle\,$mvnorm condDist\nobreak\ {\footnotesize \NWlink{nuweb120}{120}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb115a}{115a}.} +\item $\langle\,$mvnorm lLgrad\nobreak\ {\footnotesize \NWlink{nuweb128}{128}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb115a}{115a}.} +\item $\langle\,$mvnorm logLik\nobreak\ {\footnotesize \NWlink{nuweb123c}{123c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb115a}{115a}.} +\item $\langle\,$mvnorm margDist\nobreak\ {\footnotesize \NWlink{nuweb119}{119}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb115a}{115a}.} +\item $\langle\,$mvnorm mean\nobreak\ {\footnotesize \NWlink{nuweb116b}{116b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb117a}{117a}.} +\item $\langle\,$mvnorm methods\nobreak\ {\footnotesize \NWlink{nuweb117b}{117b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb115a}{115a}.} +\item $\langle\,$mvnorm simulate\nobreak\ {\footnotesize \NWlink{nuweb118}{118}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb115a}{115a}.} \item $\langle\,$names ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb7b}{7b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$new score means, lower and upper\nobreak\ {\footnotesize \NWlink{nuweb75c}{75c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb77a}{77a}.} -\item $\langle\,$output\nobreak\ {\footnotesize \NWlink{nuweb63b}{63b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb67}{67}.} -\item $\langle\,$pnorm\nobreak\ {\footnotesize \NWlink{nuweb64c}{64c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb67}{67}\NWlink{nuweb79}{, 79}. +\item $\langle\,$new score means, lower and upper\nobreak\ {\footnotesize \NWlink{nuweb81c}{81c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb83a}{83a}.} +\item $\langle\,$output\nobreak\ {\footnotesize \NWlink{nuweb69d}{69d}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb73}{73}.} +\item $\langle\,$pnorm\nobreak\ {\footnotesize \NWlink{nuweb71a}{71a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb73}{73}\NWlink{nuweb84}{, 84}. } -\item $\langle\,$pnorm fast\nobreak\ {\footnotesize \NWlink{nuweb64a}{64a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb59b}{59b}.} -\item $\langle\,$pnorm slow\nobreak\ {\footnotesize \NWlink{nuweb64b}{64b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb59b}{59b}.} -\item $\langle\,$post differentiate chol score\nobreak\ {\footnotesize \NWlink{nuweb80d}{80d}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb82}{82}.} -\item $\langle\,$post differentiate invchol score\nobreak\ {\footnotesize \NWlink{nuweb81a}{81a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb82}{82}.} -\item $\langle\,$post differentiate lower score\nobreak\ {\footnotesize \NWlink{nuweb80b}{80b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb82}{82}.} -\item $\langle\,$post differentiate mean score\nobreak\ {\footnotesize \NWlink{nuweb80a}{80a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb82}{82}.} -\item $\langle\,$post differentiate upper score\nobreak\ {\footnotesize \NWlink{nuweb80c}{80c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb82}{82}.} -\item $\langle\,$post process score\nobreak\ {\footnotesize \NWlink{nuweb81b}{81b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb82}{82}.} -\item $\langle\,$print ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb10}{10}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$R Header\nobreak\ {\footnotesize \NWlink{nuweb104}{104}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}\NWlink{nuweb59a}{, 59a}. +\item $\langle\,$pnorm fast\nobreak\ {\footnotesize \NWlink{nuweb70b}{70b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb65}{65}.} +\item $\langle\,$pnorm slow\nobreak\ {\footnotesize \NWlink{nuweb70c}{70c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb65}{65}.} +\item $\langle\,$post differentiate chol score\nobreak\ {\footnotesize \NWlink{nuweb85d}{85d}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb87}{87}.} +\item $\langle\,$post differentiate invchol score\nobreak\ {\footnotesize \NWlink{nuweb86a}{86a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb87}{87}.} +\item $\langle\,$post differentiate lower score\nobreak\ {\footnotesize \NWlink{nuweb85b}{85b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb87}{87}.} +\item $\langle\,$post differentiate mean score\nobreak\ {\footnotesize \NWlink{nuweb85a}{85a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb87}{87}.} +\item $\langle\,$post differentiate upper score\nobreak\ {\footnotesize \NWlink{nuweb85c}{85c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb87}{87}.} +\item $\langle\,$post process score\nobreak\ {\footnotesize \NWlink{nuweb86b}{86b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb87}{87}.} +\item $\langle\,$print ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb11}{11}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$R Header\nobreak\ {\footnotesize \NWlink{nuweb131}{131}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}\NWlink{nuweb64}{, 64}. } -\item $\langle\,$R lpmvnorm\nobreak\ {\footnotesize \NWlink{nuweb67}{67}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb59b}{59b}.} -\item $\langle\,$R slpmvnorm\nobreak\ {\footnotesize \NWlink{nuweb79}{79}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb59b}{59b}.} -\item $\langle\,$R slpmvnorm variables\nobreak\ {\footnotesize \NWlink{nuweb66c}{66c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb67}{67}\NWlink{nuweb79}{, 79}. +\item $\langle\,$R lpmvnorm\nobreak\ {\footnotesize \NWlink{nuweb73}{73}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb65}{65}.} +\item $\langle\,$R slpmvnorm\nobreak\ {\footnotesize \NWlink{nuweb84}{84}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb65}{65}.} +\item $\langle\,$R slpmvnorm variables\nobreak\ {\footnotesize \NWlink{nuweb72d}{72d}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb73}{73}\NWlink{nuweb84}{, 84}. } -\item $\langle\,$RC input\nobreak\ {\footnotesize \NWlink{nuweb21b}{21b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb22b}{22b}\NWlink{nuweb24}{, 24}\NWlink{nuweb27}{, 27}\NWlink{nuweb28}{, 28}\NWlink{nuweb31a}{, 31a}\NWlink{nuweb34}{, 34}\NWlink{nuweb40a}{, 40a}. +\item $\langle\,$RC input\nobreak\ {\footnotesize \NWlink{nuweb23b}{23b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb24b}{24b}\NWlink{nuweb26}{, 26}\NWlink{nuweb29}{, 29}\NWlink{nuweb30}{, 30}\NWlink{nuweb33a}{, 33a}\NWlink{nuweb36}{, 36}\NWlink{nuweb42a}{, 42a}. } -\item $\langle\,$reorder ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb11}{11}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$score a, b\nobreak\ {\footnotesize \NWlink{nuweb73a}{73a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb73b}{73b}\NWlink{nuweb79}{, 79}. +\item $\langle\,$reorder ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb12}{12}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$score a, b\nobreak\ {\footnotesize \NWlink{nuweb79a}{79a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb79b}{79b}\NWlink{nuweb84}{, 84}. } -\item $\langle\,$score c11\nobreak\ {\footnotesize \NWlink{nuweb72b}{72b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb73b}{73b}\NWlink{nuweb79}{, 79}. +\item $\langle\,$score c11\nobreak\ {\footnotesize \NWlink{nuweb78b}{78b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb79b}{79b}\NWlink{nuweb84}{, 84}. } -\item $\langle\,$score output\nobreak\ {\footnotesize \NWlink{nuweb77b}{77b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb79}{79}.} -\item $\langle\,$score output object\nobreak\ {\footnotesize \NWlink{nuweb72a}{72a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb79}{79}.} -\item $\langle\,$score wrt new chol diagonal\nobreak\ {\footnotesize \NWlink{nuweb75b}{75b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb77a}{77a}.} -\item $\langle\,$score wrt new chol off-diagonals\nobreak\ {\footnotesize \NWlink{nuweb75a}{75a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb77a}{77a}.} -\item $\langle\,$setup return object\nobreak\ {\footnotesize \NWlink{nuweb65c}{65c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb67}{67}.} -\item $\langle\,$sldmvnorm\nobreak\ {\footnotesize \NWlink{nuweb56}{56}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$sldpmvnorm\nobreak\ {\footnotesize \NWlink{nuweb96}{96}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$sldpmvnorm invchol\nobreak\ {\footnotesize \NWlink{nuweb95}{95}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb96}{96}.} -\item $\langle\,$slpmvnorm\nobreak\ {\footnotesize \NWlink{nuweb82}{82}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb59a}{59a}.} -\item $\langle\,$solve\nobreak\ {\footnotesize \NWlink{nuweb27}{27}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}.} -\item $\langle\,$solve C\nobreak\ {\footnotesize \NWlink{nuweb28}{28}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}.} -\item $\langle\,$solve ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb29}{29}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$standardise\nobreak\ {\footnotesize \NWlink{nuweb60b}{60b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb69}{69}\NWlink{nuweb82}{, 82}. +\item $\langle\,$score output\nobreak\ {\footnotesize \NWlink{nuweb83b}{83b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb84}{84}.} +\item $\langle\,$score output object\nobreak\ {\footnotesize \NWlink{nuweb78a}{78a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb84}{84}.} +\item $\langle\,$score wrt new chol diagonal\nobreak\ {\footnotesize \NWlink{nuweb81b}{81b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb83a}{83a}.} +\item $\langle\,$score wrt new chol off-diagonals\nobreak\ {\footnotesize \NWlink{nuweb81a}{81a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb83a}{83a}.} +\item $\langle\,$setup return object\nobreak\ {\footnotesize \NWlink{nuweb72a}{72a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb73}{73}.} +\item $\langle\,$sldmvnorm\nobreak\ {\footnotesize \NWlink{nuweb61}{61}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb64}{64}.} +\item $\langle\,$sldpmvnorm\nobreak\ {\footnotesize \NWlink{nuweb102}{102}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb64}{64}.} +\item $\langle\,$sldpmvnorm invchol\nobreak\ {\footnotesize \NWlink{nuweb101}{101}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb102}{102}.} +\item $\langle\,$slpmvnorm\nobreak\ {\footnotesize \NWlink{nuweb87}{87}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb64}{64}.} +\item $\langle\,$solve\nobreak\ {\footnotesize \NWlink{nuweb29}{29}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}.} +\item $\langle\,$solve C\nobreak\ {\footnotesize \NWlink{nuweb30}{30}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}.} +\item $\langle\,$solve ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb31}{31}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$standardise\nobreak\ {\footnotesize \NWlink{nuweb67a}{67a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb75}{75}\NWlink{nuweb87}{, 87}. } -\item $\langle\,$standardize\nobreak\ {\footnotesize \NWlink{nuweb98}{98}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$subset ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb13}{13}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$standardize\nobreak\ {\footnotesize \NWlink{nuweb109}{109}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb64}{64}.} +\item $\langle\,$subset ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb14}{14}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} \item $\langle\,$syMatrices\nobreak\ {\footnotesize \NWlink{nuweb6b}{6b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$t(C) S t(A)\nobreak\ {\footnotesize \NWlink{nuweb39}{39}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb40a}{40a}.} -\item $\langle\,$tcrossprod\nobreak\ {\footnotesize \NWlink{nuweb34}{34}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}.} -\item $\langle\,$tcrossprod diagonal only\nobreak\ {\footnotesize \NWlink{nuweb32b}{32b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb34}{34}.} -\item $\langle\,$tcrossprod full\nobreak\ {\footnotesize \NWlink{nuweb33a}{33a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb34}{34}.} -\item $\langle\,$tcrossprod ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb35}{35}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$univariate problem\nobreak\ {\footnotesize \NWlink{nuweb66a}{66a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb67}{67}.} -\item $\langle\,$update d, e\nobreak\ {\footnotesize \NWlink{nuweb62b}{62b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb62d}{62d}\NWlink{nuweb77a}{, 77a}. +\item $\langle\,$t(C) S t(A)\nobreak\ {\footnotesize \NWlink{nuweb41}{41}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb42a}{42a}.} +\item $\langle\,$tcrossprod\nobreak\ {\footnotesize \NWlink{nuweb36}{36}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}.} +\item $\langle\,$tcrossprod diagonal only\nobreak\ {\footnotesize \NWlink{nuweb34b}{34b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb36}{36}.} +\item $\langle\,$tcrossprod full\nobreak\ {\footnotesize \NWlink{nuweb35a}{35a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb36}{36}.} +\item $\langle\,$tcrossprod ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb37}{37}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$univariate problem\nobreak\ {\footnotesize \NWlink{nuweb72b}{72b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb73}{73}.} +\item $\langle\,$update d, e\nobreak\ {\footnotesize \NWlink{nuweb68c}{68c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb69b}{69b}\NWlink{nuweb83a}{, 83a}. } -\item $\langle\,$update f\nobreak\ {\footnotesize \NWlink{nuweb62c}{62c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb62d}{62d}\NWlink{nuweb77a}{, 77a}. +\item $\langle\,$update f\nobreak\ {\footnotesize \NWlink{nuweb69a}{69a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb69b}{69b}\NWlink{nuweb83a}{, 83a}. } -\item $\langle\,$update score for chol\nobreak\ {\footnotesize \NWlink{nuweb76a}{76a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb77a}{77a}.} -\item $\langle\,$update score means, lower and upper\nobreak\ {\footnotesize \NWlink{nuweb76b}{76b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb77a}{77a}.} -\item $\langle\,$update yp for chol\nobreak\ {\footnotesize \NWlink{nuweb73c}{73c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb77a}{77a}.} -\item $\langle\,$update yp for means, lower and upper\nobreak\ {\footnotesize \NWlink{nuweb74}{74}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb77a}{77a}.} -\item $\langle\,$upper scores\nobreak\ {\footnotesize \NWlink{nuweb71d}{71d}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb72a}{72a}.} -\item $\langle\,$vec trick\nobreak\ {\footnotesize \NWlink{nuweb40a}{40a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}.} -\item $\langle\,$W length\nobreak\ {\footnotesize \NWlink{nuweb65a}{65a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb67}{67}\NWlink{nuweb79}{, 79}. +\item $\langle\,$update score for chol\nobreak\ {\footnotesize \NWlink{nuweb82a}{82a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb83a}{83a}.} +\item $\langle\,$update score means, lower and upper\nobreak\ {\footnotesize \NWlink{nuweb82b}{82b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb83a}{83a}.} +\item $\langle\,$update yp for chol\nobreak\ {\footnotesize \NWlink{nuweb79c}{79c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb83a}{83a}.} +\item $\langle\,$update yp for means, lower and upper\nobreak\ {\footnotesize \NWlink{nuweb80}{80}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb83a}{83a}.} +\item $\langle\,$upper scores\nobreak\ {\footnotesize \NWlink{nuweb77d}{77d}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb78a}{78a}.} +\item $\langle\,$vec trick\nobreak\ {\footnotesize \NWlink{nuweb42a}{42a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}.} +\item $\langle\,$W length\nobreak\ {\footnotesize \NWlink{nuweb71b}{71b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb73}{73}\NWlink{nuweb84}{, 84}. } \end{list}} diff --git a/inst/doc/lmvnorm_src.pdf b/inst/doc/lmvnorm_src.pdf index 3c5096a..ac9e117 100644 Binary files a/inst/doc/lmvnorm_src.pdf and b/inst/doc/lmvnorm_src.pdf differ diff --git a/inst/litdb.bib b/inst/litdb.bib index cd2d668..5164aea 100644 --- a/inst/litdb.bib +++ b/inst/litdb.bib @@ -80,3 +80,14 @@ @article{blood-and-:1987 pages = {H47--H53}, doi = {10.1152/ajpheart.1987.252.1.H47} } + +@article{Barrathh_Boyd_2023, + author = {Shane Barratt and Stephen Boyd}, + year = 2023, + title = {Covariance Prediction via Convex Optimization}, + journal = {Optimization and Engineering}, + pages = {2045--2078}, + volume = 24, + number = 3, + doi = {10.1007/s11081-022-09765-w} +} diff --git a/man/interface.Rd b/man/interface.Rd new file mode 100644 index 0000000..f655528 --- /dev/null +++ b/man/interface.Rd @@ -0,0 +1,101 @@ +\name{interface} +\alias{mvnorm} +\alias{aperm.mvnorm} +\alias{simulate.mvnorm} +\alias{logLik.mvnorm} +\alias{lLgrad} +\alias{lLgrad.mvnorm} +\alias{margDist} +\alias{margDist.mvnorm} +\alias{condDist} +\alias{condDist.mvnorm} +\title{ + (Experimental) User Interface to Multiple Multivariate Normal Distributions +} +\description{ + A (still experimental) simple user interface for computing on multiple multivariate + normal distributions. +} +\usage{ +mvnorm(mean, chol, invchol) +\S3method{aperm}{mvnorm}(a, perm, ...) +margDist(object, which, ...) +\S3method{margDist}{mvnorm}(object, which, ...) +condDist(object, which_given, given, ...) +\S3method{condDist}{mvnorm}(object, which_given, given, ...) +\S3method{simulate}{mvnorm}(object, nsim = dim(object$scale)[1L], seed = NULL, + standardize = FALSE, as.data.frame = FALSE, ...) +\S3method{logLik}{mvnorm}(object, obs, lower, upper, standardize = FALSE, ...) +\S3method{lLgrad}{mvnorm}(object, obs, lower, upper, standardize = FALSE, ...) +} +\arguments{ + \item{chol}{either an \code{ltMatrices} object specifying (multiple) + Cholesky factors of the covariance matrix or + one single numeric lower triangular square matrix. +} + \item{invchol}{either an \code{ltMatrices} object specifying (multiple) + inverse Cholesky factors of the covariance matrix or + one single numeric lower triangular square matrix. +} + \item{a,object}{objects of class \code{mvnorm}. +} + \item{perm}{a permutation of the covariance matrix corresponding to \code{a}. +} + \item{which}{names or indices of elements those marginal distribution + is of interest. +} + \item{which_given}{names or indices of elements to condition on. +} +\item{given}{matrix of realisations to condition on (number of rows is + equal to \code{length(which)}, the number of + columns corresponds to the number of matrices in \code{chol} + or \code{invchol}. +} + \item{lower}{matrix of lower limits (one column for each observation, \eqn{J} rows). +} + \item{upper}{matrix of upper limits (one column for each observation, \eqn{J} rows). +} + \item{obs}{matrix of exact observations (one column for each observation, \eqn{J} rows). +} + \item{mean}{matrix of means (one column for each observation, length is + recycled to length of \code{obs}, \code{lower} and \code{upper}). +} +\item{seed}{an object specifying if and how the random number generator + should be initialized, see \code{\link[stats]{simulate}}. +} +\item{standardize}{logical, should the Cholesky factor (or its inverse) undergo + standardization (ensuring the covariance matrix is a correlation + matrix) before computing the likelihood. +} +\item{nsim}{number of samples to draw. +} +\item{as.data.frame}{logical, convert the $J x N$ matrix result to a + classical $N x J$ data frame. +} +\item{\dots}{Additional arguments to \code{\link{ldpmvnorm}} and + \code{\link{sldpmvnorm}} +} +} +\details{ + The constructor \code{mvnorm} can be used to specify (multiple) + multivariate normal distributions. \code{margDist} derives marginal and + \code{condDist} conditional distributions from such objects. A + \code{simulate} method exists for drawn samples from multivariate + normals. + + The continuous (data in \code{obs}), discrete (intervals in \code{lower} + and \code{upper}), and mixed continuous-discrete log-likelihood is + implemented in \code{logLik}. The corresponding gradients with respect + to all model parameters and with respect to the data arguments + is available from \code{lLgrad}. + + Rationals and examples are given in Chapter 7 of the package vignette + linked to below. +} +\value{ + \code{mvnorm}, \code{margDist}, and \code{condDist} return objects + of class \code{mvnorm}. \code{logLik} returns the log-likelihood + and \code{lLgrad} a list with gradients. +} +\seealso{\code{vignette("lmvnorm_src", package = "mvtnorm")}} +\keyword{distribution} diff --git a/man/ltMatrices.Rd b/man/ltMatrices.Rd index d37346b..823d444 100644 --- a/man/ltMatrices.Rd +++ b/man/ltMatrices.Rd @@ -1,7 +1,6 @@ \name{ltMatrices} \alias{ltMatrices} \alias{syMatrices} -\alias{as.syMatrices} \alias{Tcrossprod} \alias{Crossprod} \alias{diagonals} @@ -19,9 +18,23 @@ \alias{diagonals<-.ltMatrices} \alias{diagonals<-.syMatrices} \alias{diagonals.integer} +\alias{is.ltMatrices} +\alias{is.syMatrices} +\alias{as.ltMatrices} +\alias{as.ltMatrices.ltMatrices} +\alias{as.ltMatrices.syMatrices} +\alias{as.syMatrices} +\alias{is.chol} +\alias{is.invchol} +\alias{as.chol} +\alias{as.invchol} \alias{Lower_tri} \alias{chol.syMatrices} +\alias{aperm.chol} +\alias{aperm.invchol} \alias{aperm.ltMatrices} +\alias{aperm.syMatrices} +\alias{deperma} \alias{adddiag} \alias{chol2cov} \alias{invchol2chol} @@ -47,7 +60,6 @@ \usage{ ltMatrices(object, diag = FALSE, byrow = FALSE, names = TRUE) syMatrices(object, diag = FALSE, byrow = FALSE, names = TRUE) -as.syMatrices(object) \S3method{as.array}{ltMatrices}(x, symmetric = FALSE, \dots) \S3method{as.array}{syMatrices}(x, \dots) \S3method{diagonals}{ltMatrices}(x, \dots) @@ -59,13 +71,28 @@ diagonals(x) <- value \S3method{diagonals}{syMatrices}(x) <- value \S3method{solve}{ltMatrices}(a, b, transpose = FALSE, \dots) \S3method{chol}{syMatrices}(x, \dots) -\S3method{aperm}{ltMatrices}(a, perm, is_chol = FALSE, \dots) +\S3method{aperm}{chol}(a, perm, \dots) +\S3method{aperm}{invchol}(a, perm, \dots) +\S3method{aperm}{ltMatrices}(a, perm, \dots) +\S3method{aperm}{syMatrices}(a, perm, \dots) +deperma(chol = solve(invchol), permuted_chol = solve(permuted_invchol), + invchol, permuted_invchol, perm, score_schol) \S3method{Mult}{ltMatrices}(x, y, transpose = FALSE, \dots) \S3method{Mult}{syMatrices}(x, y, \dots) Tcrossprod(x, diag_only = FALSE) Crossprod(x, diag_only = FALSE) logdet(x) Lower_tri(x, diag = FALSE, byrow = attr(x, "byrow")) +is.ltMatrices(x) +is.syMatrices(x) +as.ltMatrices(x) +\S3method{as.ltMatrices}{ltMatrices}(x) +\S3method{as.ltMatrices}{syMatrices}(x) +as.syMatrices(x) +is.chol(x) +is.invchol(x) +as.chol(x) +as.invchol(x) chol2cov(x) invchol2chol(x) chol2invchol(x) @@ -81,6 +108,7 @@ invchol2pc(x) vectrick(C, S, A, transpose = c(TRUE, TRUE)) standardize(chol, invchol) destandardize(chol = solve(invchol), invchol, score_schol) +as.ltMatrices(x) } \arguments{ \item{object}{a \code{matrix} representing the lower triagular elements of @@ -103,16 +131,13 @@ destandardize(chol = solve(invchol), invchol, score_schol) \item{diag_only}{logical, compute diagonal elements of crossproduct only if \code{TRUE}. } - \item{x,chol,invchol}{object of class \code{ltMatrices} or \code{syMatrices} (for \code{chol}). + \item{x,chol,invchol,permuted_chol,permuted_invchol}{object of class \code{ltMatrices} or \code{syMatrices} (for \code{chol}). } \item{value}{a matrix of diagonal elements to be assigned (of dimension \eqn{J \times N}). } \item{a}{object of class \code{ltMatrices}. } \item{perm}{a permutation of the covariance matrix corresponding to \code{a}. -} - \item{is_chol}{a logical indicating if \code{a} is the Cholesky of the -covariance (\code{chol = TRUE}) of the precision matrix. } \item{D}{a matrix (of dimension \eqn{J \times N}) of diagonal elements to be multiplied with. } diff --git a/src/lpmvnorm.c b/src/lpmvnorm.c index 0567711..9aeb6a0 100644 --- a/src/lpmvnorm.c +++ b/src/lpmvnorm.c @@ -280,7 +280,6 @@ SEXP R_slpmvnorm(SEXP a, SEXP b, SEXP C, SEXP center, SEXP N, SEXP J, SEXP W, double intsum; int p, idx; - /* dimensions */ int iM = INTEGER(M)[0]; @@ -326,7 +325,6 @@ SEXP R_slpmvnorm(SEXP a, SEXP b, SEXP C, SEXP center, SEXP N, SEXP J, SEXP W, error("incorrect dimensions of center"); } - int start, j, k; double tmp, e, d, f, emd, x, x0, y[(iJ > 1 ? iJ - 1 : 1)]; @@ -415,7 +413,6 @@ SEXP R_slpmvnorm(SEXP a, SEXP b, SEXP C, SEXP center, SEXP N, SEXP J, SEXP W, dW = REAL(W); for (int m = 0; m < iM; m++) { - /* init score loop */ /* init logLik loop */ @@ -624,7 +621,6 @@ SEXP R_slpmvnorm(SEXP a, SEXP b, SEXP C, SEXP center, SEXP N, SEXP J, SEXP W, dans[idx + 2 * iJ] += fp_u[j]; } - if (W != R_NilValue) dW += iJ - 1; } @@ -636,7 +632,6 @@ SEXP R_slpmvnorm(SEXP a, SEXP b, SEXP C, SEXP center, SEXP N, SEXP J, SEXP W, dC += p; if (LENGTH(center)) dcenter += iJ; - dans += Jp + 1 + 3 * iJ; } diff --git a/src/ltMatrices.c b/src/ltMatrices.c index d4a75ea..8a3499d 100644 --- a/src/ltMatrices.c +++ b/src/ltMatrices.c @@ -70,7 +70,7 @@ SEXP R_ltMatrices_solve (SEXP C, SEXP y, SEXP N, SEXP J, SEXP diag, SEXP transpo SEXP ans; double *dans, *dy; - int i, j, info, ONE = 1; + int i, ONE = 1; /* RC input */ @@ -99,7 +99,7 @@ SEXP R_ltMatrices_solve (SEXP C, SEXP y, SEXP N, SEXP J, SEXP diag, SEXP transpo /* lapack options */ - char di, lo = 'L', tr = 'N'; + char di, lo = 'L'; if (Rdiag) { /* non-unit diagonal elements */ di = 'N'; @@ -108,7 +108,9 @@ SEXP R_ltMatrices_solve (SEXP C, SEXP y, SEXP N, SEXP J, SEXP diag, SEXP transpo ignored in the computations */ di = 'U'; } + + char tr = 'N'; /* t(C) instead of C */ Rboolean Rtranspose = asLogical(transpose); if (Rtranspose) { @@ -118,7 +120,6 @@ SEXP R_ltMatrices_solve (SEXP C, SEXP y, SEXP N, SEXP J, SEXP diag, SEXP transpo /* C */ tr = 'N'; } - dy = REAL(y); PROTECT(ans = allocMatrix(REALSXP, iJ, iN)); @@ -145,7 +146,7 @@ SEXP R_ltMatrices_solve_C (SEXP C, SEXP N, SEXP J, SEXP diag, SEXP transpose) SEXP ans; double *dans; - int i, j, info, jj, idx, ONE = 1; + int i, info; /* RC input */ @@ -162,19 +163,9 @@ SEXP R_ltMatrices_solve_C (SEXP C, SEXP N, SEXP J, SEXP diag, SEXP transpose) /* diagonal elements are always present */ if (!Rdiag) len += iJ; - /* C length */ - - int p; - if (LENGTH(C) == len) - /* C is constant for i = 1, ..., N */ - p = 0; - else - /* C contains C_1, ...., C_N */ - p = len; - /* lapack options */ - char di, lo = 'L', tr = 'N'; + char di, lo = 'L'; if (Rdiag) { /* non-unit diagonal elements */ di = 'N'; @@ -183,16 +174,6 @@ SEXP R_ltMatrices_solve_C (SEXP C, SEXP N, SEXP J, SEXP diag, SEXP transpose) ignored in the computations */ di = 'U'; } - - /* t(C) instead of C */ - Rboolean Rtranspose = asLogical(transpose); - if (Rtranspose) { - /* t(C) */ - tr = 'T'; - } else { - /* C */ - tr = 'N'; - } PROTECT(ans = allocMatrix(REALSXP, len, iN)); diff --git a/tests/regtest-aperm.R b/tests/regtest-aperm.R new file mode 100644 index 0000000..9080398 --- /dev/null +++ b/tests/regtest-aperm.R @@ -0,0 +1,225 @@ + +library("mvtnorm") +library("numDeriv") + +options(digits = 3) +tol <- 1e-1 + +set.seed(29) + +EVAL <- function(...) {} + +if (require("numDeriv", quietly = TRUE)) + EVAL <- eval + +chk <- function(...) stopifnot(isTRUE(all.equal(..., check.attributes = FALSE, tol = sqrt(sqrt(.Machine$double.eps))))) + +thischeck <- expression({ +J <- 5 +p <- sample(1:J) +if (isTRUE(all.equal(p, 1:J))) + warning("Checks for id permutation meaningless") +P <- matrix(0, nrow = J, ncol = J) +P[cbind(1:J, p)] <- 1 + +L <- as.invchol(ltMatrices(1 + runif(J * (J + 1) / 2), diag = TRUE, byrow = BYROW)) +mL <- as.array(L)[,,1] +S <- invchol2cov(L) +mS <- as.array(S)[,,1] +mSp <- mS[p,p] + +chk(P %*% mS %*% t(P), mSp) + +O <- invchol2pre(L) +mO <- as.array(O)[,,1] +chk(solve(P %*% mO %*% t(P)), mSp) +chk(solve(P %*% t(mL) %*% mL %*% t(P)), mSp) + +C <- invchol2chol(L) +mC <- as.array(C)[,,1] +chk(P %*% mC %*% t(mC) %*% t(P), mSp) + +Ct <- t(chol(mS[p,p])) +chk(Ct %*% t(Ct), mSp) + +chk(as.array(invchol2cov(aperm(L, perm = p)))[,,1], mSp) +chk(as.array(chol2cov(aperm(C, perm = p)))[,,1], mSp) + +N <- 10000 +obs <- matrix(rnorm(J * N), ncol = N) +obs <- Mult(C, obs) + +ll1 <- ldmvnorm(obs = obs, chol = C) +ll2 <- ldmvnorm(obs = obs[p,], chol = aperm(C, perm = p)) +ll3 <- ldmvnorm(obs = obs, invchol = L) +ll4 <- ldmvnorm(obs = obs[p,], invchol = aperm(L, perm = p)) +chk(ll1, ll2) +chk(ll1, ll3) +chk(ll1, ll4) + +### C +### diag = TRUE w/o stand +ll <- function(x) { + C <- as.chol(ltMatrices(x, diag = TRUE, byrow = BYROW)) + Ct <- aperm(C, perm = p) + -ldmvnorm(obs = obs[p,], chol = Ct) +} + +s <- function(x) { + C <- as.chol(ltMatrices(x, diag = TRUE, byrow = BYROW)) + Ct <- aperm(C, perm = p) + sC <- sldmvnorm(obs = obs[p,], chol = Ct)$chol + ret <- deperma(chol = C, permuted_chol = Ct, perm = p, score_schol = sC) + -rowSums(Lower_tri(ret, diag = TRUE)) +} + +g1 <- grad(ll, c(C)) +s1 <- s(c(C)) +chk(g1, s1) + +op1 <- optim(c(C), fn = ll, gr = s, method = "L-BFGS-B") +max(abs(ltMatrices(op1$par, diag = TRUE, byrow = BYROW) - C)) + +### check against unpermuted (expect same results) +ll <- function(x) { + C <- ltMatrices(x, diag = TRUE, byrow = BYROW) + -ldmvnorm(obs = obs, chol = C) +} + +s <- function(x) { + C <- ltMatrices(x, diag = TRUE, byrow = BYROW) + ret <- sldmvnorm(obs = obs, chol = C)$chol + -rowSums(Lower_tri(ret, diag = TRUE)) +} + +op2 <- optim(c(C), fn = ll, gr = s, method = "L-BFGS-B") +chk(max(abs(ltMatrices(op2$par, diag = TRUE, byrow = BYROW) - C)) < tol, TRUE) + +chk(op1, op2) + +### diag = FALSE +Cd <- ltMatrices(runif(J * (J - 1) / 2), byrow = BYROW) + +### w/ standardisation (1. stand, 2. perm) +ll <- function(x) { + C <- as.chol(ltMatrices(x, diag = FALSE, byrow = BYROW)) + Cs <- standardize(chol = C) + Ct <- aperm(Cs, perm = p) + -ldmvnorm(obs = obs[p,], chol = Ct) +} + +s <- function(x) { + C <- ltMatrices(x, diag = FALSE, byrow = BYROW) + Cs <- standardize(chol = C) + Ct <- aperm(Cs, perm = p) + sC <- sldmvnorm(obs = obs[p,], chol = Ct)$chol + ret <- deperma(chol = Cs, permuted_chol = Ct, perm = p, score_schol = sC) + ret <- destandardize(chol = C, score_schol = ret) + -rowSums(Lower_tri(ret, diag = FALSE)) +} + +chk(grad(ll, c(Cd)), s(c(Cd))) + +### w/o standardisation +ll <- function(x) { + C <- as.chol(ltMatrices(x, diag = FALSE, byrow = BYROW)) + Ct <- aperm(C, perm = p) + -ldmvnorm(obs = obs[p,], chol = Ct) +} + +s <- function(x) { + C <- as.chol(ltMatrices(x, diag = FALSE, byrow = BYROW)) + diagonals(C) <- 1 ### deperma expects diagonals + Ct <- aperm(as.chol(C), perm = p) + sC <- sldmvnorm(obs = obs[p,], chol = Ct)$chol + ret <- deperma(chol = C, permuted_chol = Ct, perm = p, score_schol = sC) + -rowSums(Lower_tri(ret, diag = FALSE)) +} + +chk(grad(ll, c(Cd)), s(c(Cd))) + +### L +### diag = TRUE w/o stand +ll <- function(x) { + C <- as.invchol(ltMatrices(x, diag = TRUE, byrow = BYROW)) + Ct <- aperm(C, perm = p) + -ldmvnorm(obs = obs[p,], invchol = Ct) +} + +s <- function(x) { + C <- as.invchol(ltMatrices(x, diag = TRUE, byrow = BYROW)) + Ct <- aperm(C, perm = p) + sC <- sldmvnorm(obs = obs[p,], invchol = Ct)$invchol + ret <- deperma(invchol = C, permuted_invchol = Ct, perm = p, score_schol = -vectrick(Ct, sC)) + -rowSums(Lower_tri(ret, diag = TRUE)) +} + +g2 <- grad(ll, c(L)) +chk(g2, s(c(L))) +chk(g2, c(Lower_tri(-vectrick(C, ltMatrices(g1, byrow = BYROW, diag = TRUE)), diag = TRUE))) + +op3 <- optim(c(L), fn = ll, gr = s, method = "L-BFGS-B") +chk(max(abs(ltMatrices(op3$par, diag = TRUE, byrow = BYROW) - L)) < tol, TRUE) + +### check against unpermuted (expect same results) +ll <- function(x) { + C <- ltMatrices(x, diag = TRUE, byrow = BYROW) + -ldmvnorm(obs = obs, invchol = C) +} + +s <- function(x) { + C <- ltMatrices(x, diag = TRUE, byrow = BYROW) + ret <- sldmvnorm(obs = obs, invchol = C)$invchol + -rowSums(Lower_tri(ret, diag = TRUE)) +} + +op4 <- optim(c(L), fn = ll, gr = s, method = "L-BFGS-B") +chk(max(abs(ltMatrices(op4$par, diag = TRUE, byrow = BYROW) - L)) < tol, TRUE) + +### diag = FALSE +Ld <- ltMatrices(runif(J * (J - 1) / 2), byrow = BYROW) + +### w/ standardisation (1. stand, 2. perm) +ll <- function(x) { + C <- as.invchol(ltMatrices(x, diag = FALSE, byrow = BYROW)) + Cs <- standardize(invchol = C) + Ct <- aperm(Cs, perm = p) + -ldmvnorm(obs = obs[p,], invchol = Ct) +} + +s <- function(x) { + C <- as.invchol(ltMatrices(x, diag = FALSE, byrow = BYROW)) + Cs <- standardize(invchol = C) + Ct <- aperm(Cs, perm = p) + sC <- sldmvnorm(obs = obs[p,], invchol = Ct)$invchol + ret <- deperma(invchol = Cs, permuted_invchol = Ct, perm = p, score_schol = -vectrick(Ct, sC)) + ret <- destandardize(invchol = C, score_schol = -vectrick(Cs, ret)) + -rowSums(Lower_tri(ret, diag = FALSE)) +} + +chk(grad(ll, c(Ld)), s(c(Ld))) + +### w/o standardisation +ll <- function(x) { + C <- as.invchol(ltMatrices(x, diag = FALSE, byrow = BYROW)) + Ct <- aperm(C, perm = p) + -ldmvnorm(obs = obs[p,], invchol = Ct) +} + +s <- function(x) { + C <- as.invchol(ltMatrices(x, diag = FALSE, byrow = BYROW)) + diagonals(C) <- 1 ### deperma expects diagonals + Ct <- aperm(as.invchol(C), perm = p) + sC <- sldmvnorm(obs = obs[p,], invchol = Ct)$invchol + ret <- deperma(invchol = C, permuted_invchol = Ct, perm = p, score_schol = -vectrick(Ct, sC)) + -rowSums(Lower_tri(ret, diag = FALSE)) +} + +chk(grad(ll, c(Ld)), s(c(Ld))) +}) + +BYROW <- FALSE +EVAL(thischeck) + +BYROW <- TRUE +EVAL(thischeck) diff --git a/tests/regtest_mvnorm.R b/tests/regtest_mvnorm.R new file mode 100644 index 0000000..fdd8dd1 --- /dev/null +++ b/tests/regtest_mvnorm.R @@ -0,0 +1,211 @@ + +library("mvtnorm") + +options(digits = 5) +tol <- sqrt(sqrt(.Machine$double.eps)) + +set.seed(29078) + +EVAL <- function(...) {} + +if (require("numDeriv", quietly = TRUE)) + EVAL <- eval + +chk <- function(...) stopifnot(isTRUE(all.equal(..., check.attributes = FALSE, + tol = tol))) + +x <- mvnorm() +J <- 3 +M <- diag(1:J) +rownames(M) <- colnames(M) <- LETTERS[1:J] +(x <- mvnorm(mean = runif(J), chol = M)) +margDist(x, which = 2:J) +margDist(x, which = 2:J) +condDist(x, which_given = 1, given = matrix(1)) + +logLik(x, obs = M[-1,-1]) +logLik(margDist(x, which = 2:J), obs = M[-1,-1]) + + +thischeck <- expression({ + +#set.seed(29) + +l <- matrix(pl <- runif(J * (J - 1) / 2 * Ns), + ncol = Ns) +colnames(l) <- paste0("i", 1:Ns) +L <- ltMatrices(l, byrow = BYROW, names = LETTERS[1:J]) +m <- matrix(pm <- rnorm(J * Nm), ncol = Nm) +rownames(m) <- LETTERS[1:J] +colnames(m) <- paste0("i", 1:Nm) +if (CHOL) { + x <- mvnorm(mean = m, chol = L) +} else { + x <- mvnorm(mean = m, invchol = L) +} +obs <- simulate(x, nsim = N, standardize = TRUE) + +tfun <- function(parm, perm = LETTERS[1:J], FUN = "logLik", chol = TRUE, ...) { + args <- list(...) + p1 <- parm[1:length(pm)] + p2 <- parm[length(pm) + 1:length(pl)] + p3 <- parm[-(1:(length(pm) + length(pl)))] + p2 <- matrix(p2, ncol = Ns) + L <- ltMatrices(p2, names = LETTERS[1:J]) + L <- ltMatrices(p2, byrow = BYROW, names = LETTERS[1:J]) + m <- matrix(p1, ncol = Nm) + rownames(m) <- LETTERS[1:J] + obs <- matrix(p3, ncol = N) + rownames(obs) <- LETTERS[1:J] + if (chol) { + x <- mvnorm(mean = m, invchol = L) + } else { + x <- mvnorm(mean = m, chol = L) + } + args$object <- x + args$obs <- obs[perm,,drop = FALSE] + do.call(FUN, args) +} + +ll <- tfun +sc <- function(...) tfun(..., FUN = "lLgrad") + +l1 <- logLik(x, obs) +#lLgrad(x, obs) + +prm <- c(pm, pl, obs) +ll(prm) +s <- sc(prm) +sa <- c(if (Nm > 1) s$mean else rowSums(s$mean), + if (Ns > 1) Lower_tri(s$scale) else rowSums(Lower_tri(s$scale)), + s$obs) +sn <- grad(ll, prm) +chk(sa, sn) + +l2 <- logLik(x, obs, standardize = TRUE) +# lLgrad(x, obs, standardize = TRUE) + +ll(prm, standardize = TRUE) +s <- sc(prm, standardize = TRUE) +sa <- c(if (Nm > 1) s$mean else rowSums(s$mean), + if (Ns > 1) Lower_tri(s$scale) else rowSums(Lower_tri(s$scale)), + s$obs) +sn <- grad(ll, prm, standardize = TRUE) +chk(sa, sn) + +l1p <- logLik(x, obs = obs[perm <- sample(rownames(obs)),,drop = FALSE]) +#lLgrad(x, obs = obs[perm,,drop = FALSE]) + +chk(l1, l1p) + +ll(prm, perm = perm) +s <- sc(prm, perm = perm) +sa <- c(if (Nm > 1) s$mean else rowSums(s$mean), + if (Ns > 1) Lower_tri(s$scale) else rowSums(Lower_tri(s$scale)), + s$obs[LETTERS[1:J],]) +sn <- grad(ll, prm, perm = perm) +chk(sa, sn) + +l2p <- logLik(x, obs = obs[perm,,drop = FALSE], standardize = TRUE) +# lLgrad(x, obs = obs[perm,,drop = FALSE], standardize = TRUE) + +chk(l2, l2p) + +ll(prm, perm = perm, standardize = TRUE) +s <- sc(prm, perm = perm, standardize = TRUE) +sa <- c(if (Nm > 1) s$mean else rowSums(s$mean), + if (Ns > 1) Lower_tri(s$scale) else rowSums(Lower_tri(s$scale)), + s$obs[LETTERS[1:J],]) +sn <- grad(ll, prm, perm = perm, standardize = TRUE) +chk(sa, sn) + +logLik(x, obs = obs[perm[-1],,drop = FALSE]) +# lLgrad(x, obs = obs[perm,,drop = FALSE]) + +ll(prm, perm = perm[-1]) +s <- sc(prm, perm = perm[-1]) +s$obs <- rbind(s$obs, 0) +rownames(s$obs)[nrow(s$obs)] <- perm[1] +sa <- c(if (Nm > 1) s$mean else rowSums(s$mean), + if (Ns > 1) Lower_tri(s$scale) else rowSums(Lower_tri(s$scale)), + s$obs[LETTERS[1:J],]) +sn <- grad(ll, prm, perm = perm[-1]) + +logLik(x, obs = obs[perm[-1],,drop = FALSE], standardize = TRUE) +# lLgrad(x, obs = obs[perm[-1],,drop = FALSE], standardize = TRUE) + +ll(prm, perm = perm[-1], standardize = TRUE) +s <- sc(prm, perm = perm[-1], standardize = TRUE) +s$obs <- rbind(s$obs, 0) +rownames(s$obs)[nrow(s$obs)] <- perm[1] +sa <- c(if (Nm > 1) s$mean else rowSums(s$mean), + if (Ns > 1) Lower_tri(s$scale) else rowSums(Lower_tri(s$scale)), + s$obs[LETTERS[1:J],]) +sn <- grad(ll, prm, perm = perm[-1], standardize = TRUE) +chk(sa, sn) +}) + +J <- 4 +Ns <- 1 +Nm <- 1 +N <- 3 #max(Ns, Nm) +BYROW <- FALSE +CHOL <- FALSE +EVAL(thischeck) + +J <- 4 +Ns <- 3 +Nm <- 3 +N <- max(Ns, Nm) +BYROW <- TRUE +CHOL <- TRUE +EVAL(thischeck) + +J <- 4 +Ns <- 1 +Nm <- 3 +N <- max(Ns, Nm) +BYROW <- TRUE +CHOL <- TRUE +EVAL(thischeck) + +J <- 4 +Ns <- 3 +Nm <- 1 +N <- max(Ns, Nm) +BYROW <- TRUE +CHOL <- TRUE +EVAL(thischeck) + +J <- 4 +Ns <- 3 +Nm <- 1 +N <- max(Ns, Nm) +BYROW <- TRUE +CHOL <- FALSE +EVAL(thischeck) + +J <- 4 +Ns <- 3 +Nm <- 3 +N <- max(Ns, Nm) +BYROW <- FALSE +CHOL <- TRUE +EVAL(thischeck) + +J <- 4 +Ns <- 3 +Nm <- 3 +N <- max(Ns, Nm) +BYROW <- FALSE +CHOL <- FALSE +EVAL(thischeck) + +J <- 4 +Ns <- 3 +Nm <- 3 +N <- max(Ns, Nm) +BYROW <- FALSE +CHOL <- FALSE +EVAL(thischeck) + diff --git a/vignettes/litdb.bib b/vignettes/litdb.bib index cd2d668..5164aea 100644 --- a/vignettes/litdb.bib +++ b/vignettes/litdb.bib @@ -80,3 +80,14 @@ @article{blood-and-:1987 pages = {H47--H53}, doi = {10.1152/ajpheart.1987.252.1.H47} } + +@article{Barrathh_Boyd_2023, + author = {Shane Barratt and Stephen Boyd}, + year = 2023, + title = {Covariance Prediction via Convex Optimization}, + journal = {Optimization and Engineering}, + pages = {2045--2078}, + volume = 24, + number = 3, + doi = {10.1007/s11081-022-09765-w} +} diff --git a/vignettes/lmvnorm_src.Rnw b/vignettes/lmvnorm_src.Rnw index 3dc0678..969244d 100644 --- a/vignettes/lmvnorm_src.Rnw +++ b/vignettes/lmvnorm_src.Rnw @@ -22,7 +22,7 @@ %% packages \usepackage{amsfonts,amstext,amsmath,amssymb,amsthm,nicefrac} -%\VignetteIndexEntry{Multivariate Normal Log-likelihoods} +%\VignetteIndexEntry{Multivariate Normal Log-likelihoods in the mvtnorm Package} %\VignetteDepends{mvtnorm,qrng,numDeriv} %\VignetteKeywords{multivariate normal distribution} %\VignettePackage{mvtnorm} @@ -122,7 +122,7 @@ version <- packageDescription("mvtnorm")$Version \footnote{Please cite this document as: Torsten Hothorn (\Sexpr{year}) Multivariate Normal Log-likelihoods in the \pkg{mvtnorm} Package. \textsf{R} package vignette version \Sexpr{version}, -URL \url{https://CRAN.R-project.org/package=mvtnorm}.} +URL \href{https://doi.org/10.32614/CRAN.package.mvtnorm}{DOI:10.32614/CRAN.package.mvtnorm}.} } \begin{document} @@ -162,7 +162,7 @@ partially, of \cite{Genz_Bretz_2002}, for the evaluation of $N$ multivariate $\J$-dimensional normal probabilities \begin{eqnarray} \label{pmvnorm} p_i(\mC_i \mid \avec_i, \bvec_i) = \Prob(\avec_i < \rY_i \le \bvec_i \mid \mC_i ) - = (2 \pi)^{-\frac{\J}{2}} \text{det}(\mC_i)^{-\frac{1}{2}} + = (2 \pi)^{-\frac{\J}{2}} \text{det}(\mC_i)^{-1} \int_{\avec_i}^{\bvec_i} \exp\left(-\frac{1}{2} \yvec^\top \mC_i^{-\top} \mC_i^{-1} \yvec\right) \, d \yvec \end{eqnarray} where $\avec_i = (a^{(i)}_1, \dots, a^{(i)}_\J)^\top \in \R^\J$ and @@ -181,8 +181,9 @@ In other applications, the Cholesky factor might also depend on $i$ in some structured way. Function \code{pmvnorm} in package \code{mvtnorm} computes $p_i$ based on -the covariance matrix $\mC_i \mC_i^\top$. However, the Cholesky factor $\mC_i$ is -computed in \proglang{FORTRAN}. Function \code{pmvnorm} is not vectorised +the covariance matrix $\mC_i \mC_i^\top$. However, the Cholesky factor $\mC_i$ +of the given covariance matrix is computed in \proglang{FORTRAN} first each +time this function is called. Function \code{pmvnorm} is not vectorised over $i = 1, \dots, N$ and thus separate calls to this function are necessary in order to compute likelihood contributions. @@ -202,7 +203,8 @@ developed here to implement the log-likelihood and score function for situations where some variables have been observed exactly and others only in form of interval-censoring in Chapter~\ref{cdl} and for nonparametric maximum-likelihood estimation in unstructured Gaussian copulae in -Chapter~\ref{copula}. +Chapter~\ref{copula}. An attempt to provide useRs with a simple and +(hopefully) bullet proof interface is documented in Chapter~\ref{inter}. \chapter{Lower Triangular Matrices} \label{ltMatrices} @@ -212,40 +214,36 @@ Chapter~\ref{copula}. \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape R Header}\nobreak\ {\footnotesize \NWlink{nuweb104}{104}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape R Header}\nobreak\ {\footnotesize \NWlink{nuweb131}{131}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\hbox{$\langle\,${\itshape ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb6a}{6a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\hbox{$\langle\,${\itshape syMatrices}\nobreak\ {\footnotesize \NWlink{nuweb6b}{6b}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\hbox{$\langle\,${\itshape dim ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb6c}{6c}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\hbox{$\langle\,${\itshape dimnames ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb7a}{7a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\hbox{$\langle\,${\itshape names ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb7b}{7b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape print ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb10}{10}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape reorder ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb11}{11}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape subset ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb13}{13}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape lower triangular elements}\nobreak\ {\footnotesize \NWlink{nuweb15}{15}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape diagonals ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb17}{17}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape diagonal matrix}\nobreak\ {\footnotesize \NWlink{nuweb20}{20}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape mult ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb21a}{21a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape mult syMatrices}\nobreak\ {\footnotesize \NWlink{nuweb25}{25}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape solve ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb29}{29}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape logdet ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb31b}{31b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape tcrossprod ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb35}{35}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape crossprod ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb36}{36}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape chol syMatrices}\nobreak\ {\footnotesize \NWlink{nuweb37}{37}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape add diagonal elements}\nobreak\ {\footnotesize \NWlink{nuweb18}{18}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape assign diagonal elements}\nobreak\ {\footnotesize \NWlink{nuweb19}{19}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape kronecker vec trick}\nobreak\ {\footnotesize \NWlink{nuweb42}{42}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape convenience functions}\nobreak\ {\footnotesize \NWlink{nuweb45}{45}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape aperm}\nobreak\ {\footnotesize \NWlink{nuweb47}{47}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape marginal}\nobreak\ {\footnotesize \NWlink{nuweb48b}{48b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape conditional}\nobreak\ {\footnotesize \NWlink{nuweb50b}{50b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape check obs}\nobreak\ {\footnotesize \NWlink{nuweb52b}{52b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape ldmvnorm}\nobreak\ {\footnotesize \NWlink{nuweb52a}{52a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape colSumsdnorm ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb53b}{53b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape sldmvnorm}\nobreak\ {\footnotesize \NWlink{nuweb56}{56}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape ldpmvnorm}\nobreak\ {\footnotesize \NWlink{nuweb94}{94}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape sldpmvnorm}\nobreak\ {\footnotesize \NWlink{nuweb96}{96}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape standardize}\nobreak\ {\footnotesize \NWlink{nuweb98}{98}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape destandardize}\nobreak\ {\footnotesize \NWlink{nuweb100}{100}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape is.ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb7c}{7c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape as.ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb115b}{115b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape print ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb11}{11}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape reorder ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb12}{12}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape subset ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb14}{14}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape lower triangular elements}\nobreak\ {\footnotesize \NWlink{nuweb17}{17}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape diagonals ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb19}{19}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape diagonal matrix}\nobreak\ {\footnotesize \NWlink{nuweb22}{22}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape mult ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb23a}{23a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape mult syMatrices}\nobreak\ {\footnotesize \NWlink{nuweb27}{27}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape solve ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb31}{31}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape logdet ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb33b}{33b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape tcrossprod ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb37}{37}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape crossprod ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb38}{38}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape chol syMatrices}\nobreak\ {\footnotesize \NWlink{nuweb39}{39}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape add diagonal elements}\nobreak\ {\footnotesize \NWlink{nuweb20}{20}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape assign diagonal elements}\nobreak\ {\footnotesize \NWlink{nuweb21}{21}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape kronecker vec trick}\nobreak\ {\footnotesize \NWlink{nuweb44}{44}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape convenience functions}\nobreak\ {\footnotesize \NWlink{nuweb48}{48}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape aperm}\nobreak\ {\footnotesize \NWlink{nuweb51a}{51a}, \ldots\ }$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape marginal}\nobreak\ {\footnotesize \NWlink{nuweb52b}{52b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape conditional}\nobreak\ {\footnotesize \NWlink{nuweb55}{55}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape check obs}\nobreak\ {\footnotesize \NWlink{nuweb57b}{57b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape colSumsdnorm ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb58b}{58b}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@{\NWsep} \end{list} \vspace{-1.5ex} @@ -262,7 +260,7 @@ Chapter~\ref{copula}. \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape C Header}\nobreak\ {\footnotesize \NWlink{nuweb105}{105}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape C Header}\nobreak\ {\footnotesize \NWlink{nuweb132}{132}}$\,\rangle$}\verb@@\\ \mbox{}\verb@#ifndef USE_FC_LEN_T@\\ \mbox{}\verb@# define USE_FC_LEN_T@\\ \mbox{}\verb@#endif@\\ @@ -275,15 +273,15 @@ Chapter~\ref{copula}. \mbox{}\verb@#include @\\ \mbox{}\verb@#include @\\ \mbox{}\verb@#include @\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape colSumsdnorm}\nobreak\ {\footnotesize \NWlink{nuweb53a}{53a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape solve}\nobreak\ {\footnotesize \NWlink{nuweb27}{27}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape solve C}\nobreak\ {\footnotesize \NWlink{nuweb28}{28}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape logdet}\nobreak\ {\footnotesize \NWlink{nuweb31a}{31a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape tcrossprod}\nobreak\ {\footnotesize \NWlink{nuweb34}{34}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape mult}\nobreak\ {\footnotesize \NWlink{nuweb22b}{22b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape mult transpose}\nobreak\ {\footnotesize \NWlink{nuweb24}{24}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape chol}\nobreak\ {\footnotesize \NWlink{nuweb38}{38}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape vec trick}\nobreak\ {\footnotesize \NWlink{nuweb40a}{40a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape colSumsdnorm}\nobreak\ {\footnotesize \NWlink{nuweb58a}{58a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape solve}\nobreak\ {\footnotesize \NWlink{nuweb29}{29}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape solve C}\nobreak\ {\footnotesize \NWlink{nuweb30}{30}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape logdet}\nobreak\ {\footnotesize \NWlink{nuweb33a}{33a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape tcrossprod}\nobreak\ {\footnotesize \NWlink{nuweb36}{36}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape mult}\nobreak\ {\footnotesize \NWlink{nuweb24b}{24b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape mult transpose}\nobreak\ {\footnotesize \NWlink{nuweb26}{26}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape chol}\nobreak\ {\footnotesize \NWlink{nuweb40}{40}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape vec trick}\nobreak\ {\footnotesize \NWlink{nuweb42a}{42a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@{\NWsep} \end{list} \vspace{-1.5ex} @@ -303,7 +301,7 @@ diagonal elements are one (that is, $c^{(i)}_{jj} \equiv 1, j = 1, \dots, \section{Multiple Lower Triangular Matrices} We can store $N$ such matrices in an $\J (\J + 1) / 2 \times N$ matrix -(\code{diag = TRUE}) or, for \code{diag = FALSE}, the $\J (\J +(\code{diag = TRUE}) or, for \code{diag = FALSE}, in an $\J (\J - 1) / 2 \times N$ matrix. Each vector might define the corresponding lower triangular matrix @@ -385,7 +383,9 @@ order on request (for later printing) \mbox{}\verb@ rownames(object) <- t(L)[upper.tri(L, diag = diag)]@\\ \mbox{}\verb@ else@\\ \mbox{}\verb@ rownames(object) <- L[lower.tri(L, diag = diag)]@\\ -\mbox{}\verb@}@\\ +\mbox{}\verb@} # else { ### add later@\\ +\mbox{}\verb@ # warning("ltMatrices objects should be properly named")@\\ +\mbox{}\verb@# }@\\ \mbox{}\verb@@{\NWsep} \end{list} \vspace{-1.5ex} @@ -407,8 +407,10 @@ change the storage form from row- to column-major or the other way round. \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ -\mbox{}\verb@if (inherits(object, "ltMatrices")) {@\\ +\mbox{}\verb@if (is.ltMatrices(object)) {@\\ +\mbox{}\verb@ cls <- class(object) ### keep inheriting classes@\\ \mbox{}\verb@ ret <- .reorder(object, byrow = byrow)@\\ +\mbox{}\verb@ class(ret) <- class(object)@\\ \mbox{}\verb@ return(ret)@\\ \mbox{}\verb@}@\\ \mbox{}\verb@@{\NWsep} @@ -459,7 +461,7 @@ possibly after some reordering / transposing \end{list} \end{minipage}\vspace{4ex} \end{flushleft} -For the sake of completeness, we also add a constructor for symmetric +For the sake of completeness, we also add a constructor for multiple symmetric matrices \begin{flushleft} \small @@ -468,13 +470,17 @@ multiple symmetric matrices \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ -\mbox{}\verb@as.syMatrices <- function(object) {@\\ -\mbox{}\verb@ stopifnot(inherits(object, "ltMatrices"))@\\ -\mbox{}\verb@ class(object)[1L] <- "syMatrices"@\\ -\mbox{}\verb@ return(object)@\\ +\mbox{}\verb@as.syMatrices <- function(x) {@\\ +\mbox{}\verb@ if (is.syMatrices(x))@\\ +\mbox{}\verb@ return(x)@\\ +\mbox{}\verb@ x <- as.ltMatrices(x) ### make sure "ltMatrices"@\\ +\mbox{}\verb@ ### is first class@\\ +\mbox{}\verb@ class(x)[1L] <- "syMatrices"@\\ +\mbox{}\verb@ return(x)@\\ \mbox{}\verb@}@\\ \mbox{}\verb@syMatrices <- function(object, diag = FALSE, byrow = FALSE, names = TRUE)@\\ -\mbox{}\verb@ as.syMatrices(ltMatrices(object = object, diag = diag, byrow = byrow, names = names))@\\ +\mbox{}\verb@ as.syMatrices(ltMatrices(object = object, diag = diag, byrow = byrow, @\\ +\mbox{}\verb@ names = names))@\\ \mbox{}\verb@@{\NWsep} \end{list} \vspace{-1.5ex} @@ -551,6 +557,45 @@ The names identifying rows and columns in each $\mC_i$ are \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} \item \NWtxtMacroRefIn\ \NWlink{nuweb2}{2}. +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +Finally, let's add two functions for checking the class and a function for +coersing classes inheriting from \code{ltMatrices} to the latter, the same +for \code{syMatrices}. Furthermode, \code{as.ltMatrices} coerces objects +inheriting from \code{syMatrices} or \code{ltMatrices} to class +\code{ltMatrices} (that is, \code{chol} or \code{invchol} is removed from +the class list, unlike a call to the constructor \code{ltMatrices}). A +\code{default} method is added in Chapter~\ref{inter}. + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap11}\raggedright\small +\NWtarget{nuweb7c}{} $\langle\,${\itshape is.ltMatrices}\nobreak\ {\footnotesize {7c}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@is.ltMatrices <- function(x) inherits(x, "ltMatrices")@\\ +\mbox{}\verb@is.syMatrices <- function(x) inherits(x, "syMatrices")@\\ +\mbox{}\verb@as.ltMatrices <- function(x) UseMethod("as.ltMatrices")@\\ +\mbox{}\verb@as.ltMatrices.syMatrices <- function(x) {@\\ +\mbox{}\verb@ cls <- class(x)@\\ +\mbox{}\verb@ class(x) <- cls[which(cls == "syMatrices"):length(cls)]@\\ +\mbox{}\verb@ class(x)[1L] <- "ltMatrices"@\\ +\mbox{}\verb@ return(x)@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@as.ltMatrices.ltMatrices <- function(x) {@\\ +\mbox{}\verb@ cls <- class(x)@\\ +\mbox{}\verb@ class(x) <- cls[which(cls == "ltMatrices"):length(cls)]@\\ +\mbox{}\verb@ return(x)@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb2}{2}. + \item{} \end{list} \end{minipage}\vspace{4ex} @@ -597,8 +642,8 @@ For pretty printing, we coerse objects of class \code{ltMatrices} to triangular matrix to by interpreted as a symmetric matrix. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap11}\raggedright\small -\NWtarget{nuweb9}{} $\langle\,${\itshape extract slots}\nobreak\ {\footnotesize {9}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap12}\raggedright\small +\NWtarget{nuweb10}{} $\langle\,${\itshape extract slots}\nobreak\ {\footnotesize {10}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -612,21 +657,21 @@ triangular matrix to by interpreted as a symmetric matrix. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb10}{10}\NWlink{nuweb11}{, 11}\NWlink{nuweb12}{, 12}\NWlink{nuweb15}{, 15}\NWlink{nuweb17}{, 17}\NWlink{nuweb19}{, 19}\NWlink{nuweb21a}{, 21a}\NWlink{nuweb25}{, 25}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb11}{11}\NWlink{nuweb12}{, 12}\NWlink{nuweb13}{, 13}\NWlink{nuweb17}{, 17}\NWlink{nuweb19}{, 19}\NWlink{nuweb21}{, 21}\NWlink{nuweb23a}{, 23a}\NWlink{nuweb27}{, 27}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap12}\raggedright\small -\NWtarget{nuweb10}{} $\langle\,${\itshape print ltMatrices}\nobreak\ {\footnotesize {10}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap13}\raggedright\small +\NWtarget{nuweb11}{} $\langle\,${\itshape print ltMatrices}\nobreak\ {\footnotesize {11}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@as.array.ltMatrices <- function(x, symmetric = FALSE, ...) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape extract slots}\nobreak\ {\footnotesize \NWlink{nuweb9}{9}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape extract slots}\nobreak\ {\footnotesize \NWlink{nuweb10}{10}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ x <- unclass(x)@\\ \mbox{}\verb@@\\ @@ -681,17 +726,17 @@ either column- or row-major order and this little helper function switches between the two forms \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap13}\raggedright\small -\NWtarget{nuweb11}{} $\langle\,${\itshape reorder ltMatrices}\nobreak\ {\footnotesize {11}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap14}\raggedright\small +\NWtarget{nuweb12}{} $\langle\,${\itshape reorder ltMatrices}\nobreak\ {\footnotesize {12}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@.reorder <- function(x, byrow = FALSE) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ stopifnot(inherits(x, "ltMatrices"))@\\ +\mbox{}\verb@ stopifnot(is.ltMatrices(x))@\\ \mbox{}\verb@ if (attr(x, "byrow") == byrow) return(x)@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape extract slots}\nobreak\ {\footnotesize \NWlink{nuweb9}{9}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape extract slots}\nobreak\ {\footnotesize \NWlink{nuweb10}{10}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ x <- unclass(x)@\\ \mbox{}\verb@@\\ @@ -748,8 +793,8 @@ We might want to select subsets of observations $i \in \{1, \dots, N\}$ or rows/columns $j \in \{1, \dots, \J\}$ of the corresponding matrices $\mC_i$. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap14}\raggedright\small -\NWtarget{nuweb12}{} $\langle\,${\itshape .subset ltMatrices}\nobreak\ {\footnotesize {12}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap15}\raggedright\small +\NWtarget{nuweb13}{} $\langle\,${\itshape .subset ltMatrices}\nobreak\ {\footnotesize {13}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -758,12 +803,17 @@ rows/columns $j \in \{1, \dots, \J\}$ of the corresponding matrices $\mC_i$. \mbox{}\verb@ if (drop) warning("argument drop is ignored")@\\ \mbox{}\verb@ if (missing(i) && missing(j)) return(x)@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape extract slots}\nobreak\ {\footnotesize \NWlink{nuweb9}{9}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape extract slots}\nobreak\ {\footnotesize \NWlink{nuweb10}{10}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ x <- unclass(x) @\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (!missing(j)) {@\\ \mbox{}\verb@@\\ +\mbox{}\verb@ if (is.character(j)) {@\\ +\mbox{}\verb@ stopifnot(all(j %in% dn[[2L]]))@\\ +\mbox{}\verb@ j <- match(j, dn[[2L]])@\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@@\\ \mbox{}\verb@ j <- (1:J)[j] ### get rid of negative indices@\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (length(j) == 1L && !diag) {@\\ @@ -800,22 +850,26 @@ rows/columns $j \in \{1, \dots, \J\}$ of the corresponding matrices $\mC_i$. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb13}{13}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb14}{14}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap15}\raggedright\small -\NWtarget{nuweb13}{} $\langle\,${\itshape subset ltMatrices}\nobreak\ {\footnotesize {13}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap16}\raggedright\small +\NWtarget{nuweb14}{} $\langle\,${\itshape subset ltMatrices}\nobreak\ {\footnotesize {14}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape .subset ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb12}{12}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape .subset ltMatrices}\nobreak\ {\footnotesize \NWlink{nuweb13}{13}}$\,\rangle$}\verb@@\\ \mbox{}\verb@### if j is not ordered, result is not a lower triangular matrix@\\ \mbox{}\verb@"[.ltMatrices" <- function(x, i, j, ..., drop = FALSE) {@\\ \mbox{}\verb@ if (!missing(j)) {@\\ +\mbox{}\verb@ if (is.character(j)) {@\\ +\mbox{}\verb@ stopifnot(all(j %in% dimnames(x)[[2L]]))@\\ +\mbox{}\verb@ j <- match(j, dimnames(x)[[2L]])@\\ +\mbox{}\verb@ }@\\ \mbox{}\verb@ if (all(j > 0)) {@\\ \mbox{}\verb@ if (any(diff(j) < 0)) stop("invalid subset argument j")@\\ \mbox{}\verb@ }@\\ @@ -825,7 +879,7 @@ rows/columns $j \in \{1, \dots, \J\}$ of the corresponding matrices $\mC_i$. \mbox{}\verb@}@\\ \mbox{}\verb@@\\ \mbox{}\verb@"[.syMatrices" <- function(x, i, j, ..., drop = FALSE) {@\\ -\mbox{}\verb@ class(x)[1L] <- "ltMatrices"@\\ +\mbox{}\verb@ x <- as.syMatrices(x)@\\ \mbox{}\verb@ ret <- .subset_ltMatrices(x = x, i = i, j = j, ..., drop = drop)@\\ \mbox{}\verb@ class(ret)[1L] <- "syMatrices"@\\ \mbox{}\verb@ ret@\\ @@ -845,109 +899,107 @@ We check if this works by first subsetting the \code{ltMatrices} object. Second, we coerse the object to an array and do the subset for the latter object. Both results must agree. -<>= +<>= ## subset -a <- as.array(ltMatrices(xn, byrow = FALSE)[1:2, 2:4]) -b <- as.array(ltMatrices(xn, byrow = FALSE))[2:4, 2:4, 1:2] +a <- as.array(ltMatrices(xn, byrow = FALSE, names = nm)[i, j]) +b <- as.array(ltMatrices(xn, byrow = FALSE, names = nm))[j, j, i] chk(a, b) -a <- as.array(ltMatrices(xn, byrow = TRUE)[1:2, 2:4]) -b <- as.array(ltMatrices(xn, byrow = TRUE))[2:4, 2:4, 1:2] +a <- as.array(ltMatrices(xn, byrow = TRUE, names = nm)[i, j]) +b <- as.array(ltMatrices(xn, byrow = TRUE, names = nm))[j, j, i] chk(a, b) -a <- as.array(ltMatrices(xd, byrow = FALSE, diag = TRUE)[1:2, 2:4]) -b <- as.array(ltMatrices(xd, byrow = FALSE, diag = TRUE))[2:4, 2:4, 1:2] +a <- as.array(ltMatrices(xd, byrow = FALSE, + diag = TRUE, names = nm)[i, j]) +b <- as.array(ltMatrices(xd, byrow = FALSE, + diag = TRUE, names = nm))[j, j, i] chk(a, b) -a <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE)[1:2, 2:4]) -b <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE))[2:4, 2:4, 1:2] +a <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE, + names = nm)[i, j]) +b <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE, + names = nm))[j, j, i] chk(a, b) @ -With a different subset +We start with both indices being positive integers -<>= -## subset -j <- c(1, 3, 5) -a <- as.array(ltMatrices(xn, byrow = FALSE)[1:2, j]) -b <- as.array(ltMatrices(xn, byrow = FALSE))[j, j, 1:2] -chk(a, b) - -a <- as.array(ltMatrices(xn, byrow = TRUE)[1:2, j]) -b <- as.array(ltMatrices(xn, byrow = TRUE))[j, j, 1:2] -chk(a, b) +<>= +i <- colnames(xn)[1:2] +j <- 2:4 +<> +@ -a <- as.array(ltMatrices(xd, byrow = FALSE, diag = TRUE)[1:2, j]) -b <- as.array(ltMatrices(xd, byrow = FALSE, diag = TRUE))[j, j, 1:2] -chk(a, b) +proceed with characters -a <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE)[1:2, j]) -b <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE))[j, j, 1:2] -chk(a, b) +<>= +i <- 1:2 +j <- nm[2:4] +<> @ -with negative subsets +a different subset <>= -## subset -j <- -c(1, 3, 5) -a <- as.array(ltMatrices(xn, byrow = FALSE)[1:2, j]) -b <- as.array(ltMatrices(xn, byrow = FALSE))[j, j, 1:2] -chk(a, b) +j <- c(1, 3, 5) +<> +@ -a <- as.array(ltMatrices(xn, byrow = TRUE)[1:2, j]) -b <- as.array(ltMatrices(xn, byrow = TRUE))[j, j, 1:2] -chk(a, b) +and characters again -a <- as.array(ltMatrices(xd, byrow = FALSE, diag = TRUE)[1:2, j]) -b <- as.array(ltMatrices(xd, byrow = FALSE, diag = TRUE))[j, j, 1:2] -chk(a, b) +<>= +j <- nm[c(1, 3, 5)] +<> +@ -a <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE)[1:2, j]) -b <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE))[j, j, 1:2] -chk(a, b) +and finally with with negative subsets + +<>= +j <- -c(1, 3, 5) +<> @ and with non-increasing argument \code{j} (this won't work for lower triangular matrices, only for symmetric matrices) -<>= +<>= ## subset -j <- sample(1:J) -ltM <- ltMatrices(xn, byrow = FALSE) -try(ltM[1:2, j]) +j <- nm[sample(1:J)] +ltM <- ltMatrices(xn, byrow = FALSE, names = nm) +try(ltM[i, j]) ltM <- as.syMatrices(ltM) -a <- as.array(ltM[1:2, j]) -b <- as.array(ltM)[j, j, 1:2] +a <- as.array(ltM[i, j]) +b <- as.array(ltM)[j, j, i] chk(a, b) @ Extracting the lower triangular elements from an \code{ltMatrices} object (or from an object of class \code{syMatrices}) returns a matrix with $N$ -columns, undoing the effect of \code{ltMatrices} +columns, undoing the effect of \code{ltMatrices}. Note that ordering of the +rows of this matrix depend on the \code{byrow} attribute of \code{x}, unless +the \code{byrow} to this function is used to overwrite it explicitly \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap16}\raggedright\small -\NWtarget{nuweb15}{} $\langle\,${\itshape lower triangular elements}\nobreak\ {\footnotesize {15}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap17}\raggedright\small +\NWtarget{nuweb17}{} $\langle\,${\itshape lower triangular elements}\nobreak\ {\footnotesize {17}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@Lower_tri <- function(x, diag = FALSE, byrow = attr(x, "byrow")) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ if (inherits(x, "syMatrices"))@\\ -\mbox{}\verb@ class(x)[1L] <- "ltMatrices"@\\ -\mbox{}\verb@ stopifnot(inherits(x, "ltMatrices"))@\\ +\mbox{}\verb@ if (is.syMatrices(x))@\\ +\mbox{}\verb@ x <- as.ltMatrices(x)@\\ \mbox{}\verb@ adiag <- diag@\\ \mbox{}\verb@ x <- ltMatrices(x, byrow = byrow)@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape extract slots}\nobreak\ {\footnotesize \NWlink{nuweb9}{9}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape extract slots}\nobreak\ {\footnotesize \NWlink{nuweb10}{10}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (diag == adiag)@\\ -\mbox{}\verb@ return(unclass(x))@\\ +\mbox{}\verb@ return(unclass(x)[,,drop = FALSE]) ### remove attributes@\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (!diag && adiag) {@\\ \mbox{}\verb@ diagonals(x) <- 1@\\ -\mbox{}\verb@ return(unclass(x))@\\ +\mbox{}\verb@ return(unclass(x)[,,drop = FALSE]) ### remove attributes@\\ \mbox{}\verb@ }@\\ \mbox{}\verb@@\\ \mbox{}\verb@ x <- unclass(x)@\\ @@ -990,8 +1042,8 @@ The diagonal elements of each matrix $\mC_i$ can be extracted and are always returned as an $\J \times N$ matrix. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap17}\raggedright\small -\NWtarget{nuweb17}{} $\langle\,${\itshape diagonals ltMatrices}\nobreak\ {\footnotesize {17}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap18}\raggedright\small +\NWtarget{nuweb19}{} $\langle\,${\itshape diagonals ltMatrices}\nobreak\ {\footnotesize {19}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -1000,7 +1052,7 @@ always returned as an $\J \times N$ matrix. \mbox{}\verb@@\\ \mbox{}\verb@diagonals.ltMatrices <- function(x, ...) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape extract slots}\nobreak\ {\footnotesize \NWlink{nuweb9}{9}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape extract slots}\nobreak\ {\footnotesize \NWlink{nuweb10}{10}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ x <- unclass(x)@\\ \mbox{}\verb@@\\ @@ -1040,17 +1092,17 @@ all(diagonals(ltMatrices(xn, byrow = TRUE)) == 1L) @ Sometimes we need to add diagonal elements to an \code{ltMatrices} object -defined without diagonal elements. +which was set-up with constant $c_{jj} = 1$ diagonal elements. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap18}\raggedright\small -\NWtarget{nuweb18}{} $\langle\,${\itshape add diagonal elements}\nobreak\ {\footnotesize {18}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap19}\raggedright\small +\NWtarget{nuweb20}{} $\langle\,${\itshape add diagonal elements}\nobreak\ {\footnotesize {20}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@.adddiag <- function(x) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ stopifnot(inherits(x, "ltMatrices")) @\\ +\mbox{}\verb@ stopifnot(is.ltMatrices(x))@\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (attr(x, "diag")) return(x)@\\ \mbox{}\verb@@\\ @@ -1088,8 +1140,8 @@ defined without diagonal elements. \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap19}\raggedright\small -\NWtarget{nuweb19}{} $\langle\,${\itshape assign diagonal elements}\nobreak\ {\footnotesize {19}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap20}\raggedright\small +\NWtarget{nuweb21}{} $\langle\,${\itshape assign diagonal elements}\nobreak\ {\footnotesize {21}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -1098,7 +1150,7 @@ defined without diagonal elements. \mbox{}\verb@@\\ \mbox{}\verb@"diagonals<-.ltMatrices" <- function(x, value) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape extract slots}\nobreak\ {\footnotesize \NWlink{nuweb9}{9}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape extract slots}\nobreak\ {\footnotesize \NWlink{nuweb10}{10}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (byrow)@\\ \mbox{}\verb@ idx <- cumsum(c(1, 2:J))@\\ @@ -1136,7 +1188,7 @@ defined without diagonal elements. \mbox{}\verb@@\\ \mbox{}\verb@"diagonals<-.syMatrices" <- function(x, value) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ class(x)[1L] <- "ltMatrices"@\\ +\mbox{}\verb@ x <- as.ltMatrices(x)@\\ \mbox{}\verb@ diagonals(x) <- value@\\ \mbox{}\verb@ class(x)[1L] <- "syMatrices"@\\ \mbox{}\verb@@\\ @@ -1163,8 +1215,8 @@ A unit diagonal matrix is not treated as a special case but as an \code{ltMatrices} object with all lower triangular elements being zero \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap20}\raggedright\small -\NWtarget{nuweb20}{} $\langle\,${\itshape diagonal matrix}\nobreak\ {\footnotesize {20}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap21}\raggedright\small +\NWtarget{nuweb22}{} $\langle\,${\itshape diagonal matrix}\nobreak\ {\footnotesize {22}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -1188,7 +1240,7 @@ I5 @ -\section{Multiplication} +\section{Multiplication} \label{sec:multiplication} Products $\mC_i \yvec_i$ or $\mC^\top_i \yvec_i$ with $\yvec_i \in \R^\J$ for $i = 1, \dots, N$ can be computed with $\code{y}$ being an $J \times N$ matrix of @@ -1197,16 +1249,16 @@ columns-wise stacked vectors $(\yvec_1 \mid \yvec_2 \mid \dots \mid If the number of columns of a matrix \code{y} is neither one nor $N$, we compute $\mC_i \yvec_j$ for all $i = 1, \dots, N$ and $j$. This is -dangerous but needed in \code{cond\_mvnorm} later on. +dangerous but needed in Section~\ref{sec:margcond} for defining \code{cond\_mvnorm} later on. For $\mC_i \yvec_i$, we call \proglang{C} code computing the product efficiently without copying data by leveraging the lower triangular structure of -\code{x} +\code{x}$=\mC_i$ \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap21}\raggedright\small -\NWtarget{nuweb21a}{} $\langle\,${\itshape mult ltMatrices}\nobreak\ {\footnotesize {21a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap22}\raggedright\small +\NWtarget{nuweb23a}{} $\langle\,${\itshape mult ltMatrices}\nobreak\ {\footnotesize {23a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -1219,7 +1271,7 @@ efficiently without copying data by leveraging the lower triangular structure of \mbox{}\verb@}@\\ \mbox{}\verb@Mult.ltMatrices <- function(x, y, transpose = FALSE, ...) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape extract slots}\nobreak\ {\footnotesize \NWlink{nuweb9}{9}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape extract slots}\nobreak\ {\footnotesize \NWlink{nuweb10}{10}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ stopifnot(is.numeric(y))@\\ \mbox{}\verb@ if (!is.matrix(y)) y <- matrix(y, nrow = d[2L], ncol = d[1L])@\\ @@ -1228,7 +1280,7 @@ efficiently without copying data by leveraging the lower triangular structure of \mbox{}\verb@ if (ncol(y) != N)@\\ \mbox{}\verb@ return(sapply(1:ncol(y), function(i) Mult(x, y[,i], transpose = transpose)))@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape mult ltMatrices transpose}\nobreak\ {\footnotesize \NWlink{nuweb23}{23}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape mult ltMatrices transpose}\nobreak\ {\footnotesize \NWlink{nuweb25}{25}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ x <- ltMatrices(x, byrow = TRUE)@\\ \mbox{}\verb@ if (!is.double(x)) storage.mode(x) <- "double"@\\ @@ -1257,8 +1309,8 @@ The underlying \proglang{C} code assumes $\mC_i$ (here called \code{C}) to be in row-major order. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap22}\raggedright\small -\NWtarget{nuweb21b}{} $\langle\,${\itshape RC input}\nobreak\ {\footnotesize {21b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap23}\raggedright\small +\NWtarget{nuweb23b}{} $\langle\,${\itshape RC input}\nobreak\ {\footnotesize {23b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -1277,7 +1329,7 @@ be in row-major order. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb22b}{22b}\NWlink{nuweb24}{, 24}\NWlink{nuweb27}{, 27}\NWlink{nuweb28}{, 28}\NWlink{nuweb31a}{, 31a}\NWlink{nuweb34}{, 34}\NWlink{nuweb40a}{, 40a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb24b}{24b}\NWlink{nuweb26}{, 26}\NWlink{nuweb29}{, 29}\NWlink{nuweb30}{, 30}\NWlink{nuweb33a}{, 33a}\NWlink{nuweb36}{, 36}\NWlink{nuweb42a}{, 42a}. \item{} \end{list} @@ -1288,8 +1340,8 @@ We also allow $\mC_i$ to be constant ($N$ is then determined from $\mC_i$ if \code{dim(x)[1L] > 1} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap23}\raggedright\small -\NWtarget{nuweb22a}{} $\langle\,${\itshape C length}\nobreak\ {\footnotesize {22a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap24}\raggedright\small +\NWtarget{nuweb24a}{} $\langle\,${\itshape C length}\nobreak\ {\footnotesize {24a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -1305,7 +1357,7 @@ $\mC_i$ if \code{dim(x)[1L] > 1} \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb22b}{22b}\NWlink{nuweb24}{, 24}\NWlink{nuweb27}{, 27}\NWlink{nuweb28}{, 28}\NWlink{nuweb31a}{, 31a}\NWlink{nuweb40a}{, 40a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb24b}{24b}\NWlink{nuweb26}{, 26}\NWlink{nuweb29}{, 29}\NWlink{nuweb33a}{, 33a}\NWlink{nuweb42a}{, 42a}. \item{} \end{list} @@ -1314,8 +1366,8 @@ $\mC_i$ if \code{dim(x)[1L] > 1} The \proglang{C} workhorse is now \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap24}\raggedright\small -\NWtarget{nuweb22b}{} $\langle\,${\itshape mult}\nobreak\ {\footnotesize {22b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap25}\raggedright\small +\NWtarget{nuweb24b}{} $\langle\,${\itshape mult}\nobreak\ {\footnotesize {24b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -1325,8 +1377,8 @@ The \proglang{C} workhorse is now \mbox{}\verb@ double *dans, *dy = REAL(y);@\\ \mbox{}\verb@ int i, j, k, start;@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape RC input}\nobreak\ {\footnotesize \NWlink{nuweb21b}{21b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape C length}\nobreak\ {\footnotesize \NWlink{nuweb22a}{22a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape RC input}\nobreak\ {\footnotesize \NWlink{nuweb23b}{23b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape C length}\nobreak\ {\footnotesize \NWlink{nuweb24a}{24a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ PROTECT(ans = allocMatrix(REALSXP, iJ, iN));@\\ \mbox{}\verb@ dans = REAL(ans);@\\ @@ -1398,12 +1450,12 @@ chk(a, b, check.attributes = FALSE) For $\mC^\top_i \yvec_i$ (\code{transpose = TRUE}), we add a dedicated \proglang{C} function paying attention to the lower triangular structure of -\code{x}. This function assumes \code{x} in column-major order, so we +\code{x}$= \mC_i$. This function assumes \code{x} in column-major order, so we coerce this object when necessary: \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap25}\raggedright\small -\NWtarget{nuweb23}{} $\langle\,${\itshape mult ltMatrices transpose}\nobreak\ {\footnotesize {23}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap26}\raggedright\small +\NWtarget{nuweb25}{} $\langle\,${\itshape mult ltMatrices transpose}\nobreak\ {\footnotesize {25}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -1425,7 +1477,7 @@ coerce this object when necessary: \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb21a}{21a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb23a}{23a}. \item{} \end{list} @@ -1434,8 +1486,8 @@ coerce this object when necessary: before moving to \proglang{C} for the low-level computations: \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap26}\raggedright\small -\NWtarget{nuweb24}{} $\langle\,${\itshape mult transpose}\nobreak\ {\footnotesize {24}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap27}\raggedright\small +\NWtarget{nuweb26}{} $\langle\,${\itshape mult transpose}\nobreak\ {\footnotesize {26}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -1445,8 +1497,8 @@ before moving to \proglang{C} for the low-level computations: \mbox{}\verb@ double *dans, *dy = REAL(y);@\\ \mbox{}\verb@ int i, j, k, start;@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape RC input}\nobreak\ {\footnotesize \NWlink{nuweb21b}{21b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape C length}\nobreak\ {\footnotesize \NWlink{nuweb22a}{22a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape RC input}\nobreak\ {\footnotesize \NWlink{nuweb23b}{23b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape C length}\nobreak\ {\footnotesize \NWlink{nuweb24a}{24a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ PROTECT(ans = allocMatrix(REALSXP, iJ, iN));@\\ \mbox{}\verb@ dans = REAL(ans);@\\ @@ -1508,21 +1560,21 @@ chk(Mult(lxn, y[,1], transpose = TRUE), @ Now we can add a \code{Mult} method for multiple symmetric matrices, noting -that for a symmetric matrix $\mC = \mA + \mA^\top - \text{diag}(\mA)$ with lower triangular -part $\mA$ (including the diagonal) we can compute $\mC \yvec = \mA \yvec + \mA^\top \yvec - \text{diag}(\mA) -\yvec$ using \code{Mult} applied to the lower trianular part: +that for a symmetric matrix $\mA = \mC + \mC^\top - \text{diag}(\mC)$ with lower triangular +part $\mC$ (including the diagonal) we can compute $\mA \yvec = \mC \yvec + +\mC^\top \yvec - \text{diag}(\mC) \yvec$ using \code{Mult} applied to the lower trianular part: \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap27}\raggedright\small -\NWtarget{nuweb25}{} $\langle\,${\itshape mult syMatrices}\nobreak\ {\footnotesize {25}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap28}\raggedright\small +\NWtarget{nuweb27}{} $\langle\,${\itshape mult syMatrices}\nobreak\ {\footnotesize {27}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@Mult.syMatrices <- function(x, y, ...) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape extract slots}\nobreak\ {\footnotesize \NWlink{nuweb9}{9}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape extract slots}\nobreak\ {\footnotesize \NWlink{nuweb10}{10}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ class(x)[1L] <- "ltMatrices"@\\ +\mbox{}\verb@ x <- as.ltMatrices(x)@\\ \mbox{}\verb@ stopifnot(is.numeric(y))@\\ \mbox{}\verb@ if (!is.matrix(y)) y <- matrix(y, nrow = d[2L], ncol = d[1L])@\\ \mbox{}\verb@ N <- ifelse(d[1L] == 1, ncol(y), d[1L])@\\ @@ -1547,7 +1599,8 @@ part $\mA$ (including the diagonal) we can compute $\mC \yvec = \mA \yvec + \mA^ J <- 5 N1 <- 10 ex <- expression({ - C <- syMatrices(matrix(runif(N2 * J * (J + c(-1, 1)[DIAG + 1L] ) / 2), ncol = N2), + C <- syMatrices(matrix(runif(N2 * J * (J + c(-1, 1)[DIAG + 1L] ) / 2), + ncol = N2), diag = DIAG) x <- matrix(runif(N1 * J), nrow = J) Ca <- as.array(C) @@ -1591,12 +1644,12 @@ We start with some options for the \proglang{LAPACK} workhorses \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap28}\raggedright\small -\NWtarget{nuweb26}{} $\langle\,${\itshape lapack options}\nobreak\ {\footnotesize {26}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap29}\raggedright\small +\NWtarget{nuweb28}{} $\langle\,${\itshape lapack options}\nobreak\ {\footnotesize {28}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ -\mbox{}\verb@char di, lo = 'L', tr = 'N';@\\ +\mbox{}\verb@char di, lo = 'L';@\\ \mbox{}\verb@if (Rdiag) {@\\ \mbox{}\verb@ /* non-unit diagonal elements */@\\ \mbox{}\verb@ di = 'N';@\\ @@ -1605,22 +1658,12 @@ We start with some options for the \proglang{LAPACK} workhorses \mbox{}\verb@ ignored in the computations */@\\ \mbox{}\verb@ di = 'U';@\\ \mbox{}\verb@}@\\ -\mbox{}\verb@@\\ -\mbox{}\verb@/* t(C) instead of C */@\\ -\mbox{}\verb@Rboolean Rtranspose = asLogical(transpose);@\\ -\mbox{}\verb@if (Rtranspose) {@\\ -\mbox{}\verb@ /* t(C) */@\\ -\mbox{}\verb@ tr = 'T';@\\ -\mbox{}\verb@} else {@\\ -\mbox{}\verb@ /* C */@\\ -\mbox{}\verb@ tr = 'N';@\\ -\mbox{}\verb@}@\\ \mbox{}\verb@@{\NWsep} \end{list} \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb27}{27}\NWlink{nuweb28}{, 28}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb29}{29}\NWlink{nuweb30}{, 30}. \item{} \end{list} @@ -1629,8 +1672,8 @@ We start with some options for the \proglang{LAPACK} workhorses and set-up a dedicated \proglang{C} function for computing $\mC_i \xvec_i = \yvec_i$ \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap29}\raggedright\small -\NWtarget{nuweb27}{} $\langle\,${\itshape solve}\nobreak\ {\footnotesize {27}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap30}\raggedright\small +\NWtarget{nuweb29}{} $\langle\,${\itshape solve}\nobreak\ {\footnotesize {29}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -1639,13 +1682,24 @@ and set-up a dedicated \proglang{C} function for computing $\mC_i \xvec_i = \yve \mbox{}\verb@@\\ \mbox{}\verb@ SEXP ans;@\\ \mbox{}\verb@ double *dans, *dy;@\\ -\mbox{}\verb@ int i, j, info, ONE = 1;@\\ +\mbox{}\verb@ int i, ONE = 1;@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape RC input}\nobreak\ {\footnotesize \NWlink{nuweb21b}{21b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape RC input}\nobreak\ {\footnotesize \NWlink{nuweb23b}{23b}}$\,\rangle$}\verb@@\\ \mbox{}\verb@ /* diagonal elements are always present */@\\ \mbox{}\verb@ if (!Rdiag) len += iJ;@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape C length}\nobreak\ {\footnotesize \NWlink{nuweb22a}{22a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape lapack options}\nobreak\ {\footnotesize \NWlink{nuweb26}{26}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape C length}\nobreak\ {\footnotesize \NWlink{nuweb24a}{24a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape lapack options}\nobreak\ {\footnotesize \NWlink{nuweb28}{28}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@ char tr = 'N';@\\ +\mbox{}\verb@ /* t(C) instead of C */@\\ +\mbox{}\verb@ Rboolean Rtranspose = asLogical(transpose);@\\ +\mbox{}\verb@ if (Rtranspose) {@\\ +\mbox{}\verb@ /* t(C) */@\\ +\mbox{}\verb@ tr = 'T';@\\ +\mbox{}\verb@ } else {@\\ +\mbox{}\verb@ /* C */@\\ +\mbox{}\verb@ tr = 'N';@\\ +\mbox{}\verb@ }@\\ \mbox{}\verb@@\\ \mbox{}\verb@ dy = REAL(y);@\\ \mbox{}\verb@ PROTECT(ans = allocMatrix(REALSXP, iJ, iN));@\\ @@ -1678,8 +1732,8 @@ and set-up a dedicated \proglang{C} function for computing $\mC_i \xvec_i = \yve and then for computing $\mC_i^{-1}$ explicitly \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap30}\raggedright\small -\NWtarget{nuweb28}{} $\langle\,${\itshape solve C}\nobreak\ {\footnotesize {28}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap31}\raggedright\small +\NWtarget{nuweb30}{} $\langle\,${\itshape solve C}\nobreak\ {\footnotesize {30}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -1688,13 +1742,12 @@ and then for computing $\mC_i^{-1}$ explicitly \mbox{}\verb@@\\ \mbox{}\verb@ SEXP ans;@\\ \mbox{}\verb@ double *dans;@\\ -\mbox{}\verb@ int i, j, info, jj, idx, ONE = 1;@\\ +\mbox{}\verb@ int i, info;@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape RC input}\nobreak\ {\footnotesize \NWlink{nuweb21b}{21b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape RC input}\nobreak\ {\footnotesize \NWlink{nuweb23b}{23b}}$\,\rangle$}\verb@@\\ \mbox{}\verb@ /* diagonal elements are always present */@\\ \mbox{}\verb@ if (!Rdiag) len += iJ;@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape C length}\nobreak\ {\footnotesize \NWlink{nuweb22a}{22a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape lapack options}\nobreak\ {\footnotesize \NWlink{nuweb26}{26}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape lapack options}\nobreak\ {\footnotesize \NWlink{nuweb28}{28}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ PROTECT(ans = allocMatrix(REALSXP, len, iN));@\\ \mbox{}\verb@ dans = REAL(ans);@\\ @@ -1729,8 +1782,8 @@ and then for computing $\mC_i^{-1}$ explicitly with \proglang{R} interface \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap31}\raggedright\small -\NWtarget{nuweb29}{} $\langle\,${\itshape solve ltMatrices}\nobreak\ {\footnotesize {29}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap32}\raggedright\small +\NWtarget{nuweb31}{} $\langle\,${\itshape solve ltMatrices}\nobreak\ {\footnotesize {31}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -1832,8 +1885,8 @@ we sum over the log-diagonal entries of a lower triangular matrix in \proglang{C}, both when the data are stored in row- and column-major order: \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap32}\raggedright\small -\NWtarget{nuweb31a}{} $\langle\,${\itshape logdet}\nobreak\ {\footnotesize {31a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap33}\raggedright\small +\NWtarget{nuweb33a}{} $\langle\,${\itshape logdet}\nobreak\ {\footnotesize {33a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -1843,9 +1896,9 @@ we sum over the log-diagonal entries of a lower triangular matrix in \mbox{}\verb@ double *dans;@\\ \mbox{}\verb@ int i, j, k;@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape RC input}\nobreak\ {\footnotesize \NWlink{nuweb21b}{21b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape RC input}\nobreak\ {\footnotesize \NWlink{nuweb23b}{23b}}$\,\rangle$}\verb@@\\ \mbox{}\verb@ Rboolean Rbyrow = asLogical(byrow);@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape C length}\nobreak\ {\footnotesize \NWlink{nuweb22a}{22a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape C length}\nobreak\ {\footnotesize \NWlink{nuweb24a}{24a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ PROTECT(ans = allocVector(REALSXP, iN));@\\ \mbox{}\verb@ dans = REAL(ans);@\\ @@ -1879,14 +1932,14 @@ we sum over the log-diagonal entries of a lower triangular matrix in The \proglang{R} interface now simply calls this low-level function \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap33}\raggedright\small -\NWtarget{nuweb31b}{} $\langle\,${\itshape logdet ltMatrices}\nobreak\ {\footnotesize {31b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap34}\raggedright\small +\NWtarget{nuweb33b}{} $\langle\,${\itshape logdet ltMatrices}\nobreak\ {\footnotesize {33b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@logdet <- function(x) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ if (!inherits(x, "ltMatrices"))@\\ +\mbox{}\verb@ if (!is.ltMatrices(x))@\\ \mbox{}\verb@ stop("x is not an ltMatrices object")@\\ \mbox{}\verb@@\\ \mbox{}\verb@ byrow <- attr(x, "byrow")@\\ @@ -1926,7 +1979,7 @@ chk(logdet(lxd2), colSums(log(diagonals(lxd2)))) \section{Crossproducts} -Compute $\mC_i \mC_i^\top$ or $\text{diag}(\mC_i \mC_i^\top)$ +We want to ompute $\mC_i \mC_i^\top$ or $\text{diag}(\mC_i \mC_i^\top)$ (\code{diag\_only = TRUE}) for $i = 1, \dots, N$. These are symmetric matrices, so we store them as a lower triangular matrix using a different class name \code{syMatrices}. We write one \proglang{C} function for @@ -1937,8 +1990,8 @@ We differentiate between computation of the diagonal elements of the crossproduct \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap34}\raggedright\small -\NWtarget{nuweb32a}{} $\langle\,${\itshape first element}\nobreak\ {\footnotesize {32a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap35}\raggedright\small +\NWtarget{nuweb34a}{} $\langle\,${\itshape first element}\nobreak\ {\footnotesize {34a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -1954,22 +2007,22 @@ crossproduct \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb32b}{32b}\NWlink{nuweb33a}{, 33a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb34b}{34b}\NWlink{nuweb35a}{, 35a}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap35}\raggedright\small -\NWtarget{nuweb32b}{} $\langle\,${\itshape tcrossprod diagonal only}\nobreak\ {\footnotesize {32b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap36}\raggedright\small +\NWtarget{nuweb34b}{} $\langle\,${\itshape tcrossprod diagonal only}\nobreak\ {\footnotesize {34b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@PROTECT(ans = allocMatrix(REALSXP, iJ, iN));@\\ \mbox{}\verb@dans = REAL(ans);@\\ \mbox{}\verb@for (n = 0; n < iN; n++) {@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape first element}\nobreak\ {\footnotesize \NWlink{nuweb32a}{32a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape first element}\nobreak\ {\footnotesize \NWlink{nuweb34a}{34a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@ for (i = 1; i < iJ; i++) {@\\ \mbox{}\verb@ dans[i] = 0.0;@\\ \mbox{}\verb@ if (Rtranspose) { // crossprod@\\ @@ -1993,7 +2046,7 @@ crossproduct \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb34}{34}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb36}{36}. \item{} \end{list} @@ -2002,8 +2055,8 @@ crossproduct and computation of the full $\J \times \J$ crossproduct matrix \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap36}\raggedright\small -\NWtarget{nuweb33a}{} $\langle\,${\itshape tcrossprod full}\nobreak\ {\footnotesize {33a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap37}\raggedright\small +\NWtarget{nuweb35a}{} $\langle\,${\itshape tcrossprod full}\nobreak\ {\footnotesize {35a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -2011,7 +2064,7 @@ and computation of the full $\J \times \J$ crossproduct matrix \mbox{}\verb@PROTECT(ans = allocMatrix(REALSXP, nrow, iN)); @\\ \mbox{}\verb@dans = REAL(ans);@\\ \mbox{}\verb@for (n = 0; n < INTEGER(N)[0]; n++) {@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape first element}\nobreak\ {\footnotesize \NWlink{nuweb32a}{32a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape first element}\nobreak\ {\footnotesize \NWlink{nuweb34a}{34a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@ for (i = 1; i < iJ; i++) {@\\ \mbox{}\verb@ for (j = 0; j <= i; j++) {@\\ \mbox{}\verb@ ix = IDX(i + 1, j + 1, iJ, 1);@\\ @@ -2053,7 +2106,7 @@ and computation of the full $\J \times \J$ crossproduct matrix \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb34}{34}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb36}{36}. \item{} \end{list} @@ -2062,8 +2115,8 @@ and computation of the full $\J \times \J$ crossproduct matrix and put both cases together \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap37}\raggedright\small -\NWtarget{nuweb33b}{} $\langle\,${\itshape IDX}\nobreak\ {\footnotesize {33b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap38}\raggedright\small +\NWtarget{nuweb35b}{} $\langle\,${\itshape IDX}\nobreak\ {\footnotesize {35b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -2073,20 +2126,20 @@ and put both cases together \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb34}{34}\NWlink{nuweb40a}{, 40a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb36}{36}\NWlink{nuweb42a}{, 42a}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap38}\raggedright\small -\NWtarget{nuweb34}{} $\langle\,${\itshape tcrossprod}\nobreak\ {\footnotesize {34}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap39}\raggedright\small +\NWtarget{nuweb36}{} $\langle\,${\itshape tcrossprod}\nobreak\ {\footnotesize {36}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape IDX}\nobreak\ {\footnotesize \NWlink{nuweb33b}{33b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape IDX}\nobreak\ {\footnotesize \NWlink{nuweb35b}{35b}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@SEXP R_ltMatrices_tcrossprod (SEXP C, SEXP N, SEXP J, SEXP diag, @\\ \mbox{}\verb@ SEXP diag_only, SEXP transpose) {@\\ @@ -2095,15 +2148,15 @@ and put both cases together \mbox{}\verb@ double *dans;@\\ \mbox{}\verb@ int i, j, n, k, ix, nrow;@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape RC input}\nobreak\ {\footnotesize \NWlink{nuweb21b}{21b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape RC input}\nobreak\ {\footnotesize \NWlink{nuweb23b}{23b}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ Rboolean Rdiag_only = asLogical(diag_only);@\\ \mbox{}\verb@ Rboolean Rtranspose = asLogical(transpose);@\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (Rdiag_only) {@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape tcrossprod diagonal only}\nobreak\ {\footnotesize \NWlink{nuweb32b}{32b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape tcrossprod diagonal only}\nobreak\ {\footnotesize \NWlink{nuweb34b}{34b}}$\,\rangle$}\verb@@\\ \mbox{}\verb@ } else {@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape tcrossprod full}\nobreak\ {\footnotesize \NWlink{nuweb33a}{33a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape tcrossprod full}\nobreak\ {\footnotesize \NWlink{nuweb35a}{35a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@ }@\\ \mbox{}\verb@ UNPROTECT(1);@\\ \mbox{}\verb@ return(ans);@\\ @@ -2122,8 +2175,8 @@ and put both cases together with \proglang{R} interface \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap39}\raggedright\small -\NWtarget{nuweb35}{} $\langle\,${\itshape tcrossprod ltMatrices}\nobreak\ {\footnotesize {35}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap40}\raggedright\small +\NWtarget{nuweb37}{} $\langle\,${\itshape tcrossprod ltMatrices}\nobreak\ {\footnotesize {37}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -2131,7 +2184,7 @@ with \proglang{R} interface \mbox{}\verb@### diag(C %*% t(C)) => returns matrix of diagonal elements@\\ \mbox{}\verb@.Tcrossprod <- function(x, diag_only = FALSE, transpose = FALSE) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ if (!inherits(x, "ltMatrices")) {@\\ +\mbox{}\verb@ if (!is.ltMatrices(x)) {@\\ \mbox{}\verb@ ret <- tcrossprod(x)@\\ \mbox{}\verb@ if (diag_only) ret <- diag(ret)@\\ \mbox{}\verb@ return(ret)@\\ @@ -2202,8 +2255,8 @@ We also add \code{Crossprod}, which is a call to \code{Tcrossprod} with the \code{transpose} switch turned on \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap40}\raggedright\small -\NWtarget{nuweb36}{} $\langle\,${\itshape crossprod ltMatrices}\nobreak\ {\footnotesize {36}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap41}\raggedright\small +\NWtarget{nuweb38}{} $\langle\,${\itshape crossprod ltMatrices}\nobreak\ {\footnotesize {38}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -2253,8 +2306,8 @@ One might want to compute the Cholesky factorisations $\mSigma_i = \mC_i in class \code{syMatrices}. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap41}\raggedright\small -\NWtarget{nuweb37}{} $\langle\,${\itshape chol syMatrices}\nobreak\ {\footnotesize {37}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap42}\raggedright\small +\NWtarget{nuweb39}{} $\langle\,${\itshape chol syMatrices}\nobreak\ {\footnotesize {39}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -2299,8 +2352,8 @@ so we swiftly loop over $i = 1, \dots, N$ in \proglang{C} and hand over to \code{LAPACK} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap42}\raggedright\small -\NWtarget{nuweb38}{} $\langle\,${\itshape chol}\nobreak\ {\footnotesize {38}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap43}\raggedright\small +\NWtarget{nuweb40}{} $\langle\,${\itshape chol}\nobreak\ {\footnotesize {40}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -2373,8 +2426,8 @@ trick'', we have $\text{vec}(\mS)^\top (\mA^\top \otimes \mC) = matrices, so we simply call this function looping over $i = 1, \dots, N$. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap43}\raggedright\small -\NWtarget{nuweb39}{} $\langle\,${\itshape t(C) S t(A)}\nobreak\ {\footnotesize {39}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap44}\raggedright\small +\NWtarget{nuweb41}{} $\langle\,${\itshape t(C) S t(A)}\nobreak\ {\footnotesize {41}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -2427,20 +2480,20 @@ matrices, so we simply call this function looping over $i = 1, \dots, N$. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb40a}{40a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb42a}{42a}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap44}\raggedright\small -\NWtarget{nuweb40a}{} $\langle\,${\itshape vec trick}\nobreak\ {\footnotesize {40a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap45}\raggedright\small +\NWtarget{nuweb42a}{} $\langle\,${\itshape vec trick}\nobreak\ {\footnotesize {42a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape IDX}\nobreak\ {\footnotesize \NWlink{nuweb33b}{33b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape IDX}\nobreak\ {\footnotesize \NWlink{nuweb35b}{35b}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@SEXP R_vectrick(SEXP C, SEXP N, SEXP J, SEXP S, SEXP A, SEXP diag, SEXP trans) {@\\ \mbox{}\verb@@\\ @@ -2449,15 +2502,15 @@ matrices, so we simply call this function looping over $i = 1, \dots, N$. \mbox{}\verb@ double *dS, *dans, *dA;@\\ \mbox{}\verb@@\\ \mbox{}\verb@ /* note: diag is needed by this chunk but has no consequences */@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape RC input}\nobreak\ {\footnotesize \NWlink{nuweb21b}{21b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape C length}\nobreak\ {\footnotesize \NWlink{nuweb22a}{22a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape RC input}\nobreak\ {\footnotesize \NWlink{nuweb23b}{23b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape C length}\nobreak\ {\footnotesize \NWlink{nuweb24a}{24a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@ dS = REAL(S);@\\ \mbox{}\verb@ dA = REAL(A);@\\ \mbox{}\verb@@\\ \mbox{}\verb@ Rboolean RtC = LOGICAL(trans)[0];@\\ \mbox{}\verb@ Rboolean RtA = LOGICAL(trans)[1];@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape t(C) S t(A)}\nobreak\ {\footnotesize \NWlink{nuweb39}{39}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape t(C) S t(A)}\nobreak\ {\footnotesize \NWlink{nuweb41}{41}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ UNPROTECT(1);@\\ \mbox{}\verb@ return(ans);@\\ @@ -2479,12 +2532,12 @@ argument in \code{vectrick}. Argument \code{C} is an \code{ltMatrices} object \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap45}\raggedright\small -\NWtarget{nuweb40b}{} $\langle\,${\itshape check C argument}\nobreak\ {\footnotesize {40b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap46}\raggedright\small +\NWtarget{nuweb42b}{} $\langle\,${\itshape check C argument}\nobreak\ {\footnotesize {42b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ -\mbox{}\verb@stopifnot(inherits(C, "ltMatrices"))@\\ +\mbox{}\verb@C <- as.ltMatrices(C)@\\ \mbox{}\verb@if (!attr(C, "diag")) diagonals(C) <- 1@\\ \mbox{}\verb@C_byrow_orig <- attr(C, "byrow")@\\ \mbox{}\verb@C <- ltMatrices(C, byrow = FALSE)@\\ @@ -2492,14 +2545,14 @@ object \mbox{}\verb@nm <- attr(C, "rcnames")@\\ \mbox{}\verb@N <- dC[1L]@\\ \mbox{}\verb@J <- dC[2L]@\\ -\mbox{}\verb@class(C) <- class(C)[-1L]@\\ +\mbox{}\verb@class(C) <- class(C)[-1L] ### works because of as.ltMatrices(c)@\\ \mbox{}\verb@if (!is.double(C)) storage.mode(C) <- "double"@\\ \mbox{}\verb@@{\NWsep} \end{list} \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb42}{42}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb44}{44}. \item{} \end{list} @@ -2509,12 +2562,12 @@ object featuring columns of vectorised $\J \times \J$ matrices \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap46}\raggedright\small -\NWtarget{nuweb41a}{} $\langle\,${\itshape check S argument}\nobreak\ {\footnotesize {41a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap47}\raggedright\small +\NWtarget{nuweb43a}{} $\langle\,${\itshape check S argument}\nobreak\ {\footnotesize {43a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ -\mbox{}\verb@SltM <- inherits(S, "ltMatrices")@\\ +\mbox{}\verb@SltM <- is.ltMatrices(S)@\\ \mbox{}\verb@if (SltM) {@\\ \mbox{}\verb@ if (!attr(S, "diag")) diagonals(S) <- 1@\\ \mbox{}\verb@ S_byrow_orig <- attr(S, "byrow")@\\ @@ -2545,7 +2598,7 @@ featuring columns of vectorised $\J \times \J$ matrices \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb42}{42}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb44}{44}. \item{} \end{list} @@ -2554,15 +2607,15 @@ featuring columns of vectorised $\J \times \J$ matrices \code{A} is an \code{ltMatrices} object \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap47}\raggedright\small -\NWtarget{nuweb41b}{} $\langle\,${\itshape check A argument}\nobreak\ {\footnotesize {41b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap48}\raggedright\small +\NWtarget{nuweb43b}{} $\langle\,${\itshape check A argument}\nobreak\ {\footnotesize {43b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@if (missing(A)) {@\\ \mbox{}\verb@ A <- C@\\ \mbox{}\verb@} else {@\\ -\mbox{}\verb@ stopifnot(inherits(A, "ltMatrices"))@\\ +\mbox{}\verb@ A <- as.ltMatrices(A)@\\ \mbox{}\verb@ if (!attr(A, "diag")) diagonals(A) <- 1@\\ \mbox{}\verb@ A_byrow_orig <- attr(A, "byrow")@\\ \mbox{}\verb@ stopifnot(C_byrow_orig == A_byrow_orig)@\\ @@ -2584,7 +2637,7 @@ featuring columns of vectorised $\J \times \J$ matrices \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb42}{42}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb44}{44}. \item{} \end{list} @@ -2593,8 +2646,8 @@ featuring columns of vectorised $\J \times \J$ matrices We put everything together in function \code{vectrick} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap48}\raggedright\small -\NWtarget{nuweb42}{} $\langle\,${\itshape kronecker vec trick}\nobreak\ {\footnotesize {42}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap49}\raggedright\small +\NWtarget{nuweb44}{} $\langle\,${\itshape kronecker vec trick}\nobreak\ {\footnotesize {44}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -2603,9 +2656,9 @@ We put everything together in function \code{vectrick} \mbox{}\verb@ stopifnot(all(is.logical(transpose)))@\\ \mbox{}\verb@ stopifnot(length(transpose) == 2L)@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape check C argument}\nobreak\ {\footnotesize \NWlink{nuweb40b}{40b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape check S argument}\nobreak\ {\footnotesize \NWlink{nuweb41a}{41a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape check A argument}\nobreak\ {\footnotesize \NWlink{nuweb41b}{41b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape check C argument}\nobreak\ {\footnotesize \NWlink{nuweb42b}{42b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape check S argument}\nobreak\ {\footnotesize \NWlink{nuweb43a}{43a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape check A argument}\nobreak\ {\footnotesize \NWlink{nuweb43b}{43b}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ ret <- .Call(mvtnorm_R_vectrick, C, as.integer(N), as.integer(J), S, A, @\\ \mbox{}\verb@ as.logical(TRUE), as.logical(transpose))@\\ @@ -2686,7 +2739,7 @@ chk(A, B) @ -\section{Convenience Functions} +\section{Convenience Functions} \label{sec:conv} We add a few convenience functions for computing covariance matrices @@ -2698,15 +2751,55 @@ $\tilde{\mL}_i = \mL_i \text{diag}(\mL_i^\top \mL_i)^{-\frac{1}{2}}$ from $\mL_i$ (\code{invchol}) or $\mC_i = \mL_i^{-1}$ (\code{chol}) for $i = 1, \dots, N$. +Before we start, let us put a label on lower triangular matrices, such that +we can differentiate between $\mC$ and $\mL$. + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap50}\raggedright\small +\NWtarget{nuweb45}{} $\langle\,${\itshape chol classes}\nobreak\ {\footnotesize {45}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@is.chol <- function(x) inherits(x, "chol")@\\ +\mbox{}\verb@as.chol <- function(x) {@\\ +\mbox{}\verb@ stopifnot(is.ltMatrices(x))@\\ +\mbox{}\verb@ if (is.chol(x)) return(x)@\\ +\mbox{}\verb@ if (is.invchol(x))@\\ +\mbox{}\verb@ return(invchol2chol(x))@\\ +\mbox{}\verb@ class(x) <- c("chol", class(x))@\\ +\mbox{}\verb@ return(x)@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@is.invchol <- function(x) inherits(x, "invchol")@\\ +\mbox{}\verb@as.invchol <- function(x) {@\\ +\mbox{}\verb@ stopifnot(is.ltMatrices(x))@\\ +\mbox{}\verb@ if (is.invchol(x)) return(x)@\\ +\mbox{}\verb@ if (is.chol(x))@\\ +\mbox{}\verb@ return(chol2invchol(x))@\\ +\mbox{}\verb@ class(x) <- c("invchol", class(x))@\\ +\mbox{}\verb@ return(x)@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb48}{48}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} First, we set-up functions for computing $\tilde{\mC}_i$ \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap49}\raggedright\small -\NWtarget{nuweb43}{} $\langle\,${\itshape D times C}\nobreak\ {\footnotesize {43}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap51}\raggedright\small +\NWtarget{nuweb46}{} $\langle\,${\itshape D times C}\nobreak\ {\footnotesize {46}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@Dchol <- function(x, D = 1 / sqrt(Tcrossprod(x, diag_only = TRUE))) {@\\ \mbox{}\verb@@\\ +\mbox{}\verb@ if (is.invchol(x)) stop("Dchol cannot work with invchol objects")@\\ +\mbox{}\verb@@\\ \mbox{}\verb@ x <- .adddiag(x)@\\ \mbox{}\verb@@\\ \mbox{}\verb@ byrow_orig <- attr(x, "byrow")@\\ @@ -2717,10 +2810,15 @@ First, we set-up functions for computing $\tilde{\mC}_i$ \mbox{}\verb@ J <- dim(x)[2L]@\\ \mbox{}\verb@ nm <- dimnames(x)[[2L]]@\\ \mbox{}\verb@@\\ +\mbox{}\verb@ ### for some parameter configurations logdet(ret) would@\\ +\mbox{}\verb@ ### be -Inf; make sure this does't happen@\\ +\mbox{}\verb@ if (any(D < .Machine$double.eps))@\\ +\mbox{}\verb@ D[D < .Machine$double.eps] <- 2 * .Machine$double.eps@\\ +\mbox{}\verb@@\\ \mbox{}\verb@ x <- unclass(x) * D[rep(1:J, 1:J),,drop = FALSE]@\\ \mbox{}\verb@@\\ \mbox{}\verb@ ret <- ltMatrices(x, diag = TRUE, byrow = TRUE, names = nm)@\\ -\mbox{}\verb@ ret <- ltMatrices(ret, byrow = byrow_orig)@\\ +\mbox{}\verb@ ret <- as.chol(ltMatrices(ret, byrow = byrow_orig))@\\ \mbox{}\verb@ return(ret)@\\ \mbox{}\verb@}@\\ \mbox{}\verb@@{\NWsep} @@ -2728,7 +2826,7 @@ First, we set-up functions for computing $\tilde{\mC}_i$ \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb45}{45}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb48}{48}. \item{} \end{list} @@ -2737,14 +2835,16 @@ First, we set-up functions for computing $\tilde{\mC}_i$ and $\tilde{\mC}_i^{-1} = \mL_i \text{diag}(\mL_i^{-1} \mL_i^{-\top})^{\frac{1}{2}}$ \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap50}\raggedright\small -\NWtarget{nuweb44}{} $\langle\,${\itshape L times D}\nobreak\ {\footnotesize {44}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap52}\raggedright\small +\NWtarget{nuweb47}{} $\langle\,${\itshape L times D}\nobreak\ {\footnotesize {47}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@### invcholD = solve(Dchol)@\\ \mbox{}\verb@invcholD <- function(x, D = sqrt(Tcrossprod(solve(x), diag_only = TRUE))) {@\\ \mbox{}\verb@@\\ +\mbox{}\verb@ if (is.chol(x)) stop("invcholD cannot work with chol objects")@\\ +\mbox{}\verb@@\\ \mbox{}\verb@ x <- .adddiag(x)@\\ \mbox{}\verb@@\\ \mbox{}\verb@ byrow_orig <- attr(x, "byrow")@\\ @@ -2755,10 +2855,15 @@ and $\tilde{\mC}_i^{-1} = \mL_i \text{diag}(\mL_i^{-1} \mL_i^{-\top})^{\frac{1}{ \mbox{}\verb@ J <- dim(x)[2L]@\\ \mbox{}\verb@ nm <- dimnames(x)[[2L]]@\\ \mbox{}\verb@@\\ +\mbox{}\verb@ ### for some parameter configurations logdet(ret) would@\\ +\mbox{}\verb@ ### be -Inf; make sure this does't happen@\\ +\mbox{}\verb@ if (any(D < .Machine$double.eps))@\\ +\mbox{}\verb@ D[D < .Machine$double.eps] <- 2 * .Machine$double.eps@\\ +\mbox{}\verb@@\\ \mbox{}\verb@ x <- unclass(x) * D[rep(1:J, J:1),,drop = FALSE]@\\ \mbox{}\verb@@\\ \mbox{}\verb@ ret <- ltMatrices(x, diag = TRUE, byrow = FALSE, names = nm)@\\ -\mbox{}\verb@ ret <- ltMatrices(ret, byrow = byrow_orig)@\\ +\mbox{}\verb@ ret <- as.invchol(ltMatrices(ret, byrow = byrow_orig))@\\ \mbox{}\verb@ return(ret)@\\ \mbox{}\verb@}@\\ \mbox{}\verb@@{\NWsep} @@ -2766,7 +2871,7 @@ and $\tilde{\mC}_i^{-1} = \mL_i \text{diag}(\mL_i^{-1} \mL_i^{-\top})^{\frac{1}{ \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb45}{45}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb48}{48}. \item{} \end{list} @@ -2775,13 +2880,14 @@ and $\tilde{\mC}_i^{-1} = \mL_i \text{diag}(\mL_i^{-1} \mL_i^{-\top})^{\frac{1}{ and now the convenience functions are one-liners: \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap51}\raggedright\small -\NWtarget{nuweb45}{} $\langle\,${\itshape convenience functions}\nobreak\ {\footnotesize {45}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap53}\raggedright\small +\NWtarget{nuweb48}{} $\langle\,${\itshape convenience functions}\nobreak\ {\footnotesize {48}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape D times C}\nobreak\ {\footnotesize \NWlink{nuweb43}{43}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape L times D}\nobreak\ {\footnotesize \NWlink{nuweb44}{44}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape chol classes}\nobreak\ {\footnotesize \NWlink{nuweb45}{45}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape D times C}\nobreak\ {\footnotesize \NWlink{nuweb46}{46}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape L times D}\nobreak\ {\footnotesize \NWlink{nuweb47}{47}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@### C -> Sigma@\\ \mbox{}\verb@chol2cov <- function(x)@\\ @@ -2789,11 +2895,11 @@ and now the convenience functions are one-liners: \mbox{}\verb@@\\ \mbox{}\verb@### L -> C@\\ \mbox{}\verb@invchol2chol <- function(x)@\\ -\mbox{}\verb@ solve(x)@\\ +\mbox{}\verb@ as.chol(solve(x))@\\ \mbox{}\verb@@\\ \mbox{}\verb@### C -> L@\\ \mbox{}\verb@chol2invchol <- function(x)@\\ -\mbox{}\verb@ solve(x)@\\ +\mbox{}\verb@ as.invchol(solve(x))@\\ \mbox{}\verb@@\\ \mbox{}\verb@### L -> Sigma@\\ \mbox{}\verb@invchol2cov <- function(x)@\\ @@ -2929,29 +3035,73 @@ chk(unlist(PC), c(as.array(chol2pc(C))), check.attributes = FALSE) @ -We also add an \code{aperm} method for class \code{ltMatrices} +We also add an \code{aperm} method for class \code{ltMatrices}, +implementing the parameters ($\tilde{\mC}_i$ or $\tilde{\mL}_i$) +for permuted versions of the +random vectors $\rY_i$. Let $\pi$ denote a permutation of $1, \dots, J$ and +$\Pi$ the corresponding permutation matrix. Then, we have +$\Pi \rY_i \sim \ND_\J(\mathbf{0}_\J, \Pi \mC_i \mC_i^\top \Pi^\top)$. +Unfortunately, $\Pi \mC_i$ is no longer lower triangular, so we have to find +the Cholesky decompositon $\tilde{\mC}_i \tilde{\mC}_i^\top$ of $\Pi \mC_i \mC_i^\top +\Pi^\top$. Of course, $\tilde{\mL}_i = \tilde{\mC}_i^{-1}$. + +The function \code{aperm}, with argument \code{perm} $=\pi$, +now computes the Cholesky factor $\tilde{\mC}_i$ +of the permuted covariance matrix, or the inverse thereof (in case +\code{x} is of class \code{invchol}). We start with some tests \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap52}\raggedright\small -\NWtarget{nuweb47}{} $\langle\,${\itshape aperm}\nobreak\ {\footnotesize {47}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap54}\raggedright\small +\NWtarget{nuweb50}{} $\langle\,${\itshape aperm checks}\nobreak\ {\footnotesize {50}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ -\mbox{}\verb@aperm.ltMatrices <- function(a, perm, is_chol = FALSE, ...) {@\\ +\mbox{}\verb@J <- dim(a)[2L]@\\ +\mbox{}\verb@if (missing(perm)) return(a)@\\ +\mbox{}\verb@if (is.character(perm)) @\\ +\mbox{}\verb@ perm <- match(perm, dimnames(a)[[2L]])@\\ +\mbox{}\verb@stopifnot(all(perm %in% 1:J))@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ if (is_chol) { ### a is Cholesky of covariance@\\ -\mbox{}\verb@ Sperm <- chol2cov(a)[,perm]@\\ -\mbox{}\verb@ return(chol(Sperm))@\\ -\mbox{}\verb@ }@\\ +\mbox{}\verb@args <- list(...)@\\ +\mbox{}\verb@if (length(args) > 0L)@\\ +\mbox{}\verb@ warning("Additional arguments", names(args), "ignored")@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb51a}{51a}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +and then implement the two methods + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap55}\raggedright\small +\NWtarget{nuweb51a}{} $\langle\,${\itshape aperm}\nobreak\ {\footnotesize {51a}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@aperm.chol <- function(a, perm, ...) {@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape aperm checks}\nobreak\ {\footnotesize \NWlink{nuweb50}{50}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@ return(as.chol(chol(chol2cov(a)[,perm])))@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@aperm.invchol <- function(a, perm, ...) {@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape aperm checks}\nobreak\ {\footnotesize \NWlink{nuweb50}{50}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ Sperm <- invchol2cov(a)[,perm]@\\ -\mbox{}\verb@ chol2invchol(chol(Sperm))@\\ +\mbox{}\verb@ return(chol2invchol(chol(invchol2cov(a)[,perm])))@\\ \mbox{}\verb@}@\\ \mbox{}\verb@@{\NWsep} \end{list} \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroDefBy\ \NWlink{nuweb51a}{51a}\NWlink{nuweb51b}{b}. \item \NWtxtMacroRefIn\ \NWlink{nuweb2}{2}. \item{} @@ -2959,37 +3109,69 @@ We also add an \code{aperm} method for class \code{ltMatrices} \end{minipage}\vspace{4ex} \end{flushleft} <>= -L <- lxn +L <- as.invchol(lxn) J <- dim(L)[2L] -Lp <- aperm(a = L, perm = p <- sample(1:J), is_chol = FALSE) +Lp <- aperm(a = L, perm = p <- sample(1:J)) chk(invchol2cov(L)[,p], invchol2cov(Lp)) -C <- lxn +C <- as.chol(lxn) J <- dim(C)[2L] -Cp <- aperm(a = C, perm = p <- sample(1:J), is_chol = TRUE) +Cp <- aperm(a = C, perm = p <- sample(1:J)) chk(chol2cov(C)[,p], chol2cov(Cp)) @ -\section{Marginal and Conditional Normal Distributions} +We finally add a method for class \code{ltMatrices}, for which we actually cannot +provide a reasonable result, and for symmetric matrices, where we simply +fall-back on subsetting + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap56}\raggedright\small +\NWtarget{nuweb51b}{} $\langle\,${\itshape aperm}\nobreak\ {\footnotesize {51b}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@aperm.ltMatrices <- function(a, perm, ...)@\\ +\mbox{}\verb@ stop("Cannot permute objects of class ltMatrices, @\\ +\mbox{}\verb@ consider calling as.chol() or as.invchol() first")@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@aperm.syMatrices <- function(a, perm, ...)@\\ +\mbox{}\verb@ return(a[,perm])@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroDefBy\ \NWlink{nuweb51a}{51a}\NWlink{nuweb51b}{b}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb2}{2}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +\section{Marginal and Conditional Normal Distributions} \label{sec:margcond} Marginal and conditional distributions from distributions $\rY_i \sim \ND_\J(\mathbf{0}_\J, \mC_i \mC_i^\top)$ (\code{chol} argument for $\mC_i$ for $i = 1, \dots, N$) or $\rY_i \sim \ND_\J(\mathbf{0}_\J, \mL_i^{-1} \mL_i^{-\top})$ (\code{invchol} argument for $\mL_i$ for $i = 1, \dots, N$) shall be computed. + \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap53}\raggedright\small -\NWtarget{nuweb48a}{} $\langle\,${\itshape mc input checks}\nobreak\ {\footnotesize {48a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap57}\raggedright\small +\NWtarget{nuweb52a}{} $\langle\,${\itshape mc input checks}\nobreak\ {\footnotesize {52a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@stopifnot(xor(missing(chol), missing(invchol)))@\\ \mbox{}\verb@x <- if (missing(chol)) invchol else chol@\\ \mbox{}\verb@@\\ -\mbox{}\verb@stopifnot(inherits(x, "ltMatrices"))@\\ +\mbox{}\verb@stopifnot(is.ltMatrices(x))@\\ \mbox{}\verb@@\\ \mbox{}\verb@N <- dim(x)[1L]@\\ \mbox{}\verb@J <- dim(x)[2L]@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@if (missing(which)) return(x)@\\ +\mbox{}\verb@@\\ \mbox{}\verb@if (is.character(which)) which <- match(which, dimnames(x)[[2L]])@\\ \mbox{}\verb@stopifnot(all(which %in% 1:J))@\\ \mbox{}\verb@@{\NWsep} @@ -2997,7 +3179,7 @@ computed. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb48b}{48b}\NWlink{nuweb50b}{, 50b}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb52b}{52b}\NWlink{nuweb55}{, 55}. \item{} \end{list} @@ -3010,23 +3192,26 @@ corresponding Cholesky factor (such that we can use \code{lpmvnorm} later on). \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap54}\raggedright\small -\NWtarget{nuweb48b}{} $\langle\,${\itshape marginal}\nobreak\ {\footnotesize {48b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap58}\raggedright\small +\NWtarget{nuweb52b}{} $\langle\,${\itshape marginal}\nobreak\ {\footnotesize {52b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@marg_mvnorm <- function(chol, invchol, which = 1L) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape mc input checks}\nobreak\ {\footnotesize \NWlink{nuweb48a}{48a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape mc input checks}\nobreak\ {\footnotesize \NWlink{nuweb52a}{52a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (which[1] == 1L && (length(which) == 1L || @\\ \mbox{}\verb@ all(diff(which) == 1L))) {@\\ \mbox{}\verb@ ### which is 1:j@\\ \mbox{}\verb@ tmp <- x[,which]@\\ \mbox{}\verb@ } else {@\\ -\mbox{}\verb@ if (missing(chol)) x <- solve(x)@\\ -\mbox{}\verb@ tmp <- base::chol(Tcrossprod(x)[,which])@\\ -\mbox{}\verb@ if (missing(chol)) tmp <- solve(tmp)@\\ +\mbox{}\verb@ if (missing(chol)) x <- invchol2chol(x)@\\ +\mbox{}\verb@ ### note: aperm would work but computes@\\ +\mbox{}\verb@ ### Cholesky of J^2, here only length(which)^2@\\ +\mbox{}\verb@ ### is needed@\\ +\mbox{}\verb@ tmp <- base::chol(chol2cov(x)[,which])@\\ +\mbox{}\verb@ if (missing(chol)) tmp <- chol2invchol(tmp)@\\ \mbox{}\verb@ }@\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (missing(chol))@\\ @@ -3063,8 +3248,8 @@ given) or $\tilde{\mL} = \tilde{\mC}^{-1}$ (if \code{invchol} was given). We can implement this as \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap55}\raggedright\small -\NWtarget{nuweb49}{} $\langle\,${\itshape cond general}\nobreak\ {\footnotesize {49}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap59}\raggedright\small +\NWtarget{nuweb53}{} $\langle\,${\itshape cond general}\nobreak\ {\footnotesize {53}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -3097,7 +3282,7 @@ We can implement this as \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb50b}{50b}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb55}{55}. \item{} \end{list} @@ -3125,8 +3310,8 @@ be returned. The implementation reads \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap56}\raggedright\small -\NWtarget{nuweb50a}{} $\langle\,${\itshape cond simple}\nobreak\ {\footnotesize {50a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap60}\raggedright\small +\NWtarget{nuweb54}{} $\langle\,${\itshape cond simple}\nobreak\ {\footnotesize {54}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -3135,44 +3320,82 @@ The implementation reads \mbox{}\verb@ ### which is 1:j@\\ \mbox{}\verb@ L <- if (missing(invchol)) solve(chol) else invchol@\\ \mbox{}\verb@ tmp <- matrix(0, ncol = ncol(given), nrow = J - length(which))@\\ -\mbox{}\verb@ centerm <- Mult(L, rbind(given, tmp))[-which,,drop = FALSE]@\\ +\mbox{}\verb@ centerm <- Mult(L, rbind(given, tmp)) @\\ +\mbox{}\verb@ ### if ncol(given) is not N = dim(L)[1L] > 1, then@\\ +\mbox{}\verb@ ### solve() below won't work and we loop over@\\ +\mbox{}\verb@ ### columns of centerm@\\ +\mbox{}\verb@ if (dim(L)[1L] > 1 && ncol(given) != N) {@\\ +\mbox{}\verb@ centerm <- lapply(1:ncol(centerm), function(j)@\\ +\mbox{}\verb@ matrix(centerm[,j], nrow = J, ncol = N)[-which,,drop = FALSE]@\\ +\mbox{}\verb@ )@\\ +\mbox{}\verb@ } else {@\\ +\mbox{}\verb@ centerm <- centerm[-which,,drop = FALSE]@\\ +\mbox{}\verb@ }@\\ \mbox{}\verb@ L <- L[,-which]@\\ +\mbox{}\verb@ ct <- centerm@\\ +\mbox{}\verb@ if (!is.matrix(ct)) ct <- do.call("rbind", ct)@\\ +\mbox{}\verb@ if (is.matrix(centerm)) {@\\ +\mbox{}\verb@ m <- -solve(L, centerm)@\\ +\mbox{}\verb@ } else {@\\ +\mbox{}\verb@ m <- do.call("rbind", lapply(centerm, function(cm) -solve(L, cm)))@\\ +\mbox{}\verb@ }@\\ \mbox{}\verb@ if (missing(invchol)) {@\\ \mbox{}\verb@ if (center)@\\ -\mbox{}\verb@ return(list(center = centerm, chol = solve(L)))@\\ -\mbox{}\verb@ return(list(mean = -solve(L, centerm), chol = solve(L)))@\\ +\mbox{}\verb@ return(list(center = ct, chol = solve(L)))@\\ +\mbox{}\verb@ return(list(mean = m, chol = solve(L)))@\\ \mbox{}\verb@ }@\\ \mbox{}\verb@ if (center)@\\ -\mbox{}\verb@ return(list(center = centerm, invchol = L))@\\ -\mbox{}\verb@ return(list(mean = -solve(L, centerm), invchol = L))@\\ +\mbox{}\verb@ return(list(center = ct, invchol = L))@\\ +\mbox{}\verb@ return(list(mean = m, invchol = L))@\\ \mbox{}\verb@}@\\ \mbox{}\verb@@{\NWsep} \end{list} \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb50b}{50b}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb55}{55}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} +Note that we could have avoided the general case altogether by first +computing a Cholesky decomposition of the permuted covariance matrix (such +that the conditioning variables come first). The code above only +decomposes the marginal (and thus lower-dimensional) covariance. However, we +didn't implement the \code{center = TRUE} case, so we can fall back on the +permuted version if this option is requested. Putting everything together +gives + \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap57}\raggedright\small -\NWtarget{nuweb50b}{} $\langle\,${\itshape conditional}\nobreak\ {\footnotesize {50b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap61}\raggedright\small +\NWtarget{nuweb55}{} $\langle\,${\itshape conditional}\nobreak\ {\footnotesize {55}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@cond_mvnorm <- function(chol, invchol, which_given = 1L, given, center = FALSE) {@\\ \mbox{}\verb@@\\ \mbox{}\verb@ which <- which_given@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape mc input checks}\nobreak\ {\footnotesize \NWlink{nuweb48a}{48a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape mc input checks}\nobreak\ {\footnotesize \NWlink{nuweb52a}{52a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (N == 1) N <- NCOL(given)@\\ \mbox{}\verb@ stopifnot(is.matrix(given) && nrow(given) == length(which))@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape cond simple}\nobreak\ {\footnotesize \NWlink{nuweb50a}{50a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape cond general}\nobreak\ {\footnotesize \NWlink{nuweb49}{49}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape cond simple}\nobreak\ {\footnotesize \NWlink{nuweb54}{54}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@ ### general with center = TRUE => permute first and go simple@\\ +\mbox{}\verb@ if (center) {@\\ +\mbox{}\verb@ perm <- c(which, (1:J)[!(1:J) %in% which])@\\ +\mbox{}\verb@ if (!missing(chol))@\\ +\mbox{}\verb@ return(cond_mvnorm(chol = aperm(as.chol(chol), perm = perm),@\\ +\mbox{}\verb@ which_given = 1:length(which), given = given,@\\ +\mbox{}\verb@ center = center))@\\ +\mbox{}\verb@ return(cond_mvnorm(invchol = aperm(as.invchol(invchol), perm = perm),@\\ +\mbox{}\verb@ which_given = 1:length(which), given = given,@\\ +\mbox{}\verb@ center = center))@\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape cond general}\nobreak\ {\footnotesize \NWlink{nuweb53}{53}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ chol <- base::chol(S)@\\ \mbox{}\verb@ if (missing(invchol)) @\\ @@ -3276,8 +3499,8 @@ log-likelihood contributions for observations $\yvec_1, \dots, \yvec_N$ in a function called \code{ldmvnorm} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap58}\raggedright\small -\NWtarget{nuweb52a}{} $\langle\,${\itshape ldmvnorm}\nobreak\ {\footnotesize {52a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap62}\raggedright\small +\NWtarget{nuweb57a}{} $\langle\,${\itshape ldmvnorm}\nobreak\ {\footnotesize {57a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -3288,9 +3511,9 @@ function called \code{ldmvnorm} \mbox{}\verb@ p <- ncol(obs)@\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (!missing(chol)) {@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape ldmvnorm chol}\nobreak\ {\footnotesize \NWlink{nuweb54a}{54a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape ldmvnorm chol}\nobreak\ {\footnotesize \NWlink{nuweb59a}{59a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@ } else {@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape ldmvnorm invchol}\nobreak\ {\footnotesize \NWlink{nuweb54b}{54b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape ldmvnorm invchol}\nobreak\ {\footnotesize \NWlink{nuweb59b}{59b}}$\,\rangle$}\verb@@\\ \mbox{}\verb@ }@\\ \mbox{}\verb@@\\ \mbox{}\verb@ names(logretval) <- colnames(obs)@\\ @@ -3302,7 +3525,7 @@ function called \code{ldmvnorm} \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb2}{2}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb64}{64}. \item{} \end{list} @@ -3313,8 +3536,8 @@ $\J \times N$ matrix \code{obs} with corresponding means $\muvec_1, \dots, \muvec_N$ in \code{means}. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap59}\raggedright\small -\NWtarget{nuweb52b}{} $\langle\,${\itshape check obs}\nobreak\ {\footnotesize {52b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap63}\raggedright\small +\NWtarget{nuweb57b}{} $\langle\,${\itshape check obs}\nobreak\ {\footnotesize {57b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -3366,8 +3589,8 @@ turns out to be time-consuming and memory intensive, so we provide a small internal helper function focusing on the necessary computations. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap60}\raggedright\small -\NWtarget{nuweb53a}{} $\langle\,${\itshape colSumsdnorm}\nobreak\ {\footnotesize {53a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap64}\raggedright\small +\NWtarget{nuweb58a}{} $\langle\,${\itshape colSumsdnorm}\nobreak\ {\footnotesize {58a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -3379,7 +3602,7 @@ internal helper function focusing on the necessary computations. \mbox{}\verb@ SEXP ans;@\\ \mbox{}\verb@ double *dans, Jl2pi, *dz;@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ Jl2pi = iJ * log(2 * PI);@\\ +\mbox{}\verb@ Jl2pi = iJ * log(2 * M_PI);@\\ \mbox{}\verb@ PROTECT(ans = allocVector(REALSXP, iN));@\\ \mbox{}\verb@ dans = REAL(ans);@\\ \mbox{}\verb@ dz = REAL(z);@\\ @@ -3407,8 +3630,8 @@ internal helper function focusing on the necessary computations. \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap61}\raggedright\small -\NWtarget{nuweb53b}{} $\langle\,${\itshape colSumsdnorm ltMatrices}\nobreak\ {\footnotesize {53b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap65}\raggedright\small +\NWtarget{nuweb58b}{} $\langle\,${\itshape colSumsdnorm ltMatrices}\nobreak\ {\footnotesize {58b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -3434,15 +3657,15 @@ internal helper function focusing on the necessary computations. The main part is now \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap62}\raggedright\small -\NWtarget{nuweb54a}{} $\langle\,${\itshape ldmvnorm chol}\nobreak\ {\footnotesize {54a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap66}\raggedright\small +\NWtarget{nuweb59a}{} $\langle\,${\itshape ldmvnorm chol}\nobreak\ {\footnotesize {59a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@if (missing(chol))@\\ \mbox{}\verb@ stop("either chol or invchol must be given")@\\ \mbox{}\verb@## chol is given@\\ -\mbox{}\verb@if (!inherits(chol, "ltMatrices"))@\\ +\mbox{}\verb@if (!is.ltMatrices(chol)) ### NOTE: replace with is.chol@\\ \mbox{}\verb@ stop("chol is not an object of class ltMatrices")@\\ \mbox{}\verb@N <- dim(chol)[1L]@\\ \mbox{}\verb@N <- ifelse(N == 1, p, N)@\\ @@ -3457,7 +3680,7 @@ The main part is now \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb52a}{52a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb57a}{57a}. \item{} \end{list} @@ -3473,13 +3696,13 @@ If $\mL_i = \mC_i^{-1}$ is given, we obtain \end{eqnarray*} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap63}\raggedright\small -\NWtarget{nuweb54b}{} $\langle\,${\itshape ldmvnorm invchol}\nobreak\ {\footnotesize {54b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap67}\raggedright\small +\NWtarget{nuweb59b}{} $\langle\,${\itshape ldmvnorm invchol}\nobreak\ {\footnotesize {59b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@## invchol is given@\\ -\mbox{}\verb@if (!inherits(invchol, "ltMatrices"))@\\ +\mbox{}\verb@if (!is.ltMatrices(invchol)) ### NOTE: replace with is.invchol@\\ \mbox{}\verb@ stop("invchol is not an object of class ltMatrices")@\\ \mbox{}\verb@N <- dim(invchol)[1L]@\\ \mbox{}\verb@N <- ifelse(N == 1, p, N)@\\ @@ -3498,7 +3721,7 @@ If $\mL_i = \mC_i^{-1}$ is given, we obtain \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb52a}{52a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb57a}{57a}. \item{} \end{list} @@ -3533,8 +3756,8 @@ In \code{sldmvnorm}, we compute the score with respect to $\mL_i$ and use the above relationship to compute the score with respect to $\mC_i$. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap64}\raggedright\small -\NWtarget{nuweb56}{} $\langle\,${\itshape sldmvnorm}\nobreak\ {\footnotesize {56}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap68}\raggedright\small +\NWtarget{nuweb61}{} $\langle\,${\itshape sldmvnorm}\nobreak\ {\footnotesize {61}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -3557,10 +3780,14 @@ the above relationship to compute the score with respect to $\mC_i$. \mbox{}\verb@ ret <- - matrix(Mix[, rep(1:N, each = J)] * Y, ncol = N)@\\ \mbox{}\verb@@\\ \mbox{}\verb@ M <- matrix(1:(J^2), nrow = J, byrow = FALSE)@\\ -\mbox{}\verb@ ret <- ltMatrices(ret[M[lower.tri(M, diag = attr(invchol, "diag"))],,drop = FALSE], @\\ -\mbox{}\verb@ diag = attr(invchol, "diag"), byrow = FALSE)@\\ -\mbox{}\verb@ ret <- ltMatrices(ret, @\\ -\mbox{}\verb@ diag = attr(invchol, "diag"), byrow = attr(invchol, "byrow"))@\\ +\mbox{}\verb@ ret <- ret[M[lower.tri(M, diag = attr(invchol, "diag"))],,drop = FALSE]@\\ +\mbox{}\verb@ if (!is.null(dimnames(invchol)[[1L]]))@\\ +\mbox{}\verb@ colnames(ret) <- dimnames(invchol)[[1]]@\\ +\mbox{}\verb@ ret <- ltMatrices(ret,@\\ +\mbox{}\verb@ diag = attr(invchol, "diag"), byrow = FALSE,@\\ +\mbox{}\verb@ names = dimnames(invchol)[[2L]])@\\ +\mbox{}\verb@ ret <- ltMatrices(ret, diag = attr(invchol, "diag"), @\\ +\mbox{}\verb@ byrow = attr(invchol, "byrow"))@\\ \mbox{}\verb@ if (attr(invchol, "diag")) {@\\ \mbox{}\verb@ ### recycle properly@\\ \mbox{}\verb@ diagonals(ret) <- diagonals(ret) + c(1 / diagonals(invchol))@\\ @@ -3569,14 +3796,15 @@ the above relationship to compute the score with respect to $\mC_i$. \mbox{}\verb@ }@\\ \mbox{}\verb@ ret <- list(obs = sobs, invchol = ret)@\\ \mbox{}\verb@ if (logLik) @\\ -\mbox{}\verb@ ret$logLik <- ldmvnorm(obs = obs, mean = mean, invchol = invchol, logLik = FALSE)@\\ +\mbox{}\verb@ ret$logLik <- ldmvnorm(obs = obs, mean = mean, @\\ +\mbox{}\verb@ invchol = invchol, logLik = FALSE)@\\ \mbox{}\verb@ return(ret)@\\ \mbox{}\verb@ }@\\ \mbox{}\verb@@\\ \mbox{}\verb@ invchol <- solve(chol)@\\ \mbox{}\verb@ ret <- sldmvnorm(obs = obs, mean = mean, invchol = invchol)@\\ \mbox{}\verb@ ### this means: ret$chol <- - vectrick(invchol, ret$invchol, invchol)@\\ -\mbox{}\verb@ ret$chol <- - vectrick(invchol, ret$invchol)@\\ +\mbox{}\verb@ ret$chol <- as.chol(- vectrick(invchol, ret$invchol))@\\ \mbox{}\verb@ ret$invchol <- NULL@\\ \mbox{}\verb@ return(ret)@\\ \mbox{}\verb@}@\\ @@ -3585,7 +3813,7 @@ the above relationship to compute the score with respect to $\mC_i$. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb2}{2}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb64}{64}. \item{} \end{list} @@ -3595,7 +3823,7 @@ the above relationship to compute the score with respect to $\mC_i$. Let's say we have $\rY_i \sim \ND_\J(\mathbf{0}_J, \mC_i \mC_i^{\top})$ for $i = 1, \dots, N$ and we know the Cholesky factors $\mL_i = \mC_i^{-1}$ of the $N$ -precision matrices $\Sigma^{-1} = \mL_i \mL_i^{\top}$. We generate $\rY_i = \mL_i^{-1} +precision matrices $\Sigma^{-1}_i = \mL_i \mL_i^{\top}$. We generate $\rY_i = \mL_i^{-1} \rZ_i$ from $\rZ_i \sim \ND_\J(\mathbf{0}_\J, \mI_\J)$. Evaluating the corresponding log-likelihood is now straightforward and fast, compared to repeated calls to \code{dmvnorm} @@ -3610,7 +3838,8 @@ Y <- solve(lt, Z) ll1 <- sum(dnorm(Mult(lt, Y), log = TRUE)) + sum(log(diagonals(lt))) S <- as.array(Tcrossprod(solve(lt))) -ll2 <- sum(sapply(1:N, function(i) dmvnorm(x = Y[,i], sigma = S[,,i], log = TRUE))) +ll2 <- sum(sapply(1:N, function(i) + dmvnorm(x = Y[,i], sigma = S[,,i], log = TRUE))) chk(ll1, ll2) @ @@ -3661,14 +3890,14 @@ This is relatively simple to achieve using the existing \code{pmvnorm} function, so a prototype might look like \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap65}\raggedright\small -\NWtarget{nuweb58}{} $\langle\,${\itshape lpmvnormR}\nobreak\ {\footnotesize {58}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap69}\raggedright\small +\NWtarget{nuweb63}{} $\langle\,${\itshape lpmvnormR}\nobreak\ {\footnotesize {63}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@lpmvnormR <- function(lower, upper, mean = 0, center = NULL, chol, logLik = TRUE, ...) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape input checks}\nobreak\ {\footnotesize \NWlink{nuweb60a}{60a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape input checks}\nobreak\ {\footnotesize \NWlink{nuweb66}{66}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ sigma <- Tcrossprod(chol)@\\ \mbox{}\verb@ S <- as.array(sigma)@\\ @@ -3708,7 +3937,7 @@ lpmvnormR <- function(lower, upper, mean = 0, center = NULL, chol, logLik = TRUE if (!is.matrix(upper)) upper <- matrix(upper, ncol = 1) stopifnot(isTRUE(all.equal(dim(lower), dim(upper)))) - stopifnot(inherits(chol, "ltMatrices")) + stopifnot(is.ltMatrices(chol)) ### NOTE: replace with is.chol byrow_orig <- attr(chol, "byrow") chol <- ltMatrices(chol, byrow = TRUE) d <- dim(chol) @@ -3718,8 +3947,11 @@ lpmvnormR <- function(lower, upper, mean = 0, center = NULL, chol, logLik = TRUE stopifnot(nrow(lower) == J && ncol(lower) == N) stopifnot(nrow(upper) == J && ncol(upper) == N) - if (is.matrix(mean)) + if (is.matrix(mean)) { + if (ncol(mean) == 1L) + mean <- mean[,rep(1, N),drop = FALSE] stopifnot(nrow(mean) == J && ncol(mean) == N) + } lower <- lower - mean upper <- upper - mean @@ -3784,14 +4016,21 @@ functions for all arguments $\avec_i$, $\bvec_i$, and $\mC_i$. \section{Algorithm} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap66}\raggedright\small -\NWtarget{nuweb59a}{} \verb@"lpmvnorm.R"@\nobreak\ {\footnotesize {59a}}$\equiv$ +\begin{minipage}{\linewidth}\label{scrap70}\raggedright\small +\NWtarget{nuweb64}{} \verb@"lpmvnorm.R"@\nobreak\ {\footnotesize {64}}$\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape R Header}\nobreak\ {\footnotesize \NWlink{nuweb104}{104}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape lpmvnorm}\nobreak\ {\footnotesize \NWlink{nuweb69}{69}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape slpmvnorm}\nobreak\ {\footnotesize \NWlink{nuweb82}{82}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape R Header}\nobreak\ {\footnotesize \NWlink{nuweb131}{131}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape lpmvnorm}\nobreak\ {\footnotesize \NWlink{nuweb75}{75}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape slpmvnorm}\nobreak\ {\footnotesize \NWlink{nuweb87}{87}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape ldmvnorm}\nobreak\ {\footnotesize \NWlink{nuweb57a}{57a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape sldmvnorm}\nobreak\ {\footnotesize \NWlink{nuweb61}{61}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape ldpmvnorm}\nobreak\ {\footnotesize \NWlink{nuweb100}{100}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape sldpmvnorm}\nobreak\ {\footnotesize \NWlink{nuweb102}{102}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape deperma}\nobreak\ {\footnotesize \NWlink{nuweb107}{107}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape standardize}\nobreak\ {\footnotesize \NWlink{nuweb109}{109}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape destandardize}\nobreak\ {\footnotesize \NWlink{nuweb111}{111}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@{\NWsep} \end{list} \vspace{-1.5ex} @@ -3803,12 +4042,12 @@ functions for all arguments $\avec_i$, $\bvec_i$, and $\mC_i$. \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap67}\raggedright\small -\NWtarget{nuweb59b}{} \verb@"lpmvnorm.c"@\nobreak\ {\footnotesize {59b}}$\equiv$ +\begin{minipage}{\linewidth}\label{scrap71}\raggedright\small +\NWtarget{nuweb65}{} \verb@"lpmvnorm.c"@\nobreak\ {\footnotesize {65}}$\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape C Header}\nobreak\ {\footnotesize \NWlink{nuweb105}{105}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape C Header}\nobreak\ {\footnotesize \NWlink{nuweb132}{132}}$\,\rangle$}\verb@@\\ \mbox{}\verb@#ifndef USE_FC_LEN_T@\\ \mbox{}\verb@# define USE_FC_LEN_T@\\ \mbox{}\verb@#endif@\\ @@ -3821,10 +4060,10 @@ functions for all arguments $\avec_i$, $\bvec_i$, and $\mC_i$. \mbox{}\verb@#include @\\ \mbox{}\verb@#include @\\ \mbox{}\verb@#include @\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape pnorm fast}\nobreak\ {\footnotesize \NWlink{nuweb64a}{64a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape pnorm slow}\nobreak\ {\footnotesize \NWlink{nuweb64b}{64b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape R lpmvnorm}\nobreak\ {\footnotesize \NWlink{nuweb67}{67}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape R slpmvnorm}\nobreak\ {\footnotesize \NWlink{nuweb79}{79}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape pnorm fast}\nobreak\ {\footnotesize \NWlink{nuweb70b}{70b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape pnorm slow}\nobreak\ {\footnotesize \NWlink{nuweb70c}{70c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape R lpmvnorm}\nobreak\ {\footnotesize \NWlink{nuweb73}{73}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape R slpmvnorm}\nobreak\ {\footnotesize \NWlink{nuweb84}{84}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@{\NWsep} \end{list} \vspace{-1.5ex} @@ -3846,8 +4085,8 @@ For each $i = 1, \dots, N$, do (\code{upper}), and control parameters $\alpha$, $\epsilon$, and $M_\text{max}$ (\code{M}). \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap68}\raggedright\small -\NWtarget{nuweb60a}{} $\langle\,${\itshape input checks}\nobreak\ {\footnotesize {60a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap72}\raggedright\small +\NWtarget{nuweb66}{} $\langle\,${\itshape input checks}\nobreak\ {\footnotesize {66}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -3855,7 +4094,7 @@ For each $i = 1, \dots, N$, do \mbox{}\verb@if (!is.matrix(upper)) upper <- matrix(upper, ncol = 1)@\\ \mbox{}\verb@stopifnot(isTRUE(all.equal(dim(lower), dim(upper))))@\\ \mbox{}\verb@@\\ -\mbox{}\verb@stopifnot(inherits(chol, "ltMatrices"))@\\ +\mbox{}\verb@stopifnot(is.ltMatrices(chol)) ### NOTE: replace with is.chol@\\ \mbox{}\verb@byrow_orig <- attr(chol, "byrow")@\\ \mbox{}\verb@chol <- ltMatrices(chol, byrow = TRUE)@\\ \mbox{}\verb@d <- dim(chol)@\\ @@ -3865,8 +4104,11 @@ For each $i = 1, \dots, N$, do \mbox{}\verb@@\\ \mbox{}\verb@stopifnot(nrow(lower) == J && ncol(lower) == N)@\\ \mbox{}\verb@stopifnot(nrow(upper) == J && ncol(upper) == N)@\\ -\mbox{}\verb@if (is.matrix(mean))@\\ +\mbox{}\verb@if (is.matrix(mean)) {@\\ +\mbox{}\verb@ if (ncol(mean) == 1L) @\\ +\mbox{}\verb@ mean <- mean[,rep(1, N),drop = FALSE]@\\ \mbox{}\verb@ stopifnot(nrow(mean) == J && ncol(mean) == N)@\\ +\mbox{}\verb@}@\\ \mbox{}\verb@@\\ \mbox{}\verb@lower <- lower - mean@\\ \mbox{}\verb@upper <- upper - mean@\\ @@ -3880,7 +4122,7 @@ For each $i = 1, \dots, N$, do \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb58}{58}\NWlink{nuweb69}{, 69}\NWlink{nuweb82}{, 82}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb63}{63}\NWlink{nuweb75}{, 75}\NWlink{nuweb87}{, 87}. \item{} \end{list} @@ -3890,8 +4132,8 @@ For each $i = 1, \dots, N$, do \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap69}\raggedright\small -\NWtarget{nuweb60b}{} $\langle\,${\itshape standardise}\nobreak\ {\footnotesize {60b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap73}\raggedright\small +\NWtarget{nuweb67a}{} $\langle\,${\itshape standardise}\nobreak\ {\footnotesize {67a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -3919,7 +4161,7 @@ For each $i = 1, \dots, N$, do \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb69}{69}\NWlink{nuweb82}{, 82}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb75}{75}\NWlink{nuweb87}{, 87}. \item{} \end{list} @@ -3930,8 +4172,8 @@ For each $i = 1, \dots, N$, do \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap70}\raggedright\small -\NWtarget{nuweb61a}{} $\langle\,${\itshape initialisation}\nobreak\ {\footnotesize {61a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap74}\raggedright\small +\NWtarget{nuweb67b}{} $\langle\,${\itshape initialisation}\nobreak\ {\footnotesize {67b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -3948,7 +4190,7 @@ For each $i = 1, \dots, N$, do \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb67}{67}\NWlink{nuweb79}{, 79}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb73}{73}\NWlink{nuweb84}{, 84}. \item{} \end{list} @@ -3957,8 +4199,8 @@ For each $i = 1, \dots, N$, do \item Repeat \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap71}\raggedright\small -\NWtarget{nuweb61b}{} $\langle\,${\itshape init logLik loop}\nobreak\ {\footnotesize {61b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap75}\raggedright\small +\NWtarget{nuweb67c}{} $\langle\,${\itshape init logLik loop}\nobreak\ {\footnotesize {67c}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -3971,7 +4213,7 @@ For each $i = 1, \dots, N$, do \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb67}{67}\NWlink{nuweb73b}{, 73b}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb73}{73}\NWlink{nuweb79b}{, 79b}. \item{} \end{list} @@ -3990,8 +4232,8 @@ We either generate $w_{j - 1}$ on the fly or use pre-computed weights (\code{w}). \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap72}\raggedright\small -\NWtarget{nuweb61c}{} $\langle\,${\itshape compute y}\nobreak\ {\footnotesize {61c}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap76}\raggedright\small +\NWtarget{nuweb68a}{} $\langle\,${\itshape compute y}\nobreak\ {\footnotesize {68a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4010,7 +4252,7 @@ We either generate $w_{j - 1}$ on the fly or use pre-computed weights \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb62d}{62d}\NWlink{nuweb77a}{, 77a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb69b}{69b}\NWlink{nuweb83a}{, 83a}. \item{} \end{list} @@ -4021,8 +4263,8 @@ We either generate $w_{j - 1}$ on the fly or use pre-computed weights \end{eqnarray*} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap73}\raggedright\small -\NWtarget{nuweb62a}{} $\langle\,${\itshape compute x}\nobreak\ {\footnotesize {62a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap77}\raggedright\small +\NWtarget{nuweb68b}{} $\langle\,${\itshape compute x}\nobreak\ {\footnotesize {68b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4040,7 +4282,7 @@ We either generate $w_{j - 1}$ on the fly or use pre-computed weights \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb62d}{62d}\NWlink{nuweb77a}{, 77a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb69b}{69b}\NWlink{nuweb83a}{, 83a}. \item{} \end{list} @@ -4052,8 +4294,8 @@ We either generate $w_{j - 1}$ on the fly or use pre-computed weights \end{eqnarray*} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap74}\raggedright\small -\NWtarget{nuweb62b}{} $\langle\,${\itshape update d, e}\nobreak\ {\footnotesize {62b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap78}\raggedright\small +\NWtarget{nuweb68c}{} $\langle\,${\itshape update d, e}\nobreak\ {\footnotesize {68c}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4065,7 +4307,7 @@ We either generate $w_{j - 1}$ on the fly or use pre-computed weights \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb62d}{62d}\NWlink{nuweb77a}{, 77a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb69b}{69b}\NWlink{nuweb83a}{, 83a}. \item{} \end{list} @@ -4076,8 +4318,8 @@ We either generate $w_{j - 1}$ on the fly or use pre-computed weights \end{eqnarray*} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap75}\raggedright\small -\NWtarget{nuweb62c}{} $\langle\,${\itshape update f}\nobreak\ {\footnotesize {62c}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap79}\raggedright\small +\NWtarget{nuweb69a}{} $\langle\,${\itshape update f}\nobreak\ {\footnotesize {69a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4088,7 +4330,7 @@ We either generate $w_{j - 1}$ on the fly or use pre-computed weights \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb62d}{62d}\NWlink{nuweb77a}{, 77a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb69b}{69b}\NWlink{nuweb83a}{, 83a}. \item{} \end{list} @@ -4097,24 +4339,24 @@ We either generate $w_{j - 1}$ on the fly or use pre-computed weights We put everything together in a loop starting with the second dimension \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap76}\raggedright\small -\NWtarget{nuweb62d}{} $\langle\,${\itshape inner logLik loop}\nobreak\ {\footnotesize {62d}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap80}\raggedright\small +\NWtarget{nuweb69b}{} $\langle\,${\itshape inner logLik loop}\nobreak\ {\footnotesize {69b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@for (j = 1; j < iJ; j++) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape compute y}\nobreak\ {\footnotesize \NWlink{nuweb61c}{61c}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape compute x}\nobreak\ {\footnotesize \NWlink{nuweb62a}{62a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape update d, e}\nobreak\ {\footnotesize \NWlink{nuweb62b}{62b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape update f}\nobreak\ {\footnotesize \NWlink{nuweb62c}{62c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape compute y}\nobreak\ {\footnotesize \NWlink{nuweb68a}{68a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape compute x}\nobreak\ {\footnotesize \NWlink{nuweb68b}{68b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape update d, e}\nobreak\ {\footnotesize \NWlink{nuweb68c}{68c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape update f}\nobreak\ {\footnotesize \NWlink{nuweb69a}{69a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@}@\\ \mbox{}\verb@@{\NWsep} \end{list} \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb67}{67}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb73}{73}. \item{} \end{list} @@ -4124,8 +4366,8 @@ We put everything together in a loop starting with the second dimension and $\text{error} = \sqrt{(\text{varsum}/M - (\text{intsum}/M)^2) / M}$. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap77}\raggedright\small -\NWtarget{nuweb63a}{} $\langle\,${\itshape increment}\nobreak\ {\footnotesize {63a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap81}\raggedright\small +\NWtarget{nuweb69c}{} $\langle\,${\itshape increment}\nobreak\ {\footnotesize {69c}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4135,7 +4377,7 @@ We put everything together in a loop starting with the second dimension \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb67}{67}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb73}{73}. \item{} \end{list} @@ -4151,8 +4393,8 @@ We refrain from early stopping and error estimation. We return $\log{\hat{p}_i}$ for each $i$, or we immediately sum-up over $i$. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap78}\raggedright\small -\NWtarget{nuweb63b}{} $\langle\,${\itshape output}\nobreak\ {\footnotesize {63b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap82}\raggedright\small +\NWtarget{nuweb69d}{} $\langle\,${\itshape output}\nobreak\ {\footnotesize {69d}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4164,7 +4406,7 @@ We return $\log{\hat{p}_i}$ for each $i$, or we immediately sum-up over $i$. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb67}{67}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb73}{73}. \item{} \end{list} @@ -4174,8 +4416,8 @@ and move on to the next observation (note that \code{p} might be $0$ in case $\mC_i \equiv \mC$). \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap79}\raggedright\small -\NWtarget{nuweb63c}{} $\langle\,${\itshape move on}\nobreak\ {\footnotesize {63c}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap83}\raggedright\small +\NWtarget{nuweb70a}{} $\langle\,${\itshape move on}\nobreak\ {\footnotesize {70a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4188,7 +4430,7 @@ $\mC_i \equiv \mC$). \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb67}{67}\NWlink{nuweb79}{, 79}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb73}{73}\NWlink{nuweb84}{, 84}. \item{} \end{list} @@ -4197,12 +4439,13 @@ $\mC_i \equiv \mC$). \end{enumerate} It turned out that calls to \code{pnorm} are expensive, so a slightly faster -alternative \citep[suggested by][]{Matic_Radoicic_Stefanica_2018} can be used +alternative \citep[suggested by][]{Matic_Radoicic_Stefanica_2018} might +provide an alternative which can be requested from using (\code{fast = TRUE} in the calls to \code{lpmvnorm} and \code{slpmvnorm}): \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap80}\raggedright\small -\NWtarget{nuweb64a}{} $\langle\,${\itshape pnorm fast}\nobreak\ {\footnotesize {64a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap84}\raggedright\small +\NWtarget{nuweb70b}{} $\langle\,${\itshape pnorm fast}\nobreak\ {\footnotesize {70b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4239,15 +4482,15 @@ alternative \citep[suggested by][]{Matic_Radoicic_Stefanica_2018} can be used \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb59b}{59b}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb65}{65}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap81}\raggedright\small -\NWtarget{nuweb64b}{} $\langle\,${\itshape pnorm slow}\nobreak\ {\footnotesize {64b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap85}\raggedright\small +\NWtarget{nuweb70c}{} $\langle\,${\itshape pnorm slow}\nobreak\ {\footnotesize {70c}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4259,7 +4502,7 @@ alternative \citep[suggested by][]{Matic_Radoicic_Stefanica_2018} can be used \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb59b}{59b}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb65}{65}. \item{} \end{list} @@ -4269,8 +4512,8 @@ The \code{fast} argument can be used to switch on the faster but less accurate version of \code{pnorm} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap82}\raggedright\small -\NWtarget{nuweb64c}{} $\langle\,${\itshape pnorm}\nobreak\ {\footnotesize {64c}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap86}\raggedright\small +\NWtarget{nuweb71a}{} $\langle\,${\itshape pnorm}\nobreak\ {\footnotesize {71a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4283,7 +4526,7 @@ accurate version of \code{pnorm} \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb67}{67}\NWlink{nuweb79}{, 79}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb73}{73}\NWlink{nuweb84}{, 84}. \item{} \end{list} @@ -4294,8 +4537,8 @@ observations. In the former case, the number of columns is $M \times N$ and in the latter just $M$. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap83}\raggedright\small -\NWtarget{nuweb65a}{} $\langle\,${\itshape W length}\nobreak\ {\footnotesize {65a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap87}\raggedright\small +\NWtarget{nuweb71b}{} $\langle\,${\itshape W length}\nobreak\ {\footnotesize {71b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4315,15 +4558,15 @@ in the latter just $M$. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb67}{67}\NWlink{nuweb79}{, 79}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb73}{73}\NWlink{nuweb84}{, 84}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap84}\raggedright\small -\NWtarget{nuweb65b}{} $\langle\,${\itshape dimensions}\nobreak\ {\footnotesize {65b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap88}\raggedright\small +\NWtarget{nuweb71c}{} $\langle\,${\itshape dimensions}\nobreak\ {\footnotesize {71c}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4345,15 +4588,15 @@ in the latter just $M$. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb67}{67}\NWlink{nuweb79}{, 79}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb73}{73}\NWlink{nuweb84}{, 84}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap85}\raggedright\small -\NWtarget{nuweb65c}{} $\langle\,${\itshape setup return object}\nobreak\ {\footnotesize {65c}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap89}\raggedright\small +\NWtarget{nuweb72a}{} $\langle\,${\itshape setup return object}\nobreak\ {\footnotesize {72a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4367,7 +4610,7 @@ in the latter just $M$. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb67}{67}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb73}{73}. \item{} \end{list} @@ -4376,8 +4619,8 @@ in the latter just $M$. The case $\J = 1$ does not loop over $M$ \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap86}\raggedright\small -\NWtarget{nuweb66a}{} $\langle\,${\itshape univariate problem}\nobreak\ {\footnotesize {66a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap90}\raggedright\small +\NWtarget{nuweb72b}{} $\langle\,${\itshape univariate problem}\nobreak\ {\footnotesize {72b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4392,15 +4635,15 @@ The case $\J = 1$ does not loop over $M$ \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb67}{67}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb73}{73}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap87}\raggedright\small -\NWtarget{nuweb66b}{} $\langle\,${\itshape init center}\nobreak\ {\footnotesize {66b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap91}\raggedright\small +\NWtarget{nuweb72c}{} $\langle\,${\itshape init center}\nobreak\ {\footnotesize {72c}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4414,7 +4657,7 @@ The case $\J = 1$ does not loop over $M$ \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb67}{67}\NWlink{nuweb79}{, 79}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb73}{73}\NWlink{nuweb84}{, 84}. \item{} \end{list} @@ -4423,8 +4666,8 @@ The case $\J = 1$ does not loop over $M$ We put the code together in a dedicated \proglang{C} function \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap88}\raggedright\small -\NWtarget{nuweb66c}{} $\langle\,${\itshape R slpmvnorm variables}\nobreak\ {\footnotesize {66c}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap92}\raggedright\small +\NWtarget{nuweb72d}{} $\langle\,${\itshape R slpmvnorm variables}\nobreak\ {\footnotesize {72d}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4438,41 +4681,41 @@ We put the code together in a dedicated \proglang{C} function \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb67}{67}\NWlink{nuweb79}{, 79}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb73}{73}\NWlink{nuweb84}{, 84}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap89}\raggedright\small -\NWtarget{nuweb67}{} $\langle\,${\itshape R lpmvnorm}\nobreak\ {\footnotesize {67}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap93}\raggedright\small +\NWtarget{nuweb73}{} $\langle\,${\itshape R lpmvnorm}\nobreak\ {\footnotesize {73}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@SEXP R_lpmvnorm(SEXP a, SEXP b, SEXP C, SEXP center, SEXP N, SEXP J, @\\ \mbox{}\verb@ SEXP W, SEXP M, SEXP tol, SEXP logLik, SEXP fast) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape R slpmvnorm variables}\nobreak\ {\footnotesize \NWlink{nuweb66c}{66c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape R slpmvnorm variables}\nobreak\ {\footnotesize \NWlink{nuweb72d}{72d}}$\,\rangle$}\verb@@\\ \mbox{}\verb@ double l0, lM, x0, intsum;@\\ \mbox{}\verb@ int p, len;@\\ \mbox{}\verb@@\\ \mbox{}\verb@ Rboolean RlogLik = asLogical(logLik);@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape pnorm}\nobreak\ {\footnotesize \NWlink{nuweb64c}{64c}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape dimensions}\nobreak\ {\footnotesize \NWlink{nuweb65b}{65b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape W length}\nobreak\ {\footnotesize \NWlink{nuweb65a}{65a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape init center}\nobreak\ {\footnotesize \NWlink{nuweb66b}{66b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape pnorm}\nobreak\ {\footnotesize \NWlink{nuweb71a}{71a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape dimensions}\nobreak\ {\footnotesize \NWlink{nuweb71c}{71c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape W length}\nobreak\ {\footnotesize \NWlink{nuweb71b}{71b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape init center}\nobreak\ {\footnotesize \NWlink{nuweb72c}{72c}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ int start, j, k;@\\ \mbox{}\verb@ double tmp, Wtmp, e, d, f, emd, x, y[(iJ > 1 ? iJ - 1 : 1)];@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape setup return object}\nobreak\ {\footnotesize \NWlink{nuweb65c}{65c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape setup return object}\nobreak\ {\footnotesize \NWlink{nuweb72a}{72a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ q0 = qnorm(dtol, 0.0, 1.0, 1L, 0L);@\\ \mbox{}\verb@ l0 = log(dtol);@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape univariate problem}\nobreak\ {\footnotesize \NWlink{nuweb66a}{66a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape univariate problem}\nobreak\ {\footnotesize \NWlink{nuweb72b}{72b}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (W == R_NilValue)@\\ \mbox{}\verb@ GetRNGstate();@\\ @@ -4480,23 +4723,23 @@ We put the code together in a dedicated \proglang{C} function \mbox{}\verb@ for (int i = 0; i < iN; i++) {@\\ \mbox{}\verb@@\\ \mbox{}\verb@ x0 = 0;@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape initialisation}\nobreak\ {\footnotesize \NWlink{nuweb61a}{61a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape initialisation}\nobreak\ {\footnotesize \NWlink{nuweb67b}{67b}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (W != R_NilValue && pW == 0)@\\ \mbox{}\verb@ dW = REAL(W);@\\ \mbox{}\verb@@\\ \mbox{}\verb@ for (int m = 0; m < iM; m++) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape init logLik loop}\nobreak\ {\footnotesize \NWlink{nuweb61b}{61b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape inner logLik loop}\nobreak\ {\footnotesize \NWlink{nuweb62d}{62d}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape increment}\nobreak\ {\footnotesize \NWlink{nuweb63a}{63a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape init logLik loop}\nobreak\ {\footnotesize \NWlink{nuweb67c}{67c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape inner logLik loop}\nobreak\ {\footnotesize \NWlink{nuweb69b}{69b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape increment}\nobreak\ {\footnotesize \NWlink{nuweb69c}{69c}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (W != R_NilValue)@\\ \mbox{}\verb@ dW += iJ - 1;@\\ \mbox{}\verb@ }@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape output}\nobreak\ {\footnotesize \NWlink{nuweb63b}{63b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape move on}\nobreak\ {\footnotesize \NWlink{nuweb63c}{63c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape output}\nobreak\ {\footnotesize \NWlink{nuweb69d}{69d}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape move on}\nobreak\ {\footnotesize \NWlink{nuweb70a}{70a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@ }@\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (W == R_NilValue)@\\ @@ -4510,7 +4753,7 @@ We put the code together in a dedicated \proglang{C} function \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb59b}{59b}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb65}{65}. \item{} \end{list} @@ -4521,8 +4764,8 @@ The \proglang{R} user interface consists of some checks and a call to case we want a new set of weights for each observation. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap90}\raggedright\small -\NWtarget{nuweb68a}{} $\langle\,${\itshape init random seed, reset on exit}\nobreak\ {\footnotesize {68a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap94}\raggedright\small +\NWtarget{nuweb74a}{} $\langle\,${\itshape init random seed, reset on exit}\nobreak\ {\footnotesize {74a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4542,15 +4785,15 @@ case we want a new set of weights for each observation. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb69}{69}\NWlink{nuweb82}{, 82}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb75}{75}\NWlink{nuweb87}{, 87}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap91}\raggedright\small -\NWtarget{nuweb68b}{} $\langle\,${\itshape check and / or set integration weights}\nobreak\ {\footnotesize {68b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap95}\raggedright\small +\NWtarget{nuweb74b}{} $\langle\,${\itshape check and / or set integration weights}\nobreak\ {\footnotesize {74b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4573,20 +4816,20 @@ case we want a new set of weights for each observation. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb69}{69}\NWlink{nuweb82}{, 82}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb75}{75}\NWlink{nuweb87}{, 87}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} Sometimes we want to evaluate the log-likelihood based on $\mL = \mC^{-1}$, -the Cholesky factor of the precision (not the covariance) matrix. In this +the inverse Cholesky factor of the covariance matrix. In this case, we explicitly invert $\mL$ to give $\mC$ (both matrices are lower triangular, so this is fast). \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap92}\raggedright\small -\NWtarget{nuweb68c}{} $\langle\,${\itshape Cholesky of precision}\nobreak\ {\footnotesize {68c}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap96}\raggedright\small +\NWtarget{nuweb74c}{} $\langle\,${\itshape Cholesky of precision}\nobreak\ {\footnotesize {74c}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4597,15 +4840,15 @@ triangular, so this is fast). \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb69}{69}\NWlink{nuweb82}{, 82}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb75}{75}\NWlink{nuweb87}{, 87}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap93}\raggedright\small -\NWtarget{nuweb69}{} $\langle\,${\itshape lpmvnorm}\nobreak\ {\footnotesize {69}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap97}\raggedright\small +\NWtarget{nuweb75}{} $\langle\,${\itshape lpmvnorm}\nobreak\ {\footnotesize {75}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4613,11 +4856,11 @@ triangular, so this is fast). \mbox{}\verb@ logLik = TRUE, M = NULL, w = NULL, seed = NULL, @\\ \mbox{}\verb@ tol = .Machine$double.eps, fast = FALSE) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape init random seed, reset on exit}\nobreak\ {\footnotesize \NWlink{nuweb68a}{68a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape Cholesky of precision}\nobreak\ {\footnotesize \NWlink{nuweb68c}{68c}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape input checks}\nobreak\ {\footnotesize \NWlink{nuweb60a}{60a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape standardise}\nobreak\ {\footnotesize \NWlink{nuweb60b}{60b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape check and / or set integration weights}\nobreak\ {\footnotesize \NWlink{nuweb68b}{68b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape init random seed, reset on exit}\nobreak\ {\footnotesize \NWlink{nuweb74a}{74a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape Cholesky of precision}\nobreak\ {\footnotesize \NWlink{nuweb74c}{74c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape input checks}\nobreak\ {\footnotesize \NWlink{nuweb66}{66}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape standardise}\nobreak\ {\footnotesize \NWlink{nuweb67a}{67a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape check and / or set integration weights}\nobreak\ {\footnotesize \NWlink{nuweb74b}{74b}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ ret <- .Call(mvtnorm_R_lpmvnorm, ac, bc, uC, as.double(center), @\\ \mbox{}\verb@ as.integer(N), as.integer(J), w, as.integer(M), as.double(tol), @\\ @@ -4629,7 +4872,7 @@ triangular, so this is fast). \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb59a}{59a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb64}{64}. \item{} \end{list} @@ -4648,7 +4891,7 @@ using quasi-Monte-Carlo integration. The \code{pmvnorm} function uses randomised Korobov rules. The experiment here applies generalised Halton sequences. Plain Monte-Carlo (\code{w = NULL}) will also work but produces more variable results. Results -will depend a lot on appropriate choices and it is the users +will depend a lot on appropriate choices and it is the user's responsibility to make sure things work as intended. If you are unsure, you should use \code{pmvnorm} which provides a well-tested configuration. @@ -4662,7 +4905,7 @@ if (require("qrng", quietly = TRUE)) { W <- matrix(runif(M * (J - 1)), nrow = J - 1) } -### Genz & Bretz, 2001, without early stopping (really?) +### Genz & Bretz, 2002, without early stopping (really?) pGB <- lpmvnormR(a, b, chol = lx, logLik = FALSE, algorithm = GenzBretz(maxpts = M, abseps = 0, releps = 0)) ### Genz 1992 with quasi-Monte-Carlo, fast pnorm @@ -4711,8 +4954,8 @@ once, the chain rule rules, so to speak. We need the derivatives of $d$, $e$, $y$, and $f$ with respect to the $c$ parameters \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap94}\raggedright\small -\NWtarget{nuweb71a}{} $\langle\,${\itshape chol scores}\nobreak\ {\footnotesize {71a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap98}\raggedright\small +\NWtarget{nuweb77a}{} $\langle\,${\itshape chol scores}\nobreak\ {\footnotesize {77a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4722,7 +4965,7 @@ parameters \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb72a}{72a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb78a}{78a}. \item{} \end{list} @@ -4731,8 +4974,8 @@ parameters and the derivates with respect to the mean \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap95}\raggedright\small -\NWtarget{nuweb71b}{} $\langle\,${\itshape mean scores}\nobreak\ {\footnotesize {71b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap99}\raggedright\small +\NWtarget{nuweb77b}{} $\langle\,${\itshape mean scores}\nobreak\ {\footnotesize {77b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4742,7 +4985,7 @@ and the derivates with respect to the mean \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb72a}{72a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb78a}{78a}. \item{} \end{list} @@ -4751,8 +4994,8 @@ and the derivates with respect to the mean and the derivates with respect to lower (\code{a}) \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap96}\raggedright\small -\NWtarget{nuweb71c}{} $\langle\,${\itshape lower scores}\nobreak\ {\footnotesize {71c}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap100}\raggedright\small +\NWtarget{nuweb77c}{} $\langle\,${\itshape lower scores}\nobreak\ {\footnotesize {77c}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4762,7 +5005,7 @@ and the derivates with respect to lower (\code{a}) \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb72a}{72a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb78a}{78a}. \item{} \end{list} @@ -4771,8 +5014,8 @@ and the derivates with respect to lower (\code{a}) and the derivates with respect to upper (\code{b}) \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap97}\raggedright\small -\NWtarget{nuweb71d}{} $\langle\,${\itshape upper scores}\nobreak\ {\footnotesize {71d}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap101}\raggedright\small +\NWtarget{nuweb77d}{} $\langle\,${\itshape upper scores}\nobreak\ {\footnotesize {77d}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4782,7 +5025,7 @@ and the derivates with respect to upper (\code{b}) \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb72a}{72a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb78a}{78a}. \item{} \end{list} @@ -4796,16 +5039,16 @@ finally with respect to the off-diagonal elements of the Cholesky factor (last $\J (\J - 1) / 2$ rows). \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap98}\raggedright\small -\NWtarget{nuweb72a}{} $\langle\,${\itshape score output object}\nobreak\ {\footnotesize {72a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap102}\raggedright\small +\NWtarget{nuweb78a}{} $\langle\,${\itshape score output object}\nobreak\ {\footnotesize {78a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@int Jp = iJ * (iJ + 1) / 2;@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape chol scores}\nobreak\ {\footnotesize \NWlink{nuweb71a}{71a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape mean scores}\nobreak\ {\footnotesize \NWlink{nuweb71b}{71b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape lower scores}\nobreak\ {\footnotesize \NWlink{nuweb71c}{71c}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape upper scores}\nobreak\ {\footnotesize \NWlink{nuweb71d}{71d}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape chol scores}\nobreak\ {\footnotesize \NWlink{nuweb77a}{77a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape mean scores}\nobreak\ {\footnotesize \NWlink{nuweb77b}{77b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape lower scores}\nobreak\ {\footnotesize \NWlink{nuweb77c}{77c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape upper scores}\nobreak\ {\footnotesize \NWlink{nuweb77d}{77d}}$\,\rangle$}\verb@@\\ \mbox{}\verb@double dtmp, etmp, Wtmp, ytmp, xx;@\\ \mbox{}\verb@@\\ \mbox{}\verb@PROTECT(ans = allocMatrix(REALSXP, Jp + 1 + 3 * iJ, iN));@\\ @@ -4816,7 +5059,7 @@ finally with respect to the off-diagonal elements of the Cholesky factor \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb79}{79}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb84}{84}. \item{} \end{list} @@ -4840,8 +5083,8 @@ We start initialised the score wrt to $c^{(i)}_{11}$ (the parameter is non-exist here due to standardisation) \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap99}\raggedright\small -\NWtarget{nuweb72b}{} $\langle\,${\itshape score c11}\nobreak\ {\footnotesize {72b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap103}\raggedright\small +\NWtarget{nuweb78b}{} $\langle\,${\itshape score c11}\nobreak\ {\footnotesize {78b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4858,15 +5101,15 @@ here due to standardisation) \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb73b}{73b}\NWlink{nuweb79}{, 79}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb79b}{79b}\NWlink{nuweb84}{, 84}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap100}\raggedright\small -\NWtarget{nuweb73a}{} $\langle\,${\itshape score a, b}\nobreak\ {\footnotesize {73a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap104}\raggedright\small +\NWtarget{nuweb79a}{} $\langle\,${\itshape score a, b}\nobreak\ {\footnotesize {79a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4884,7 +5127,7 @@ here due to standardisation) \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb73b}{73b}\NWlink{nuweb79}{, 79}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb79b}{79b}\NWlink{nuweb84}{, 84}. \item{} \end{list} @@ -4893,20 +5136,20 @@ here due to standardisation) \item Repeat \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap101}\raggedright\small -\NWtarget{nuweb73b}{} $\langle\,${\itshape init score loop}\nobreak\ {\footnotesize {73b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap105}\raggedright\small +\NWtarget{nuweb79b}{} $\langle\,${\itshape init score loop}\nobreak\ {\footnotesize {79b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape init logLik loop}\nobreak\ {\footnotesize \NWlink{nuweb61b}{61b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape score c11}\nobreak\ {\footnotesize \NWlink{nuweb72b}{72b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\hbox{$\langle\,${\itshape score a, b}\nobreak\ {\footnotesize \NWlink{nuweb73a}{73a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape init logLik loop}\nobreak\ {\footnotesize \NWlink{nuweb67c}{67c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape score c11}\nobreak\ {\footnotesize \NWlink{nuweb78b}{78b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape score a, b}\nobreak\ {\footnotesize \NWlink{nuweb79a}{79a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@{\NWsep} \end{list} \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb79}{79}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb84}{84}. \item{} \end{list} @@ -4926,8 +5169,8 @@ We again either generate $w_{j - 1}$ on the fly or use pre-computed weights parameters. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap102}\raggedright\small -\NWtarget{nuweb73c}{} $\langle\,${\itshape update yp for chol}\nobreak\ {\footnotesize {73c}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap106}\raggedright\small +\NWtarget{nuweb79c}{} $\langle\,${\itshape update yp for chol}\nobreak\ {\footnotesize {79c}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4944,15 +5187,15 @@ parameters. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb77a}{77a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb83a}{83a}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap103}\raggedright\small -\NWtarget{nuweb74}{} $\langle\,${\itshape update yp for means, lower and upper}\nobreak\ {\footnotesize {74}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap107}\raggedright\small +\NWtarget{nuweb80}{} $\langle\,${\itshape update yp for means, lower and upper}\nobreak\ {\footnotesize {80}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -4982,7 +5225,7 @@ parameters. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb77a}{77a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb83a}{83a}. \item{} \end{list} @@ -5004,8 +5247,8 @@ parameters. The scores with respect to $c^{(i)}_{j\jmath}, \jmath = 1, \dots, j - 1$ are \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap104}\raggedright\small -\NWtarget{nuweb75a}{} $\langle\,${\itshape score wrt new chol off-diagonals}\nobreak\ {\footnotesize {75a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap108}\raggedright\small +\NWtarget{nuweb81a}{} $\langle\,${\itshape score wrt new chol off-diagonals}\nobreak\ {\footnotesize {81a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -5028,7 +5271,7 @@ The scores with respect to $c^{(i)}_{j\jmath}, \jmath = 1, \dots, j - 1$ are \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb77a}{77a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb83a}{83a}. \item{} \end{list} @@ -5037,8 +5280,8 @@ The scores with respect to $c^{(i)}_{j\jmath}, \jmath = 1, \dots, j - 1$ are and the score with respect to (the here non-existing) $c^{(i)}_{jj}$ is \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap105}\raggedright\small -\NWtarget{nuweb75b}{} $\langle\,${\itshape score wrt new chol diagonal}\nobreak\ {\footnotesize {75b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap109}\raggedright\small +\NWtarget{nuweb81b}{} $\langle\,${\itshape score wrt new chol diagonal}\nobreak\ {\footnotesize {81b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -5056,15 +5299,15 @@ and the score with respect to (the here non-existing) $c^{(i)}_{jj}$ is \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb77a}{77a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb83a}{83a}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap106}\raggedright\small -\NWtarget{nuweb75c}{} $\langle\,${\itshape new score means, lower and upper}\nobreak\ {\footnotesize {75c}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap110}\raggedright\small +\NWtarget{nuweb81c}{} $\langle\,${\itshape new score means, lower and upper}\nobreak\ {\footnotesize {81c}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -5082,7 +5325,7 @@ and the score with respect to (the here non-existing) $c^{(i)}_{jj}$ is \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb77a}{77a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb83a}{83a}. \item{} \end{list} @@ -5091,8 +5334,8 @@ and the score with respect to (the here non-existing) $c^{(i)}_{jj}$ is We next update scores for parameters introduced for smaller $j$ \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap107}\raggedright\small -\NWtarget{nuweb76a}{} $\langle\,${\itshape update score for chol}\nobreak\ {\footnotesize {76a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap111}\raggedright\small +\NWtarget{nuweb82a}{} $\langle\,${\itshape update score for chol}\nobreak\ {\footnotesize {82a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -5110,15 +5353,15 @@ We next update scores for parameters introduced for smaller $j$ \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb77a}{77a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb83a}{83a}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap108}\raggedright\small -\NWtarget{nuweb76b}{} $\langle\,${\itshape update score means, lower and upper}\nobreak\ {\footnotesize {76b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap112}\raggedright\small +\NWtarget{nuweb82b}{} $\langle\,${\itshape update score means, lower and upper}\nobreak\ {\footnotesize {82b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -5156,7 +5399,7 @@ We next update scores for parameters introduced for smaller $j$ \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb77a}{77a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb83a}{83a}. \item{} \end{list} @@ -5165,24 +5408,24 @@ We next update scores for parameters introduced for smaller $j$ We put everything together in a loop starting with the second dimension \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap109}\raggedright\small -\NWtarget{nuweb77a}{} $\langle\,${\itshape inner score loop}\nobreak\ {\footnotesize {77a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap113}\raggedright\small +\NWtarget{nuweb83a}{} $\langle\,${\itshape inner score loop}\nobreak\ {\footnotesize {83a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@for (j = 1; j < iJ; j++) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape compute y}\nobreak\ {\footnotesize \NWlink{nuweb61c}{61c}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape compute x}\nobreak\ {\footnotesize \NWlink{nuweb62a}{62a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape update d, e}\nobreak\ {\footnotesize \NWlink{nuweb62b}{62b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape update yp for chol}\nobreak\ {\footnotesize \NWlink{nuweb73c}{73c}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape update yp for means, lower and upper}\nobreak\ {\footnotesize \NWlink{nuweb74}{74}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape score wrt new chol off-diagonals}\nobreak\ {\footnotesize \NWlink{nuweb75a}{75a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape score wrt new chol diagonal}\nobreak\ {\footnotesize \NWlink{nuweb75b}{75b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape new score means, lower and upper}\nobreak\ {\footnotesize \NWlink{nuweb75c}{75c}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape update score for chol}\nobreak\ {\footnotesize \NWlink{nuweb76a}{76a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape update score means, lower and upper}\nobreak\ {\footnotesize \NWlink{nuweb76b}{76b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape update f}\nobreak\ {\footnotesize \NWlink{nuweb62c}{62c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape compute y}\nobreak\ {\footnotesize \NWlink{nuweb68a}{68a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape compute x}\nobreak\ {\footnotesize \NWlink{nuweb68b}{68b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape update d, e}\nobreak\ {\footnotesize \NWlink{nuweb68c}{68c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape update yp for chol}\nobreak\ {\footnotesize \NWlink{nuweb79c}{79c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape update yp for means, lower and upper}\nobreak\ {\footnotesize \NWlink{nuweb80}{80}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape score wrt new chol off-diagonals}\nobreak\ {\footnotesize \NWlink{nuweb81a}{81a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape score wrt new chol diagonal}\nobreak\ {\footnotesize \NWlink{nuweb81b}{81b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape new score means, lower and upper}\nobreak\ {\footnotesize \NWlink{nuweb81c}{81c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape update score for chol}\nobreak\ {\footnotesize \NWlink{nuweb82a}{82a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape update score means, lower and upper}\nobreak\ {\footnotesize \NWlink{nuweb82b}{82b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape update f}\nobreak\ {\footnotesize \NWlink{nuweb69a}{69a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@}@\\ \mbox{}\verb@@{\NWsep} @@ -5190,7 +5433,7 @@ We put everything together in a loop starting with the second dimension \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb79}{79}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb84}{84}. \item{} \end{list} @@ -5210,8 +5453,8 @@ We return $\log{\hat{p}_i}$ for each $i$, or we immediately sum-up over $i$. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap110}\raggedright\small -\NWtarget{nuweb77b}{} $\langle\,${\itshape score output}\nobreak\ {\footnotesize {77b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap114}\raggedright\small +\NWtarget{nuweb83b}{} $\langle\,${\itshape score output}\nobreak\ {\footnotesize {83b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -5229,7 +5472,7 @@ We return $\log{\hat{p}_i}$ for each $i$, or we immediately sum-up over $i$. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb79}{79}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb84}{84}. \item{} \end{list} @@ -5238,8 +5481,8 @@ We return $\log{\hat{p}_i}$ for each $i$, or we immediately sum-up over $i$. \end{enumerate} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap111}\raggedright\small -\NWtarget{nuweb77c}{} $\langle\,${\itshape init dans}\nobreak\ {\footnotesize {77c}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap115}\raggedright\small +\NWtarget{nuweb83c}{} $\langle\,${\itshape init dans}\nobreak\ {\footnotesize {83c}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -5255,7 +5498,7 @@ We return $\log{\hat{p}_i}$ for each $i$, or we immediately sum-up over $i$. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb79}{79}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb84}{84}. \item{} \end{list} @@ -5264,27 +5507,25 @@ We return $\log{\hat{p}_i}$ for each $i$, or we immediately sum-up over $i$. We put everything together in \proglang{C} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap112}\raggedright\small -\NWtarget{nuweb79}{} $\langle\,${\itshape R slpmvnorm}\nobreak\ {\footnotesize {79}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap116}\raggedright\small +\NWtarget{nuweb84}{} $\langle\,${\itshape R slpmvnorm}\nobreak\ {\footnotesize {84}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@SEXP R_slpmvnorm(SEXP a, SEXP b, SEXP C, SEXP center, SEXP N, SEXP J, SEXP W, @\\ \mbox{}\verb@ SEXP M, SEXP tol, SEXP fast) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape R slpmvnorm variables}\nobreak\ {\footnotesize \NWlink{nuweb66c}{66c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape R slpmvnorm variables}\nobreak\ {\footnotesize \NWlink{nuweb72d}{72d}}$\,\rangle$}\verb@@\\ \mbox{}\verb@ double intsum;@\\ \mbox{}\verb@ int p, idx;@\\ -\mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape dimensions}\nobreak\ {\footnotesize \NWlink{nuweb65b}{65b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape pnorm}\nobreak\ {\footnotesize \NWlink{nuweb64c}{64c}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape W length}\nobreak\ {\footnotesize \NWlink{nuweb65a}{65a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape init center}\nobreak\ {\footnotesize \NWlink{nuweb66b}{66b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape dimensions}\nobreak\ {\footnotesize \NWlink{nuweb71c}{71c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape pnorm}\nobreak\ {\footnotesize \NWlink{nuweb71a}{71a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape W length}\nobreak\ {\footnotesize \NWlink{nuweb71b}{71b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape init center}\nobreak\ {\footnotesize \NWlink{nuweb72c}{72c}}$\,\rangle$}\verb@@\\ \mbox{}\verb@ int start, j, k;@\\ \mbox{}\verb@ double tmp, e, d, f, emd, x, x0, y[(iJ > 1 ? iJ - 1 : 1)];@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape score output object}\nobreak\ {\footnotesize \NWlink{nuweb72a}{72a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape score output object}\nobreak\ {\footnotesize \NWlink{nuweb78a}{78a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ q0 = qnorm(dtol, 0.0, 1.0, 1L, 0L);@\\ \mbox{}\verb@@\\ @@ -5296,26 +5537,23 @@ We put everything together in \proglang{C} \mbox{}\verb@@\\ \mbox{}\verb@ for (int i = 0; i < iN; i++) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape initialisation}\nobreak\ {\footnotesize \NWlink{nuweb61a}{61a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape score c11}\nobreak\ {\footnotesize \NWlink{nuweb72b}{72b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape score a, b}\nobreak\ {\footnotesize \NWlink{nuweb73a}{73a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape init dans}\nobreak\ {\footnotesize \NWlink{nuweb77c}{77c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape initialisation}\nobreak\ {\footnotesize \NWlink{nuweb67b}{67b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape score c11}\nobreak\ {\footnotesize \NWlink{nuweb78b}{78b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape score a, b}\nobreak\ {\footnotesize \NWlink{nuweb79a}{79a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape init dans}\nobreak\ {\footnotesize \NWlink{nuweb83c}{83c}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (W != R_NilValue && pW == 0)@\\ \mbox{}\verb@ dW = REAL(W);@\\ \mbox{}\verb@@\\ \mbox{}\verb@ for (int m = 0; m < iM; m++) {@\\ -\mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape init score loop}\nobreak\ {\footnotesize \NWlink{nuweb73b}{73b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape inner score loop}\nobreak\ {\footnotesize \NWlink{nuweb77a}{77a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape score output}\nobreak\ {\footnotesize \NWlink{nuweb77b}{77b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape init score loop}\nobreak\ {\footnotesize \NWlink{nuweb79b}{79b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape inner score loop}\nobreak\ {\footnotesize \NWlink{nuweb83a}{83a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape score output}\nobreak\ {\footnotesize \NWlink{nuweb83b}{83b}}$\,\rangle$}\verb@@\\ \mbox{}\verb@ if (W != R_NilValue)@\\ \mbox{}\verb@ dW += iJ - 1;@\\ \mbox{}\verb@ }@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape move on}\nobreak\ {\footnotesize \NWlink{nuweb63c}{63c}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape move on}\nobreak\ {\footnotesize \NWlink{nuweb70a}{70a}}$\,\rangle$}\verb@@\\ \mbox{}\verb@ dans += Jp + 1 + 3 * iJ;@\\ \mbox{}\verb@ }@\\ \mbox{}\verb@@\\ @@ -5330,7 +5568,7 @@ We put everything together in \proglang{C} \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb59b}{59b}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb65}{65}. \item{} \end{list} @@ -5341,8 +5579,8 @@ however, we need to undo the effect of standardisation once the scores have been computed \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap113}\raggedright\small -\NWtarget{nuweb80a}{} $\langle\,${\itshape post differentiate mean score}\nobreak\ {\footnotesize {80a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap117}\raggedright\small +\NWtarget{nuweb85a}{} $\langle\,${\itshape post differentiate mean score}\nobreak\ {\footnotesize {85a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -5355,15 +5593,15 @@ been computed \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb82}{82}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb87}{87}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap114}\raggedright\small -\NWtarget{nuweb80b}{} $\langle\,${\itshape post differentiate lower score}\nobreak\ {\footnotesize {80b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap118}\raggedright\small +\NWtarget{nuweb85b}{} $\langle\,${\itshape post differentiate lower score}\nobreak\ {\footnotesize {85b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -5375,15 +5613,15 @@ been computed \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb82}{82}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb87}{87}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap115}\raggedright\small -\NWtarget{nuweb80c}{} $\langle\,${\itshape post differentiate upper score}\nobreak\ {\footnotesize {80c}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap119}\raggedright\small +\NWtarget{nuweb85c}{} $\langle\,${\itshape post differentiate upper score}\nobreak\ {\footnotesize {85c}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -5395,15 +5633,15 @@ been computed \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb82}{82}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb87}{87}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap116}\raggedright\small -\NWtarget{nuweb80d}{} $\langle\,${\itshape post differentiate chol score}\nobreak\ {\footnotesize {80d}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap120}\raggedright\small +\NWtarget{nuweb85d}{} $\langle\,${\itshape post differentiate chol score}\nobreak\ {\footnotesize {85d}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -5421,7 +5659,7 @@ been computed \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb82}{82}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb87}{87}. \item{} \end{list} @@ -5441,13 +5679,14 @@ implemented by the ``vec trick''~(Section~\ref{sec:vectrick}) where $\svec = \text{vec}(\mS)$. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap117}\raggedright\small -\NWtarget{nuweb81a}{} $\langle\,${\itshape post differentiate invchol score}\nobreak\ {\footnotesize {81a}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap121}\raggedright\small +\NWtarget{nuweb86a}{} $\langle\,${\itshape post differentiate invchol score}\nobreak\ {\footnotesize {86a}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@if (!missing(invchol)) {@\\ -\mbox{}\verb@ ret <- ltMatrices(ret, diag = TRUE, byrow = TRUE)@\\ +\mbox{}\verb@ ret <- ltMatrices(ret, diag = TRUE, byrow = TRUE,@\\ +\mbox{}\verb@ names = dimnames(chol)[[2L]])@\\ \mbox{}\verb@ ### this means vectrick(chol, ret, chol)@\\ \mbox{}\verb@ ret <- - unclass(vectrick(chol, ret))@\\ \mbox{}\verb@}@\\ @@ -5456,7 +5695,7 @@ where $\svec = \text{vec}(\mS)$. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb82}{82}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb87}{87}. \item{} \end{list} @@ -5468,21 +5707,22 @@ elements (use \code{Lower\_tri(, diag = FALSE)} to extract the lower triangular elements such that the scores match the input) \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap118}\raggedright\small -\NWtarget{nuweb81b}{} $\langle\,${\itshape post process score}\nobreak\ {\footnotesize {81b}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap122}\raggedright\small +\NWtarget{nuweb86b}{} $\langle\,${\itshape post process score}\nobreak\ {\footnotesize {86b}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@if (!attr(chol, "diag"))@\\ \mbox{}\verb@ ### remove scores for constant diagonal elements@\\ \mbox{}\verb@ ret[idx,] <- 0@\\ -\mbox{}\verb@ret <- ltMatrices(ret, diag = TRUE, byrow = TRUE)@\\ +\mbox{}\verb@ret <- ltMatrices(ret, diag = TRUE, byrow = TRUE, @\\ +\mbox{}\verb@ names = dimnames(chol)[[2L]])@\\ \mbox{}\verb@@{\NWsep} \end{list} \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb82}{82}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb87}{87}. \item{} \end{list} @@ -5491,19 +5731,21 @@ triangular elements such that the scores match the input) We can now finally put everything together in a single score function. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap119}\raggedright\small -\NWtarget{nuweb82}{} $\langle\,${\itshape slpmvnorm}\nobreak\ {\footnotesize {82}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap123}\raggedright\small +\NWtarget{nuweb87}{} $\langle\,${\itshape slpmvnorm}\nobreak\ {\footnotesize {87}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ -\mbox{}\verb@slpmvnorm <- function(lower, upper, mean = 0, center = NULL, chol, invchol, logLik = TRUE, M = NULL, @\\ -\mbox{}\verb@ w = NULL, seed = NULL, tol = .Machine$double.eps, fast = FALSE) {@\\ +\mbox{}\verb@slpmvnorm <- function(lower, upper, mean = 0, center = NULL, @\\ +\mbox{}\verb@ chol, invchol, logLik = TRUE, M = NULL, @\\ +\mbox{}\verb@ w = NULL, seed = NULL, tol = .Machine$double.eps, @\\ +\mbox{}\verb@ fast = FALSE) {@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape init random seed, reset on exit}\nobreak\ {\footnotesize \NWlink{nuweb68a}{68a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape Cholesky of precision}\nobreak\ {\footnotesize \NWlink{nuweb68c}{68c}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape input checks}\nobreak\ {\footnotesize \NWlink{nuweb60a}{60a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape standardise}\nobreak\ {\footnotesize \NWlink{nuweb60b}{60b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape check and / or set integration weights}\nobreak\ {\footnotesize \NWlink{nuweb68b}{68b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape init random seed, reset on exit}\nobreak\ {\footnotesize \NWlink{nuweb74a}{74a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape Cholesky of precision}\nobreak\ {\footnotesize \NWlink{nuweb74c}{74c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape input checks}\nobreak\ {\footnotesize \NWlink{nuweb66}{66}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape standardise}\nobreak\ {\footnotesize \NWlink{nuweb67a}{67a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape check and / or set integration weights}\nobreak\ {\footnotesize \NWlink{nuweb74b}{74b}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ ret <- .Call(mvtnorm_R_slpmvnorm, ac, bc, uC, as.double(center), as.integer(N), @\\ \mbox{}\verb@ as.integer(J), w, as.integer(M), as.double(tol), as.logical(fast));@\\ @@ -5514,18 +5756,21 @@ We can now finally put everything together in a single score function. \mbox{}\verb@ ret <- ret[-1L,,drop = FALSE] / m ### NOTE: division by zero MAY happen,@\\ \mbox{}\verb@ ### catch outside@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape post differentiate mean score}\nobreak\ {\footnotesize \NWlink{nuweb80a}{80a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape post differentiate lower score}\nobreak\ {\footnotesize \NWlink{nuweb80b}{80b}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape post differentiate upper score}\nobreak\ {\footnotesize \NWlink{nuweb80c}{80c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape post differentiate mean score}\nobreak\ {\footnotesize \NWlink{nuweb85a}{85a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape post differentiate lower score}\nobreak\ {\footnotesize \NWlink{nuweb85b}{85b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape post differentiate upper score}\nobreak\ {\footnotesize \NWlink{nuweb85c}{85c}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ ret <- ret[1:Jp, , drop = FALSE]@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape post differentiate chol score}\nobreak\ {\footnotesize \NWlink{nuweb80d}{80d}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape post differentiate invchol score}\nobreak\ {\footnotesize \NWlink{nuweb81a}{81a}}$\,\rangle$}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape post process score}\nobreak\ {\footnotesize \NWlink{nuweb81b}{81b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape post differentiate chol score}\nobreak\ {\footnotesize \NWlink{nuweb85d}{85d}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape post differentiate invchol score}\nobreak\ {\footnotesize \NWlink{nuweb86a}{86a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape post process score}\nobreak\ {\footnotesize \NWlink{nuweb86b}{86b}}$\,\rangle$}\verb@@\\ \mbox{}\verb@@\\ \mbox{}\verb@ ret <- ltMatrices(ret, byrow = byrow_orig)@\\ \mbox{}\verb@@\\ +\mbox{}\verb@ rownames(smean) <- rownames(slower) <- @\\ +\mbox{}\verb@ rownames(supper) <- dimnames(chol)[[2L]]@\\ +\mbox{}\verb@@\\ \mbox{}\verb@ if (logLik) {@\\ \mbox{}\verb@ ret <- list(logLik = ll, @\\ \mbox{}\verb@ mean = smean, @\\ @@ -5543,14 +5788,15 @@ We can now finally put everything together in a single score function. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb59a}{59a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb64}{64}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} Let's look at an example, where we use \code{numDeriv::grad} to check the -results +results (this functionality from package \pkg{numDeriv} was absolutely +instrumental for this project) <>= J <- 5L @@ -5582,7 +5828,8 @@ sC <- slpmvnorm(a, b, chol = mC, w = W, M = M) chk(lli, sC$logLik) if (require("numDeriv", quietly = TRUE)) - chk(grad(fC, unclass(mC)), rowSums(unclass(sC$chol)), check.attributes = FALSE) + chk(grad(fC, unclass(mC)), rowSums(unclass(sC$chol)), + check.attributes = FALSE) @ We can do the same when $\mL$ (and not $\mC$) is given @@ -5612,8 +5859,8 @@ The score function also works for univariate problems ptr <- pnorm(b[1,] / c(unclass(mC[,1]))) - pnorm(a[1,] / c(unclass(mC[,1]))) log(ptr) lpmvnorm(a[1,,drop = FALSE], b[1,,drop = FALSE], chol = mC[,1], logLik = FALSE) -lapply(slpmvnorm(a[1,,drop = FALSE], b[1,,drop = FALSE], chol = mC[,1], logLik = -TRUE), unclass) +lapply(slpmvnorm(a[1,,drop = FALSE], b[1,,drop = FALSE], chol = mC[,1], + logLik = TRUE), unclass) sd1 <- c(unclass(mC[,1])) (dnorm(b[1,] / sd1) * b[1,] - dnorm(a[1,] / sd1) * a[1,]) * (-1) / sd1^2 / ptr @ @@ -5749,7 +5996,8 @@ for (j in 1:J) { Let's do some sanity and performance checks first. For different values of $M$, we evaluate the log-likelihood using \code{pmvnorm} (called in -\code{lpmvnormR}) and the simplified implementation (fast and slow). The comparion is a bit +\code{lpmvnormR}) and the simplified implementation (fast and slow). The +comparison is a bit unfair, because we do not add the time needed to setup Halton sequences, but we would do this only once and use the stored values for repeated evaluations of a log-likelihood (because the optimiser expects a @@ -5851,8 +6099,8 @@ if (require("qrng", quietly = TRUE)) { W <- matrix(runif(M * (J - 1)), nrow = J - 1) } ll <- function(parm, J) { - m <- parm[1:J] ### mean parameters - parm <- parm[-(1:J)] ### chol parameters + m <- parm[1:J] ### mean parameters + parm <- parm[-(1:J)] ### chol parameters C <- matrix(c(parm), ncol = 1L) C <- ltMatrices(C, diag = TRUE, byrow = BYROW) -lpmvnorm(lower = lwr, upper = upr, mean = m, chol = C, @@ -5957,10 +6205,26 @@ Interval-censoring in the response could have been handled by some Tobit model, what about interval-censoring in the explanatory variables? Based on the multivariate distribution just estimated, we can obtain the regression coefficients $\beta_j$ as - <>= c(cond_mvnorm(chol = C, which = 2:J, given = diag(J - 1))$mean) @ +Alternatively, we can compute these regressions from a permuted Cholesky +factor (this goes into the ``simple'' conditional distribution in Section~\ref{sec:margcond}) +<>= +c(cond_mvnorm(chol = aperm(as.chol(C), perm = c(2:J, 1)), + which = 1:(J - 1), given = diag(J - 1))$mean) +@ +or, as a third option, from the last row of the precision matrix of the +permuted Cholesky factor +<>= +x <- as.array(chol2pre(aperm(as.chol(C), perm = c(2:J, 1))))[J,,1] +c(-x[-J] / x[J]) +@ +In higher dimensions, the first option is to be preferred, because it +only involves computing the Cholesky decomposition of a $(\J - 1) \times (\J - +1)$ matrix, whereas the latter two options are based on a decomposition of +the full $\J \times \J$ covariance matrix. + We can compare these estimated regression coefficients with those obtained from a linear model fitted to the exact observations <>= @@ -6026,8 +6290,12 @@ $\avec_i < \rX_i \le \bvec_i$ (that is, interval-censored observations for $\rX_i$). We define the log-likelihood based on the joint normal distribution $(\rY_i, \rX_i) \sim \ND_J((\muvec_i, \etavec_i)^\top, \mC_i \mC_i^\top)$ as \begin{eqnarray*} -\ell_i(\muvec_i, \etavec_i, \mC_i) = \ell_i(\muvec_i, \mC_i) + \log(\Prob(\avec_i < \rX_i \le \bvec_i \mid \mC_i, \etavec_i, \rY_i = \yvec_i)). +\ell_i(\muvec_i, \etavec_i, \mC_i) = \ell_i(\muvec_i, \mC_{\rY,i}) + + \log(\Prob(\avec_i < \rX_i \le \bvec_i \mid \mC_i, \muvec_i, \etavec_i, \rY_i = \yvec_i)). \end{eqnarray*} +where $\mC_{\rY,i}$ is the upper part of $\mC_i$ corresponding to the +marginal distribution of $\rY_i$. The conditional probability of $\rX$ given +$\rY$ depends on all parameters, as explained in Section~\ref{sec:margcond}. The trick here is to decompose the joint likelihood into a product of the marginal Lebesque density of $\rY_i$ and the conditional probability of $\rX_i$ given $\rY_i = \yvec_i$. @@ -6035,8 +6303,8 @@ $\rX_i$ given $\rY_i = \yvec_i$. We first check the data \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap120}\raggedright\small -\NWtarget{nuweb93}{} $\langle\,${\itshape dp input checks}\nobreak\ {\footnotesize {93}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap124}\raggedright\small +\NWtarget{nuweb99}{} $\langle\,${\itshape dp input checks}\nobreak\ {\footnotesize {99}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -6050,7 +6318,7 @@ We first check the data \mbox{}\verb@ cmean <- 0@\\ \mbox{}\verb@ dmean <- 0@\\ \mbox{}\verb@} else {@\\ -\mbox{}\verb@ if (!is.matrix(mean)) @\\ +\mbox{}\verb@ if (!is.matrix(mean) || NCOL(mean) == 1L) @\\ \mbox{}\verb@ mean <- matrix(mean, nrow = cJ + dJ, ncol = N)@\\ \mbox{}\verb@ stopifnot(nrow(mean) == cJ + dJ)@\\ \mbox{}\verb@ stopifnot(ncol(mean) == N)@\\ @@ -6062,7 +6330,7 @@ We first check the data \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb94}{94}\NWlink{nuweb96}{, 96}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb100}{100}\NWlink{nuweb102}{, 102}. \item{} \end{list} @@ -6073,8 +6341,8 @@ marginal and the conditional normal distributions and the joint log-likelihood is simply the sum of the two corresponding log-likelihoods. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap121}\raggedright\small -\NWtarget{nuweb94}{} $\langle\,${\itshape ldpmvnorm}\nobreak\ {\footnotesize {94}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap125}\raggedright\small +\NWtarget{nuweb100}{} $\langle\,${\itshape ldpmvnorm}\nobreak\ {\footnotesize {100}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -6088,7 +6356,7 @@ is simply the sum of the two corresponding log-likelihoods. \mbox{}\verb@ return(ldmvnorm(obs = obs, mean = mean,@\\ \mbox{}\verb@ chol = chol, invchol = invchol, logLik = logLik))@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape dp input checks}\nobreak\ {\footnotesize \NWlink{nuweb93}{93}}$\,\rangle$}\verb@ @\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape dp input checks}\nobreak\ {\footnotesize \NWlink{nuweb99}{99}}$\,\rangle$}\verb@ @\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (!missing(invchol)) {@\\ \mbox{}\verb@ J <- dim(invchol)[2L]@\\ @@ -6124,7 +6392,7 @@ is simply the sum of the two corresponding log-likelihoods. \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb2}{2}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb64}{64}. \item{} \end{list} @@ -6134,8 +6402,8 @@ The score function requires a little extra work. We start with the case when \code{invchol} is given \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap122}\raggedright\small -\NWtarget{nuweb95}{} $\langle\,${\itshape sldpmvnorm invchol}\nobreak\ {\footnotesize {95}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap126}\raggedright\small +\NWtarget{nuweb101}{} $\langle\,${\itshape sldpmvnorm invchol}\nobreak\ {\footnotesize {101}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -6195,7 +6463,7 @@ The score function requires a little extra work. We start with the case when \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb96}{96}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb102}{102}. \item{} \end{list} @@ -6205,12 +6473,13 @@ For \code{chol}, we compute the above code for its inverse and post-differentiate using the vec-trick \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap123}\raggedright\small -\NWtarget{nuweb96}{} $\langle\,${\itshape sldpmvnorm}\nobreak\ {\footnotesize {96}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap127}\raggedright\small +\NWtarget{nuweb102}{} $\langle\,${\itshape sldpmvnorm}\nobreak\ {\footnotesize {102}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ -\mbox{}\verb@sldpmvnorm <- function(obs, lower, upper, mean = 0, chol, invchol, logLik = TRUE, ...) {@\\ +\mbox{}\verb@sldpmvnorm <- function(obs, lower, upper, mean = 0, chol, invchol, @\\ +\mbox{}\verb@ logLik = TRUE, ...) {@\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (missing(obs) || is.null(obs))@\\ \mbox{}\verb@ return(slpmvnorm(lower = lower, upper = upper, mean = mean,@\\ @@ -6219,17 +6488,17 @@ post-differentiate using the vec-trick \mbox{}\verb@ return(sldmvnorm(obs = obs, mean = mean,@\\ \mbox{}\verb@ chol = chol, invchol = invchol, logLik = logLik))@\\ \mbox{}\verb@@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape dp input checks}\nobreak\ {\footnotesize \NWlink{nuweb93}{93}}$\,\rangle$}\verb@ @\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape dp input checks}\nobreak\ {\footnotesize \NWlink{nuweb99}{99}}$\,\rangle$}\verb@ @\\ \mbox{}\verb@@\\ \mbox{}\verb@ if (!missing(invchol)) {@\\ -\mbox{}\verb@ @\hbox{$\langle\,${\itshape sldpmvnorm invchol}\nobreak\ {\footnotesize \NWlink{nuweb95}{95}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape sldpmvnorm invchol}\nobreak\ {\footnotesize \NWlink{nuweb101}{101}}$\,\rangle$}\verb@@\\ \mbox{}\verb@ }@\\ \mbox{}\verb@@\\ \mbox{}\verb@ invchol <- solve(chol)@\\ \mbox{}\verb@ ret <- sldpmvnorm(obs = obs, lower = lower, upper = upper, @\\ \mbox{}\verb@ mean = mean, invchol = invchol, logLik = logLik, ...)@\\ \mbox{}\verb@ ### this means: ret$chol <- - vectrick(invchol, ret$invchol, invchol)@\\ -\mbox{}\verb@ ret$chol <- - vectrick(invchol, ret$invchol)@\\ +\mbox{}\verb@ ret$chol <- as.chol(- vectrick(invchol, ret$invchol))@\\ \mbox{}\verb@ ret$invchol <- NULL@\\ \mbox{}\verb@ return(ret)@\\ \mbox{}\verb@}@\\ @@ -6238,7 +6507,7 @@ post-differentiate using the vec-trick \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb2}{2}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb64}{64}. \item{} \end{list} @@ -6249,24 +6518,26 @@ example, and the remaining two dimensions are only known in intervals. The log-likelihood and score function for $\muvec$ and $\mC$ are <>= +ic <- 1:2 ### position of continuous variables ll_cd <- function(parm, J) { m <- parm[1:J] ### mean parameters parm <- parm[-(1:J)] ### chol parameters C <- matrix(c(parm), ncol = 1L) C <- ltMatrices(C, diag = TRUE, byrow = BYROW) - -ldpmvnorm(obs = Y[1:2,], lower = lwr[-(1:2),], - upper = upr[-(1:2),], mean = m, chol = C, - w = W[-(1:2),,drop = FALSE], M = M) + -ldpmvnorm(obs = Y[ic,], lower = lwr[-ic,], + upper = upr[-ic,], mean = m, chol = C, + w = W[-ic,,drop = FALSE], M = M) } sc_cd <- function(parm, J) { m <- parm[1:J] ### mean parameters parm <- parm[-(1:J)] ### chol parameters C <- matrix(c(parm), ncol = 1L) C <- ltMatrices(C, diag = TRUE, byrow = BYROW) - ret <- sldpmvnorm(obs = Y[1:2,], lower = lwr[-(1:2),], - upper = upr[-(1:2),], mean = m, chol = C, - w = W[-(1:2),,drop = FALSE], M = M) - return(-c(rowSums(ret$mean), rowSums(unclass(ret$chol)))) + ret <- sldpmvnorm(obs = Y[ic,], lower = lwr[-ic,], + upper = upr[-ic,], mean = m, chol = C, + w = W[-ic,,drop = FALSE], M = M) + return(-c(rowSums(ret$mean), + rowSums(Lower_tri(ret$chol, diag = TRUE)))) } @ and the score function seems to be correct @@ -6292,6 +6563,311 @@ op$par[1:J] mn @ +The one restriction in both \code{ldpmvnorm} and \code{sldpmvnorm} is that the +continuous variables $\rY$ are ranked before the discrete variables $\rX$ in +the observation $(\rY_i, \rX_i)$, and thus also in $(\muvec, \etavec)$ and $\mC$ +(the subscript $i$ is dropped from the parameters in the following paragraph +to keep the notational complexity in check). + +While the means can be simply permuted, this is not the case for the +Cholesky factor $\mC$ (see function \code{aperm} in +Section~\ref{sec:conv}). Of course, we can simply permute $\hat{\mC}_i$, but +we loose standard errors in this process. Alternatively, we can permute the +order of variables in $\mC$ to our liking in the log-likelihood function (while +keeping the original order of the observations and for the mean parameters) + +<>= +### discrete variables first +perm <- c((1:J)[-ic], ic) +ll_ap <- function(parm, J) { + m <- parm[1:J] ### mean parameters; NOT permuted + parm <- parm[-(1:J)] ### chol parameters + C <- matrix(c(parm), ncol = 1L) + C <- ltMatrices(C, diag = TRUE, byrow = BYROW) + Ct <- aperm(as.chol(C), perm = perm) + -ldpmvnorm(obs = Y[ic,], lower = lwr[-ic,], + upper = upr[-ic,], mean = m, chol = Ct, + w = W[-ic,,drop = FALSE], M = M) +} +@ + +Unfortunately, this distorts the score function and we need to +``de-permute'' the scores. We start with $\mSigma = \mC \mC^\top$, the +Cholesky decomposition of a quadratic positive definite $\J \times \J$ covariance +matrix. There are $\J \times (\J + 1) / 2$ parameters in the lower +triagular part (including the diagonal) of $\mC$. Changing the order of the +variables by a permutation $\pi$ with permutation matrix $\Pi$ gives a +covariance $\Pi \mC \mC^\top \Pi^\top$. This is no longer a Cholesky +decomposition, because $\Pi \mC$ is not lower triangular. The new +decomposition is +\begin{eqnarray*} +\Pi \mC \mC^\top \Pi^\top = \tilde{\mC} \tilde{\mC}^\top +\end{eqnarray*} +($\tilde{\mC}$ is what \code{aperm} computes). As $\mC$, the Cholesky factor +$\tilde{\mC}$ is lower triangular with $\J \times (\J + 1) / 2$ parameters. +We could write this operation as a function +\begin{eqnarray*} +& & f_3: \R^{\J \times (\J + 1) / 2} \rightarrow \R^{\J \times (\J + 1) / 2} \\ +& & f_3(\mC) = \tilde{\mC}, +\end{eqnarray*} +where in fact $f_3 = $\code{aperm}, and we are interested in its gradient. Deriving the gradient of a Cholesky +decomposition might seem hopeless (it certainly did, at least to me, for a +very long time), but there is a trick. Let us define two other functions: +\begin{eqnarray*} +& & f_1: \R^{\J \times (\J + 1) / 2} \rightarrow \R^{\J \times \J} \\ +& & f_1(\mC) = \Pi \mC \mC^\top \Pi^\top \\ +& & f_2: \R^{\J \times (\J + 1) / 2} \rightarrow \R^{\J \times \J} \\ +& & f_2(\tilde{\mC}) = \tilde{\mC} \tilde{\mC}^\top. +\end{eqnarray*} +Exploiting the chain rule for the composition $f_1 = f_2 \circ f_3$, +we can write the gradient of $f_1$ as the product +of the gradients of $f_2$ and $f_3$: +\begin{eqnarray} \label{fm:chain} +\frac{\partial f_1(\mC)}{\partial \mC} = +\frac{\partial f_2(\tilde{\mC})}{\partial \tilde{\mC}} \frac{\partial f_3(\mC)}{\partial \mC}. +\end{eqnarray} +The last factor is what we want to compute. It turns out that it is simpler +to compute the first two gradients first and, in a second step, to derive +the last factor. In more detail +\begin{eqnarray*} +\frac{\partial f_1(\mC)}{\partial \mC} & = & \frac{\partial \Pi \mC \mC^\top \Pi^\top}{\partial \mC} \\ +& = & \frac{\partial \Pi \mC \mC^\top \Pi^\top}{\partial \Pi \mC} \frac{\partial \Pi \mC}{\mC} \\ +& = & \left( (\Pi \mC \otimes \mI_\J) + (\mI_\J \otimes \Pi \mC) \frac{\partial \mA^\top}{\partial \mA} \right) (\mI_\J \otimes \Pi). +\end{eqnarray*} +($\mA$ is a quadratic matrix and the gradient of its transpose is a +permutation matrix). This analytic expression only contains known elements +and can be computed. The same applies to +\begin{eqnarray*} +\frac{\partial f_2(\tilde{\mC})}{\partial \tilde{\mC}} & = & \frac{\partial \tilde{\mC} \tilde{\mC}^\top \Pi}{\partial \tilde{\mC}} \\ +&= & (\tilde{\mC} \otimes \mI_\J) + (\mI_\J \otimes \tilde{\mC}) \frac{\partial \mA^\top}{\partial \mA} +\end{eqnarray*} +Both expressions treat $\mC$ or $\tilde{\mC}$ as full matrices, we are only +interested in the score contributions by the $\J \times (\J + 1) / 2$ lower +triangular elements. Using sloppy notation, we collect the relevant columns +in matrices $\mB_1 = \frac{\partial f_1(\mC)}{\partial \mC} \in \R^{\J^2 \times \J \times (\J + 1) / 2}$ +and $\mB_2 = \frac{\partial f_2(\tilde{\mC})}{\partial \tilde{\mC}} \in \R^{\J^2 \times \J \times (\J + 1) / +2}$. For the last, unknown, factor, we write $\mB_3 = \frac{\partial f_3(\tilde{\mC})}{\partial \tilde{\mC}} \in +\R^{\J \times (\J + 1) / 2 \times \J \times (\J + 1) / 2}$ and, with +formula~(\ref{fm:chain}), $\mB_1 = \mB_2 \mB_3$. We can then solve for +$\mB_3$ in the system $\mB_1^\top \mB_1 = \mB_1^\top \mB_2 \mB_3$. + +With \code{chol} $ = \mC$, \code{permuted\_chol} $ = \tilde{\mC}$, +\code{perm} $ = \pi$ and score \code{score\_schol} of the log-likelihood $\ell(\tilde{\mC})$ +with respect to the parameters in $\tilde{\mC}$, we can now implement this +de-permutation of the scores. Starting with some basic sanity checks, we +require lower triangular matrix objects as inputs, with diagonal elements, +and check if the dimensions match + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap128}\raggedright\small +\NWtarget{nuweb105a}{} $\langle\,${\itshape deperma input checks chol}\nobreak\ {\footnotesize {105a}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@stopifnot(is.ltMatrices(chol)) ### NOTE: replace with is.chol@\\ +\mbox{}\verb@byrow_orig <- attr(chol, "byrow")@\\ +\mbox{}\verb@chol <- ltMatrices(chol, byrow = FALSE)@\\ +\mbox{}\verb@stopifnot(is.ltMatrices(permuted_chol)) ### NOTE: replace with is.chol@\\ +\mbox{}\verb@permuted_chol <- ltMatrices(permuted_chol, byrow = FALSE)@\\ +\mbox{}\verb@stopifnot(max(abs(dim(chol) - dim(permuted_chol))) == 0)@\\ +\mbox{}\verb@J <- dim(chol)[2L]@\\ +\mbox{}\verb@stopifnot(attr(chol, "diag"))@\\ +\mbox{}\verb@INVCHOL <- !missing(invchol)@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb107}{107}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +Regarding \code{perm}, we check if this is an actual permutation + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap129}\raggedright\small +\NWtarget{nuweb105b}{} $\langle\,${\itshape deperma input checks perm}\nobreak\ {\footnotesize {105b}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@if (missing(perm)) return(score_schol)@\\ +\mbox{}\verb@stopifnot(isTRUE(all.equal(sort(perm), 1:J)))@\\ +\mbox{}\verb@if (max(abs(perm - 1:J)) == 0) return(score_schol)@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb107}{107}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +The scores with respect to $\tilde{\mC}$ have been computed elsewhere, we +just check the dimensions. In case we were given the scores with respect to +$\mL$, we first compute the scores with respect to $\mC$ (as we were lazy +and only derived the results for $\mC$). As in \code{standardize}, the +argument \code{score\_schol} gives the score with respect to $\mC$ and it is +the user's responsibility to provide this quantity (even when \code{invchol} +is given). + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap130}\raggedright\small +\NWtarget{nuweb106a}{} $\langle\,${\itshape deperma input checks schol}\nobreak\ {\footnotesize {106a}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@if (is.ltMatrices(score_schol)) { @\\ +\mbox{}\verb@ byrow_orig_s <- attr(score_schol, "byrow")@\\ +\mbox{}\verb@ score_schol <- ltMatrices(score_schol, byrow = FALSE)@\\ +\mbox{}\verb@ ### don't do this here!@\\ +\mbox{}\verb@ ### if (INVCHOL) score_schol <- -vectrick(permuted_invchol, score_schol)@\\ +\mbox{}\verb@ score_schol <- unclass(score_schol) ### this preserves byrow@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@stopifnot(is.matrix(score_schol))@\\ +\mbox{}\verb@N <- ncol(score_schol)@\\ +\mbox{}\verb@stopifnot(J * (J + 1) / 2 == nrow(score_schol))@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb107}{107}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +We'll have to loop over $i = 1, \dots, N$ eventually and therefore coerce +all objects to objects of class \code{array}, there is no need to worry +about row or column storage order. We set-up indices matrices and the +permutation matrix $\Pi$ + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap131}\raggedright\small +\NWtarget{nuweb106b}{} $\langle\,${\itshape deperma indices}\nobreak\ {\footnotesize {106b}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@idx <- matrix(1:J^2, nrow = J, ncol = J) ### assuming byrow = TRUE@\\ +\mbox{}\verb@tidx <- c(t(idx))@\\ +\mbox{}\verb@ltT <- idx[lower.tri(idx, diag = TRUE)]@\\ +\mbox{}\verb@P <- matrix(0, nrow = J, ncol = J)@\\ +\mbox{}\verb@P[cbind(1:J, perm)] <- 1@\\ +\mbox{}\verb@ID <- diag(J)@\\ +\mbox{}\verb@IDP <- (ID %x% P)@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb107}{107}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +and are now ready for the main course. We are gentle and also allow +\code{invchol}$ = \mL$ as input, and we clean-up by post-differentiation at +the very end in this case. + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap132}\raggedright\small +\NWtarget{nuweb107}{} $\langle\,${\itshape deperma}\nobreak\ {\footnotesize {107}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@deperma <- function(chol = solve(invchol), @\\ +\mbox{}\verb@ permuted_chol = solve(permuted_invchol), @\\ +\mbox{}\verb@ invchol, permuted_invchol, perm, score_schol) {@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape deperma input checks chol}\nobreak\ {\footnotesize \NWlink{nuweb105a}{105a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape deperma input checks perm}\nobreak\ {\footnotesize \NWlink{nuweb105b}{105b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape deperma input checks schol}\nobreak\ {\footnotesize \NWlink{nuweb106a}{106a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape deperma indices}\nobreak\ {\footnotesize \NWlink{nuweb106b}{106b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@ Nc <- dim(chol)[1L]@\\ +\mbox{}\verb@ mC <- as.array(chol)[perm,,,drop = FALSE]@\\ +\mbox{}\verb@ Ct <- as.array(permuted_chol)@\\ +\mbox{}\verb@ ret <- lapply(1:Nc, function(i) {@\\ +\mbox{}\verb@ B1 <- (mC[,,i] %x% ID) + (ID %x% mC[,,i])[,tidx]@\\ +\mbox{}\verb@ # ^^^^^^^ <- d t(A) / d A@\\ +\mbox{}\verb@ B1 <- B1 %*% IDP@\\ +\mbox{}\verb@ B1 <- B1[,ltT] ### relevant columns of B1@\\ +\mbox{}\verb@ B2 <- (Ct[,,i] %x% ID) + (ID %x% Ct[,,i])[,tidx]@\\ +\mbox{}\verb@ B2 <- B2[,ltT] ### relevant columns of B2@\\ +\mbox{}\verb@ B3 <- try(solve(crossprod(B2), crossprod(B2, B1)))@\\ +\mbox{}\verb@ if (inherits(B3, "try-error")) @\\ +\mbox{}\verb@ stop("failure computing permutation score")@\\ +\mbox{}\verb@ if (Nc == 1L)@\\ +\mbox{}\verb@ return(crossprod(score_schol, B3))@\\ +\mbox{}\verb@ return(crossprod(score_schol[,i,drop = FALSE], B3))@\\ +\mbox{}\verb@ })@\\ +\mbox{}\verb@ ret <- do.call("rbind", ret)@\\ +\mbox{}\verb@ ret <-ltMatrices(t(ret), diag = TRUE, byrow = FALSE)@\\ +\mbox{}\verb@ if (INVCHOL)@\\ +\mbox{}\verb@ ret <- -vectrick(chol, ret)@\\ +\mbox{}\verb@ ret <- ltMatrices(ret, byrow = byrow_orig_s)@\\ +\mbox{}\verb@ return(ret)@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb64}{64}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +We can now use this function to estimate the Cholesky factor for $(\rX, \rY)$ +when the data comes as $(\rY, \rX)$ (which is needed because continuous +variables come first in our implementation of log-likehood and score +function). + +<>= +sc_ap <- function(parm, J) { + m <- parm[1:J] ### mean parameters; NOT permuted + parm <- parm[-(1:J)] ### chol parameters + C <- matrix(c(parm), ncol = 1L) + C <- ltMatrices(C, diag = TRUE, byrow = BYROW) + ### permutation + Ct <- aperm(as.chol(C), perm = perm) + ret <- sldpmvnorm(obs = Y[ic,], lower = lwr[-ic,], + upper = upr[-ic,], mean = m, chol = Ct, + w = W[-ic,,drop = FALSE], M = M) + ### undo permutation for chol + retC <- deperma(chol = C, permuted_chol = Ct, + perm = perm, score_schol = ret$chol) + return(-c(rowSums(ret$mean), + rowSums(Lower_tri(retC, diag = TRUE)))) +} +@ +and the score function seems to be correct +<>= +if (require("numDeriv", quietly = TRUE)) + chk(grad(ll_ap, start, J = J), sc_ap(start, J = J), + check.attributes = FALSE, tol = 1e-6) +@ + +We can now jointly estimate all model parameters via +<>= +op <- optim(start, fn = ll_ap, gr = sc_ap, J = J, + method = "L-BFGS-B", lower = llim, + control = list(trace = TRUE)) +## estimated C for (X, Y) +ltMatrices(matrix(op$par[-(1:J)], ncol = 1), + diag = TRUE, byrow = BYROW) +## compare with true _permuted_ C for (X, Y) +aperm(as.chol(lt), perm = perm) +@ + + \chapter{Unstructured Gaussian Copula Estimation} \label{copula} With $\rZ \sim \ND_\J(0, \mI_\J)$ and $\rY = \tilde{\mC} \rZ \sim \ND_\J(0, \tilde{\mC} @@ -6306,8 +6882,8 @@ $\diag(\mC \mC^\top)^{-\nicefrac{1}{2}}$ ensures that $\diag(\mSigma) \equiv 1$, that is, unconstained optimisation can be applied. \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap124}\raggedright\small -\NWtarget{nuweb98}{} $\langle\,${\itshape standardize}\nobreak\ {\footnotesize {98}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap133}\raggedright\small +\NWtarget{nuweb109}{} $\langle\,${\itshape standardize}\nobreak\ {\footnotesize {109}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -6325,7 +6901,7 @@ $\diag(\mC \mC^\top)^{-\nicefrac{1}{2}}$ ensures that $\diag(\mSigma) \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb2}{2}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb64}{64}. \item{} \end{list} @@ -6379,7 +6955,8 @@ we can write \begin{eqnarray*} \vecop(\mI_\J \mT \mC^\top)^\top (-\frac{1}{2}) \diag(\vecop(\diag(\mC \mC^\top)^{-\nicefrac{3}{2}})) & = & - -\frac{1}{2} \times \vecop(\mI_\J \mT \mC^\top)^\top \times \vecop(\diag(\mC \mC^\top)^{-\nicefrac{3}{2}})^\top =: \bvec^\top + -\frac{1}{2} \times \vecop(\mI_\J \mT \mC^\top)^\top \times \vecop(\diag(\mC \mC^\top)^{-\nicefrac{3}{2}})^\top \\ +& =: & \bvec^\top \end{eqnarray*} thus \begin{eqnarray*} @@ -6393,24 +6970,27 @@ thus when $\bvec = \vecop(\mB)$. These scores are implemented in \code{destandardize} with \code{chol} $ = \mC$ and \code{score\_schol} $= \mT$. If the model was parameterised in $\mL = \mC^{-1}$, we have \code{invchol} $ -= \mL$, however, we would still need to compute $\mT$ (the score with -respect to $\mC$). += \mL$, however, we would still need to compute $\mT$ (\code{score\_schol}, the score with +respect to $\mC$, and it is the user's responsibility to provide this +quantity). \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap125}\raggedright\small -\NWtarget{nuweb100}{} $\langle\,${\itshape destandardize}\nobreak\ {\footnotesize {100}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap134}\raggedright\small +\NWtarget{nuweb111}{} $\langle\,${\itshape destandardize}\nobreak\ {\footnotesize {111}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ \mbox{}\verb@destandardize <- function(chol = solve(invchol), invchol, score_schol)@\\ \mbox{}\verb@{@\\ -\mbox{}\verb@ stopifnot(inherits(chol, "ltMatrices"))@\\ +\mbox{}\verb@ stopifnot(is.ltMatrices(chol)) ### NOTE: replace with is.chol@\\ \mbox{}\verb@ J <- dim(chol)[2L]@\\ \mbox{}\verb@ stopifnot(!attr(chol, "diag"))@\\ \mbox{}\verb@ byrow_orig <- attr(chol, "byrow")@\\ \mbox{}\verb@ chol <- ltMatrices(chol, byrow = FALSE)@\\ \mbox{}\verb@ @\\ -\mbox{}\verb@ if (inherits(score_schol, "ltMatrices"))@\\ +\mbox{}\verb@ ### TODO: check byrow in score_schol?@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@ if (is.ltMatrices(score_schol))@\\ \mbox{}\verb@ score_schol <- matrix(as.array(score_schol), @\\ \mbox{}\verb@ nrow = dim(score_schol)[2L]^2)@\\ \mbox{}\verb@ stopifnot(is.matrix(score_schol))@\\ @@ -6441,8 +7021,12 @@ respect to $\mC$). \mbox{}\verb@ ### this means: ret <- - vectrick(chol, ret, chol)@\\ \mbox{}\verb@ ret <- - vectrick(chol, ret)@\\ \mbox{}\verb@ }@\\ -\mbox{}\verb@ ret <- ltMatrices(ret[M[lower.tri(M)],,drop = FALSE],@\\ -\mbox{}\verb@ diag = FALSE, byrow = FALSE)@\\ +\mbox{}\verb@ ret <- ret[M[lower.tri(M)],,drop = FALSE]@\\ +\mbox{}\verb@ if (!is.null(dimnames(chol)[[1L]]))@\\ +\mbox{}\verb@ colnames(ret) <- dimnames(chol)[[1L]]@\\ +\mbox{}\verb@ ret <- ltMatrices(ret,@\\ +\mbox{}\verb@ diag = FALSE, byrow = FALSE, @\\ +\mbox{}\verb@ names = dimnames(chol)[[2L]])@\\ \mbox{}\verb@ ret <- ltMatrices(ret, byrow = byrow_orig)@\\ \mbox{}\verb@ diagonals(ret) <- 0@\\ \mbox{}\verb@ return(ret)@\\ @@ -6452,19 +7036,21 @@ respect to $\mC$). \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb2}{2}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb64}{64}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} We can now set-up the log-likelihood and score functions for a Gaussian -copula model. We start with the classical approach of generating the +copula model. We start with the classical approach of generating the marginal observations $\rY$ from the ECDF with denominator $N + 1$ and -subsequent use of the Lebesque density as likelihood. +subsequent use of the Lebesque density as likelihood. Because no stats text +on multivariate problems is complete without a reference to Edgar Anderson's +iris data, let's set up a model for these four classical variables <>= -data("iris") +data("iris", package = "datasets") J <- 4 Z <- t(qnorm(do.call("cbind", lapply(iris[1:J], rank)) / (nrow(iris) + 1))) (CR <- cor(t(Z))) @@ -6545,19 +7131,974 @@ if (!inherits(sd_NPML, "try-error")) { } @ - -\chapter{Package Infrastructure} +\chapter{(Experimental) User Interface} \label{inter} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap126}\raggedright\small -\NWtarget{nuweb104}{} $\langle\,${\itshape R Header}\nobreak\ {\footnotesize {104}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap135}\raggedright\small +\NWtarget{nuweb115a}{} \verb@"interface.R"@\nobreak\ {\footnotesize {115a}}$\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ -\mbox{}\verb@### Copyright (C) 2022- Torsten Hothorn@\\ -\mbox{}\verb@###@\\ -\mbox{}\verb@### This file is part of the 'mvtnorm' R add-on package.@\\ -\mbox{}\verb@###@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape mvnorm}\nobreak\ {\footnotesize \NWlink{nuweb117a}{117a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape mvnorm methods}\nobreak\ {\footnotesize \NWlink{nuweb117b}{117b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape mvnorm simulate}\nobreak\ {\footnotesize \NWlink{nuweb118}{118}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape mvnorm margDist}\nobreak\ {\footnotesize \NWlink{nuweb119}{119}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape mvnorm condDist}\nobreak\ {\footnotesize \NWlink{nuweb120}{120}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape mvnorm logLik}\nobreak\ {\footnotesize \NWlink{nuweb123c}{123c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape mvnorm lLgrad}\nobreak\ {\footnotesize \NWlink{nuweb128}{128}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +The tools provided in the previous chapters are rather low-level, so we will +invest some time into setting-up a more high-level interface for +representing normal models, either as $\ND_\J(\muvec, \mC \mC^\top)$ or +$\ND_\J(\muvec, \mL^{-1} \mL^{-\top})$, for simulating from such models, and +for evaluating the log-likelihood and corresponding score functions. The +latter functionality shall also work when only incomplete (variables are +missing) or censored (observations are only known as intervals) data is +available. + +We start with the conversion of a lower triangular matrix \code{x} to an +\code{ltMatrices} object + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap136}\raggedright\small +\NWtarget{nuweb115b}{} $\langle\,${\itshape as.ltMatrices}\nobreak\ {\footnotesize {115b}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@as.ltMatrices.default <- function(x) {@\\ +\mbox{}\verb@ stopifnot(is.numeric(x))@\\ +\mbox{}\verb@ if (!is.matrix(x)) x <- matrix(x) @\\ +\mbox{}\verb@ DIAG <- max(abs(diag(x) - 1)) > .Machine$double.eps@\\ +\mbox{}\verb@ DIAG <- DIAG & (nrow(x) > 1)@\\ +\mbox{}\verb@ lt <- x[lower.tri(x, diag = DIAG)]@\\ +\mbox{}\verb@ up <- x[upper.tri(x, diag = FALSE)]@\\ +\mbox{}\verb@ stopifnot(max(abs(up)) < .Machine$double.eps)@\\ +\mbox{}\verb@ nm <- rownames(x)@\\ +\mbox{}\verb@ if (!is.null(nm))@\\ +\mbox{}\verb@ return(ltMatrices(lt, diag = DIAG, names = nm))@\\ +\mbox{}\verb@ return(ltMatrices(lt, diag = DIAG))@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb2}{2}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +and proceed defining a constructor for object respresenting, potentially +multiple, multivariate normal distributions. If the Cholesky factor $\mC$ +(or multiple Cholesky factors $\mC_1, \dots, \mC_N$) are given as +\code{chol} argument, we label them as being such objects using \code{as.chol}. If +only a matrix is given, we convert it (if possible) to a single Cholesky +factor $\mC$. The same is done when $\mL$ is given as \code{invchol} +argument. Of course, only one of these arguments must be specified. + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap137}\raggedright\small +\NWtarget{nuweb116a}{} $\langle\,${\itshape mvnorm chol invchol}\nobreak\ {\footnotesize {116a}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@if (missing(chol) && missing(invchol))@\\ +\mbox{}\verb@ chol <- as.chol(ltMatrices(1, diag = TRUE))@\\ +\mbox{}\verb@stopifnot(xor(missing(chol), missing(invchol)))@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@if (!missing(chol)) {@\\ +\mbox{}\verb@ if (!is.ltMatrices(chol))@\\ +\mbox{}\verb@ chol <- as.ltMatrices(chol)@\\ +\mbox{}\verb@ scale <- as.chol(chol)@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@if (!missing(invchol)) {@\\ +\mbox{}\verb@ if (!is.ltMatrices(invchol))@\\ +\mbox{}\verb@ invchol <- as.ltMatrices(invchol)@\\ +\mbox{}\verb@ scale <- as.invchol(invchol)@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@ret <- list(scale = scale)@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb117a}{117a}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +The mean, or multiple means, is stored as a $\J \times 1$ or $\J \times N$ +matrix, and we check if dimensions and, possibly, names are in line with +what was specified as \code{chol} or \code{invchol} + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap138}\raggedright\small +\NWtarget{nuweb116b}{} $\langle\,${\itshape mvnorm mean}\nobreak\ {\footnotesize {116b}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@if (!missing(mean)) {@\\ +\mbox{}\verb@ stopifnot(is.numeric(mean))@\\ +\mbox{}\verb@ stopifnot(NROW(mean) == dim(scale)[2L])@\\ +\mbox{}\verb@ if (!is.matrix(mean)) {@\\ +\mbox{}\verb@ mean <- matrix(mean, nrow = NROW(mean))@\\ +\mbox{}\verb@ rownames(mean) <- names(mean)@\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@ nm <- dimnames(scale)[[2L]]@\\ +\mbox{}\verb@ if (is.null(rownames(mean)))@\\ +\mbox{}\verb@ rownames(mean) <- nm@\\ +\mbox{}\verb@ if (!isTRUE(all.equal(rownames(mean), nm)))@\\ +\mbox{}\verb@ stop("rownames of mean do not match") @\\ +\mbox{}\verb@ nm <- dimnames(scale)[[1L]]@\\ +\mbox{}\verb@ if (!is.null(nm) && dim(scale)[[2L]] == ncol(mean)) {@\\ +\mbox{}\verb@ if (is.null(colnames(mean)))@\\ +\mbox{}\verb@ colnames(mean) <- nm@\\ +\mbox{}\verb@ if (!isTRUE(all.equal(colnames(mean), nm)))@\\ +\mbox{}\verb@ stop("colnames of mean do not match") @\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@ ret$mean <- mean@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb117a}{117a}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +Finally, we put everything together and return an object of class +\code{mvnorm}, featuring \code{mean} and \code{scale}. The class of the +latter slot carries the information how this object is to be interpreted (as +Cholesky factor or inverse thereof) + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap139}\raggedright\small +\NWtarget{nuweb117a}{} $\langle\,${\itshape mvnorm}\nobreak\ {\footnotesize {117a}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@### allow more than one distribution@\\ +\mbox{}\verb@mvnorm <- function(mean, chol, invchol) {@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape mvnorm chol invchol}\nobreak\ {\footnotesize \NWlink{nuweb116a}{116a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape mvnorm mean}\nobreak\ {\footnotesize \NWlink{nuweb116b}{116b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ class(ret) <- "mvnorm"@\\ +\mbox{}\verb@ return(ret)@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb115a}{115a}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +It might have been smarter to specify the scaled mean $\etavec = \mL \muvec$ +because the log-density is then jointly convex in $\etavec$ and $\mL$ and +thus a convex problem would emerge \citep{Barrathh_Boyd_2023}. + +We add a \code{names} and \code{aperm} method. The latter returns a +multivariate normal distribution with permuted order of the variables + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap140}\raggedright\small +\NWtarget{nuweb117b}{} $\langle\,${\itshape mvnorm methods}\nobreak\ {\footnotesize {117b}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@names.mvnorm <- function(x)@\\ +\mbox{}\verb@ dimnames(x$scale)[[2L]]@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@aperm.mvnorm <- function(a, perm, ...) {@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@ ret <- list(scale = aperm(a$scale, perm = perm, ...))@\\ +\mbox{}\verb@ if (!is.null(a$mean))@\\ +\mbox{}\verb@ ret$mean <- a$mean[perm,,drop = FALSE]@\\ +\mbox{}\verb@ class(ret) <- "mvnorm"@\\ +\mbox{}\verb@ ret@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb115a}{115a}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +We are now ready to draw samples from such an object. If multiple normal +distributions are contained in \code{object}, we return one sample each, +otherwise, \code{nsim} samples are returned. Because most tools in this +package expect data as $\J \times N$ matrices, we return the data in this +format. If a classical \code{data.frame} is preferred, \code{as.data.frame = +TRUE} we provide one + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap141}\raggedright\small +\NWtarget{nuweb118}{} $\langle\,${\itshape mvnorm simulate}\nobreak\ {\footnotesize {118}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@simulate.mvnorm <- function(object, nsim = dim(object$scale)[1L], seed = NULL, @\\ +\mbox{}\verb@ standardize = FALSE, as.data.frame = FALSE, ...) {@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@ J <- dim(object$scale)[2L]@\\ +\mbox{}\verb@ N <- dim(object$scale)[1L]@\\ +\mbox{}\verb@ if (N > 1)@\\ +\mbox{}\verb@ stopifnot(nsim == N)@\\ +\mbox{}\verb@ if (standardize) {@\\ +\mbox{}\verb@ if (is.chol(object$scale)) {@\\ +\mbox{}\verb@ object$scale <- standardize(chol = object$scale)@\\ +\mbox{}\verb@ } else {@\\ +\mbox{}\verb@ object$scale <- standardize(invchol = object$scale)@\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@ Z <- matrix(rnorm(nsim * J), nrow = J)@\\ +\mbox{}\verb@ if (is.chol(object$scale)) {@\\ +\mbox{}\verb@ Y <- Mult(object$scale, Z)@\\ +\mbox{}\verb@ } else {@\\ +\mbox{}\verb@ Y <- solve(object$scale, Z)@\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@ ret <- Y + c(object$mean)@\\ +\mbox{}\verb@ rownames(ret) <- dimnames(object$scale)[[2L]]@\\ +\mbox{}\verb@ if (!as.data.frame)@\\ +\mbox{}\verb@ return(ret)@\\ +\mbox{}\verb@ return(as.data.frame(t(ret)))@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb115a}{115a}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +It is maybe time for a first example, and we return to the iris dataset, +ignoring the iris' species for the time being. We set-up a model +in terms of the sample estimates +<>= +data("iris", package = "datasets") +vars <- names(iris)[-5L] +m <- colMeans(iris[,vars]) +V <- var(iris[,vars]) +iris_mvn <- mvnorm(mean = m, chol = t(chol(V))) +iris_var <- simulate(iris_mvn, nsim = nrow(iris)) +@ + +Marginal and conditional distributions might be of interest, the +\code{margDist} and \code{condDist} methods are simple wrappers to +\code{marg\_mvnorm} and \code{cond\_mvnorm} + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap142}\raggedright\small +\NWtarget{nuweb119}{} $\langle\,${\itshape mvnorm margDist}\nobreak\ {\footnotesize {119}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@margDist <- function(object, which, ...)@\\ +\mbox{}\verb@ UseMethod("margDist")@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@margDist.mvnorm <- function(object, which, ...) {@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@ if (is.chol(object$scale)) {@\\ +\mbox{}\verb@ ret <- list(scale = as.chol(marg_mvnorm(chol = object$scale, @\\ +\mbox{}\verb@ which = which)$chol))@\\ +\mbox{}\verb@ } else {@\\ +\mbox{}\verb@ ret <- list(scale = as.invchol(marg_mvnorm(invchol = object$scale, @\\ +\mbox{}\verb@ which = which)$invchol))@\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@ if (!is.null(object$mean))@\\ +\mbox{}\verb@ ret$mean <- object$mean[which,,drop = FALSE]@\\ +\mbox{}\verb@ class(ret) <- "mvnorm"@\\ +\mbox{}\verb@ return(ret)@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb115a}{115a}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap143}\raggedright\small +\NWtarget{nuweb120}{} $\langle\,${\itshape mvnorm condDist}\nobreak\ {\footnotesize {120}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@condDist <- function(object, which_given, given, ...)@\\ +\mbox{}\verb@ UseMethod("condDist")@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@condDist.mvnorm <- function(object, which_given = 1L, given, ...) {@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@ if (is.chol(object$scale)) {@\\ +\mbox{}\verb@ ret <- cond_mvnorm(chol = object$scale, which_given = which_given, @\\ +\mbox{}\verb@ given = given, ...)@\\ +\mbox{}\verb@ ret$scale <- as.chol(ret$chol)@\\ +\mbox{}\verb@ ret$chol <- NULL@\\ +\mbox{}\verb@ } else {@\\ +\mbox{}\verb@ ret <- cond_mvnorm(invchol = object$scale, which_given = which_given, @\\ +\mbox{}\verb@ given = given, ...)@\\ +\mbox{}\verb@ ret$invchol <- as.chol(ret$invchol)@\\ +\mbox{}\verb@ ret$invchol <- NULL@\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@ if (!is.null(object$mean)) {@\\ +\mbox{}\verb@ if (is.character(which_given)) @\\ +\mbox{}\verb@ which_given <- match(which_given, dimnames(object$scale)[[2L]])@\\ +\mbox{}\verb@ if (ncol(object$mean) > 1L && ncol(ret$mean) > 1)@\\ +\mbox{}\verb@ stop("dimensions do not match")@\\ +\mbox{}\verb@ if (ncol(object$mean) == 1L && ncol(ret$mean) > 1L) {@\\ +\mbox{}\verb@ ret$mean <- object$mean[-which_given,,drop = TRUE] + ret$mean@\\ +\mbox{}\verb@ } else {@\\ +\mbox{}\verb@ ret$mean <- object$mean[-which_given,,drop = FALSE] + c(ret$mean)@\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@ @\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@ class(ret) <- "mvnorm"@\\ +\mbox{}\verb@ return(ret)@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb115a}{115a}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +We could now compute the marginal distribution of two Petal variables +or the bivariate regressions of the two Petal variables given the observed +Sepal variables. Note that the last object contains $N = \Sexpr{nrow(iris)}$ +different distributions + +<>= +j <- 3:4 +margDist(iris_mvn, which = vars[j]) +gm <- t(iris[,vars[-(j)]]) +iris_cmvn <- condDist(iris_mvn, which = vars[j], given = gm) +@ + +We now work towards implementating the corresponding log-likelihood +function. This is a trivial task as long as all variables for all +observations have been observed exactly (that is, we can interpret +the data as being continuous). Here, we also want to allow imprecise, that +is, interval-censored, measurements. The one constraint in \code{ldpmvnorm} +is that the continuous variables come first, followed by the censored ones. +This of course might not be in line with the variable ordering we have in +mind for our model. Our log-likelihood function shall be able to evaluate +the log-likelihood for arbitrary permutations of the variables and, +optionally, also based on marginal distributions in case observations are +missing. + +The following \code{logLik} method for objects of class \code{mvnorm} is +essentially a wrapper for \code{ldpmvnorm}, handling permutations, +marginalisation, and standardisation. We begin with some sanity checks + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap144}\raggedright\small +\NWtarget{nuweb122}{} $\langle\,${\itshape argchecks}\nobreak\ {\footnotesize {122}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@args <- c(object, list(...))@\\ +\mbox{}\verb@nargs <- missing(obs) + missing(lower) + missing(upper)@\\ +\mbox{}\verb@stopifnot(nargs < 3L)@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@nmobs <- NULL@\\ +\mbox{}\verb@if (!missing(obs)) {@\\ +\mbox{}\verb@ if (!is.null(obs)) {@\\ +\mbox{}\verb@ stopifnot(is.matrix(obs))@\\ +\mbox{}\verb@ nmobs <- rownames(obs)@\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@nmlower <- nmupper <- nmlu <- NULL@\\ +\mbox{}\verb@if (!missing(lower)) {@\\ +\mbox{}\verb@ if (!is.null(lower)) {@\\ +\mbox{}\verb@ stopifnot(is.matrix(lower))@\\ +\mbox{}\verb@ nmlu <- nmlower <- rownames(lower)@\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@if (!missing(upper)) {@\\ +\mbox{}\verb@ if (!is.null(lower)) {@\\ +\mbox{}\verb@ stopifnot(is.matrix(upper))@\\ +\mbox{}\verb@ nmupper <- rownames(upper)@\\ +\mbox{}\verb@ if (!missing(lower)) {@\\ +\mbox{}\verb@ stopifnot(isTRUE(all.equal(nmlower, nmupper)))@\\ +\mbox{}\verb@ } else {@\\ +\mbox{}\verb@ nmlu <- nmupper@\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@nm <- c(nmobs, nmlu)@\\ +\mbox{}\verb@no <- names(object)@\\ +\mbox{}\verb@stopifnot(nm %in% no)@\\ +\mbox{}\verb@perm <- NULL@\\ +\mbox{}\verb@if (!isTRUE(all.equal(nm, no)))@\\ +\mbox{}\verb@ perm <- c(nm, no[!no %in% nm])@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@if (!missing(obs)) args$obs <- obs@\\ +\mbox{}\verb@if (!missing(lower)) args$lower <- lower@\\ +\mbox{}\verb@if (!missing(upper)) args$upper <- upper@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb123c}{123c}\NWlink{nuweb128}{, 128}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +and proceed with the workhorse when $\mC$ was given + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap145}\raggedright\small +\NWtarget{nuweb123a}{} $\langle\,${\itshape logLik chol}\nobreak\ {\footnotesize {123a}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@names(args)[names(args) == "scale"] <- "chol"@\\ +\mbox{}\verb@if (standardize)@\\ +\mbox{}\verb@ args$chol <- standardize(chol = args$chol)@\\ +\mbox{}\verb@if (!is.null(perm)) {@\\ +\mbox{}\verb@ args$chol <- aperm(as.chol(args$chol), perm = perm)@\\ +\mbox{}\verb@ if (length(nm) < length(no))@\\ +\mbox{}\verb@ args$chol <- marg_mvnorm(chol = args$chol, which = nm)$chol@\\ +\mbox{}\verb@ args$mean <- args$mean[nm,,drop = FALSE]@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@return(do.call("ldpmvnorm", args))@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb123c}{123c}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +For inverse Cholesky factors $\mL$, the code is very similar, just the argument names change + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap146}\raggedright\small +\NWtarget{nuweb123b}{} $\langle\,${\itshape logLik invchol}\nobreak\ {\footnotesize {123b}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@names(args)[names(args) == "scale"] <- "invchol"@\\ +\mbox{}\verb@if (standardize)@\\ +\mbox{}\verb@ args$invchol <- standardize(invchol = args$invchol)@\\ +\mbox{}\verb@if (!is.null(perm)) {@\\ +\mbox{}\verb@ args$invchol <- aperm(as.invchol(args$invchol), perm = perm)@\\ +\mbox{}\verb@ if (length(nm) < length(no))@\\ +\mbox{}\verb@ args$invchol <- marg_mvnorm(invchol = args$invchol, @\\ +\mbox{}\verb@ which = nm)$invchol@\\ +\mbox{}\verb@ args$mean <- args$mean[nm,,drop = FALSE]@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@return(do.call("ldpmvnorm", args))@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb123c}{123c}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +Putting everything together in a corresponding \code{logLik} method + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap147}\raggedright\small +\NWtarget{nuweb123c}{} $\langle\,${\itshape mvnorm logLik}\nobreak\ {\footnotesize {123c}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@logLik.mvnorm <- function(object, obs, lower, upper, standardize = FALSE, @\\ +\mbox{}\verb@ ...) {@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape argchecks}\nobreak\ {\footnotesize \NWlink{nuweb122}{122}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ if (is.chol(object$scale)) {@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape logLik chol}\nobreak\ {\footnotesize \NWlink{nuweb123a}{123a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape logLik invchol}\nobreak\ {\footnotesize \NWlink{nuweb123b}{123b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb115a}{115a}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +allows us to evaluate the log-likelihood of the conditional models for iris + +<>= +logLik(object = iris_cmvn, obs = t(iris[,vars[-j]])) +@ + +This implementation of the log-likelihood silently handles the case when +variables have been specified in a different order than hard-wired into the +model + +<>= +logLik(object = iris_cmvn, obs = t(iris[,rev(vars[-j])])) +@ + +The hardest task is the implementation of a score function which features +the same options as the log-likelihood function and provides the gradients +with respect not only to the parameters ($\mu$ and $\mC$ or $\mL$), but also +with respect to the data objects \code{obs}, \code{lower}, and \code{upper}. + +In essence, we have to repair the damage imposed by a series of +transformations in \code{logLik.mvnorm}, that is, by standardisation, +permutation, and marginalisation. We start with the case when $\mC$ was +given. First, we repeat all the steps performed in \code{logLik}, but call +the score function \code{sldpmvnorm} instead of the log-likelihood function +\code{ldpmvnorm} + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap148}\raggedright\small +\NWtarget{nuweb124a}{} $\langle\,${\itshape lLgrad chol}\nobreak\ {\footnotesize {124a}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@names(args)[names(args) == "scale"] <- "chol"@\\ +\mbox{}\verb@sc <- args$chol@\\ +\mbox{}\verb@if (standardize)@\\ +\mbox{}\verb@ args$chol <- sc <- standardize(chol = args$chol)@\\ +\mbox{}\verb@if (!is.null(perm)) {@\\ +\mbox{}\verb@ if (!attr(args$chol, "diag")) {@\\ +\mbox{}\verb@ diagonals(args$chol) <- 1@\\ +\mbox{}\verb@ sc <- args$chol@\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@ args$chol <- pc <- aperm(as.chol(args$chol), perm = perm)@\\ +\mbox{}\verb@ if (length(nm) < length(no))@\\ +\mbox{}\verb@ args$chol <- marg_mvnorm(chol = args$chol, which = nm)$chol@\\ +\mbox{}\verb@ args$mean <- args$mean[nm,,drop = FALSE]@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@ret <- do.call("sldpmvnorm", args)@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape lLgrad mean}\nobreak\ {\footnotesize \NWlink{nuweb124b}{124b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape lLgrad marginalisation}\nobreak\ {\footnotesize \NWlink{nuweb125a}{125a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape lLgrad deperma}\nobreak\ {\footnotesize \NWlink{nuweb125b}{125b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape lLgrad destandarized}\nobreak\ {\footnotesize \NWlink{nuweb125c}{125c}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape lLgrad diagonals}\nobreak\ {\footnotesize \NWlink{nuweb126a}{126a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@\hbox{$\langle\,${\itshape lLgrad return}\nobreak\ {\footnotesize \NWlink{nuweb126b}{126b}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb128}{128}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +The next task is to post-differentiate all scores such that the gradients +with respect to the original arguments of \code{logLik} are obtained. We +start with the gradient with respect to $\muvec$, in case it was not given + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap149}\raggedright\small +\NWtarget{nuweb124b}{} $\langle\,${\itshape lLgrad mean}\nobreak\ {\footnotesize {124b}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@### sldmvnorm returns mean score as -obs@\\ +\mbox{}\verb@if (is.null(ret$mean)) ret$mean <- - ret$obs@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb124a}{124a}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +In case we marginalised over some variables, we have to set the omitted +parameters to zero + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap150}\raggedright\small +\NWtarget{nuweb125a}{} $\langle\,${\itshape lLgrad marginalisation}\nobreak\ {\footnotesize {125a}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@om <- length(no) - length(nm)@\\ +\mbox{}\verb@if (om > 0) {@\\ +\mbox{}\verb@ am <- matrix(0, nrow = om, ncol = ncol(ret$mean))@\\ +\mbox{}\verb@ rownames(am) <- no[!no %in% nm]@\\ +\mbox{}\verb@ ret$mean <- rbind(ret$mean, am)@\\ +\mbox{}\verb@ Jo <- dim(object$scale)[[2L]]@\\ +\mbox{}\verb@ pJ <- dim(args$invchol)[[2L]]@\\ +\mbox{}\verb@ am <- matrix(0, nrow = Jo * (Jo + 1) / 2 - pJ * (pJ + 1) / 2, @\\ +\mbox{}\verb@ ncol = dim(ret$invchol)[1L])@\\ +\mbox{}\verb@ byrow_orig <- attr(ret$chol, "byrow")@\\ +\mbox{}\verb@ ret$chol <- ltMatrices(ret$chol, byrow = TRUE)@\\ +\mbox{}\verb@ ### rbind only works for byrow = TRUE@\\ +\mbox{}\verb@ ret$chol <- ltMatrices(rbind(unclass(ret$chol), am), @\\ +\mbox{}\verb@ byrow = TRUE, @\\ +\mbox{}\verb@ diag = TRUE,@\\ +\mbox{}\verb@ names = perm)@\\ +\mbox{}\verb@ ret$chol <- ltMatrices(ret$chol, byrow = byrow_orig)@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb124a}{124a}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +If the order of the variables was permuted, we compute the scores for the +original ordering of the variables, as explained in Chapter~\ref{cdl} + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap151}\raggedright\small +\NWtarget{nuweb125b}{} $\langle\,${\itshape lLgrad deperma}\nobreak\ {\footnotesize {125b}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@if (!is.null(perm))@\\ +\mbox{}\verb@ ret$chol <- deperma(chol = sc, permuted_chol = pc, @\\ +\mbox{}\verb@ perm = match(perm, no), @\\ +\mbox{}\verb@ score_schol = ret$chol)@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb124a}{124a}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +The effect of standardization can be removed as discussed in +Chapter~\ref{copula} + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap152}\raggedright\small +\NWtarget{nuweb125c}{} $\langle\,${\itshape lLgrad destandarized}\nobreak\ {\footnotesize {125c}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@if (standardize)@\\ +\mbox{}\verb@ ret$chol <- destandardize(chol = object$scale, @\\ +\mbox{}\verb@ score_schol = ret$chol)@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb124a}{124a}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +and it remains to remove fix diagonal elements + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap153}\raggedright\small +\NWtarget{nuweb126a}{} $\langle\,${\itshape lLgrad diagonals}\nobreak\ {\footnotesize {126a}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@if (!attr(sc, "diag"))@\\ +\mbox{}\verb@ ret$chol <- ltMatrices(Lower_tri(ret$chol, diag = FALSE),@\\ +\mbox{}\verb@ diag = FALSE, @\\ +\mbox{}\verb@ byrow = attr(ret$chol, "byrow"), @\\ +\mbox{}\verb@ names = dimnames(ret$chol)[[2L]])@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb124a}{124a}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +and to return the results, with mean scores in the correct ordering + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap154}\raggedright\small +\NWtarget{nuweb126b}{} $\langle\,${\itshape lLgrad return}\nobreak\ {\footnotesize {126b}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@ret$scale <- ret$chol@\\ +\mbox{}\verb@ret$chol <- NULL@\\ +\mbox{}\verb@ret$mean <- ret$mean[no,,drop = FALSE]@\\ +\mbox{}\verb@return(ret)@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb124a}{124a}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +The steps are essentially the same when $\mL$ was given, but we have to +post-differentiate $\mC = \mL^{-1}$ with respect to $\mL$ + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap155}\raggedright\small +\NWtarget{nuweb127}{} $\langle\,${\itshape lLgrad invchol}\nobreak\ {\footnotesize {127}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@names(args)[names(args) == "scale"] <- "invchol"@\\ +\mbox{}\verb@si <- args$invchol@\\ +\mbox{}\verb@if (standardize)@\\ +\mbox{}\verb@ args$invchol <- si <- standardize(invchol = args$invchol)@\\ +\mbox{}\verb@if (!is.null(perm)) {@\\ +\mbox{}\verb@ if (!attr(args$invchol, "diag")) {@\\ +\mbox{}\verb@ diagonals(args$invchol) <- 1@\\ +\mbox{}\verb@ si <- args$invchol@\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@ args$invchol <- pi <- aperm(as.invchol(args$invchol), perm = perm)@\\ +\mbox{}\verb@ if (length(nm) < length(no))@\\ +\mbox{}\verb@ args$invchol <- marg_mvnorm(invchol = args$invchol,@\\ +\mbox{}\verb@ which = nm)$invchol@\\ +\mbox{}\verb@ args$mean <- args$mean[nm,,drop = FALSE]@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@ret <- do.call("sldpmvnorm", args)@\\ +\mbox{}\verb@### sldmvnorm returns mean score as -obs@\\ +\mbox{}\verb@if (is.null(ret$mean)) ret$mean <- - ret$obs@\\ +\mbox{}\verb@om <- length(no) - length(nm)@\\ +\mbox{}\verb@if (om > 0) {@\\ +\mbox{}\verb@ am <- matrix(0, nrow = om, ncol = ncol(ret$mean))@\\ +\mbox{}\verb@ rownames(am) <- no[!no %in% nm]@\\ +\mbox{}\verb@ ret$mean <- rbind(ret$mean, am)@\\ +\mbox{}\verb@ Jo <- dim(object$scale)[[2L]]@\\ +\mbox{}\verb@ pJ <- dim(args$invchol)[[2L]]@\\ +\mbox{}\verb@ am <- matrix(0, nrow = Jo * (Jo + 1) / 2 - pJ * (pJ + 1) / 2, @\\ +\mbox{}\verb@ ncol = dim(ret$invchol)[1L])@\\ +\mbox{}\verb@ byrow_orig <- attr(ret$invchol, "byrow")@\\ +\mbox{}\verb@ ret$invchol <- ltMatrices(ret$invchol, byrow = TRUE)@\\ +\mbox{}\verb@ ### rbind only works for byrow = TRUE@\\ +\mbox{}\verb@ ret$invchol <- ltMatrices(rbind(unclass(ret$invchol), am), @\\ +\mbox{}\verb@ byrow = TRUE,@\\ +\mbox{}\verb@ diag = TRUE,@\\ +\mbox{}\verb@ names = perm)@\\ +\mbox{}\verb@ ret$invchol <- ltMatrices(ret$invchol, byrow = byrow_orig)@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@if (!is.null(perm))@\\ +\mbox{}\verb@ ret$invchol <- deperma(invchol = si, permuted_invchol = pi, @\\ +\mbox{}\verb@ perm = match(perm, no), @\\ +\mbox{}\verb@ score_schol = -vectrick(pi, ret$invchol))@\\ +\mbox{}\verb@if (standardize)@\\ +\mbox{}\verb@ ret$invchol <- destandardize(invchol = object$scale, @\\ +\mbox{}\verb@ score_schol = -vectrick(si, ret$invchol))@\\ +\mbox{}\verb@if (!attr(si, "diag"))@\\ +\mbox{}\verb@ ret$invchol <- ltMatrices(Lower_tri(ret$invchol, diag = FALSE),@\\ +\mbox{}\verb@ diag = FALSE, @\\ +\mbox{}\verb@ byrow = attr(ret$invchol, "byrow"), @\\ +\mbox{}\verb@ names = dimnames(ret$invchol)[[2L]])@\\ +\mbox{}\verb@ret$scale <- ret$invchol@\\ +\mbox{}\verb@ret$invchol <- NULL@\\ +\mbox{}\verb@ret$mean <- ret$mean[no,,drop = FALSE]@\\ +\mbox{}\verb@return(ret)@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb128}{128}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +We can now provide the log-likelihood gradients + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap156}\raggedright\small +\NWtarget{nuweb128}{} $\langle\,${\itshape mvnorm lLgrad}\nobreak\ {\footnotesize {128}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@lLgrad <- function(object, ...)@\\ +\mbox{}\verb@ UseMethod("lLgrad")@\\ +\mbox{}\verb@@\\ +\mbox{}\verb@lLgrad.mvnorm <- function(object, obs, lower, upper, standardize = FALSE, @\\ +\mbox{}\verb@ ...) {@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape argchecks}\nobreak\ {\footnotesize \NWlink{nuweb122}{122}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ if (is.chol(object$scale)) {@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape lLgrad chol}\nobreak\ {\footnotesize \NWlink{nuweb124a}{124a}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@ }@\\ +\mbox{}\verb@ @\hbox{$\langle\,${\itshape lLgrad invchol}\nobreak\ {\footnotesize \NWlink{nuweb127}{127}}$\,\rangle$}\verb@@\\ +\mbox{}\verb@}@\\ +\mbox{}\verb@@{\NWsep} +\end{list} +\vspace{-1.5ex} +\footnotesize +\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} +\item \NWtxtMacroRefIn\ \NWlink{nuweb115a}{115a}. + +\item{} +\end{list} +\end{minipage}\vspace{4ex} +\end{flushleft} +Let's use this infrastructure to set-up maximum-likelihood estimation +procedures. We start implementing the log-likelihood and score functions for +the iris dataset + +<>= +J <- length(vars) +obs <- t(iris[, vars]) +lower <- upper <- NULL +ll <- function(parm) { + C <- ltMatrices(parm[-(1:J)], diag = TRUE, names = vars) + x <- mvnorm(mean = parm[1:J], chol = C) + -logLik(object = x, obs = obs, lower = lower, upper = upper) +} +sc <- function(parm) { + C <- ltMatrices(parm[-(1:J)], diag = TRUE, names = vars) + x <- mvnorm(mean = parm[1:J], chol = C) + ret <- lLgrad(object = x, obs = obs, lower = lower, upper = upper) + -c(rowSums(ret$mean), rowSums(Lower_tri(ret$scale, diag = TRUE))) +} +@ + +and can now estimate the mean and Cholesky factor of the covariance matrix + +<>= +start <- c(c(iris_mvn$mean), Lower_tri(iris_mvn$scale, diag = TRUE)) +if (require("numDeriv", quietly = TRUE)) + chk(grad(ll, start), sc(start), check.attributes = FALSE) +op <- optim(start, fn = ll, gr = sc, method = "L-BFGS-B", + lower = llim, control = list(trace = TRUE)) +Chat <- ltMatrices(op$par[-(1:J)], diag = TRUE, names = vars) +ML <- mvnorm(mean = op$par[1:J], chol = Chat) +@ + +Quit unsurprisingly, the results are practically equivalent to the +analytically available maximum-likelihood estimators in this case + +<>= +### covariance +round(chol2cov(ML$scale), 2) +N <- nrow(iris) +round(V * (N - 1) / N, 2) +### mean +ML$mean[,,drop = TRUE] +m +@ + +Now, this was a lot of work to replace \code{mean} and \code{var} with +something more fancy, and we would of course not go down this way in real +life. But how about a more complex situation where one (or more) variables +are only known up to intervals? Let's present the first variable is such a +case + +<>= +v1 <- vars[1] +q1 <- quantile(iris[[v1]], prob = 1:4 / 5) +head(f1 <- cut(iris[[v1]], breaks = c(-Inf, q1, Inf))) +@ + +The only necessary modification to our code is the specification of +\code{lower} and \code{upper} bounds for these intervals, and the removal of +the first variable from the ``exact continuous'' observations \code{obs}. +The rest of the machinery \emph{doesn't need any update at all}. Note that +the mean and covariance parameters are no longer orthogonal (as in the toy +example above), so we do have to optimise over both sets of parameters +simultaneously. + +<>= +lower <- matrix(c(-Inf, q1)[f1], nrow = 1) +upper <- matrix(c(q1, Inf)[f1], nrow = 1) +rownames(lower) <- rownames(upper) <- v1 +obs <- obs[!rownames(obs) %in% v1,,drop = FALSE] +if (require("numDeriv", quietly = TRUE)) + chk(grad(ll, start), sc(start), check.attributes = FALSE) +opi <- optim(start, fn = ll, gr = sc, method = "L-BFGS-B", + lower = llim, control = list(trace = TRUE)) +Chati <- ltMatrices(opi$par[-(1:J)], diag = TRUE, names = vars) +MLi <- mvnorm(mean = opi$par[1:J], chol = Chati) +@ + +Because the likelihood is a product of a continuous density and a +conditional probability as introduced in Chapter~\ref{cdl}, the two +in-sample log-likelihoods are not comparable. However, the parameters of the +two estimated normal distributions can be compared directly (and are rather +close in our case) + +<>= +op$value +opi$value +### covariance +round(chol2cov(MLi$scale), 2) +round(chol2cov(ML$scale), 2) +### mean +MLi$mean[,,drop = TRUE] +ML$mean[,,drop = TRUE] +@ + +We close this chapter with a word of warning: If more than one variable is +censored, the \code{M} and \code{w} arguments to \code{lpmvnorm} and +\code{slpmvnorm} have to be specified in \code{logLik} and \code{lLgrad} as +additional arguments (\code{...}) \emph{AND MUST BE IDENTICAL} in both calls. + +\chapter{Package Infrastructure} + +\begin{flushleft} \small +\begin{minipage}{\linewidth}\label{scrap157}\raggedright\small +\NWtarget{nuweb131}{} $\langle\,${\itshape R Header}\nobreak\ {\footnotesize {131}}$\,\rangle\equiv$ +\vspace{-1ex} +\begin{list}{}{} \item +\mbox{}\verb@@\\ +\mbox{}\verb@### Copyright (C) 2022- Torsten Hothorn@\\ +\mbox{}\verb@###@\\ +\mbox{}\verb@### This file is part of the 'mvtnorm' R add-on package.@\\ +\mbox{}\verb@###@\\ \mbox{}\verb@### 'mvtnorm' is free software: you can redistribute it and/or modify@\\ \mbox{}\verb@### it under the terms of the GNU General Public License as published by@\\ \mbox{}\verb@### the Free Software Foundation, version 2.@\\ @@ -6579,15 +8120,15 @@ if (!inherits(sd_NPML, "try-error")) { \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb2}{2}\NWlink{nuweb59a}{, 59a}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb2}{2}\NWlink{nuweb64}{, 64}. \item{} \end{list} \end{minipage}\vspace{4ex} \end{flushleft} \begin{flushleft} \small -\begin{minipage}{\linewidth}\label{scrap127}\raggedright\small -\NWtarget{nuweb105}{} $\langle\,${\itshape C Header}\nobreak\ {\footnotesize {105}}$\,\rangle\equiv$ +\begin{minipage}{\linewidth}\label{scrap158}\raggedright\small +\NWtarget{nuweb132}{} $\langle\,${\itshape C Header}\nobreak\ {\footnotesize {132}}$\,\rangle\equiv$ \vspace{-1ex} \begin{list}{}{} \item \mbox{}\verb@@\\ @@ -6618,7 +8159,7 @@ if (!inherits(sd_NPML, "try-error")) { \vspace{-1.5ex} \footnotesize \begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \NWtxtMacroRefIn\ \NWlink{nuweb3}{3}\NWlink{nuweb59b}{, 59b}. +\item \NWtxtMacroRefIn\ \NWlink{nuweb3}{3}\NWlink{nuweb65}{, 65}. \item{} \end{list} @@ -6635,7 +8176,8 @@ This document uses the following matrix derivatives & = & (\mA \otimes \mI_J) + (\mI_J \otimes \mA) \frac{\partial \mA^\top}{\partial \mA} \\ \frac{\partial \diag(\mA)}{\partial \mA} & = & \diag(\vecop(\mI_J)) \\ \frac{\partial \mA}{\partial \mA} & = & \diag(I_{J^2}) \\ -\frac{\yvec^\top \mA \yvec}{\partial \yvec} & = & \yvec^\top (\mA + \mA^\top) +\frac{\partial \yvec^\top \mA \yvec}{\partial \yvec} & = & \yvec^\top (\mA + \mA^\top) \\ +\frac{\partial \mB \mA}{\partial \mA} & = & (\mI_J \otimes \mB) \end{eqnarray*} and the ``vec trick'' $\vecop(\rX)^\top (\mB \otimes \mA^\top) = \vecop(\mA \rX \mB)^\top$. @@ -6647,8 +8189,9 @@ and the ``vec trick'' $\vecop(\rX)^\top (\mB \otimes \mA^\top) = \vecop(\mA {\small\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item \verb@"lpmvnorm.c"@ {\footnotesize {\NWtxtDefBy} \NWlink{nuweb59b}{59b}.} -\item \verb@"lpmvnorm.R"@ {\footnotesize {\NWtxtDefBy} \NWlink{nuweb59a}{59a}.} +\item \verb@"interface.R"@ {\footnotesize {\NWtxtDefBy} \NWlink{nuweb115a}{115a}.} +\item \verb@"lpmvnorm.c"@ {\footnotesize {\NWtxtDefBy} \NWlink{nuweb65}{65}.} +\item \verb@"lpmvnorm.R"@ {\footnotesize {\NWtxtDefBy} \NWlink{nuweb64}{64}.} \item \verb@"ltMatrices.c"@ {\footnotesize {\NWtxtDefBy} \NWlink{nuweb3}{3}.} \item \verb@"ltMatrices.R"@ {\footnotesize {\NWtxtDefBy} \NWlink{nuweb2}{2}.} \end{list}} @@ -6657,157 +8200,187 @@ and the ``vec trick'' $\vecop(\rX)^\top (\mB \otimes \mA^\top) = \vecop(\mA {\small\begin{list}{}{\setlength{\itemsep}{-\parsep}\setlength{\itemindent}{-\leftmargin}} -\item $\langle\,$.subset ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb12}{12}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb13}{13}.} -\item $\langle\,$add diagonal elements\nobreak\ {\footnotesize \NWlink{nuweb18}{18}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$aperm\nobreak\ {\footnotesize \NWlink{nuweb47}{47}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$assign diagonal elements\nobreak\ {\footnotesize \NWlink{nuweb19}{19}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$C Header\nobreak\ {\footnotesize \NWlink{nuweb105}{105}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}\NWlink{nuweb59b}{, 59b}. +\item $\langle\,$.subset ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb13}{13}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb14}{14}.} +\item $\langle\,$add diagonal elements\nobreak\ {\footnotesize \NWlink{nuweb20}{20}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$aperm\nobreak\ {\footnotesize \NWlink{nuweb51a}{51a}\NWlink{nuweb51b}{b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$aperm checks\nobreak\ {\footnotesize \NWlink{nuweb50}{50}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb51a}{51a}.} +\item $\langle\,$argchecks\nobreak\ {\footnotesize \NWlink{nuweb122}{122}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb123c}{123c}\NWlink{nuweb128}{, 128}. +} +\item $\langle\,$as.ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb115b}{115b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$assign diagonal elements\nobreak\ {\footnotesize \NWlink{nuweb21}{21}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$C Header\nobreak\ {\footnotesize \NWlink{nuweb132}{132}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}\NWlink{nuweb65}{, 65}. } -\item $\langle\,$C length\nobreak\ {\footnotesize \NWlink{nuweb22a}{22a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb22b}{22b}\NWlink{nuweb24}{, 24}\NWlink{nuweb27}{, 27}\NWlink{nuweb28}{, 28}\NWlink{nuweb31a}{, 31a}\NWlink{nuweb40a}{, 40a}. +\item $\langle\,$C length\nobreak\ {\footnotesize \NWlink{nuweb24a}{24a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb24b}{24b}\NWlink{nuweb26}{, 26}\NWlink{nuweb29}{, 29}\NWlink{nuweb33a}{, 33a}\NWlink{nuweb42a}{, 42a}. } -\item $\langle\,$check A argument\nobreak\ {\footnotesize \NWlink{nuweb41b}{41b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb42}{42}.} -\item $\langle\,$check and / or set integration weights\nobreak\ {\footnotesize \NWlink{nuweb68b}{68b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb69}{69}\NWlink{nuweb82}{, 82}. +\item $\langle\,$check A argument\nobreak\ {\footnotesize \NWlink{nuweb43b}{43b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb44}{44}.} +\item $\langle\,$check and / or set integration weights\nobreak\ {\footnotesize \NWlink{nuweb74b}{74b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb75}{75}\NWlink{nuweb87}{, 87}. } -\item $\langle\,$check C argument\nobreak\ {\footnotesize \NWlink{nuweb40b}{40b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb42}{42}.} -\item $\langle\,$check obs\nobreak\ {\footnotesize \NWlink{nuweb52b}{52b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$check S argument\nobreak\ {\footnotesize \NWlink{nuweb41a}{41a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb42}{42}.} -\item $\langle\,$chol\nobreak\ {\footnotesize \NWlink{nuweb38}{38}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}.} -\item $\langle\,$chol scores\nobreak\ {\footnotesize \NWlink{nuweb71a}{71a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb72a}{72a}.} -\item $\langle\,$chol syMatrices\nobreak\ {\footnotesize \NWlink{nuweb37}{37}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$Cholesky of precision\nobreak\ {\footnotesize \NWlink{nuweb68c}{68c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb69}{69}\NWlink{nuweb82}{, 82}. +\item $\langle\,$check C argument\nobreak\ {\footnotesize \NWlink{nuweb42b}{42b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb44}{44}.} +\item $\langle\,$check obs\nobreak\ {\footnotesize \NWlink{nuweb57b}{57b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$check S argument\nobreak\ {\footnotesize \NWlink{nuweb43a}{43a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb44}{44}.} +\item $\langle\,$chol\nobreak\ {\footnotesize \NWlink{nuweb40}{40}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}.} +\item $\langle\,$chol classes\nobreak\ {\footnotesize \NWlink{nuweb45}{45}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb48}{48}.} +\item $\langle\,$chol scores\nobreak\ {\footnotesize \NWlink{nuweb77a}{77a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb78a}{78a}.} +\item $\langle\,$chol syMatrices\nobreak\ {\footnotesize \NWlink{nuweb39}{39}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$Cholesky of precision\nobreak\ {\footnotesize \NWlink{nuweb74c}{74c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb75}{75}\NWlink{nuweb87}{, 87}. } -\item $\langle\,$colSumsdnorm\nobreak\ {\footnotesize \NWlink{nuweb53a}{53a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}.} -\item $\langle\,$colSumsdnorm ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb53b}{53b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$compute x\nobreak\ {\footnotesize \NWlink{nuweb62a}{62a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb62d}{62d}\NWlink{nuweb77a}{, 77a}. +\item $\langle\,$colSumsdnorm\nobreak\ {\footnotesize \NWlink{nuweb58a}{58a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}.} +\item $\langle\,$colSumsdnorm ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb58b}{58b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$compute x\nobreak\ {\footnotesize \NWlink{nuweb68b}{68b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb69b}{69b}\NWlink{nuweb83a}{, 83a}. } -\item $\langle\,$compute y\nobreak\ {\footnotesize \NWlink{nuweb61c}{61c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb62d}{62d}\NWlink{nuweb77a}{, 77a}. +\item $\langle\,$compute y\nobreak\ {\footnotesize \NWlink{nuweb68a}{68a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb69b}{69b}\NWlink{nuweb83a}{, 83a}. } -\item $\langle\,$cond general\nobreak\ {\footnotesize \NWlink{nuweb49}{49}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb50b}{50b}.} -\item $\langle\,$cond simple\nobreak\ {\footnotesize \NWlink{nuweb50a}{50a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb50b}{50b}.} -\item $\langle\,$conditional\nobreak\ {\footnotesize \NWlink{nuweb50b}{50b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$convenience functions\nobreak\ {\footnotesize \NWlink{nuweb45}{45}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$crossprod ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb36}{36}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$D times C\nobreak\ {\footnotesize \NWlink{nuweb43}{43}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb45}{45}.} -\item $\langle\,$destandardize\nobreak\ {\footnotesize \NWlink{nuweb100}{100}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$diagonal matrix\nobreak\ {\footnotesize \NWlink{nuweb20}{20}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$diagonals ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb17}{17}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$cond general\nobreak\ {\footnotesize \NWlink{nuweb53}{53}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb55}{55}.} +\item $\langle\,$cond simple\nobreak\ {\footnotesize \NWlink{nuweb54}{54}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb55}{55}.} +\item $\langle\,$conditional\nobreak\ {\footnotesize \NWlink{nuweb55}{55}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$convenience functions\nobreak\ {\footnotesize \NWlink{nuweb48}{48}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$crossprod ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb38}{38}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$D times C\nobreak\ {\footnotesize \NWlink{nuweb46}{46}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb48}{48}.} +\item $\langle\,$deperma\nobreak\ {\footnotesize \NWlink{nuweb107}{107}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb64}{64}.} +\item $\langle\,$deperma indices\nobreak\ {\footnotesize \NWlink{nuweb106b}{106b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb107}{107}.} +\item $\langle\,$deperma input checks chol\nobreak\ {\footnotesize \NWlink{nuweb105a}{105a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb107}{107}.} +\item $\langle\,$deperma input checks perm\nobreak\ {\footnotesize \NWlink{nuweb105b}{105b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb107}{107}.} +\item $\langle\,$deperma input checks schol\nobreak\ {\footnotesize \NWlink{nuweb106a}{106a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb107}{107}.} +\item $\langle\,$destandardize\nobreak\ {\footnotesize \NWlink{nuweb111}{111}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb64}{64}.} +\item $\langle\,$diagonal matrix\nobreak\ {\footnotesize \NWlink{nuweb22}{22}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$diagonals ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb19}{19}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} \item $\langle\,$dim ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb6c}{6c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$dimensions\nobreak\ {\footnotesize \NWlink{nuweb65b}{65b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb67}{67}\NWlink{nuweb79}{, 79}. +\item $\langle\,$dimensions\nobreak\ {\footnotesize \NWlink{nuweb71c}{71c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb73}{73}\NWlink{nuweb84}{, 84}. } \item $\langle\,$dimnames ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb7a}{7a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$dp input checks\nobreak\ {\footnotesize \NWlink{nuweb93}{93}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb94}{94}\NWlink{nuweb96}{, 96}. +\item $\langle\,$dp input checks\nobreak\ {\footnotesize \NWlink{nuweb99}{99}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb100}{100}\NWlink{nuweb102}{, 102}. } -\item $\langle\,$extract slots\nobreak\ {\footnotesize \NWlink{nuweb9}{9}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb10}{10}\NWlink{nuweb11}{, 11}\NWlink{nuweb12}{, 12}\NWlink{nuweb15}{, 15}\NWlink{nuweb17}{, 17}\NWlink{nuweb19}{, 19}\NWlink{nuweb21a}{, 21a}\NWlink{nuweb25}{, 25}. +\item $\langle\,$extract slots\nobreak\ {\footnotesize \NWlink{nuweb10}{10}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb11}{11}\NWlink{nuweb12}{, 12}\NWlink{nuweb13}{, 13}\NWlink{nuweb17}{, 17}\NWlink{nuweb19}{, 19}\NWlink{nuweb21}{, 21}\NWlink{nuweb23a}{, 23a}\NWlink{nuweb27}{, 27}. } -\item $\langle\,$first element\nobreak\ {\footnotesize \NWlink{nuweb32a}{32a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb32b}{32b}\NWlink{nuweb33a}{, 33a}. +\item $\langle\,$first element\nobreak\ {\footnotesize \NWlink{nuweb34a}{34a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb34b}{34b}\NWlink{nuweb35a}{, 35a}. } -\item $\langle\,$IDX\nobreak\ {\footnotesize \NWlink{nuweb33b}{33b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb34}{34}\NWlink{nuweb40a}{, 40a}. +\item $\langle\,$IDX\nobreak\ {\footnotesize \NWlink{nuweb35b}{35b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb36}{36}\NWlink{nuweb42a}{, 42a}. } -\item $\langle\,$increment\nobreak\ {\footnotesize \NWlink{nuweb63a}{63a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb67}{67}.} -\item $\langle\,$init center\nobreak\ {\footnotesize \NWlink{nuweb66b}{66b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb67}{67}\NWlink{nuweb79}{, 79}. +\item $\langle\,$increment\nobreak\ {\footnotesize \NWlink{nuweb69c}{69c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb73}{73}.} +\item $\langle\,$init center\nobreak\ {\footnotesize \NWlink{nuweb72c}{72c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb73}{73}\NWlink{nuweb84}{, 84}. } -\item $\langle\,$init dans\nobreak\ {\footnotesize \NWlink{nuweb77c}{77c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb79}{79}.} -\item $\langle\,$init logLik loop\nobreak\ {\footnotesize \NWlink{nuweb61b}{61b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb67}{67}\NWlink{nuweb73b}{, 73b}. +\item $\langle\,$init dans\nobreak\ {\footnotesize \NWlink{nuweb83c}{83c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb84}{84}.} +\item $\langle\,$init logLik loop\nobreak\ {\footnotesize \NWlink{nuweb67c}{67c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb73}{73}\NWlink{nuweb79b}{, 79b}. } -\item $\langle\,$init random seed, reset on exit\nobreak\ {\footnotesize \NWlink{nuweb68a}{68a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb69}{69}\NWlink{nuweb82}{, 82}. +\item $\langle\,$init random seed, reset on exit\nobreak\ {\footnotesize \NWlink{nuweb74a}{74a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb75}{75}\NWlink{nuweb87}{, 87}. } -\item $\langle\,$init score loop\nobreak\ {\footnotesize \NWlink{nuweb73b}{73b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb79}{79}.} -\item $\langle\,$initialisation\nobreak\ {\footnotesize \NWlink{nuweb61a}{61a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb67}{67}\NWlink{nuweb79}{, 79}. +\item $\langle\,$init score loop\nobreak\ {\footnotesize \NWlink{nuweb79b}{79b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb84}{84}.} +\item $\langle\,$initialisation\nobreak\ {\footnotesize \NWlink{nuweb67b}{67b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb73}{73}\NWlink{nuweb84}{, 84}. } -\item $\langle\,$inner logLik loop\nobreak\ {\footnotesize \NWlink{nuweb62d}{62d}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb67}{67}.} -\item $\langle\,$inner score loop\nobreak\ {\footnotesize \NWlink{nuweb77a}{77a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb79}{79}.} -\item $\langle\,$input checks\nobreak\ {\footnotesize \NWlink{nuweb60a}{60a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb58}{58}\NWlink{nuweb69}{, 69}\NWlink{nuweb82}{, 82}. +\item $\langle\,$inner logLik loop\nobreak\ {\footnotesize \NWlink{nuweb69b}{69b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb73}{73}.} +\item $\langle\,$inner score loop\nobreak\ {\footnotesize \NWlink{nuweb83a}{83a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb84}{84}.} +\item $\langle\,$input checks\nobreak\ {\footnotesize \NWlink{nuweb66}{66}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb63}{63}\NWlink{nuweb75}{, 75}\NWlink{nuweb87}{, 87}. } -\item $\langle\,$kronecker vec trick\nobreak\ {\footnotesize \NWlink{nuweb42}{42}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$L times D\nobreak\ {\footnotesize \NWlink{nuweb44}{44}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb45}{45}.} -\item $\langle\,$lapack options\nobreak\ {\footnotesize \NWlink{nuweb26}{26}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb27}{27}\NWlink{nuweb28}{, 28}. +\item $\langle\,$is.ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb7c}{7c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$kronecker vec trick\nobreak\ {\footnotesize \NWlink{nuweb44}{44}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$L times D\nobreak\ {\footnotesize \NWlink{nuweb47}{47}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb48}{48}.} +\item $\langle\,$lapack options\nobreak\ {\footnotesize \NWlink{nuweb28}{28}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb29}{29}\NWlink{nuweb30}{, 30}. } -\item $\langle\,$ldmvnorm\nobreak\ {\footnotesize \NWlink{nuweb52a}{52a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$ldmvnorm chol\nobreak\ {\footnotesize \NWlink{nuweb54a}{54a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb52a}{52a}.} -\item $\langle\,$ldmvnorm invchol\nobreak\ {\footnotesize \NWlink{nuweb54b}{54b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb52a}{52a}.} -\item $\langle\,$ldpmvnorm\nobreak\ {\footnotesize \NWlink{nuweb94}{94}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$logdet\nobreak\ {\footnotesize \NWlink{nuweb31a}{31a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}.} -\item $\langle\,$logdet ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb31b}{31b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$lower scores\nobreak\ {\footnotesize \NWlink{nuweb71c}{71c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb72a}{72a}.} -\item $\langle\,$lower triangular elements\nobreak\ {\footnotesize \NWlink{nuweb15}{15}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$lpmvnorm\nobreak\ {\footnotesize \NWlink{nuweb69}{69}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb59a}{59a}.} -\item $\langle\,$lpmvnormR\nobreak\ {\footnotesize \NWlink{nuweb58}{58}}$\,\rangle$ {\footnotesize {\NWtxtNoRef}.} +\item $\langle\,$ldmvnorm\nobreak\ {\footnotesize \NWlink{nuweb57a}{57a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb64}{64}.} +\item $\langle\,$ldmvnorm chol\nobreak\ {\footnotesize \NWlink{nuweb59a}{59a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb57a}{57a}.} +\item $\langle\,$ldmvnorm invchol\nobreak\ {\footnotesize \NWlink{nuweb59b}{59b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb57a}{57a}.} +\item $\langle\,$ldpmvnorm\nobreak\ {\footnotesize \NWlink{nuweb100}{100}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb64}{64}.} +\item $\langle\,$lLgrad chol\nobreak\ {\footnotesize \NWlink{nuweb124a}{124a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb128}{128}.} +\item $\langle\,$lLgrad deperma\nobreak\ {\footnotesize \NWlink{nuweb125b}{125b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb124a}{124a}.} +\item $\langle\,$lLgrad destandarized\nobreak\ {\footnotesize \NWlink{nuweb125c}{125c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb124a}{124a}.} +\item $\langle\,$lLgrad diagonals\nobreak\ {\footnotesize \NWlink{nuweb126a}{126a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb124a}{124a}.} +\item $\langle\,$lLgrad invchol\nobreak\ {\footnotesize \NWlink{nuweb127}{127}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb128}{128}.} +\item $\langle\,$lLgrad marginalisation\nobreak\ {\footnotesize \NWlink{nuweb125a}{125a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb124a}{124a}.} +\item $\langle\,$lLgrad mean\nobreak\ {\footnotesize \NWlink{nuweb124b}{124b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb124a}{124a}.} +\item $\langle\,$lLgrad return\nobreak\ {\footnotesize \NWlink{nuweb126b}{126b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb124a}{124a}.} +\item $\langle\,$logdet\nobreak\ {\footnotesize \NWlink{nuweb33a}{33a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}.} +\item $\langle\,$logdet ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb33b}{33b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$logLik chol\nobreak\ {\footnotesize \NWlink{nuweb123a}{123a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb123c}{123c}.} +\item $\langle\,$logLik invchol\nobreak\ {\footnotesize \NWlink{nuweb123b}{123b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb123c}{123c}.} +\item $\langle\,$lower scores\nobreak\ {\footnotesize \NWlink{nuweb77c}{77c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb78a}{78a}.} +\item $\langle\,$lower triangular elements\nobreak\ {\footnotesize \NWlink{nuweb17}{17}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$lpmvnorm\nobreak\ {\footnotesize \NWlink{nuweb75}{75}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb64}{64}.} +\item $\langle\,$lpmvnormR\nobreak\ {\footnotesize \NWlink{nuweb63}{63}}$\,\rangle$ {\footnotesize {\NWtxtNoRef}.} \item $\langle\,$ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb6a}{6a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} \item $\langle\,$ltMatrices dim\nobreak\ {\footnotesize \NWlink{nuweb4}{4}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb6a}{6a}.} \item $\langle\,$ltMatrices input\nobreak\ {\footnotesize \NWlink{nuweb5b}{5b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb6a}{6a}.} \item $\langle\,$ltMatrices names\nobreak\ {\footnotesize \NWlink{nuweb5a}{5a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb6a}{6a}.} -\item $\langle\,$marginal\nobreak\ {\footnotesize \NWlink{nuweb48b}{48b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$mc input checks\nobreak\ {\footnotesize \NWlink{nuweb48a}{48a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb48b}{48b}\NWlink{nuweb50b}{, 50b}. +\item $\langle\,$marginal\nobreak\ {\footnotesize \NWlink{nuweb52b}{52b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$mc input checks\nobreak\ {\footnotesize \NWlink{nuweb52a}{52a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb52b}{52b}\NWlink{nuweb55}{, 55}. } -\item $\langle\,$mean scores\nobreak\ {\footnotesize \NWlink{nuweb71b}{71b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb72a}{72a}.} -\item $\langle\,$move on\nobreak\ {\footnotesize \NWlink{nuweb63c}{63c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb67}{67}\NWlink{nuweb79}{, 79}. +\item $\langle\,$mean scores\nobreak\ {\footnotesize \NWlink{nuweb77b}{77b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb78a}{78a}.} +\item $\langle\,$move on\nobreak\ {\footnotesize \NWlink{nuweb70a}{70a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb73}{73}\NWlink{nuweb84}{, 84}. } -\item $\langle\,$mult\nobreak\ {\footnotesize \NWlink{nuweb22b}{22b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}.} -\item $\langle\,$mult ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb21a}{21a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$mult ltMatrices transpose\nobreak\ {\footnotesize \NWlink{nuweb23}{23}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb21a}{21a}.} -\item $\langle\,$mult syMatrices\nobreak\ {\footnotesize \NWlink{nuweb25}{25}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$mult transpose\nobreak\ {\footnotesize \NWlink{nuweb24}{24}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}.} +\item $\langle\,$mult\nobreak\ {\footnotesize \NWlink{nuweb24b}{24b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}.} +\item $\langle\,$mult ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb23a}{23a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$mult ltMatrices transpose\nobreak\ {\footnotesize \NWlink{nuweb25}{25}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb23a}{23a}.} +\item $\langle\,$mult syMatrices\nobreak\ {\footnotesize \NWlink{nuweb27}{27}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$mult transpose\nobreak\ {\footnotesize \NWlink{nuweb26}{26}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}.} +\item $\langle\,$mvnorm\nobreak\ {\footnotesize \NWlink{nuweb117a}{117a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb115a}{115a}.} +\item $\langle\,$mvnorm chol invchol\nobreak\ {\footnotesize \NWlink{nuweb116a}{116a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb117a}{117a}.} +\item $\langle\,$mvnorm condDist\nobreak\ {\footnotesize \NWlink{nuweb120}{120}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb115a}{115a}.} +\item $\langle\,$mvnorm lLgrad\nobreak\ {\footnotesize \NWlink{nuweb128}{128}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb115a}{115a}.} +\item $\langle\,$mvnorm logLik\nobreak\ {\footnotesize \NWlink{nuweb123c}{123c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb115a}{115a}.} +\item $\langle\,$mvnorm margDist\nobreak\ {\footnotesize \NWlink{nuweb119}{119}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb115a}{115a}.} +\item $\langle\,$mvnorm mean\nobreak\ {\footnotesize \NWlink{nuweb116b}{116b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb117a}{117a}.} +\item $\langle\,$mvnorm methods\nobreak\ {\footnotesize \NWlink{nuweb117b}{117b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb115a}{115a}.} +\item $\langle\,$mvnorm simulate\nobreak\ {\footnotesize \NWlink{nuweb118}{118}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb115a}{115a}.} \item $\langle\,$names ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb7b}{7b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$new score means, lower and upper\nobreak\ {\footnotesize \NWlink{nuweb75c}{75c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb77a}{77a}.} -\item $\langle\,$output\nobreak\ {\footnotesize \NWlink{nuweb63b}{63b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb67}{67}.} -\item $\langle\,$pnorm\nobreak\ {\footnotesize \NWlink{nuweb64c}{64c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb67}{67}\NWlink{nuweb79}{, 79}. +\item $\langle\,$new score means, lower and upper\nobreak\ {\footnotesize \NWlink{nuweb81c}{81c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb83a}{83a}.} +\item $\langle\,$output\nobreak\ {\footnotesize \NWlink{nuweb69d}{69d}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb73}{73}.} +\item $\langle\,$pnorm\nobreak\ {\footnotesize \NWlink{nuweb71a}{71a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb73}{73}\NWlink{nuweb84}{, 84}. } -\item $\langle\,$pnorm fast\nobreak\ {\footnotesize \NWlink{nuweb64a}{64a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb59b}{59b}.} -\item $\langle\,$pnorm slow\nobreak\ {\footnotesize \NWlink{nuweb64b}{64b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb59b}{59b}.} -\item $\langle\,$post differentiate chol score\nobreak\ {\footnotesize \NWlink{nuweb80d}{80d}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb82}{82}.} -\item $\langle\,$post differentiate invchol score\nobreak\ {\footnotesize \NWlink{nuweb81a}{81a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb82}{82}.} -\item $\langle\,$post differentiate lower score\nobreak\ {\footnotesize \NWlink{nuweb80b}{80b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb82}{82}.} -\item $\langle\,$post differentiate mean score\nobreak\ {\footnotesize \NWlink{nuweb80a}{80a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb82}{82}.} -\item $\langle\,$post differentiate upper score\nobreak\ {\footnotesize \NWlink{nuweb80c}{80c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb82}{82}.} -\item $\langle\,$post process score\nobreak\ {\footnotesize \NWlink{nuweb81b}{81b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb82}{82}.} -\item $\langle\,$print ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb10}{10}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$R Header\nobreak\ {\footnotesize \NWlink{nuweb104}{104}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}\NWlink{nuweb59a}{, 59a}. +\item $\langle\,$pnorm fast\nobreak\ {\footnotesize \NWlink{nuweb70b}{70b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb65}{65}.} +\item $\langle\,$pnorm slow\nobreak\ {\footnotesize \NWlink{nuweb70c}{70c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb65}{65}.} +\item $\langle\,$post differentiate chol score\nobreak\ {\footnotesize \NWlink{nuweb85d}{85d}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb87}{87}.} +\item $\langle\,$post differentiate invchol score\nobreak\ {\footnotesize \NWlink{nuweb86a}{86a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb87}{87}.} +\item $\langle\,$post differentiate lower score\nobreak\ {\footnotesize \NWlink{nuweb85b}{85b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb87}{87}.} +\item $\langle\,$post differentiate mean score\nobreak\ {\footnotesize \NWlink{nuweb85a}{85a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb87}{87}.} +\item $\langle\,$post differentiate upper score\nobreak\ {\footnotesize \NWlink{nuweb85c}{85c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb87}{87}.} +\item $\langle\,$post process score\nobreak\ {\footnotesize \NWlink{nuweb86b}{86b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb87}{87}.} +\item $\langle\,$print ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb11}{11}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$R Header\nobreak\ {\footnotesize \NWlink{nuweb131}{131}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}\NWlink{nuweb64}{, 64}. } -\item $\langle\,$R lpmvnorm\nobreak\ {\footnotesize \NWlink{nuweb67}{67}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb59b}{59b}.} -\item $\langle\,$R slpmvnorm\nobreak\ {\footnotesize \NWlink{nuweb79}{79}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb59b}{59b}.} -\item $\langle\,$R slpmvnorm variables\nobreak\ {\footnotesize \NWlink{nuweb66c}{66c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb67}{67}\NWlink{nuweb79}{, 79}. +\item $\langle\,$R lpmvnorm\nobreak\ {\footnotesize \NWlink{nuweb73}{73}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb65}{65}.} +\item $\langle\,$R slpmvnorm\nobreak\ {\footnotesize \NWlink{nuweb84}{84}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb65}{65}.} +\item $\langle\,$R slpmvnorm variables\nobreak\ {\footnotesize \NWlink{nuweb72d}{72d}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb73}{73}\NWlink{nuweb84}{, 84}. } -\item $\langle\,$RC input\nobreak\ {\footnotesize \NWlink{nuweb21b}{21b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb22b}{22b}\NWlink{nuweb24}{, 24}\NWlink{nuweb27}{, 27}\NWlink{nuweb28}{, 28}\NWlink{nuweb31a}{, 31a}\NWlink{nuweb34}{, 34}\NWlink{nuweb40a}{, 40a}. +\item $\langle\,$RC input\nobreak\ {\footnotesize \NWlink{nuweb23b}{23b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb24b}{24b}\NWlink{nuweb26}{, 26}\NWlink{nuweb29}{, 29}\NWlink{nuweb30}{, 30}\NWlink{nuweb33a}{, 33a}\NWlink{nuweb36}{, 36}\NWlink{nuweb42a}{, 42a}. } -\item $\langle\,$reorder ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb11}{11}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$score a, b\nobreak\ {\footnotesize \NWlink{nuweb73a}{73a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb73b}{73b}\NWlink{nuweb79}{, 79}. +\item $\langle\,$reorder ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb12}{12}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$score a, b\nobreak\ {\footnotesize \NWlink{nuweb79a}{79a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb79b}{79b}\NWlink{nuweb84}{, 84}. } -\item $\langle\,$score c11\nobreak\ {\footnotesize \NWlink{nuweb72b}{72b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb73b}{73b}\NWlink{nuweb79}{, 79}. +\item $\langle\,$score c11\nobreak\ {\footnotesize \NWlink{nuweb78b}{78b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb79b}{79b}\NWlink{nuweb84}{, 84}. } -\item $\langle\,$score output\nobreak\ {\footnotesize \NWlink{nuweb77b}{77b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb79}{79}.} -\item $\langle\,$score output object\nobreak\ {\footnotesize \NWlink{nuweb72a}{72a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb79}{79}.} -\item $\langle\,$score wrt new chol diagonal\nobreak\ {\footnotesize \NWlink{nuweb75b}{75b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb77a}{77a}.} -\item $\langle\,$score wrt new chol off-diagonals\nobreak\ {\footnotesize \NWlink{nuweb75a}{75a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb77a}{77a}.} -\item $\langle\,$setup return object\nobreak\ {\footnotesize \NWlink{nuweb65c}{65c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb67}{67}.} -\item $\langle\,$sldmvnorm\nobreak\ {\footnotesize \NWlink{nuweb56}{56}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$sldpmvnorm\nobreak\ {\footnotesize \NWlink{nuweb96}{96}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$sldpmvnorm invchol\nobreak\ {\footnotesize \NWlink{nuweb95}{95}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb96}{96}.} -\item $\langle\,$slpmvnorm\nobreak\ {\footnotesize \NWlink{nuweb82}{82}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb59a}{59a}.} -\item $\langle\,$solve\nobreak\ {\footnotesize \NWlink{nuweb27}{27}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}.} -\item $\langle\,$solve C\nobreak\ {\footnotesize \NWlink{nuweb28}{28}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}.} -\item $\langle\,$solve ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb29}{29}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$standardise\nobreak\ {\footnotesize \NWlink{nuweb60b}{60b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb69}{69}\NWlink{nuweb82}{, 82}. +\item $\langle\,$score output\nobreak\ {\footnotesize \NWlink{nuweb83b}{83b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb84}{84}.} +\item $\langle\,$score output object\nobreak\ {\footnotesize \NWlink{nuweb78a}{78a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb84}{84}.} +\item $\langle\,$score wrt new chol diagonal\nobreak\ {\footnotesize \NWlink{nuweb81b}{81b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb83a}{83a}.} +\item $\langle\,$score wrt new chol off-diagonals\nobreak\ {\footnotesize \NWlink{nuweb81a}{81a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb83a}{83a}.} +\item $\langle\,$setup return object\nobreak\ {\footnotesize \NWlink{nuweb72a}{72a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb73}{73}.} +\item $\langle\,$sldmvnorm\nobreak\ {\footnotesize \NWlink{nuweb61}{61}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb64}{64}.} +\item $\langle\,$sldpmvnorm\nobreak\ {\footnotesize \NWlink{nuweb102}{102}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb64}{64}.} +\item $\langle\,$sldpmvnorm invchol\nobreak\ {\footnotesize \NWlink{nuweb101}{101}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb102}{102}.} +\item $\langle\,$slpmvnorm\nobreak\ {\footnotesize \NWlink{nuweb87}{87}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb64}{64}.} +\item $\langle\,$solve\nobreak\ {\footnotesize \NWlink{nuweb29}{29}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}.} +\item $\langle\,$solve C\nobreak\ {\footnotesize \NWlink{nuweb30}{30}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}.} +\item $\langle\,$solve ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb31}{31}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$standardise\nobreak\ {\footnotesize \NWlink{nuweb67a}{67a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb75}{75}\NWlink{nuweb87}{, 87}. } -\item $\langle\,$standardize\nobreak\ {\footnotesize \NWlink{nuweb98}{98}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$subset ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb13}{13}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$standardize\nobreak\ {\footnotesize \NWlink{nuweb109}{109}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb64}{64}.} +\item $\langle\,$subset ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb14}{14}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} \item $\langle\,$syMatrices\nobreak\ {\footnotesize \NWlink{nuweb6b}{6b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$t(C) S t(A)\nobreak\ {\footnotesize \NWlink{nuweb39}{39}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb40a}{40a}.} -\item $\langle\,$tcrossprod\nobreak\ {\footnotesize \NWlink{nuweb34}{34}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}.} -\item $\langle\,$tcrossprod diagonal only\nobreak\ {\footnotesize \NWlink{nuweb32b}{32b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb34}{34}.} -\item $\langle\,$tcrossprod full\nobreak\ {\footnotesize \NWlink{nuweb33a}{33a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb34}{34}.} -\item $\langle\,$tcrossprod ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb35}{35}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} -\item $\langle\,$univariate problem\nobreak\ {\footnotesize \NWlink{nuweb66a}{66a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb67}{67}.} -\item $\langle\,$update d, e\nobreak\ {\footnotesize \NWlink{nuweb62b}{62b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb62d}{62d}\NWlink{nuweb77a}{, 77a}. +\item $\langle\,$t(C) S t(A)\nobreak\ {\footnotesize \NWlink{nuweb41}{41}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb42a}{42a}.} +\item $\langle\,$tcrossprod\nobreak\ {\footnotesize \NWlink{nuweb36}{36}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}.} +\item $\langle\,$tcrossprod diagonal only\nobreak\ {\footnotesize \NWlink{nuweb34b}{34b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb36}{36}.} +\item $\langle\,$tcrossprod full\nobreak\ {\footnotesize \NWlink{nuweb35a}{35a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb36}{36}.} +\item $\langle\,$tcrossprod ltMatrices\nobreak\ {\footnotesize \NWlink{nuweb37}{37}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb2}{2}.} +\item $\langle\,$univariate problem\nobreak\ {\footnotesize \NWlink{nuweb72b}{72b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb73}{73}.} +\item $\langle\,$update d, e\nobreak\ {\footnotesize \NWlink{nuweb68c}{68c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb69b}{69b}\NWlink{nuweb83a}{, 83a}. } -\item $\langle\,$update f\nobreak\ {\footnotesize \NWlink{nuweb62c}{62c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb62d}{62d}\NWlink{nuweb77a}{, 77a}. +\item $\langle\,$update f\nobreak\ {\footnotesize \NWlink{nuweb69a}{69a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb69b}{69b}\NWlink{nuweb83a}{, 83a}. } -\item $\langle\,$update score for chol\nobreak\ {\footnotesize \NWlink{nuweb76a}{76a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb77a}{77a}.} -\item $\langle\,$update score means, lower and upper\nobreak\ {\footnotesize \NWlink{nuweb76b}{76b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb77a}{77a}.} -\item $\langle\,$update yp for chol\nobreak\ {\footnotesize \NWlink{nuweb73c}{73c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb77a}{77a}.} -\item $\langle\,$update yp for means, lower and upper\nobreak\ {\footnotesize \NWlink{nuweb74}{74}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb77a}{77a}.} -\item $\langle\,$upper scores\nobreak\ {\footnotesize \NWlink{nuweb71d}{71d}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb72a}{72a}.} -\item $\langle\,$vec trick\nobreak\ {\footnotesize \NWlink{nuweb40a}{40a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}.} -\item $\langle\,$W length\nobreak\ {\footnotesize \NWlink{nuweb65a}{65a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb67}{67}\NWlink{nuweb79}{, 79}. +\item $\langle\,$update score for chol\nobreak\ {\footnotesize \NWlink{nuweb82a}{82a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb83a}{83a}.} +\item $\langle\,$update score means, lower and upper\nobreak\ {\footnotesize \NWlink{nuweb82b}{82b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb83a}{83a}.} +\item $\langle\,$update yp for chol\nobreak\ {\footnotesize \NWlink{nuweb79c}{79c}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb83a}{83a}.} +\item $\langle\,$update yp for means, lower and upper\nobreak\ {\footnotesize \NWlink{nuweb80}{80}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb83a}{83a}.} +\item $\langle\,$upper scores\nobreak\ {\footnotesize \NWlink{nuweb77d}{77d}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb78a}{78a}.} +\item $\langle\,$vec trick\nobreak\ {\footnotesize \NWlink{nuweb42a}{42a}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb3}{3}.} +\item $\langle\,$W length\nobreak\ {\footnotesize \NWlink{nuweb71b}{71b}}$\,\rangle$ {\footnotesize {\NWtxtRefIn} \NWlink{nuweb73}{73}\NWlink{nuweb84}{, 84}. } \end{list}} diff --git a/vignettes/lmvnorm_src.Rout.save b/vignettes/lmvnorm_src.Rout.save index e84c044..80f83b1 100644 --- a/vignettes/lmvnorm_src.Rout.save +++ b/vignettes/lmvnorm_src.Rout.save @@ -164,112 +164,192 @@ E 0.4913541358 0.2849431 0.005961103 0.8901457863 1.000000000 > chk(a, b) -> a <- as.array(ltMatrices(xn, byrow = FALSE)[1:2, 2:4]) +> i <- colnames(xn)[1:2] -> b <- as.array(ltMatrices(xn, byrow = FALSE))[2:4, -+ 2:4, 1:2] +> j <- 2:4 + +> a <- as.array(ltMatrices(xn, byrow = FALSE, names = nm)[i, ++ j]) + +> b <- as.array(ltMatrices(xn, byrow = FALSE, names = nm))[j, ++ j, i] > chk(a, b) -> a <- as.array(ltMatrices(xn, byrow = TRUE)[1:2, 2:4]) +> a <- as.array(ltMatrices(xn, byrow = TRUE, names = nm)[i, ++ j]) -> b <- as.array(ltMatrices(xn, byrow = TRUE))[2:4, 2:4, -+ 1:2] +> b <- as.array(ltMatrices(xn, byrow = TRUE, names = nm))[j, ++ j, i] > chk(a, b) -> a <- as.array(ltMatrices(xd, byrow = FALSE, diag = TRUE)[1:2, -+ 2:4]) +> a <- as.array(ltMatrices(xd, byrow = FALSE, diag = TRUE, ++ names = nm)[i, j]) -> b <- as.array(ltMatrices(xd, byrow = FALSE, diag = TRUE))[2:4, -+ 2:4, 1:2] +> b <- as.array(ltMatrices(xd, byrow = FALSE, diag = TRUE, ++ names = nm))[j, j, i] > chk(a, b) -> a <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE)[1:2, -+ 2:4]) +> a <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE, ++ names = nm)[i, j]) -> b <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE))[2:4, -+ 2:4, 1:2] +> b <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE, ++ names = nm))[j, j, i] > chk(a, b) -> j <- c(1, 3, 5) +> i <- 1:2 -> a <- as.array(ltMatrices(xn, byrow = FALSE)[1:2, j]) +> j <- nm[2:4] -> b <- as.array(ltMatrices(xn, byrow = FALSE))[j, j, -+ 1:2] +> a <- as.array(ltMatrices(xn, byrow = FALSE, names = nm)[i, ++ j]) + +> b <- as.array(ltMatrices(xn, byrow = FALSE, names = nm))[j, ++ j, i] > chk(a, b) -> a <- as.array(ltMatrices(xn, byrow = TRUE)[1:2, j]) +> a <- as.array(ltMatrices(xn, byrow = TRUE, names = nm)[i, ++ j]) -> b <- as.array(ltMatrices(xn, byrow = TRUE))[j, j, -+ 1:2] +> b <- as.array(ltMatrices(xn, byrow = TRUE, names = nm))[j, ++ j, i] > chk(a, b) -> a <- as.array(ltMatrices(xd, byrow = FALSE, diag = TRUE)[1:2, +> a <- as.array(ltMatrices(xd, byrow = FALSE, diag = TRUE, ++ names = nm)[i, j]) + +> b <- as.array(ltMatrices(xd, byrow = FALSE, diag = TRUE, ++ names = nm))[j, j, i] + +> chk(a, b) + +> a <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE, ++ names = nm)[i, j]) + +> b <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE, ++ names = nm))[j, j, i] + +> chk(a, b) + +> j <- c(1, 3, 5) + +> a <- as.array(ltMatrices(xn, byrow = FALSE, names = nm)[i, + j]) -> b <- as.array(ltMatrices(xd, byrow = FALSE, diag = TRUE))[j, -+ j, 1:2] +> b <- as.array(ltMatrices(xn, byrow = FALSE, names = nm))[j, ++ j, i] > chk(a, b) -> a <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE)[1:2, +> a <- as.array(ltMatrices(xn, byrow = TRUE, names = nm)[i, + j]) -> b <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE))[j, -+ j, 1:2] +> b <- as.array(ltMatrices(xn, byrow = TRUE, names = nm))[j, ++ j, i] > chk(a, b) -> j <- -c(1, 3, 5) +> a <- as.array(ltMatrices(xd, byrow = FALSE, diag = TRUE, ++ names = nm)[i, j]) + +> b <- as.array(ltMatrices(xd, byrow = FALSE, diag = TRUE, ++ names = nm))[j, j, i] + +> chk(a, b) -> a <- as.array(ltMatrices(xn, byrow = FALSE)[1:2, j]) +> a <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE, ++ names = nm)[i, j]) -> b <- as.array(ltMatrices(xn, byrow = FALSE))[j, j, -+ 1:2] +> b <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE, ++ names = nm))[j, j, i] > chk(a, b) -> a <- as.array(ltMatrices(xn, byrow = TRUE)[1:2, j]) +> j <- nm[c(1, 3, 5)] -> b <- as.array(ltMatrices(xn, byrow = TRUE))[j, j, -+ 1:2] +> a <- as.array(ltMatrices(xn, byrow = FALSE, names = nm)[i, ++ j]) + +> b <- as.array(ltMatrices(xn, byrow = FALSE, names = nm))[j, ++ j, i] > chk(a, b) -> a <- as.array(ltMatrices(xd, byrow = FALSE, diag = TRUE)[1:2, +> a <- as.array(ltMatrices(xn, byrow = TRUE, names = nm)[i, + j]) -> b <- as.array(ltMatrices(xd, byrow = FALSE, diag = TRUE))[j, -+ j, 1:2] +> b <- as.array(ltMatrices(xn, byrow = TRUE, names = nm))[j, ++ j, i] + +> chk(a, b) + +> a <- as.array(ltMatrices(xd, byrow = FALSE, diag = TRUE, ++ names = nm)[i, j]) + +> b <- as.array(ltMatrices(xd, byrow = FALSE, diag = TRUE, ++ names = nm))[j, j, i] > chk(a, b) -> a <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE)[1:2, +> a <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE, ++ names = nm)[i, j]) + +> b <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE, ++ names = nm))[j, j, i] + +> chk(a, b) + +> j <- -c(1, 3, 5) + +> a <- as.array(ltMatrices(xn, byrow = FALSE, names = nm)[i, + j]) -> b <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE))[j, -+ j, 1:2] +> b <- as.array(ltMatrices(xn, byrow = FALSE, names = nm))[j, ++ j, i] > chk(a, b) -> j <- sample(1:J) +> a <- as.array(ltMatrices(xn, byrow = TRUE, names = nm)[i, ++ j]) + +> b <- as.array(ltMatrices(xn, byrow = TRUE, names = nm))[j, ++ j, i] + +> chk(a, b) + +> a <- as.array(ltMatrices(xd, byrow = FALSE, diag = TRUE, ++ names = nm)[i, j]) + +> b <- as.array(ltMatrices(xd, byrow = FALSE, diag = TRUE, ++ names = nm))[j, j, i] -> ltM <- ltMatrices(xn, byrow = FALSE) +> chk(a, b) + +> a <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE, ++ names = nm)[i, j]) + +> b <- as.array(ltMatrices(xd, byrow = TRUE, diag = TRUE, ++ names = nm))[j, j, i] + +> chk(a, b) -> try(ltM[1:2, j]) -Error in `[.ltMatrices`(ltM, 1:2, j) : invalid subset argument j +> j <- nm[sample(1:J)] + +> ltM <- ltMatrices(xn, byrow = FALSE, names = nm) + +> try(ltM[i, j]) +Error in `[.ltMatrices`(ltM, i, j) : invalid subset argument j > ltM <- as.syMatrices(ltM) -> a <- as.array(ltM[1:2, j]) +> a <- as.array(ltM[i, j]) -> b <- as.array(ltM)[j, j, 1:2] +> b <- as.array(ltM)[j, j, i] > chk(a, b) @@ -297,14 +377,6 @@ Error in `[.ltMatrices`(ltM, 1:2, j) : invalid subset argument j 3.3 8 8 4.3 9 9 4.4 10 10 -attr(,"J") -[1] 4 -attr(,"diag") -[1] TRUE -attr(,"byrow") -[1] FALSE -attr(,"rcnames") -[1] "1" "2" "3" "4" > M <- ltMatrices(matrix(1:6, nrow = 6, ncol = 2), diag = FALSE) @@ -316,14 +388,6 @@ attr(,"rcnames") 3.2 4 4 4.2 5 5 4.3 6 6 -attr(,"J") -[1] 4 -attr(,"diag") -[1] FALSE -attr(,"byrow") -[1] FALSE -attr(,"rcnames") -[1] "1" "2" "3" "4" > Lower_tri(M, diag = TRUE) [,1] [,2] @@ -337,14 +401,6 @@ attr(,"rcnames") 3.3 1 1 4.3 6 6 4.4 1 1 -attr(,"J") -[1] 4 -attr(,"diag") -[1] TRUE -attr(,"byrow") -[1] FALSE -attr(,"rcnames") -[1] "1" "2" "3" "4" > Lower_tri(invchol2cor(M)) [,1] [,2] @@ -354,14 +410,6 @@ attr(,"rcnames") 3.2 -0.9258201 -0.9258201 4.2 0.9189002 0.9189002 4.3 -0.9974149 -0.9974149 -attr(,"J") -[1] 4 -attr(,"diag") -[1] FALSE -attr(,"byrow") -[1] FALSE -attr(,"rcnames") -[1] "1" "2" "3" "4" > all(diagonals(ltMatrices(xn, byrow = TRUE)) == 1) [1] TRUE @@ -777,19 +825,19 @@ attr(,"rcnames") > chk(unlist(PC), c(as.array(chol2pc(C))), check.attributes = FALSE) -> L <- lxn +> L <- as.invchol(lxn) > J <- dim(L)[2] -> Lp <- aperm(a = L, perm = p <- sample(1:J), is_chol = FALSE) +> Lp <- aperm(a = L, perm = p <- sample(1:J)) > chk(invchol2cov(L)[, p], invchol2cov(Lp)) -> C <- lxn +> C <- as.chol(lxn) > J <- dim(C)[2] -> Cp <- aperm(a = C, perm = p <- sample(1:J), is_chol = TRUE) +> Cp <- aperm(a = C, perm = p <- sample(1:J)) > chk(chol2cov(C)[, p], chol2cov(Cp)) @@ -1102,16 +1150,16 @@ $logLik [1] -0.01165889 -0.08617272 -0.01240094 -0.03105050 $mean - [,1] [,2] [,3] [,4] -[1,] 0.02222249 0.2140162 0.02641782 0.08861162 + [,1] [,2] [,3] [,4] +1 0.02222249 0.2140162 0.02641782 0.08861162 $lower - [,1] [,2] [,3] [,4] -[1,] -0.03221736 -0.214453 -0.03536199 -0.09096213 + [,1] [,2] [,3] [,4] +1 -0.03221736 -0.214453 -0.03536199 -0.09096213 $upper - [,1] [,2] [,3] [,4] -[1,] 0.00999487 0.0004368597 0.008944164 0.002350511 + [,1] [,2] [,3] [,4] +1 0.00999487 0.0004368597 0.008944164 0.002350511 $chol [,1] [,2] [,3] [,4] @@ -1439,6 +1487,17 @@ converged + 1))$mean) [1] 0.2602003 0.2270392 -0.1298560 +> c(cond_mvnorm(chol = aperm(as.chol(C), perm = c(2:J, ++ 1)), which = 1:(J - 1), given = diag(J - 1))$mean) +[1] 0.2602003 0.2270392 -0.1298560 + +> x <- as.array(chol2pre(aperm(as.chol(C), perm = c(2:J, ++ 1))))[J, , 1] + +> c(-x[-J]/x[J]) + 2 3 4 + 0.2602003 0.2270392 -0.1298560 + > dY <- as.data.frame(t(Y)) > colnames(dY) <- paste0("Y", 1:J) @@ -1486,6 +1545,8 @@ converged Y2 Y3 Y4 0.08229627 0.05039009 0.06246094 +> ic <- 1:2 + > ll_cd <- function(parm, J) { + m <- parm[1:J] + parm <- parm[-(1:J)] @@ -1536,6 +1597,51 @@ converged > mn [1] 1 2 3 4 +> perm <- c((1:J)[-ic], ic) + +> ll_ap <- function(parm, J) { ++ m <- parm[1:J] ++ parm <- parm[-(1:J)] ++ C <- matrix(c(parm), ncol = 1) ++ C <- ltMatrices(C, diag = TR .... [TRUNCATED] + +> sc_ap <- function(parm, J) { ++ m <- parm[1:J] ++ parm <- parm[-(1:J)] ++ C <- matrix(c(parm), ncol = 1) ++ C <- ltMatrices(C, diag = TR .... [TRUNCATED] + +> if (require("numDeriv", quietly = TRUE)) chk(grad(ll_ap, ++ start, J = J), sc_ap(start, J = J), check.attributes = FALSE, ++ tol = 1e-06) + +> op <- optim(start, fn = ll_ap, gr = sc_ap, J = J, ++ method = "L-BFGS-B", lower = llim, control = list(trace = TRUE)) +iter 10 value 655.708083 +final value 655.707779 +converged + +> ltMatrices(matrix(op$par[-(1:J)], ncol = 1), diag = TRUE, ++ byrow = BYROW) +, , 1 + + 1 2 3 4 +1 1.23595850 0.00000000 0.0000000 0.0000000 +2 0.05465127 1.36451801 0.0000000 0.0000000 +3 0.29575878 0.02193832 0.6152995 0.0000000 +4 0.07133278 0.66705199 0.2361473 0.6618529 + + +> aperm(as.chol(lt), perm = perm) +, , 1 + + 3 4 1 2 +3 1.2247449 0.000000 0.0000000 0.000000 +4 0.0000000 1.414214 0.0000000 0.000000 +1 0.3535534 0.000000 0.6123724 0.000000 +2 0.0000000 0.750000 0.2886751 0.595119 + + > C <- ltMatrices(runif(10)) > all.equal(as.array(chol2cov(standardize(chol = C))), @@ -1548,7 +1654,7 @@ converged + as.array(invchol2cor(standardize(invchol = L)))) [1] TRUE -> data("iris") +> data("iris", package = "datasets") > J <- 4 @@ -1672,7 +1778,175 @@ Petal.Width 0.78190591 -0.24142185 0.8713759 1.0000000 4 0.13691328 0.11037843 0.1161017 0 +> data("iris", package = "datasets") + +> vars <- names(iris)[-5] + +> m <- colMeans(iris[, vars]) + +> V <- var(iris[, vars]) + +> iris_mvn <- mvnorm(mean = m, chol = t(chol(V))) + +> iris_var <- simulate(iris_mvn, nsim = nrow(iris)) + +> j <- 3:4 + +> margDist(iris_mvn, which = vars[j]) +$scale +, , 1 + + Petal.Length Petal.Width +Petal.Length 1.7652982 0.0000000 +Petal.Width 0.7339323 0.2057903 + + +$mean + [,1] +Petal.Length 3.758000 +Petal.Width 1.199333 + +attr(,"class") +[1] "mvnorm" + +> gm <- t(iris[, vars[-(j)]]) + +> iris_cmvn <- condDist(iris_mvn, which = vars[j], given = gm) + +> logLik(object = iris_cmvn, obs = t(iris[, vars[-j]])) +[1] -4750.456 + +> logLik(object = iris_cmvn, obs = t(iris[, rev(vars[-j])])) +[1] -4750.456 + +> J <- length(vars) + +> obs <- t(iris[, vars]) + +> lower <- upper <- NULL + +> ll <- function(parm) { ++ C <- ltMatrices(parm[-(1:J)], diag = TRUE, names = vars) ++ x <- mvnorm(mean = parm[1:J], chol = C) ++ -logLik(ob .... [TRUNCATED] + +> sc <- function(parm) { ++ C <- ltMatrices(parm[-(1:J)], diag = TRUE, names = vars) ++ x <- mvnorm(mean = parm[1:J], chol = C) ++ ret <- lLg .... [TRUNCATED] + +> start <- c(c(iris_mvn$mean), Lower_tri(iris_mvn$scale, ++ diag = TRUE)) + +> if (require("numDeriv", quietly = TRUE)) chk(grad(ll, ++ start), sc(start), check.attributes = FALSE) + +> op <- optim(start, fn = ll, gr = sc, method = "L-BFGS-B", ++ lower = llim, control = list(trace = TRUE)) +iter 10 value 379.914996 +iter 20 value 379.914642 +final value 379.914631 +converged + +> Chat <- ltMatrices(op$par[-(1:J)], diag = TRUE, names = vars) + +> ML <- mvnorm(mean = op$par[1:J], chol = Chat) + +> round(chol2cov(ML$scale), 2) +, , 1 + + Sepal.Length Sepal.Width Petal.Length Petal.Width +Sepal.Length 0.68 -0.04 1.27 0.51 +Sepal.Width -0.04 0.19 -0.33 -0.12 +Petal.Length 1.27 -0.33 3.10 1.29 +Petal.Width 0.51 -0.12 1.29 0.58 + + +> N <- nrow(iris) + +> round(V * (N - 1)/N, 2) + Sepal.Length Sepal.Width Petal.Length Petal.Width +Sepal.Length 0.68 -0.04 1.27 0.51 +Sepal.Width -0.04 0.19 -0.33 -0.12 +Petal.Length 1.27 -0.33 3.10 1.29 +Petal.Width 0.51 -0.12 1.29 0.58 + +> ML$mean[, , drop = TRUE] +Sepal.Length Sepal.Width Petal.Length Petal.Width + 5.843333 3.057333 3.758000 1.199333 + +> m +Sepal.Length Sepal.Width Petal.Length Petal.Width + 5.843333 3.057333 3.758000 1.199333 + +> v1 <- vars[1] + +> q1 <- quantile(iris[[v1]], prob = 1:4/5) + +> head(f1 <- cut(iris[[v1]], breaks = c(-Inf, q1, Inf))) +[1] (5,5.6] (-Inf,5] (-Inf,5] (-Inf,5] (-Inf,5] (5,5.6] +Levels: (-Inf,5] (5,5.6] (5.6,6.1] (6.1,6.52] (6.52, Inf] + +> lower <- matrix(c(-Inf, q1)[f1], nrow = 1) + +> upper <- matrix(c(q1, Inf)[f1], nrow = 1) + +> rownames(lower) <- rownames(upper) <- v1 + +> obs <- obs[!rownames(obs) %in% v1, , drop = FALSE] + +> if (require("numDeriv", quietly = TRUE)) chk(grad(ll, ++ start), sc(start), check.attributes = FALSE) + +> opi <- optim(start, fn = ll, gr = sc, method = "L-BFGS-B", ++ lower = llim, control = list(trace = TRUE)) +iter 10 value 472.264901 +iter 20 value 472.211584 +iter 30 value 472.208646 +iter 40 value 472.208420 +final value 472.208416 +converged + +> Chati <- ltMatrices(opi$par[-(1:J)], diag = TRUE, ++ names = vars) + +> MLi <- mvnorm(mean = opi$par[1:J], chol = Chati) + +> op$value +[1] 379.9146 + +> opi$value +[1] 472.2084 + +> round(chol2cov(MLi$scale), 2) +, , 1 + + Sepal.Length Sepal.Width Petal.Length Petal.Width +Sepal.Length 0.73 -0.03 1.27 0.52 +Sepal.Width -0.03 0.19 -0.33 -0.12 +Petal.Length 1.27 -0.33 3.09 1.29 +Petal.Width 0.52 -0.12 1.29 0.58 + + +> round(chol2cov(ML$scale), 2) +, , 1 + + Sepal.Length Sepal.Width Petal.Length Petal.Width +Sepal.Length 0.68 -0.04 1.27 0.51 +Sepal.Width -0.04 0.19 -0.33 -0.12 +Petal.Length 1.27 -0.33 3.10 1.29 +Petal.Width 0.51 -0.12 1.29 0.58 + + +> MLi$mean[, , drop = TRUE] +Sepal.Length Sepal.Width Petal.Length Petal.Width + 5.759601 3.057314 3.757959 1.199314 + +> ML$mean[, , drop = TRUE] +Sepal.Length Sepal.Width Petal.Length Petal.Width + 5.843333 3.057333 3.758000 1.199333 + *** Run successfully completed *** > proc.time() user system elapsed - 10.496 0.083 10.660 + 11.248 0.053 11.310