├── .Rbuildignore ├── .editorconfig ├── .github ├── .gitignore └── workflows │ ├── R-CMD-check.yaml │ └── rhub.yaml ├── .gitignore ├── DESCRIPTION ├── INDEX ├── NAMESPACE ├── NEWS.md ├── R ├── By.R ├── Col.R ├── Expand.R ├── Grep.R ├── IC.R ├── Inverse.R ├── Missing.R ├── NA2x.R ├── Objective.R ├── addattr.R ├── addhook.R ├── addvar.R ├── assoc.R ├── backdoor.R ├── baptize.R ├── binomial.rrw.R ├── blockdiag.R ├── bootstrap.R ├── cancel.R ├── categorical.R ├── children.R ├── chisqsum.R ├── cluster.hook.R ├── coef.R ├── combine.R ├── commutation.R ├── compare.R ├── complik.R ├── confband.R ├── confint.R ├── confpred.R ├── constrain.R ├── contr.R ├── correlation.R ├── covariance.R ├── csplit.R ├── curly.R ├── cv.R ├── deriv.R ├── describecoef.R ├── devcoords.R ├── diagtest.R ├── distribution.R ├── dsep.R ├── effects.R ├── endogenous.R ├── equivalence.R ├── estimate.default.R ├── estimate.formula.R ├── estimate.list.R ├── estimate.lvm.R ├── estimate.multigroup.R ├── eventTime.R ├── exogenous.R ├── finalize.R ├── fix.R ├── fixsome.R ├── formula.R ├── fplot.R ├── frobnorm.R ├── functional.R ├── gkgamma.R ├── glmest.R ├── gof.R ├── graph.R ├── graph2lvm.R ├── heavytail.R ├── iid.R ├── img.R ├── index.sem.R ├── information.R ├── interactive.R ├── intervention.R ├── iv.R ├── kappa.R ├── kill.R ├── ksmooth.R ├── labels.R ├── latent.R ├── lava-package.R ├── lisrel.R ├── lmers.R ├── logLik.R ├── logo.R ├── lvm.R ├── makemissing.R ├── manifest.R ├── matrices.R ├── measurement.R ├── measurement.error.R ├── merge.R ├── missingMLE.R ├── mixture.R ├── model.R ├── model.frame.R ├── modelPar.R ├── modelVar.R ├── modelsearch.R ├── moments.R ├── multigroup.R ├── multinomial.R ├── multipleinput.R ├── multipletesting.R ├── mvnmix.R ├── napass0.R ├── nodecolor.R ├── nonlinear.R ├── normal.R ├── onload.R ├── operators.R ├── optims.R ├── ordinal.R ├── ordreg.R ├── parameter.R ├── parlabels.R ├── parpos.R ├── pars.R ├── parsedesign.R ├── partialcor.R ├── path.R ├── pcor.R ├── pdfconvert.R ├── plot.R ├── plot.estimate.R ├── plot.sim.R ├── plotConf.R ├── predict.R ├── predict.mixture.R ├── print.R ├── procformula.R ├── profile.R ├── randomslope.R ├── rbind.Surv.R ├── regression.R ├── residuals.R ├── revdiag.R ├── rotation.R ├── scheffe.R ├── score.R ├── score.survreg.R ├── sim.default.R ├── sim.lvm.R ├── spaghetti.R ├── stack.R ├── startvalues.R ├── subgraph.R ├── subset.R ├── summary.R ├── timedep.R ├── toformula.R ├── tr.R ├── transform.R ├── trim.R ├── twostage.R ├── utils.R ├── var_ic.R ├── variances.R ├── vars.R ├── vcov.R ├── vec.R ├── wait.R ├── weights.R ├── wkm.R ├── wrapvec.R ├── zcolorbar.R ├── zgetmplus.R ├── zgetsas.R └── zib.R ├── README.md ├── README.org ├── _pkgdown.yml ├── data ├── bmd.rda ├── bmidata.rda ├── brisa.rda ├── calcium.rda ├── hubble.rda ├── hubble2.rda ├── indoorenv.rda ├── missingdata.rda ├── nldata.rda ├── nsem.rda ├── semdata.rda ├── serotonin.rda ├── serotonin2.rda └── twindata.rda ├── demo ├── 00Index ├── estimation.R ├── inference.R ├── lava.R ├── model.R └── simulation.R ├── inst └── CITATION ├── man ├── By.Rd ├── Col.Rd ├── Combine.Rd ├── Expand.Rd ├── Graph.Rd ├── Grep.Rd ├── IC.Rd ├── Missing.Rd ├── Model.Rd ├── NA2x.Rd ├── NR.Rd ├── PD.Rd ├── Print.Rd ├── Range.lvm.Rd ├── addvar.Rd ├── backdoor.Rd ├── baptize.Rd ├── binomial.rd.Rd ├── blockdiag.Rd ├── bmd.Rd ├── bmidata.Rd ├── bootstrap.Rd ├── bootstrap.lvm.Rd ├── brisa.Rd ├── calcium.Rd ├── cancel.Rd ├── children.Rd ├── click.Rd ├── closed.testing.Rd ├── colorbar.Rd ├── commutation.Rd ├── compare.Rd ├── complik.Rd ├── confband.Rd ├── confint.lvmfit.Rd ├── confpred.Rd ├── constrain-set.Rd ├── contr.Rd ├── correlation.Rd ├── covariance.Rd ├── csplit.Rd ├── curly.Rd ├── devcoords.Rd ├── diagtest.Rd ├── dsep.lvm.Rd ├── equivalence.Rd ├── estimate.array.Rd ├── estimate.default.Rd ├── estimate.lvm.Rd ├── eventTime.Rd ├── figures │ ├── gof1-1.png │ ├── lvm1-1.png │ ├── mediation1-1.png │ ├── nlin1-1.png │ └── simres1-1.png ├── fplot.Rd ├── getMplus.Rd ├── getSAS.Rd ├── gof.Rd ├── hubble.Rd ├── hubble2.Rd ├── iid.Rd ├── images.Rd ├── indoorenv.Rd ├── intercept.Rd ├── internal.Rd ├── intervention.lvm.Rd ├── ksmooth2.Rd ├── labels-set.Rd ├── lava-package.Rd ├── lava.options.Rd ├── lvm.Rd ├── makemissing.Rd ├── measurement.error.Rd ├── missingdata.Rd ├── mixture.Rd ├── modelsearch.Rd ├── multinomial.Rd ├── mvnmix.Rd ├── nldata.Rd ├── nsem.Rd ├── op_concat.Rd ├── op_match.Rd ├── ordinal-set.Rd ├── ordreg.Rd ├── parpos.Rd ├── partialcor.Rd ├── path.Rd ├── pcor.Rd ├── pdfconvert.Rd ├── plot.estimate.Rd ├── plot.lvm.Rd ├── plot.sim.Rd ├── plotConf.Rd ├── predict.lvm.Rd ├── predictlvm.Rd ├── rbind.Surv.Rd ├── regression-set.Rd ├── revdiag.Rd ├── rmvar.Rd ├── rotate2.Rd ├── scheffe.Rd ├── semdata.Rd ├── serotonin.Rd ├── serotonin2.Rd ├── sim.Rd ├── sim.default.Rd ├── spaghetti.Rd ├── stack.estimate.Rd ├── subset.lvm.Rd ├── summary.sim.Rd ├── timedep.Rd ├── toformula.Rd ├── tr.Rd ├── trim.Rd ├── twindata.Rd ├── twostage.Rd ├── twostage.lvmfit.Rd ├── twostageCV.Rd ├── vars.Rd ├── vec.Rd ├── wait.Rd ├── wkm.Rd ├── wrapvec.Rd └── zibreg.Rd ├── tests ├── test-all.R └── testthat │ ├── test-constrain.R │ ├── test-estimate_default.R │ ├── test-graph.R │ ├── test-inference.R │ ├── test-influence.R │ ├── test-misc.R │ ├── test-model.R │ ├── test-multigroup.R │ ├── test-plot.R │ ├── test-sim.R │ └── test-simdef.R └── vignettes ├── correlation.Rmd ├── data ├── nonlinear_em0.rds ├── nonlinear_fitcv.rds └── nonlinear_selmod.rds ├── figs ├── closedtesting.pdf └── closedtesting.tex ├── influencefunction.Rmd ├── nonlinear.Rmd └── ref.bib /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.editorconfig$ 2 | ^TODO$ 3 | ^LICENSE$ 4 | ^dependencies$ 5 | ^tmp$ 6 | ^\.travis\.yml$ 7 | ^\.git$ 8 | ^.github$ 9 | ^.gitignore$ 10 | ^README\.Rmd$ 11 | ^README\.org$ 12 | ^examples$ 13 | ^TODO$ 14 | ^doc$ 15 | ^Meta$ 16 | ^_pkgdown\.yml$ 17 | ^docs$ 18 | ^pkgdown$ 19 | ^Meta$ 20 | ^\.github$ 21 | _cache$ 22 | -------------------------------------------------------------------------------- /.editorconfig: -------------------------------------------------------------------------------- 1 | # EditorConfig is awesome: https://EditorConfig.org 2 | 3 | # top-most EditorConfig file 4 | root = true 5 | 6 | [*] 7 | charset = utf-8 8 | end_of_line = lf # Unix-style newlines with a newline ending every file 9 | trim_trailing_whitespace = true 10 | indent_size = 2 11 | tab_width = 2 12 | indent_style = space 13 | 14 | [*.{h,.hpp,cpp,c}] 15 | insert_final_newline = true 16 | 17 | [*.{R}] 18 | insert_final_newline = true 19 | 20 | # Tab indentation (no size specified) 21 | [Makefile] 22 | indent_style = tab 23 | -------------------------------------------------------------------------------- /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | revdep 2 | *-exported.pdf 3 | TODO 4 | inst/doc 5 | vignettes/*.html 6 | vignettes/figure/*chunk* 7 | vignettes/*_cache 8 | vignettes/*_files 9 | vignettes/*.R 10 | README.Rmd 11 | cache 12 | docs 13 | deprecated* 14 | devel 15 | tmp 16 | *.gcno 17 | TAGS 18 | .git 19 | *.o 20 | *.so 21 | *~ 22 | test 23 | INDEX.missing 24 | *.RData 25 | *.Rhistory 26 | *.Rcheck 27 | *.tar.gz 28 | *.zip 29 | *.tgz 30 | *.obsolete 31 | x.log 32 | nohup.out 33 | tmp 34 | valgrind* 35 | test 36 | *.tmp 37 | *.bbl 38 | *.blg 39 | *.bak 40 | *.snm 41 | *.aux 42 | *.log 43 | *~ 44 | *.out 45 | *.swp 46 | *.nav 47 | *.toc 48 | *.vrb 49 | *.dvi 50 | _region* 51 | symbols.rds 52 | Rplots.pdf 53 | doc 54 | Meta 55 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: lava 2 | Type: Package 3 | Title: Latent Variable Models 4 | Version: 1.8.1 5 | Authors@R: c(person("Klaus K.", "Holst", email="klaus@holst.it", role=c("aut", "cre")), 6 | person("Brice", "Ozenne", role = "ctb"), 7 | person("Thomas", "Gerds", role = "ctb")) 8 | Author: Klaus K. Holst [aut, cre], 9 | Brice Ozenne [ctb], 10 | Thomas Gerds [ctb] 11 | Maintainer: Klaus K. Holst 12 | Description: A general implementation of Structural Equation Models 13 | with latent variables (MLE, 2SLS, and composite likelihood 14 | estimators) with both continuous, censored, and ordinal 15 | outcomes (Holst and Budtz-Joergensen (2013) ). 16 | Mixture latent variable models and non-linear latent variable models 17 | (Holst and Budtz-Joergensen (2020) ). 18 | The package also provides methods for graph exploration (d-separation, 19 | back-door criterion), simulation of general non-linear latent variable 20 | models, and estimation of influence functions for a broad range of 21 | statistical models. 22 | URL: https://kkholst.github.io/lava/ 23 | BugReports: https://github.com/kkholst/lava/issues 24 | License: GPL-3 25 | LazyLoad: yes 26 | Depends: 27 | R (>= 3.0) 28 | Imports: 29 | cli, 30 | future.apply, 31 | graphics, 32 | grDevices, 33 | methods, 34 | numDeriv, 35 | progressr, 36 | stats, 37 | survival, 38 | SQUAREM, 39 | utils 40 | Suggests: 41 | KernSmooth, 42 | Rgraphviz, 43 | data.table, 44 | ellipse, 45 | fields, 46 | geepack, 47 | graph, 48 | knitr, 49 | rmarkdown, 50 | igraph (>= 0.6), 51 | lavaSearch2, 52 | lme4 (>= 1.1.35.1), 53 | MASS, 54 | Matrix (>= 1.6.3), 55 | mets (>= 1.1), 56 | nlme, 57 | optimx, 58 | polycor, 59 | quantreg, 60 | rgl, 61 | targeted (>= 0.4), 62 | testthat (>= 0.11), 63 | visNetwork 64 | VignetteBuilder: knitr,rmarkdown 65 | ByteCompile: yes 66 | Encoding: UTF-8 67 | RoxygenNote: 7.3.2 68 | -------------------------------------------------------------------------------- /R/By.R: -------------------------------------------------------------------------------- 1 | ##' Apply a Function to a Data Frame Split by Factors 2 | ##' 3 | ##' Simple wrapper of the 'by' function 4 | ##' @title Apply a Function to a Data Frame Split by Factors 5 | ##' @param x Data frame 6 | ##' @param INDICES Indices (vector or list of indices, vector of column names, or formula of column names) 7 | ##' @param FUN A function to be applied to data frame subsets of 'data'. 8 | ##' @param COLUMNS (Optional) subset of columns of x to work on 9 | ##' @param array if TRUE an array/matrix is always returned 10 | ##' @param ... Additional arguments to lower-level functions 11 | ##' @author Klaus K. Holst 12 | ##' @export 13 | ##' @examples 14 | ##' By(datasets::CO2,~Treatment+Type,colMeans,~conc) 15 | ##' By(datasets::CO2,~Treatment+Type,colMeans,~conc+uptake) 16 | By <- function(x,INDICES,FUN,COLUMNS,array=FALSE,...) { 17 | if (inherits(INDICES,"formula")) { 18 | INDICES <- as.list(model.frame(INDICES,x)) 19 | } else { 20 | if (is.character(INDICES) && length(INDICES)!=nrow(x)) { 21 | INDICES <- as.list(x[,INDICES,drop=FALSE]) 22 | } 23 | } 24 | if (!missing(COLUMNS)) { 25 | if (inherits(COLUMNS,"formula")) { 26 | x <- model.frame(COLUMNS,x) 27 | } else { 28 | x <- x[,COLUMNS,drop=FALSE] 29 | } 30 | } 31 | a <- by(x, INDICES, FUN=FUN, ...) 32 | if (NCOL(x)==1 && !array) { 33 | ##DimElem <- length(a[rep(1,length(dim(a)))][[1]]) 34 | a <- a[] 35 | attr(a,"call") <- NULL 36 | } 37 | return(a) 38 | } 39 | -------------------------------------------------------------------------------- /R/Col.R: -------------------------------------------------------------------------------- 1 | mypal <- function(set=TRUE,...) { 2 | oldpal <- palette() 3 | col <- c("black","darkblue","darkred","goldenrod","mediumpurple", 4 | "seagreen","aquamarine3","violetred1","salmon1", 5 | "lightgoldenrod1","darkorange2","firebrick1","violetred1", "gold") 6 | if (!set) return(col) 7 | palette(col) 8 | invisible(oldpal) 9 | } 10 | 11 | 12 | ##' This function transforms a standard color (e.g. "red") into an 13 | ##' transparent RGB-color (i.e. alpha-blend<1). 14 | ##' 15 | ##' This only works for certain graphics devices (Cairo-X11 (x11 as of R>=2.7), quartz, pdf, ...). 16 | ##' @title Generate a transparent RGB color 17 | ##' @param col Color (numeric or character) 18 | ##' @param alpha Degree of transparency (0,1) 19 | ##' @param locate Choose colour (with mouse) 20 | ##' @return A character vector with elements of 7 or 9 characters, `#` 21 | ##' followed by the red, blue, green and optionally alpha values in 22 | ##' hexadecimal (after rescaling to '0 ... 255'). 23 | ##' @author Klaus K. Holst 24 | ##' @examples 25 | ##' plot(runif(1000),cex=runif(1000,0,4),col=Col(c("darkblue","orange"),0.5),pch=16) 26 | ##' @keywords color 27 | ##' @export 28 | Col <- function(col,alpha=0.2,locate=0) { 29 | if (locate>0) return(colsel(locate)) 30 | 31 | mapply(function(x,alpha) 32 | do.call(rgb,as.list(c(col2rgb(x)/255,alpha))), 33 | col,alpha) 34 | } 35 | 36 | -------------------------------------------------------------------------------- /R/Expand.R: -------------------------------------------------------------------------------- 1 | ##' Create a Data Frame from All Combinations of Factors 2 | ##' 3 | ##' Simple wrapper of the 'expand.grid' function. If x is a table 4 | ##' then a data frame is returned with one row pr individual 5 | ##' observation. 6 | ##' @title Create a Data Frame from All Combinations of Factors 7 | ##' @param _data Data.frame 8 | ##' @param ... vectors, factors or a list containing these 9 | ##' @author Klaus K. Holst 10 | ##' @export 11 | ##' @aliases Expand 12 | ##' @examples 13 | ##' dd <- Expand(iris, Sepal.Length=2:8, Species=c("virginica","setosa")) 14 | ##' summary(dd) 15 | ##' 16 | ##' T <- with(warpbreaks, table(wool, tension)) 17 | ##' Expand(T) 18 | Expand <- function(`_data`, ...) { 19 | if (missing(`_data`)) { 20 | return(expand.grid(...)) 21 | } 22 | if (inherits(`_data`, "table")) { 23 | M <- as.data.frame(`_data`) 24 | idx <- rep(seq(nrow(M)), M[, ncol(M)]) 25 | return(M[idx, -ncol(M), drop=FALSE]) 26 | } 27 | if (!inherits(`_data`, "data.frame")) { 28 | return(expand.grid(`_data`, ...)) 29 | } 30 | dots <- list(...) 31 | nn <- names(dots) 32 | for (n in nn) { 33 | y <- dots[[n]] 34 | if (is.factor(`_data`[1, n])) { 35 | dots[[n]] <- factor(y, levels=levels(`_data`[1, n])) 36 | } 37 | } 38 | do.call("expand.grid", dots) 39 | } 40 | -------------------------------------------------------------------------------- /R/Grep.R: -------------------------------------------------------------------------------- 1 | ##' Finds elements in vector or column-names in data.frame/matrix 2 | ##' 3 | ##' Pattern matching in a vector or column names of a data.frame or matrix. 4 | ##' @param x vector, matrix or data.frame. 5 | ##' @param pattern regular expression to search for 6 | ##' @param subset If TRUE returns subset of data.frame/matrix otherwise just the matching column names 7 | ##' @param ignore.case Default ignore case 8 | ##' @param ... Additional arguments to 'grep' 9 | ##' @return A data.frame with 2 columns with the indices in the first and the 10 | ##' matching names in the second. 11 | ##' @author Klaus K. Holst 12 | ##' @seealso \code{\link{grep}}, and \code{\link{agrep}} for approximate string 13 | ##' matching, 14 | ##' @keywords misc utilities 15 | ##' @examples 16 | ##' data(iris) 17 | ##' head(Grep(iris,"(len)|(sp)")) 18 | ##' @export 19 | `Grep` <- 20 | function(x, pattern, subset=TRUE, ignore.case = TRUE,...) { 21 | if (is.data.frame(x)) 22 | nn <- names(x) 23 | else if (is.matrix(x)) 24 | nn <- colnames(nn) 25 | else nn <- x 26 | ii <- grep(pattern,nn,ignore.case=ignore.case,...) 27 | if (subset) { 28 | if (is.matrix(x) || is.data.frame(x)) 29 | return(x[,ii,drop=FALSE]) 30 | else return(x[ii]) 31 | } 32 | res <- data.frame(index=ii,name=nn[ii]); 33 | res 34 | } 35 | 36 | -------------------------------------------------------------------------------- /R/Inverse.R: -------------------------------------------------------------------------------- 1 | ##' @export 2 | Inverse <- function(X,tol=lava.options()$itol,det=TRUE,names=!chol,chol=FALSE,symmetric=FALSE) { 3 | n <- NROW(X) 4 | if (n==1L) { 5 | res <- 1/X 6 | if (det) attributes(res)$det <- X 7 | if (chol) attributes(res)$chol <- X 8 | return(res) 9 | } 10 | if (chol) { 11 | L <- chol(X) 12 | res <- chol2inv(L) 13 | if (det) attributes(res)$det <- prod(diag(L)^2) 14 | if (chol) attributes(res)$chol <- X 15 | } else { 16 | if(symmetric){ 17 | decomp <- eigen(X, symmetric = TRUE) 18 | D <- decomp$values 19 | U <- decomp$vectors 20 | V <- decomp$vectors 21 | }else{ 22 | X.svd <- svd(X) 23 | U <- X.svd$u 24 | V <- X.svd$v 25 | D <- X.svd$d 26 | } 27 | id0 <- numeric(n) 28 | idx <- which(abs(D)>tol) 29 | id0[idx] <- 1/D[idx] 30 | res <- V%*%diag(id0,nrow=length(id0))%*%t(U) 31 | 32 | if (det) 33 | attributes(res)$det <- prod(D[D>tol]) 34 | attributes(res)$pseudo <- (length(idx)1) { 22 | ff <- getFromNamespace(ff[2],ff[1]) 23 | } 24 | f <- do.call(ff,list(x)) 25 | if (is.null(val) || !is.logical(f[[attr]])) 26 | attrvar <- f[[attr]] 27 | else 28 | attrvar <- names(f[[attr]])[which(val==f[[attr]])] 29 | return(attrvar) 30 | } 31 | if (is.character(val)) 32 | myexpr <- paste0("list(",attr,"=c(", paste0("\"",var,"\"=\"",val,"\"" , collapse=", "), "))") 33 | else 34 | myexpr <- paste0("list(",attr,"=c(", paste0("\"",var,"\"=",val, collapse=", "), "))") 35 | Debug(list("str=",myexpr),debug) 36 | eval(parse(text=paste0(fun,"(x) <- ",myexpr))) 37 | return(x) 38 | } 39 | 40 | -------------------------------------------------------------------------------- /R/baptize.R: -------------------------------------------------------------------------------- 1 | ##' Generic method for labeling elements of an object 2 | ##' 3 | ##' @title Label elements of object 4 | ##' @param x Object 5 | ##' @param \dots Additional arguments 6 | ##' @author Klaus K. Holst 7 | ##' @export 8 | `baptize` <- function(x,...) UseMethod("baptize") 9 | 10 | 11 | ##' @export 12 | baptize.lvm <- function(x,labels,overwrite=FALSE,unique=FALSE,...) { 13 | p <- describecoef(x, mean=TRUE) 14 | sym <- lava.options()$symbols 15 | MeanFix <- intfix(x) 16 | RegFix <- regfix(x) 17 | CovFix <- covfix(x) 18 | count <- 0 19 | curlab <- parlabels(x) 20 | coef(x) 21 | for (i in seq_along(p)) { 22 | p0 <- p[[i]] 23 | if (attributes(p0)$type=="reg") { 24 | curfix <- RegFix$values[p0[2],p0[1]] 25 | curlab <- RegFix$labels[p0[2],p0[1]] 26 | if (all(is.na(c(curfix,curlab))) | overwrite) { 27 | count <- count+1 28 | st <- ifelse(missing(labels),paste(p0[1],p0[2],sep=sym[1]),labels[count]) 29 | regfix(x,from=p0[2],to=p0[1]) <- st 30 | } 31 | } else if (attributes(p0)$type=="cov") { 32 | curfix <- CovFix$values[p0[2],p0[1]] 33 | curlab <- CovFix$labels[p0[2],p0[1]] 34 | if (all(is.na(c(curfix,curlab))) | overwrite) { 35 | count <- count+1 36 | st <- ifelse(missing(labels),paste(p0[1],p0[2],sep=sym[2]),labels[count]) 37 | covfix(x,p0[2],p0[1],exo=FALSE) <- st 38 | } 39 | } else { ## Mean parameter 40 | curfix <- MeanFix[[p0]] 41 | if (length(curfix)>0) 42 | if (is.na(curfix) | overwrite) { 43 | count <- count+1 44 | st <- ifelse(missing(labels),p0,labels[count]) 45 | intfix(x,p0) <- st 46 | } 47 | } 48 | } 49 | if (index(x)$npar.ex>0) { 50 | x$exfix[is.na(x$exfix)] <- names(x$exfix)[is.na(x$exfix)] 51 | index(x) <- reindex(x) 52 | } 53 | return(x) 54 | } 55 | -------------------------------------------------------------------------------- /R/blockdiag.R: -------------------------------------------------------------------------------- 1 | ##' Combine matrices to block diagonal structure 2 | ##' @title Combine matrices to block diagonal structure 3 | ##' @param x Matrix 4 | ##' @param \dots Additional matrices 5 | ##' @param pad Vyalue outside block-diagonal 6 | ##' @author Klaus K. Holst 7 | ##' @export 8 | ##' @examples 9 | ##' A <- diag(3)+1 10 | ##' blockdiag(A,A,A,pad=NA) 11 | blockdiag <- function(x,...,pad=0) { 12 | if (is.list(x)) xx <- x else xx <- list(x,...) 13 | rows <- unlist(lapply(xx,nrow)) 14 | crows <- c(0,cumsum(rows)) 15 | cols <- unlist(lapply(xx,ncol)) 16 | ccols <- c(0,cumsum(cols)) 17 | res <- matrix(pad,nrow=sum(rows),ncol=sum(cols)) 18 | for (i in seq_len(length(xx))) { 19 | idx1 <- seq_len(rows[i])+crows[i]; idx2 <- seq_len(cols[i])+ccols[i] 20 | res[idx1,idx2] <- xx[[i]] 21 | } 22 | colnames(res) <- unlist(lapply(xx,colnames)); rownames(res) <- unlist(lapply(xx,rownames)) 23 | return(res) 24 | } 25 | -------------------------------------------------------------------------------- /R/cancel.R: -------------------------------------------------------------------------------- 1 | ##' Generic cancel method 2 | ##' 3 | ##' @title Generic cancel method 4 | ##' @param x Object 5 | ##' @param \dots Additioal arguments 6 | ##' @author Klaus K. Holst 7 | ##' @aliases cancel<- 8 | ##' @export 9 | "cancel" <- function(x,...) UseMethod("cancel") 10 | 11 | ##' @export 12 | "cancel<-" <- function(x,...,value) UseMethod("cancel<-") 13 | 14 | ##' @export 15 | "cancel<-.lvm" <- function(x, ..., value) { 16 | cancel(x,value,...) 17 | } 18 | 19 | 20 | ##' @export 21 | cancel.lvm <- function(x,value,...) { 22 | if (inherits(value,"formula")) { 23 | lhs <- getoutcome(value) 24 | if (length(lhs)==0) yy <- NULL else yy <- decomp.specials(lhs) 25 | xf <- attributes(terms(value))$term.labels 26 | if(identical(all.vars(value),xf)) 27 | return(cancel(x,xf)) 28 | res <- lapply(xf,decomp.specials) 29 | xx <- unlist(lapply(res, function(z) z[1])) 30 | for (i in yy) { 31 | for (j in xx) 32 | cancel(x) <- c(i,j) 33 | } 34 | index(x) <- reindex(x) 35 | return(x) 36 | } 37 | 38 | for (v1 in value) 39 | for (v2 in value) 40 | if (v1!=v2) 41 | { 42 | if (all(c(v1,v2)%in%vars(x))) { 43 | x$M[v1,v2] <- 0 44 | x$par[v1,v2] <- x$fix[v1,v2] <- 45 | x$covpar[v1,v2] <- x$covfix[v1,v2] <- NA 46 | x$cov[v1,v2] <- 0 47 | } 48 | } 49 | x$parpos <- NULL 50 | index(x) <- reindex(x) 51 | return(x) 52 | } 53 | -------------------------------------------------------------------------------- /R/categorical.R: -------------------------------------------------------------------------------- 1 | ##' @export 2 | categorical <- function(x,formula,K,beta,p,liability=FALSE,regr.only=FALSE,exo=TRUE,...) { 3 | 4 | if (is.character(formula)) { 5 | regr <- FALSE 6 | X <- formula 7 | } else { 8 | y <- getoutcome(formula) 9 | X <- attributes(y)$x 10 | regr <- TRUE 11 | if (length(y)==0) regr <- FALSE 12 | if (length(attributes(y)$x)==0) { 13 | X <- y; regr <- FALSE 14 | } 15 | } 16 | if (!missing(p)) { 17 | if (!missing(K)) { 18 | if (!(K==length(p) || K==length(p)+1)) stop("Wrong dimension of 'p'") 19 | if (length(K)==length(p)) { 20 | if (!identical(sum(p),1.0)) stop("Not a probability vector") 21 | p <- p[-length(p)] 22 | } 23 | } 24 | if (is.numeric(p) && sum(p)>1) warning("'p' sum > 1") 25 | if (is.logical(all.equal(1.0,sum(p)))) p <- p[-length(p)] 26 | } 27 | if (missing(K)) { 28 | if (!is.null(list(...)$labels)) K <- length(list(...)$labels) 29 | if (!missing(beta)) K <- length(beta) 30 | if (!missing(p)) K <- length(p)+1 31 | } 32 | if (!regr.only) { 33 | if (missing(p)) p <- rep(1/K,K-1) 34 | pname <- names(p) 35 | if (is.null(pname)) pname <- rep(NA,K-1) 36 | ordinal(x,K=K,liability=liability,p=p,constrain=pname,exo=exo,...) <- X 37 | if (!regr) return(x) 38 | } 39 | 40 | if (missing(beta)) beta <- rep(0,K) 41 | fname <- paste(gsub(" ","",deparse(formula)),seq(K)-1,sep=":") 42 | fpar <- names(beta) 43 | if (is.null(fpar)) fpar <- fname 44 | 45 | parameter(x,fpar,start=beta) <- fname 46 | val <- paste0("function(x,p,...) p[\"",fpar[1],"\"]*(x==0)") 47 | for (i in seq(K-1)) { 48 | val <- paste0(val,"+p[\"",fpar[i+1],"\"]*(x==",i,")") 49 | } 50 | functional(x,formula) <- eval(parse(text=val)) 51 | return(x) 52 | } 53 | 54 | ##' @export 55 | 'categorical<-' <- function(x,...,value) categorical(x,value,...) 56 | -------------------------------------------------------------------------------- /R/chisqsum.R: -------------------------------------------------------------------------------- 1 | rchisqsum <- function(n,lambda) { 2 | p <- length(lambda) 3 | X2 <- matrix(rnorm(n*p)^2,ncol=p) ## Chi-squared (df=1) 4 | res <- numeric(n) 5 | for (i in seq(p)) { 6 | res <- res + X2[,i]*lambda[i] 7 | } 8 | return(res) 9 | } 10 | 11 | pchisqsum <- function(x, lambda=1, B=1e6, seed=NULL) { 12 | if (!is.null(seed)) set.seed(seed) 13 | y <- rchisqsum(B,lambda) 14 | mean(y<=x) 15 | } 16 | -------------------------------------------------------------------------------- /R/commutation.R: -------------------------------------------------------------------------------- 1 | ##' Finds the unique commutation matrix K: 2 | ##' \eqn{K vec(A) = vec(A^t)} 3 | ##' 4 | ##' @title Finds the unique commutation matrix 5 | ##' @param m rows 6 | ##' @param n columns 7 | ##' @author Klaus K. Holst 8 | ##' @export 9 | commutation <- function(m, n=m) { 10 | if (inherits(m,"matrix")) { 11 | n <- ncol(m) 12 | m <- nrow(m) 13 | } 14 | H <- function(i,j) { ## mxn-matrix with 1 at (i,j) 15 | Hij <- matrix(0, nrow=m, ncol=n) 16 | Hij[i,j] <- 1 17 | Hij 18 | } 19 | K <- matrix(0,m*n,m*n) 20 | for (i in seq_len(m)) 21 | for (j in seq_len(n)) 22 | K <- K + H(i,j)%x%t(H(i,j)) 23 | K 24 | } 25 | 26 | -------------------------------------------------------------------------------- /R/contr.R: -------------------------------------------------------------------------------- 1 | ##' Create contrast matrix 2 | ##' 3 | ##' Create contrast matrix typically for use with 'estimate' (Wald tests). 4 | ##' @export 5 | ##' @param p index of non-zero entries (see example) 6 | ##' @param n Total number of parameters (if omitted the max number in p will be used) 7 | ##' @param diff If FALSE all non-zero entries are +1, otherwise the second non-zero element in each row will be -1. 8 | ##' @param ... Additional arguments to lower level functions 9 | ##' @aliases contr parsedesign pairwise.diff 10 | ##' @examples 11 | ##' contr(2,n=5) 12 | ##' contr(as.list(2:4),n=5) 13 | ##' contr(list(1,2,4),n=5) 14 | ##' contr(c(2,3,4),n=5) 15 | ##' contr(list(c(1,3),c(2,4)),n=5) 16 | ##' contr(list(c(1,3),c(2,4),5)) 17 | ##' 18 | ##' parsedesign(c("aa","b","c"),"?","?",diff=c(FALSE,TRUE)) 19 | ##' 20 | ##' ## All pairs comparisons: 21 | ##' pdiff <- function(n) lava::contr(lapply(seq(n-1), \(x) seq(x, n))) 22 | ##' pdiff(4) 23 | contr <- function(p, n, diff = TRUE, ...) { 24 | if (missing(n)) n <- max(unlist(p)) 25 | if (is.character(p)) { 26 | return(parsedesign(n, p, ...)) 27 | } 28 | if (is.list(p)) { 29 | return(Reduce(rbind, lapply(p, function(x) { 30 | do.call(contr, list(x, n, diff[1L])) 31 | }))) 32 | } 33 | if (is.character(n)) n <- length(n) 34 | if (!is.numeric(n)) { 35 | try(n <- length(coef(n)), silent = TRUE) 36 | } 37 | B <- matrix(0, ncol = n, nrow = max(1L, length(p) - 1L)) 38 | B[, p[1]] <- 1L 39 | if (length(p) > 1L) { 40 | B[cbind(seq_len(nrow(B)), p[-1])] <- ifelse(diff[1L], -1, 1) 41 | } 42 | return(B) 43 | } 44 | 45 | ##' @export 46 | pairwise.diff <- function(n) { 47 | pdiff <- function(n) lava::contr(lapply(seq(n-1), function(x) seq(x, n))) 48 | pdiff(n) 49 | } 50 | -------------------------------------------------------------------------------- /R/csplit.R: -------------------------------------------------------------------------------- 1 | ##' Split data into folds 2 | ##' 3 | ##' @title Split data into folds 4 | ##' @param x Data or integer (size) 5 | ##' @param p Number of folds, or if a number between 0 and 1 is given two folds of size p and (1-p) will be returned 6 | ##' @param replace With or with-out replacement 7 | ##' @param return.index If TRUE index of folds are returned otherwise the actual data splits are returned (default) 8 | ##' @param k (Optional, only used when p=NULL) number of folds without shuffling 9 | ##' @param ... additional arguments to lower-level functions 10 | ##' @export 11 | ##' @aliases csplit foldr 12 | ##' @examples 13 | ##' foldr(5,2,rep=2) 14 | ##' csplit(10,3) 15 | ##' csplit(iris[1:10,]) ## Split in two sets 1:(n/2) and (n/2+1):n 16 | ##' csplit(iris[1:10,],0.5) 17 | ##' @author Klaus K. Holst 18 | csplit <- function(x, p=NULL, replace=FALSE, 19 | return.index=FALSE, k=2, ...) { 20 | if (length(x)==1 && is.numeric(x)) 21 | x <- seq(x) 22 | N <- NROW(x) 23 | if (is.null(p)) { ## 24 | K <- base::round(N/k) 25 | idx <- split(seq(N), sort(rep(seq(k), length.out=N, each=K))) 26 | } else { 27 | if (p<1) { ## two folds (size N*p and N*(1-p)) 28 | 29 | idx1 <- base::sample(N, base::round(p*N), replace=replace) 30 | idx <- list(idx1, 31 | base::sample(setdiff(seq(N), idx1), replace=replace)) 32 | } else { ## Number of folds (equal size) 33 | idx <- split(sample(seq(N)), rep(seq(p), length=N)) 34 | } 35 | } 36 | if (return.index) 37 | return(idx) 38 | if (!is.vector(x)) { 39 | return(lapply(idx, function(ii) x[ii, , drop=FALSE])) 40 | } 41 | return(lapply(idx, function(ii) x[ii])) 42 | } 43 | 44 | ##' @export 45 | foldr <- function(n, K=5, rep=1, list=TRUE) { 46 | res <- replicate(rep, split(sample(seq(n)), 47 | rep(seq(K), length=n)), 48 | simplify=FALSE) 49 | if (!list) { 50 | ids <- rep(seq_len(length(res[[1]])), 51 | unlist(lapply(res[[1]], length))) 52 | res <- lapply(res, function(x) { 53 | ids[order(unlist(x))] 54 | }) 55 | if (length(res)==1) 56 | res <- res[[1]] 57 | } 58 | return(res) 59 | } 60 | 61 | -------------------------------------------------------------------------------- /R/describecoef.R: -------------------------------------------------------------------------------- 1 | ##' @export 2 | describecoef <- function(x,par,from,to,mean=TRUE) { 3 | p <- coef(x, mean=mean) 4 | if (!missing(from)) { 5 | st1 <- paste0(to,lava.options()$symbol[1],from) 6 | st2 <- paste0(to,lava.options()$symbol[2],from) 7 | st3 <- paste0(from,lava.options()$symbol[2],to) 8 | pos <- na.omit(match(unique(c(st1,st2,st3)),p)) 9 | attributes(pos) <- NULL 10 | return(pos) 11 | } 12 | res <- strsplit(p,lava.options()$symbol[2]) 13 | var.idx <- which(unlist(lapply(res,length))>1) ## Variance parameters 14 | rest.idx <- setdiff(seq_along(p),var.idx) 15 | res[rest.idx] <- strsplit(p[rest.idx],lava.options()$symbol[1]) 16 | mean.idx <- which(unlist(lapply(res,length))==1) ## Mean parameters 17 | reg.idx <- setdiff(rest.idx,mean.idx) 18 | names(res)[mean.idx] <- paste0("m",seq_along(mean.idx)) 19 | for (i in var.idx) 20 | attr(res[[i]],"type") <- "cov" 21 | for (i in mean.idx) 22 | attr(res[[i]],"type") <- "mean" 23 | for (i in reg.idx) 24 | attr(res[[i]],"type") <- "reg" 25 | if (missing(par)) 26 | return(res) 27 | return(res[par]) 28 | } 29 | -------------------------------------------------------------------------------- /R/devcoords.R: -------------------------------------------------------------------------------- 1 | ##' Returns device-coordinates and plot-region 2 | ##' 3 | ##' @title Returns device-coordinates and plot-region 4 | ##' @return A \code{list} with elements 5 | ##' \item{dev.x1}{Device: Left x-coordinate} 6 | ##' \item{dev.x2}{Device: Right x-coordinate} 7 | ##' \item{dev.y1}{Device Bottom y-coordinate} 8 | ##' \item{dev.y2}{Device Top y-coordinate} 9 | ##' \item{fig.x1}{Plot: Left x-coordinate} 10 | ##' \item{fig.x2}{Plot: Right x-coordinate} 11 | ##' \item{fig.y1}{Plot: Bottom y-coordinate} 12 | ##' \item{fig.y2}{Plot: Top y-coordinate} 13 | ##' @author Klaus K. Holst 14 | ##' @export 15 | ##' @keywords hplot 16 | `devcoords` <- 17 | function() { 18 | cc <- par("usr") ## extremes of coordinates of plotting region (x1,x2,y1,y2) 19 | plotinch <- par("pin") ## Plot dimensions (width,height) in inches 20 | margininch <- par("mai") ## Margin sizes in inches (bottom, left, top ,right) 21 | plotlenX <- cc[2]-cc[1] 22 | unitinchX <- plotlenX/plotinch[1] 23 | plotlenY <- cc[4]-cc[3] 24 | unitinchY <- plotlenY/plotinch[2] 25 | deviceXleft <- cc[1]-unitinchX*margininch[2] 26 | deviceXright <- cc[2]+unitinchX*margininch[4] 27 | deviceYtop <- cc[4]+unitinchY*margininch[3] 28 | deviceYbottom <- cc[3]-unitinchY*margininch[1] 29 | return(list(dev.x1=deviceXleft, dev.x2=deviceXright, dev.y1=deviceYbottom, dev.y2=deviceYtop, fig.x1=cc[1], fig.x2=cc[2], fig.y1=cc[3], fig.y2=cc[4])) 30 | } 31 | -------------------------------------------------------------------------------- /R/dsep.R: -------------------------------------------------------------------------------- 1 | ##' @export 2 | `dsep` <- 3 | function(object,...) UseMethod("dsep") 4 | 5 | ##' Check d-separation criterion 6 | ##' 7 | ##' Check for conditional independence (d-separation) 8 | ##' @export 9 | ##' @aliases dsep dsep.lvm 10 | ##' @param object lvm object 11 | ##' @param x Variables for which to check for conditional independence 12 | ##' @param cond Conditioning set 13 | ##' @param return.graph If TRUE the moralized ancestral graph with the 14 | ##' conditioning set removed is returned 15 | ##' @param ... Additional arguments to lower level functions 16 | ##' @details The argument 'x' can be given as a formula, e.g. x~y|z+v 17 | ##' or ~x+y|z+v With everything on the rhs of the bar defining the 18 | ##' variables on which to condition on. 19 | ##' @examples 20 | ##' m <- lvm(x5 ~ x4+x3, x4~x3+x1, x3~x2, x2~x1) 21 | ##' if (interactive()) { 22 | ##' plot(m,layoutType='neato') 23 | ##' } 24 | ##' dsep(m,x5~x1|x2+x4) 25 | ##' dsep(m,x5~x1|x3+x4) 26 | ##' dsep(m,~x1+x2+x3|x4) 27 | ##' 28 | dsep.lvm <- function(object,x,cond=NULL,return.graph=FALSE,...) { 29 | if (inherits(x,"formula")) { 30 | xf <- getoutcome(x,sep="|") 31 | xx <- attr(xf,"x") 32 | if (length(xx)==0) stop("Not a valid formula") 33 | x <- c(xf,all.vars(xx[[1]])) 34 | if (length(xx)>1) { 35 | cond <- all.vars(xx[[2]]) 36 | } 37 | } 38 | if (inherits(cond,"formula")) { 39 | cond <- all.vars(cond) 40 | } 41 | nod <- vars(object) 42 | x <- intersect(x,nod) 43 | cond <- intersect(cond,nod) 44 | V <- c(x,cond) 45 | ## Ancenstral graph 46 | keep <- c(V,ancestors(object,V)) 47 | del <- setdiff(nod,keep) 48 | if (length(del)>0) object <- rmvar(object,del) 49 | ## moralized graph 50 | man <- object 51 | for (v in V) { 52 | pa <- parents(object,v) 53 | if (length(pa)>1) 54 | man$M[pa,pa] <- 1 55 | } 56 | man.sel <- rmvar(man,cond) 57 | ii <- match(x,vars(man.sel)) 58 | A <- with(man.sel, (t(M)+M)>0) 59 | dsep <- c() 60 | for (i in ii) { 61 | conn <- DFS(A,i) 62 | i0 <- setdiff(ii,i) 63 | dsep <- c(dsep,!any(i0%in%conn)) 64 | } 65 | res <- all(dsep) 66 | attr(man.sel,"dsep") <- res 67 | if (return.graph) return(man.sel) 68 | return(res) 69 | } 70 | -------------------------------------------------------------------------------- /R/endogenous.R: -------------------------------------------------------------------------------- 1 | ##' @export 2 | `endogenous` <- 3 | function(x,...) UseMethod("endogenous") 4 | 5 | ##' @export 6 | `endogenous.lvmfit` <- 7 | function(x,...) { 8 | endogenous(Model(x),...) 9 | } 10 | 11 | ##' @export 12 | `endogenous.lvm` <- 13 | function(x,top=FALSE,latent=FALSE,...) { 14 | observed <- manifest(x) 15 | if (latent) observed <- vars(x) 16 | if (top) { 17 | M <- x$M 18 | res <- c() 19 | for (i in observed) 20 | if (!any(M[i,]==1)) 21 | res <- c(res, i) 22 | return(res) 23 | } 24 | exo <- exogenous(x) 25 | return(setdiff(observed,exo)) 26 | } 27 | 28 | ##' @export 29 | endogenous.list <- function(x,...) { 30 | endolist <- c() 31 | for (i in seq_along(x)) { 32 | endolist <- c(endolist, endogenous(x[[i]])) 33 | } 34 | endolist <- unique(endolist) 35 | return(endolist) 36 | } 37 | 38 | ##' @export 39 | `endogenous.multigroup` <- 40 | function(x,...) { 41 | endogenous(Model(x)) 42 | } 43 | 44 | ##' @export 45 | `endogenous.lm` <- 46 | function(x,...) { 47 | getoutcome(formula(x))[1] 48 | } 49 | -------------------------------------------------------------------------------- /R/estimate.list.R: -------------------------------------------------------------------------------- 1 | 2 | ##' @export 3 | estimate.list <- function(x,...) { 4 | if (inherits(x[[1]],"lvm")) return(estimate_lvmlist(x,...)) 5 | res <- lapply(x,function(x) estimate(x,...)) 6 | class(res) <- c("estimate.list","list") 7 | res 8 | } 9 | 10 | ##' @export 11 | coef.estimate.list <- function(object,...) { 12 | lapply(object,coef) 13 | } 14 | 15 | 16 | -------------------------------------------------------------------------------- /R/formula.R: -------------------------------------------------------------------------------- 1 | ##' @export 2 | formula.lvm <- function(x,char=FALSE,all=FALSE,...) { 3 | A <- index(x)$M 4 | res <- c() 5 | for (i in seq_len(ncol(A))) { 6 | if (all || !(colnames(A)[i]%in%c(index(x)$exogenous,parameter(x)) )) { 7 | f <- paste(colnames(A)[i],"~ 1") 8 | if (any(A[,i]!=0)) { 9 | f <- (paste(colnames(A)[i],"~",paste(colnames(A)[A[,i]!=0],collapse="+"))) 10 | } 11 | if (!char) 12 | f <- formula(f) 13 | res <- c(res, list(f)) 14 | } 15 | } 16 | return(res) 17 | } 18 | 19 | 20 | ##' @export 21 | formula.lvmfit <- formula.lvm 22 | -------------------------------------------------------------------------------- /R/fplot.R: -------------------------------------------------------------------------------- 1 | ##' Faster plot via RGL 2 | ##' @title fplot 3 | ##' @export 4 | ##' @examples 5 | ##' if (interactive()) { 6 | ##' data(iris) 7 | ##' fplot(Sepal.Length ~ Petal.Length+Species, data=iris, size=2, type="s") 8 | ##' } 9 | ##' @param x X variable 10 | ##' @param y Y variable 11 | ##' @param z Z variable (optional) 12 | ##' @param xlab x-axis label 13 | ##' @param ylab y-axis label 14 | ##' @param ... additional arggument to lower-level plot functions 15 | ##' @param z.col color (use argument alpha to set transparency) 16 | ##' @param data data.frame 17 | ##' @param add if TRUE use current active device 18 | ##' @param aspect aspect ratio 19 | ##' @param zoom zoom level 20 | fplot <- function(x,y,z=NULL,xlab,ylab,...,z.col=topo.colors(64), 21 | data=parent.frame(),add=FALSE,aspect=c(1,1),zoom=0.8) { 22 | if (!requireNamespace("rgl",quietly=TRUE)) stop("Requires 'rgl'") 23 | if (inherits(x,"formula")) { 24 | y <- getoutcome(x) 25 | x <- attributes(y)$x 26 | if (length(x)>1) { 27 | z <- as.numeric(with(data, get(x[2]))) 28 | } 29 | if (length(x)==0) { 30 | x <- seq(nrow(data)) 31 | if (missing(xlab)) xlab <- "Index" 32 | } else { 33 | if (missing(xlab)) xlab <- x[1] 34 | x <- with(data, get(x[1])) 35 | } 36 | if (missing(ylab)) ylab <- y 37 | y <- with(data, get(y)) 38 | } else { 39 | if (missing(y)) { 40 | y <- x 41 | if (missing(ylab)) ylab <- deparse(substitute(x)) 42 | x <- seq(nrow(data)) 43 | if (missing(xlab)) xlab <- "Index" 44 | } else { 45 | if (missing(xlab)) xlab <- deparse(substitute(x)) 46 | if (missing(ylab)) ylab <- deparse(substitute(y)) 47 | } 48 | } 49 | rgl::.check3d() 50 | if (!is.null(z)) { 51 | ncol <- length(z.col); 52 | glut <- approxfun(seq(min(z),max(z),length.out=ncol),seq(ncol)) 53 | rgl::plot3d(x,y,0,col=z.col[round(glut(z))],xlab=xlab,ylab=ylab,add=add,...) 54 | } else { 55 | rgl::plot3d(x,y,0,xlab=xlab,ylab=ylab,add=add,...) 56 | 57 | } 58 | rgl::view3d(0,0,fov=0,zoom=zoom) 59 | rgl::aspect3d(c(aspect,1)) 60 | } 61 | 62 | 63 | -------------------------------------------------------------------------------- /R/frobnorm.R: -------------------------------------------------------------------------------- 1 | frobnorm <- function(x,y=0,...) { 2 | sum((x-y)^2)^.5 3 | } 4 | -------------------------------------------------------------------------------- /R/functional.R: -------------------------------------------------------------------------------- 1 | ##' @export 2 | "functional<-" <- function(x,...,value) UseMethod("functional<-") 3 | 4 | ##' @export 5 | "functional<-.lvm" <- function(x,to,from,...,value) { 6 | if (inherits(to,"formula")) { 7 | yy <- decomp.specials(getoutcome(to)) 8 | myvars <- all.vars(to) 9 | xx <- setdiff(myvars,yy) 10 | if (length(yy)*length(xx)>length(value) & length(value)!=1) stop("Wrong number of values") 11 | count <- 0 12 | for (y in yy) { 13 | count <- count+1 14 | for (i in seq_along(xx)) { 15 | suppressWarnings(x <- regression(x,to=y,from=xx[i],messages=0)) 16 | count <- count+1 17 | if (length(value)==1) { 18 | functional(x, to=y, from=xx[i],...) <- value 19 | } else 20 | functional(x, to=y, from=xx[i],...) <- value[[count]] 21 | } 22 | } 23 | return(x) 24 | } 25 | 26 | if (missing(from) | missing(to)) 27 | return(x) 28 | 29 | edges <- paste(from,to,sep="~") 30 | x$attributes$functional[[edges]] <- value 31 | return(x) 32 | } 33 | 34 | ##' @export 35 | "functional" <- function(x,...) UseMethod("functional") 36 | 37 | ##' @export 38 | functional.lvm <- function(x,to,from,value,...) { 39 | if (!missing(value)) { 40 | functional(x,to,from,...) <- value 41 | return(x) 42 | } 43 | if (missing(from)) 44 | return(x$attributes$functional) 45 | 46 | edges <- paste(from,to,sep="~") 47 | x$attributes$functional[edges] 48 | } 49 | -------------------------------------------------------------------------------- /R/graph.R: -------------------------------------------------------------------------------- 1 | ##' Extract graph 2 | ##' 3 | ##' Extract or replace graph object 4 | ##' 5 | ##' 6 | ##' @aliases Graph Graph<- 7 | ##' @usage 8 | ##' 9 | ##' Graph(x, ...) 10 | ##' 11 | ##' Graph(x, ...) <- value 12 | ##' 13 | ##' @param x Model object 14 | ##' @param value New \code{graphNEL} object 15 | ##' @param \dots Additional arguments to be passed to the low level functions 16 | ##' @author Klaus K. Holst 17 | ##' @seealso \code{\link{Model}} 18 | ##' @keywords graphs models 19 | ##' @export 20 | ##' @examples 21 | ##' 22 | ##' m <- lvm(y~x) 23 | ##' Graph(m) 24 | ##' 25 | ##' @export 26 | `Graph` <- 27 | function(x,...) UseMethod("Graph") 28 | 29 | ##' @export 30 | `Graph.lvm` <- 31 | function(x,add=FALSE,...) { 32 | if ((is.null(x$graph) || length(x$graph)==0) & add) { 33 | m <- Model(x) 34 | return(plot(m,noplot=TRUE)) 35 | } 36 | else return(x$graph) 37 | } 38 | 39 | ##' @export 40 | `Graph.lvmfit` <- function(x,...) Graph.lvm(x,...) 41 | 42 | ##' @export 43 | "Graph<-" <- function(x,...,value) UseMethod("Graph<-") 44 | 45 | ##' @export 46 | "Graph<-.lvmfit" <- function(x,...,value) { x$graph <- value; return(x) } 47 | 48 | ##' @export 49 | "Graph<-.lvm" <- function(x,...,value) { x$graph <- value; return(x) } 50 | -------------------------------------------------------------------------------- /R/graph2lvm.R: -------------------------------------------------------------------------------- 1 | ##' @export 2 | `graph2lvm` <- 3 | function(g, debug=FALSE, messages=0) { 4 | res <- lvm(graph::nodes(g), debug=debug, messages=messages) 5 | M <- t(as(g, Class="matrix")) 6 | for (i in seq_len(nrow(M))) { 7 | if (any(M[,i]==1)) { 8 | res <- regression(res, rownames(M)[M[,i]==1], rownames(M)[i], messages=messages) 9 | } 10 | } 11 | res 12 | } 13 | 14 | -------------------------------------------------------------------------------- /R/heavytail.R: -------------------------------------------------------------------------------- 1 | ##' @export 2 | `heavytail` <- function(x,...) UseMethod("heavytail") 3 | ##' @export 4 | "heavytail<-" <- function(x,...,value) UseMethod("heavytail<-") 5 | 6 | ##' @export 7 | "heavytail<-.lvm" <- function(x,...,value) { 8 | if (inherits(value,"formula")) { 9 | return(heavytail(x,all.vars(value),...)) 10 | } 11 | heavytail(x, value, ...) 12 | } 13 | 14 | ##' @export 15 | `heavytail.lvm` <- 16 | function(x,var=NULL,df=1,...) { 17 | if (is.null(var)) { 18 | htidx <- x$attributes$heavytail 19 | if (length(htidx)>0 && any(htidx!=0)) { 20 | res <- htidx[htidx>0] 21 | attributes(res)$couple <- unlist(x$attributes$heavytail.couple)[htidx>0] 22 | return(res) 23 | } 24 | return(NULL) 25 | } 26 | couples <- attributes(heavytail(x))$couple 27 | newval <- 1 28 | if (length(couples)>0) newval <- max(couples)+1 29 | x$attributes$heavytail.couple[var] <- newval 30 | x$attributes$heavytail[var] <- df 31 | return(x) 32 | } 33 | 34 | heavytail_init_hook <- function(x,...) { 35 | x$attributes$heavytail <- list() 36 | x$attributes$heavytail.couple <- list() 37 | return(x) 38 | } 39 | 40 | heavytail_sim_hook <- function(x,data,...) { 41 | n <- nrow(data) 42 | hvar <- heavytail(x) 43 | if (length(hvar)==0) return(data) 44 | couples <- unique(attributes(hvar)$couple) 45 | h.type <- list() 46 | for (j in couples) 47 | h.type <- c(h.type, list( hvar[(which(attributes(hvar)$couple==j))])) 48 | for (i in seq_along(couples)) { 49 | df <- hvar[[i]][1] 50 | Z <- rchisq(n,df=df)/df 51 | for (v in names(h.type[[i]])) { 52 | data[,v] <- data[,v]/sqrt(Z) 53 | } 54 | } 55 | return(data) 56 | } 57 | -------------------------------------------------------------------------------- /R/iid.R: -------------------------------------------------------------------------------- 1 | ##' Extract i.i.d. decomposition from model object 2 | ##' 3 | ##' This function extracts 4 | ##' @param x Model object 5 | ##' @param ... Additional arguments (see the man-page of the IC method) 6 | ##' @export 7 | iid <- function(x, ...) UseMethod("iid") 8 | 9 | ##' @export 10 | iid.default <- function(x, ...) { 11 | res <- IC(x, ...) 12 | if (!is.null(attr(res, "bread"))) { 13 | attr(res, "bread") <- attr(res, "bread")/NROW(res) 14 | } 15 | return(res/NROW(res)) 16 | } 17 | 18 | -------------------------------------------------------------------------------- /R/intervention.R: -------------------------------------------------------------------------------- 1 | ##' @export 2 | "intervention<-" <- function(object, ..., value) 3 | UseMethod("intervention<-") 4 | 5 | ##' @export 6 | `intervention` <- 7 | function(object, ...) UseMethod("intervention") 8 | 9 | ##' Define intervention 10 | ##' 11 | ##' Define intervention in a `lvm` object 12 | ##' @param object lvm object 13 | ##' @param to String defining variable or formula 14 | ##' @param value function defining intervention 15 | ##' @param dist Distribution 16 | ##' @param ... Additional arguments to lower level functions 17 | ##' @aliases intervention<- intervention intervention.lvm intervention<-.lvm 18 | ##' @seealso regression lvm sim 19 | ##' @examples 20 | ##' m <- lvm(y ~ a + x, a ~ x) 21 | ##' distribution(m, ~a+y) <- binomial.lvm() 22 | ##' mm <- intervention(m, "a", value=3) 23 | ##' sim(mm, 10) 24 | ##' mm <- intervention(m, a~x, function(x) (x>0)*1) 25 | ##' sim(mm, 10) 26 | ##' @export 27 | intervention.lvm <- function(object, to, value, dist=none.lvm(), ...) { 28 | if (!is.numeric(value)) 29 | regression(object, to, ...) <- value 30 | y <- to 31 | if (inherits(to, "formula")) { 32 | y <- getoutcome(to) 33 | if (length(y)==0) 34 | y <- attr(y, "x") 35 | } 36 | parents <- parents(object, y) 37 | if (length(parents)>0) 38 | cancel(object) <- toformula(y, parents) 39 | if (is.numeric(value)) { 40 | distribution(object, y) <- constant.lvm(value) 41 | } else { 42 | distribution(object, y) <- dist 43 | } 44 | return(object) 45 | } 46 | 47 | ##' @export 48 | "intervention<-.lvm" <- function(object, to, ..., value) { 49 | object <- intervention(object, to, value, ...) 50 | return(object) 51 | } 52 | -------------------------------------------------------------------------------- /R/kappa.R: -------------------------------------------------------------------------------- 1 | ################################################## 2 | ## Cohen's kappa 3 | ################################################## 4 | 5 | ##' @export 6 | kappa.multinomial <- function(z,all=FALSE,...) { 7 | pp <- length(coef(z)) 8 | if ((length(z$levels)!=2) || !(identical(z$levels[[1]],z$levels[[2]]))) 9 | stop("Expected square table and same factor levels in rows and columns") 10 | k <- length(z$levels[[1]]) 11 | zeros <- rbind(rep(0,pp)) 12 | A0 <- zeros; A0[diag(z$position)] <- 1 13 | A <- matrix(0,ncol=pp,nrow=2*k) 14 | for (i in seq(k)) A[i,z$position[i,]] <- 1 15 | for (i in seq(k)) A[i+k,z$position[,i]] <- 1 16 | b <- estimate(z,function(p) as.vector(rbind(A0,A)%*%p),IC=TRUE) 17 | b2 <- estimate(b,function(p) c(p[1],sum(p[seq(k)+1]*p[seq(k)+k+1])),IC=TRUE) 18 | if (!all) { 19 | return(estimate(b2,function(p) list(kappa=(p[1]-p[2])/(1-p[2])),IC=TRUE,...)) 20 | } 21 | estimate(b2,function(p) list(kappa=(p[1]-p[2])/(1-p[2]),agree=p[1], independence=p[2]),IC=TRUE,...) 22 | } 23 | 24 | ##' @export 25 | kappa.table <- function(z,...) { 26 | kappa(multinomial(Expand(z)),...) 27 | } 28 | 29 | ##' @export 30 | kappa.data.frame <- function(z,...) { 31 | kappa(multinomial(z),...) 32 | } 33 | -------------------------------------------------------------------------------- /R/latent.R: -------------------------------------------------------------------------------- 1 | ##' @export 2 | "latent<-" <- function(x,...,value) UseMethod("latent<-") 3 | 4 | ##' @export 5 | "latent<-.lvm" <- function(x, clear=FALSE,..., value) { 6 | if (inherits(value,"formula")) { 7 | return(latent(x,all.vars(value),clear=clear,...)) 8 | } 9 | latent(x, var=value, clear=clear,...) 10 | } 11 | 12 | ##' @export 13 | `latent` <- 14 | function(x,...) UseMethod("latent") 15 | 16 | ##' @export 17 | `latent.lvm` <- function(x,var,clear=FALSE,messages=lava.options()$messages,...) { 18 | if (missing(var)) { 19 | latentidx <- unlist(x$latent) 20 | if (length(latentidx)>0) 21 | return(names(latentidx)) 22 | else 23 | return(NULL) 24 | } 25 | if (inherits(var,"formula")) var <- all.vars(var) 26 | if (clear) { 27 | x$noderender$shape[var] <- "rectangle" 28 | x$latent[var] <- NULL 29 | ## intfix(x,var) <- NA 30 | } else { 31 | if (!all(var%in%vars(x))) { 32 | addvar(x,messages=messages,reindex=FALSE,) <- setdiff(var,vars(x)) 33 | } 34 | x$noderender$shape[var] <- "ellipse" 35 | x$latent[var] <- TRUE 36 | ord <- intersect(var,ordinal(x)) 37 | if (length(ord)>0) ordinal(x,K=NULL) <- ord 38 | } 39 | 40 | xorg <- exogenous(x) 41 | exoset <- setdiff(xorg,var) 42 | if (length(exoset)0) 13 | ## J[eta.idx,eta.idx] <- 0; J <- J[-eta.idx,] 14 | ## Jeta[obs.idx,obs.idx] <- 0; Jeta <- J[-obs.idx,] 15 | 16 | A <- t(mom$A) 17 | Lambda <- A[y.idx,eta.idx,drop=FALSE] 18 | K <- A[y.idx,exo.idx,drop=FALSE] 19 | B <- A[eta.idx,eta.idx,drop=FALSE] 20 | I <- diag(nrow=nrow(B)) 21 | Gamma <- A[eta.idx,exo.idx,drop=FALSE] 22 | V <- mom$P 23 | Psi <- V[eta.idx,eta.idx] ## Residual variance 24 | 25 | Theta <- V[y.idx,y.idx] ## - 26 | IBi <- if (ncol(I)>0) solve(I-B) else I 27 | LIBi <- Lambda%*%IBi 28 | Phi <- LIBi%*%Gamma + K 29 | 30 | Veta.x <- IBi%*%Psi%*%IBi ## Variance of eta given x 31 | COVetay.x <- Veta.x%*%t(Lambda) ## Covariance of eta,y given x 32 | ## Vy.x <- Lambda%*%COVetay.x + Theta ## Omega 33 | Vy.x <- LIBi%*%Psi%*%t(LIBi) + Theta 34 | 35 | if (!is.null(X)) { 36 | Ey.x <- t(apply(as.matrix(X)%*% t(LIBi%*%Gamma + K),1,function(x) x + mom$v[y.idx])) 37 | } else Ey.x <- NULL 38 | 39 | CV <- COVetay.x%*%Vy.x 40 | ## Sigma <- Vy.x + Phi%*%varX%*%t(Phi) 41 | 42 | return(list(mu=mom$v, 43 | Lambda=Lambda, K=K, B=B, I=I, Gamma=Gamma, Psi=Psi, Theta=Theta, IBi=IBi, LIBi=LIBi, Phi=Phi, 44 | Vy.x=Vy.x, Veta.x=Veta.x, COVetay.x=COVetay.x, CV=CV, Ey.x=Ey.x)) 45 | } 46 | -------------------------------------------------------------------------------- /R/logo.R: -------------------------------------------------------------------------------- 1 | gfilter <- function(x,sigma=1) { 2 | gridfn <- function(fn,width,height,center=TRUE) { 3 | jx <- seq_len(height) 4 | jy <- seq_len(width) 5 | if (center) { 6 | jx <- jx/height-0.5 7 | jy <- jy/width-0.5 8 | } 9 | outer(jx, jy, FUN=fn) 10 | } 11 | width <- ncol(x); height <- nrow(x) 12 | oscunits <- gridfn(function(x,y) ((-1)^(x+y)),height=height,width=width,center=FALSE) 13 | x0 <- x*oscunits ## translate origo to center of image 14 | X <- fft(x0) 15 | d <- gridfn(function(x,y) (x^2+y^2),height=height,width=width,center=TRUE) 16 | Gn <- exp(-2*(base::pi*sigma)^2*d) # frequency response 17 | H <- X*Gn 18 | res <- Re(fft(H,inverse=TRUE))/(width*height)*oscunits 19 | return(res) 20 | } 21 | 22 | ##' @export 23 | lava <- function(seed,w=128,h=w,bw=4,sigma=5000,bg=20000,numcol=128,col=grDevices::heat.colors(numcol),...) { 24 | if (!missing(seed)) 25 | set.seed(seed) 26 | x <- matrix(rnorm(w*h,bg,sigma),nrow=h, ncol=w) 27 | x0 <- gfilter(x,sigma=bw) 28 | y <- (x0-min(x0)+1)^1.2 29 | opt <- graphics::par(mai=c(0,0,0,0)) 30 | graphics::image(y,axes=FALSE,col=col) 31 | graphics::par(opt) 32 | invisible(y) 33 | } 34 | -------------------------------------------------------------------------------- /R/makemissing.R: -------------------------------------------------------------------------------- 1 | ##' Generates missing entries in data.frame/matrix 2 | ##' 3 | ##' @title Create random missing data 4 | ##' @param data data.frame 5 | ##' @param p Fraction of missing data in each column 6 | ##' @param cols Which columns (name or index) to alter 7 | ##' @param rowwise Should missing occur row-wise (either none or all selected columns are missing) 8 | ##' @param nafun (Optional) function to be applied on data.frame before return (e.g. \code{na.omit} to return complete-cases only) 9 | ##' @param seed Random seed 10 | ##' @return data.frame 11 | ##' @author Klaus K. Holst 12 | ##' @keywords utilities 13 | ##' @export 14 | makemissing <- function(data,p=0.2,cols=seq_len(ncol(data)),rowwise=FALSE,nafun=function(x) x, seed=NULL) { 15 | if (!exists(".Random.seed", envir = .GlobalEnv, inherits = FALSE)) 16 | runif(1) 17 | if (is.null(seed)) 18 | RNGstate <- get(".Random.seed", envir = .GlobalEnv) 19 | else { 20 | R.seed <- get(".Random.seed", envir = .GlobalEnv) 21 | set.seed(seed) 22 | RNGstate <- structure(seed, kind = as.list(RNGkind())) 23 | on.exit(assign(".Random.seed", R.seed, envir = .GlobalEnv)) 24 | } 25 | p <- rep(p,length.out=length(cols)) 26 | if (!rowwise) 27 | for (i in seq_along(cols)) { 28 | data[rbinom(nrow(data),1,p[i])==1,cols[i]] <- NA 29 | } 30 | else 31 | data[which(rbinom(nrow(data),1,p)==1),cols] <- NA 32 | return(nafun(data)) 33 | } 34 | -------------------------------------------------------------------------------- /R/manifest.R: -------------------------------------------------------------------------------- 1 | ##' @export 2 | `manifest` <- 3 | function(x,...) UseMethod("manifest") 4 | 5 | ##' @export 6 | `manifest.lvm` <- 7 | function(x,...) { 8 | if (length(vars(x))>0) 9 | setdiff(vars(x),latent(x)) 10 | else 11 | NULL 12 | } 13 | 14 | ##' @export 15 | `manifest.lvmfit` <- 16 | function(x,...) { 17 | manifest(Model(x)) 18 | } 19 | 20 | ##' @export 21 | manifest.list <- function(x,...) { 22 | manifestlist <- c() 23 | for (i in seq_along(x)) { 24 | manifestlist <- c(manifestlist, manifest(x[[i]])) 25 | } 26 | ## endolist <- unique(manifestlist) 27 | return(manifestlist) 28 | } 29 | 30 | ##' @export 31 | `manifest.multigroup` <- 32 | function(x,...) { 33 | manifest(Model(x)) 34 | } 35 | -------------------------------------------------------------------------------- /R/measurement.R: -------------------------------------------------------------------------------- 1 | ##' @export 2 | `measurement` <- 3 | function(x, ...) { 4 | M <- x$M 5 | latent.idx <- match(latent(x),vars(x)) 6 | obs.idx <- match(manifest(x),vars(x)) 7 | if (length(latent.idx)==0) 8 | return(NULL) 9 | 10 | measurementmodels <- c() 11 | for (i in seq_along(latent.idx)) { 12 | ii <- latent.idx[i] 13 | 14 | relation <- M[ii,obs.idx]==1 15 | byNodes <- names(relation)[relation] 16 | newnodes <- c(latent(x)[i],byNodes) 17 | lvm1 <- subset(x,newnodes) 18 | measurementmodels <- c(measurementmodels, list(lvm1)) 19 | } 20 | 21 | measurementmodels 22 | } 23 | -------------------------------------------------------------------------------- /R/model.R: -------------------------------------------------------------------------------- 1 | ##' Extract model 2 | ##' 3 | ##' Extract or replace model object 4 | ##' 5 | ##' 6 | ##' @aliases Model Model<- 7 | ##' @usage 8 | ##' 9 | ##' Model(x, ...) 10 | ##' 11 | ##' Model(x, ...) <- value 12 | ##' 13 | ##' @param x Fitted model 14 | ##' @param value New model object (e.g. \code{lvm} or \code{multigroup}) 15 | ##' @param \dots Additional arguments to be passed to the low level functions 16 | ##' @return Returns a model object (e.g. \code{lvm} or \code{multigroup}) 17 | ##' @author Klaus K. Holst 18 | ##' @seealso \code{\link{Graph}} 19 | ##' @keywords models 20 | ##' @examples 21 | ##' 22 | ##' m <- lvm(y~x) 23 | ##' e <- estimate(m, sim(m,100)) 24 | ##' Model(e) 25 | ##' 26 | ##' @export 27 | `Model` <- function(x,...) UseMethod("Model") 28 | 29 | 30 | ##' @export 31 | `Model.default` <- function(x,...) x 32 | 33 | ##' @export 34 | `Model.lvm` <- function(x,...) x 35 | 36 | ##' @export 37 | `Model.lvmfit` <- function(x,...) x$model 38 | 39 | ##' @export 40 | `Model.multigroup` <- function(x,...) x$lvm 41 | 42 | ##' @export 43 | `Model.multigroupfit` <- function(x,...) x$model 44 | 45 | ##' @export 46 | "Model<-" <- function(x,...,value) UseMethod("Model<-") 47 | 48 | ##' @export 49 | "Model<-.lvm" <- function(x,...,value) { x <- value; return(x) } 50 | ##' @export 51 | "Model<-.lvmfit" <- function(x,...,value) { x$model <- value; return(x) } 52 | ##' @export 53 | "Model<-.multigroup" <- function(x,...,value) { x$lvm <- value; return(x) } 54 | ##' @export 55 | "Model<-.multigroupfit" <- function(x,...,value) { x$model <- value; return(x) } 56 | -------------------------------------------------------------------------------- /R/model.frame.R: -------------------------------------------------------------------------------- 1 | ##' @export 2 | model.frame.lvmfit <- function(formula, all=FALSE,...) { 3 | mydata <- formula$data$model.frame 4 | if (!is.data.frame(mydata) & !is.matrix(mydata)) 5 | return(mydata) 6 | if (all) return(mydata) 7 | ## xfix <- colnames(mydata)[(colnames(mydata)%in%parlabels(formula$model0,exo=TRUE))] 8 | xfix <- colnames(mydata)[(colnames(mydata)%in%parlabels(formula$model0))] 9 | return( mydata[,c(manifest(formula),xfix),drop=FALSE] ) 10 | } 11 | 12 | ##' @export 13 | model.frame.multigroupfit <- function(formula,...) { 14 | mydata <- formula$model$data 15 | return(mydata) 16 | } 17 | -------------------------------------------------------------------------------- /R/modelVar.R: -------------------------------------------------------------------------------- 1 | 2 | ###{{{ modelVar 3 | 4 | ##' @export 5 | `modelVar` <- 6 | function(x,p,...) UseMethod("modelVar") 7 | 8 | ##' @export 9 | modelVar.lvmfit <- function(x, p=pars(x), ...) modelVar(Model(x),p=p,...) 10 | 11 | ##' @export 12 | modelVar.lvm <- function(x,p,data,...) { 13 | pp <- modelPar(x,p) 14 | res <- moments(x, p=p, data=data,...) 15 | attr(res, "pars") <- pp$p 16 | attr(res, "meanpar") <- pp$meanpar 17 | attr(res, "epar") <- pp$epar 18 | res 19 | } 20 | ###}}} modelVar 21 | -------------------------------------------------------------------------------- /R/moments.R: -------------------------------------------------------------------------------- 1 | Moments <- function(x,p,data,conditional=TRUE,...) { 2 | 3 | } 4 | 5 | ##' @export 6 | `moments` <- 7 | function(x,...) UseMethod("moments") 8 | 9 | ##' @export 10 | moments.lvmfit <- function(x, p=pars(x),...) moments(Model(x),p=p,...) 11 | 12 | ##' @export 13 | moments.lvm.missing <- function(x, p=pars(x), ...) { 14 | idx <- match(coef(Model(x)),names(coef(x))) 15 | moments.lvmfit(x,p=p[idx],...) 16 | } 17 | 18 | 19 | ##' @export 20 | moments.lvm <- function(x, p, debug=FALSE, conditional=FALSE, data=NULL, latent=FALSE, ...) { 21 | ### p: model-parameters as obtained from e.g. 'startvalues'. 22 | ### (vector of regression parameters and variance parameters) 23 | ### meanpar: mean-parameters (optional) 24 | 25 | ii <- index(x) 26 | pp <- modelPar(x,p) 27 | AP <- with(pp, matrices(x,p,meanpar=meanpar,epars=p2,data=data,...)) 28 | P <- AP$P 29 | v <- AP$v 30 | if (!is.null(v)) { 31 | names(v) <- ii$vars 32 | } 33 | 34 | J <- ii$J 35 | if (conditional) { 36 | J <- ii$Jy 37 | if (latent) { 38 | J <- diag(nrow=length(ii$vars))[sort(c(ii$endo.idx,ii$eta.idx)),,drop=FALSE] 39 | } 40 | px <- ii$px 41 | exo <- exogenous(x) 42 | ## if (missing(row)) { 43 | v <- rbind(v) %x% cbind(rep(1,nrow(data))) 44 | if (length(ii$exo.idx)>0) { 45 | v[,ii$exo.idx] <- as.matrix(data[,exo]) 46 | } 47 | ## } else { 48 | ## if (!is.null(v)) 49 | ## v[exo] <- as.numeric(data[row,exo]) 50 | ## } 51 | P <- px%*% tcrossprod(P, px) 52 | } 53 | 54 | Im <- diag(nrow=nrow(AP$A)) 55 | if (ii$sparse) { 56 | IAi <- with(AP, as(Inverse(Im-t(A)),"sparseMatrix")) 57 | ##IAi <- as(solve(Matrix::Diagonal(nrow(A))-t(A)),"sparseMatrix") 58 | G <- as(J%*%IAi,"sparseMatrix") 59 | } else { 60 | IAi <- Inverse(Im-t(AP$A)) 61 | G <- J%*%IAi 62 | } 63 | 64 | xi <- NULL 65 | if (!is.null(v)) { 66 | xi <- v%*%t(G) ## Model-specific mean vector 67 | } 68 | Cfull <- as.matrix(IAi %*% tcrossprod(P,IAi)) 69 | C <- as.matrix(J %*% tcrossprod(Cfull,J)) 70 | 71 | return(list(Cfull=Cfull, C=C, v=v, e=AP$e, xi=xi, A=AP$A, P=P, IAi=IAi, J=J, G=G, npar=ii$npar, npar.reg=ii$npar.reg, npar.mean=ii$npar.mean, npar.ex=ii$npar.ex, parval=AP$parval, constrain.idx=AP$constrain.idx, constrainpar=AP$constrainpar)) 72 | } 73 | -------------------------------------------------------------------------------- /R/multipleinput.R: -------------------------------------------------------------------------------- 1 | simulatehook_multiple_inputs <- function(x,data,...) { 2 | minp <- x$attributes$multiple.inputs 3 | if (length(minp)>0) { 4 | for (i in seq_along(minp)) { 5 | outcome <- names(minp[i]) 6 | inp <- minp[[i]]$input 7 | fun <- minp[[i]]$fun 8 | data[,outcome] <- fun(x, data, inp) 9 | } 10 | } 11 | return(data) 12 | } 13 | 14 | addhook("simulatehook_multiple_inputs","sim.hooks") 15 | 16 | printhook_multiple_inputs <- function(x,...) { 17 | minp <- x$attributes$multiple.inputs 18 | if (length(minp)>0) { 19 | outcomes <- names(minp) 20 | for (i in seq_along(minp)) { 21 | cat(minp[[i]]$type, ":\n\n") 22 | st <- paste0(outcomes[i]," ~ ", paste0(minp[[i]]$input,collapse=" | ")) 23 | cat(" ", st, "\n") 24 | cat("\n") 25 | } 26 | } 27 | return(NULL) 28 | } 29 | 30 | addhook("printhook_multiple_inputs","print.hooks") 31 | -------------------------------------------------------------------------------- /R/napass0.R: -------------------------------------------------------------------------------- 1 | 2 | impute0 <- function(object,rows,idx,na.action=na.omit,value,...) { 3 | if (missing(rows) && missing(idx)) { 4 | df <- na.action(object,...) 5 | rows <- attr(df,"na.action") 6 | } 7 | if (!missing(idx)) { 8 | obs1 <- setdiff(seq(length(object)),idx)[1] 9 | } else { 10 | obs1 <- setdiff(seq(NROW(object)),rows)[1] 11 | } 12 | if (missing(value)) { 13 | fobs <- object[obs1] 14 | if (is.logical(fobs)) value <- FALSE 15 | else if (is.character(fobs)) value <- fobs 16 | else if (is.factor(fobs)) value <- levels(fobs)[1] 17 | else value <- 0 18 | } 19 | if (!missing(idx)) { 20 | object[idx] <- value 21 | return(object) 22 | } 23 | if (is.matrix(object)) { 24 | object[rows,] <- value 25 | } else { 26 | object[rows] <- value 27 | } 28 | return(object) 29 | } 30 | 31 | ##' @export 32 | na.pass0 <- function(object,all=TRUE,na.action=na.omit, ...) { 33 | ## Fill in "zeros" in the design matrix where we have missing data 34 | df <- na.action(object,...) 35 | idx <- attr(df,"na.action") 36 | if (is.matrix(object) || is.vector(object)) { 37 | object <- impute0(object,rows=idx,...) 38 | } else { 39 | for (i in seq_len(NCOL(object))) { 40 | object[[i]] <- impute0(object[[i]],rows=idx,...) 41 | } 42 | } 43 | if (!is.null(idx)) 44 | return(structure(object,na.action=structure(idx,class="pass0"))) 45 | return(object) 46 | } 47 | -------------------------------------------------------------------------------- /R/nodecolor.R: -------------------------------------------------------------------------------- 1 | ##' @export 2 | `nodecolor<-` <- 3 | function(object,var,...,value) UseMethod("nodecolor<-") 4 | 5 | ##' @export 6 | `nodecolor<-.lvm` <- 7 | function(object, var=vars(object), border, labcol, shape, lwd, ..., value) { 8 | if (length(var)>0 & length(value)>0) { 9 | if (inherits(var,"formula")) var <- all.vars(var) 10 | object$noderender$fill[var] <- value 11 | if (!missing(border)) 12 | object$noderender$col[var] <- border 13 | if (!missing(shape)) 14 | object$noderender$shape[var] <- shape 15 | if (!missing(labcol)) 16 | object$noderender$textCol[var] <- labcol 17 | if (!missing(lwd)) 18 | object$noderender$lwd[var] <- lwd 19 | } 20 | return(object) 21 | } 22 | 23 | ##' @export 24 | `nodecolor<-.default` <- 25 | function(object, var=vars(object), border, labcol, shape, lwd, ..., value) { 26 | if (length(var)>0 & length(value)>0) { 27 | if (inherits(var,"formula")) var <- all.vars(var) 28 | object <- addattr(object,attr="fill",var=var,val=value) 29 | if (!missing(border)) 30 | object <- addattr(object,attr="col",var=var,val=border) 31 | if (!missing(shape)) 32 | object <- addattr(object,attr="shape",var=var,val=shape) 33 | if (!missing(labcol)) 34 | object <- addattr(object,attr="textCol",var=var,val=labcol) 35 | if (!missing(lwd)) 36 | object <- addattr(object,attr="lwd",var=var,val=lwd) 37 | } 38 | return(object) 39 | } 40 | -------------------------------------------------------------------------------- /R/onload.R: -------------------------------------------------------------------------------- 1 | '.onLoad' <- function(libname, pkgname="lava") { 2 | addhook("heavytail_init_hook","init.hooks") 3 | addhook("glm_estimate_hook","estimate.hooks") 4 | addhook("ordinal_estimate_hook","estimate.hooks") 5 | addhook("cluster_post_hook","post.hooks") 6 | addhook("ordinal_sim_hook","sim.hooks") 7 | addhook("color_ordinal","color.hooks") 8 | addhook("ordinal_remove_hook","remove.hooks") 9 | lava.options(cluster.index = packagecheck("mets")) 10 | } 11 | 12 | '.onAttach' <- function(libname, pkgname="lava") { 13 | # desc <- utils::packageDescription(pkgname) 14 | # packageStartupMessage(desc$Package, " version ",desc$Version) 15 | } 16 | -------------------------------------------------------------------------------- /R/operators.R: -------------------------------------------------------------------------------- 1 | ##' For matrices a block-diagonal matrix is created. For all other 2 | ##' data types he operator is a wrapper of \code{paste}. 3 | ##' 4 | ##' Concatenation operator 5 | ##' @aliases %++% 6 | ##' @rdname op_concat 7 | ##' @usage x \%++\% y 8 | ##' @title Concatenation operator 9 | ##' @param x First object 10 | ##' @param y Second object of same class 11 | ##' @author Klaus K. Holst 12 | ##' @keywords utilities misc 13 | ##' @seealso \code{blockdiag}, \code{\link{paste}}, \code{\link{cat}}, 14 | ##' @examples 15 | ##' ## Block diagonal 16 | ##' matrix(rnorm(25),5)%++%matrix(rnorm(25),5) 17 | ##' ## String concatenation 18 | ##' "Hello "%++%" World" 19 | ##' ## Function composition 20 | ##' f <- log %++% exp 21 | ##' f(2) 22 | ##' @export 23 | `%++%` <- function(x,y) UseMethod("%++%",y) 24 | 25 | ## ##' @export 26 | ## `%+%` <- function(x,y) UseMethod("%+%",y) 27 | 28 | ##' @export 29 | `%++%.default` <- function(x,y) paste0(x,y) 30 | 31 | ##' @export 32 | `%++%.character` <- function(x,y) paste0(x,y) 33 | 34 | ##' @export 35 | `%++%.matrix` <- function(x,y) blockdiag(x,y) 36 | 37 | ##' @export 38 | `%++%.function` <- function(x,y) function(...) x(y(...)) 39 | 40 | 41 | notin <- Negate(get("%in%")) 42 | ##' Matching operator (x not in y) oposed to the \code{\%in\%}-operator (x in y) 43 | ##' 44 | ##' Matching operator 45 | ##' @rdname op_match 46 | ##' @aliases %ni% %in.open% %in.closed% 47 | ##' @usage x \%ni\% y 48 | ##' @param x vector 49 | ##' @param y vector of same type as \code{x} 50 | ##' @return A logical vector. 51 | ##' @author Klaus K. Holst 52 | ##' @seealso \code{\link{match}} 53 | ##' @keywords utilities misc 54 | ##' @examples 55 | ##' 56 | ##' 1:10 %ni% c(1,5,10) 57 | ##' 58 | ##' @export 59 | "%ni%" <- function(x,y) notin(x,y) 60 | 61 | ## function(x,y) { 62 | ## is.na(match(x,y)) 63 | ## } 64 | 65 | ##' @export 66 | "%in.open%" <- function(x, y) { 67 | if (length(y) == 1) y <- c(y, y) 68 | if (length(y) != 2 || !is.numeric(y)) stop("rhs should be a range (numeric vector of length 2)") 69 | x > y[1] & x < y[2] 70 | } 71 | 72 | ##' @export 73 | "%in.closed%" <- function(x,y) { 74 | if (length(y) == 1) y <- c(y, y) 75 | if (length(y) != 2 || !is.numeric(y)) stop("rhs should be a range (numeric vector of length 2)") 76 | x >= y[1] & x <= y[2] 77 | } 78 | -------------------------------------------------------------------------------- /R/parameter.R: -------------------------------------------------------------------------------- 1 | ##' @export 2 | "parameter<-" <- function(x,...,value) UseMethod("parameter<-") 3 | 4 | ##' @export 5 | "parameter<-.lvmfit" <- function(x,...,value) { 6 | parameter(Model(x),...) <- value 7 | return(x) 8 | } 9 | 10 | 11 | ##' @export 12 | "parameter<-.lvm" <- function(x,constrain,start,remove=FALSE,...,value) { 13 | if (inherits(value,"formula")) value <- all.vars(value) 14 | x <- rmvar(x, value) 15 | if (remove) { 16 | x$expar[value] <- NULL 17 | x$exfix[value] <- NULL 18 | x$attributes$parameter[value] <- NULL 19 | index(x) <- reindex(x) 20 | return(x) 21 | 22 | } 23 | if (!missing(start)) { 24 | if (length(start) != length(value)) stop("'start' and 'value' should be of the same lengths") 25 | start <- as.list(start) 26 | names(start) <- value 27 | } else { 28 | start <- as.list(rep(0,length(value))); names(start) <- value 29 | } 30 | if (!missing(constrain)) { 31 | newfix <- constrain 32 | if (!is.list(newfix)) newfix <- as.list(newfix) 33 | } else { 34 | newfix <- as.list(value); 35 | } 36 | names(newfix) <- value 37 | x$expar[value] <- start 38 | x$exfix[value] <- newfix 39 | index(x) <- reindex(x) 40 | x$attributes$parameter[value] <- TRUE 41 | return(x) 42 | } 43 | 44 | ##' @export 45 | parameter <- function(x,...,value) UseMethod("parameter") 46 | 47 | ##' @export 48 | parameter.default <- function(x, var, ...) { 49 | if (missing(var)) return (names(unlist(x$attributes$parameter))) 50 | parameter(x, ...) <- var 51 | return(x) 52 | } 53 | -------------------------------------------------------------------------------- /R/parlabels.R: -------------------------------------------------------------------------------- 1 | ##' @export 2 | parlabels <- function(x,exo=FALSE) { 3 | res <- c(unlist(intfix(x)[unlist(lapply(intfix(x), function(y) !is.na(y) & !is.numeric(y)))]), 4 | regfix(x)$labels[!is.na(regfix(x)$labels)], 5 | covfix(x)$labels[!is.na(covfix(x)$labels)]) 6 | if (!is.null(x$exfix)) 7 | res <- c(res, 8 | unlist(x$exfix[!is.na(x$exfix) & !is.numeric(x$exfix)])) 9 | if (exo) 10 | res <- intersect(res,index(Model(x))$exogenous) 11 | return(res) 12 | } 13 | -------------------------------------------------------------------------------- /R/pars.R: -------------------------------------------------------------------------------- 1 | ##' @export 2 | `pars` <- 3 | function(x,...) UseMethod("pars") 4 | 5 | ##' @export 6 | pars.default <- function(x,...) { 7 | if (!is.null(x$opt$estimate)) 8 | return(x$opt$estimate) 9 | if (!is.null(x$opt$par)) 10 | return(x$opt$par) 11 | if (!is.null(x$coef)) 12 | return(x$coef) 13 | return(coef(x)) 14 | } 15 | 16 | ##' @export 17 | pars.lvm.missing <- function(x,reorder=FALSE,...) { 18 | res <- pars.default(x) 19 | if (reorder) { 20 | idx <- match(coef(Model(x)),names(coef(x))) 21 | return(res[idx]) 22 | } 23 | return(res) 24 | } 25 | 26 | 27 | 28 | ###{{{ pars.multigroupfit 29 | ## pars.multigroupfit <- function(x,...) { 30 | ## res <- pars.default(x) 31 | ## lapply(ee$model$lvm,coef)) 32 | ## coef() 33 | ##} 34 | ###}}} 35 | 36 | ###{{{ pars.lvm 37 | 38 | ##' @export 39 | pars.lvm <- function(x, A, P, v, e, ...) { 40 | parres <- A[index(x)$M1==1] 41 | diagcorfree <- diag(P)[diag(index(x)$P1)==1] 42 | parres <- c(parres, diagcorfree) 43 | 44 | if (ncol(A)>1) 45 | for (i in seq_len(ncol(index(x)$P1)-1)) 46 | for (j in seq(i+1,nrow(index(x)$P1))) { 47 | if (index(x)$P1[j,i]!=0) { 48 | parres <- c(parres, P[j,i]) 49 | } 50 | } 51 | if (length(parres)>0) 52 | names(parres) <- paste0("p",seq_len(length(parres))) 53 | if (!missing(v)) { 54 | parres <- c( v[which(index(x)$v1==1)], parres) 55 | } 56 | if (!missing(e)) { 57 | parres <- c( parres, e[which(index(x)$e1==1)] ) 58 | } 59 | return(parres) 60 | } 61 | 62 | ###}}} pars.lvm 63 | -------------------------------------------------------------------------------- /R/partialcor.R: -------------------------------------------------------------------------------- 1 | ##' Calculate partial correlations 2 | ##' 3 | ##' Calculate partial correlation coefficients and confidence limits via Fishers 4 | ##' z-transform 5 | ##' 6 | ##' 7 | ##' @param formula formula speciying the covariates and optionally the outcomes 8 | ##' to calculate partial correlation for 9 | ##' @param data data.frame 10 | ##' @param level Level of confidence limits 11 | ##' @param ... Additional arguments to lower level functions 12 | ##' @return A coefficient matrix 13 | ##' @author Klaus K. Holst 14 | ##' @keywords models regression 15 | ##' @examples 16 | ##' 17 | ##' m <- lvm(c(y1,y2,y3)~x1+x2) 18 | ##' covariance(m) <- c(y1,y2,y3)~y1+y2+y3 19 | ##' d <- sim(m,500) 20 | ##' partialcor(~x1+x2,d) 21 | ##' 22 | ##' @export 23 | partialcor <- function(formula,data,level=0.95,...) { 24 | y <- getoutcome(formula) 25 | if (length(y)==0) { 26 | preds <- all.vars(formula) 27 | yy <- setdiff(names(data),preds) 28 | } else { 29 | yy <- decomp.specials(y) 30 | preds <- attr(y,"x") 31 | } 32 | if (length(yy)<2) 33 | return(NULL) 34 | res <- c() 35 | for (i in seq_len(length(yy)-1)) 36 | for (j in seq(i+1,length(yy))) { 37 | f <- as.formula(paste("cbind(",yy[i],",",yy[j],")~", paste(preds,collapse="+"))) 38 | res <- rbind(res, partialcorpair(f,data,level=level)) 39 | rownames(res)[nrow(res)] <- paste(yy[i],yy[j],sep="~") 40 | } 41 | return(res) 42 | } 43 | 44 | 45 | partialcorpair <- function(formula,data,level=0.95,...) { 46 | l <- lm(formula,data) 47 | k <- ncol(model.matrix(l)) 48 | n <- nrow(model.matrix(l)) 49 | r <- residuals(l) 50 | rho <- cor(r)[1,2] 51 | zrho <- atanh(rho) 52 | var.z <- 1/(n-k-3) 53 | ci.z <- zrho + c(-1,1)*qnorm(1-(1-level)/2)*sqrt(var.z) 54 | ci.rho <- tanh(ci.z) 55 | z <- 1/sqrt(var.z)*zrho 56 | p.z <- 2*(pnorm(-abs(z))) # p-value using z-transform for H_0: rho=0. 57 | return(c(cor=rho,z=z,pval=p.z,lowerCI=ci.rho[1],upperCI=ci.rho[2])) 58 | } 59 | -------------------------------------------------------------------------------- /R/pdfconvert.R: -------------------------------------------------------------------------------- 1 | ##' Convert PDF file to print quality png (default 300 dpi) 2 | ##' 3 | ##' Access to ghostscript program 'gs' is needed 4 | ##' @title Convert pdf to raster format 5 | ##' @param files Vector of (pdf-)filenames to process 6 | ##' @param dpi DPI 7 | ##' @param resolution Resolution of raster image file 8 | ##' @param gs Optional ghostscript command 9 | ##' @param gsopt Optional ghostscript arguments 10 | ##' @param resize Optional resize arguments (mogrify) 11 | ##' @param format Raster format (e.g. png, jpg, tif, ...) 12 | ##' @param \dots Additional arguments 13 | ##' @seealso \code{dev.copy2pdf}, \code{printdev} 14 | ##' @export 15 | ##' @author Klaus K. Holst 16 | ##' @keywords iplot 17 | pdfconvert <- function(files, dpi=300, resolution=1024, gs, gsopt, resize, format="png", ...) { 18 | if (missing(gsopt)) 19 | gsopt <- "-dSAFTER -dBATCH -dNOPAUSE -sDEVICE=png16m -dGraphicsAlphaBits=4 -dTextAlphaBits=4" 20 | if (missing(gs)) { 21 | gs <- names(which(Sys.which(c("gs", "gswin32c", "gswin64c")) != "")) 22 | } 23 | cmd1 <- paste0(gs," -r",dpi," -dBackgroundColor='16#ffffff'") 24 | if (missing(resize)) { 25 | resize <- paste0("mogrify -resize ", resolution) 26 | } 27 | for (f in files) { 28 | f0 <- strsplit(f,".pdf")[1] 29 | f.out <- paste(f0,format,sep=".") 30 | f.pdf <- paste(f0,"pdf",sep=".") 31 | mycmd1 <- paste0(cmd1, " ", gsopt, " -sOutputFile=", f.out, " > /dev/null ", f.pdf) 32 | mycmd2 <- paste0(resize, " ", f.out) 33 | cat(f.pdf) 34 | system(mycmd1) 35 | cat(" -> ") 36 | system(mycmd2) 37 | cat(f.out, "\n") 38 | } 39 | } 40 | -------------------------------------------------------------------------------- /R/plot.estimate.R: -------------------------------------------------------------------------------- 1 | ##' Plot method for 'estimate' objects 2 | ##' 3 | ##' Plot method for 'estimate' objects 4 | ##' @export 5 | ##' @param x estimate object 6 | ##' @param f function of parameter coefficients and data parsed on to 'estimate'. 7 | ##' If omitted a forest-plot will be produced. 8 | ##' @param idx Index of parameters (default all) 9 | ##' @param intercept include intercept in forest-plot 10 | ##' @param data data.frame 11 | ##' @param confint Add confidence limits 12 | ##' @param type plot type ('l') 13 | ##' @param xlab x-axis label 14 | ##' @param ylab y-axis label 15 | ##' @param col color 16 | ##' @param add add plot to current device 17 | ##' @param ... additional arguments to lower-level functions 18 | plot.estimate <- function(x,f,idx,intercept=FALSE,data,confint=TRUE,type="l",xlab="x",ylab="f(x)",col=1,add=FALSE,...) { 19 | if (!missing(f) && !is.null(f)) { 20 | data <- as.list(data) 21 | env <- new.env() 22 | for (y in names(data)) { 23 | assign(y,data[[y]],env) 24 | } 25 | environment(f) <- env 26 | pp <- estimate(x, f, ..., vcov=vcov(x), IC=FALSE)$coefmat 27 | if (!add) suppressWarnings(plot(data[[1]],pp[,1],xlab=xlab,ylab=ylab,type=type,...)) 28 | else lines(data[[1]],pp[,1],xlab=xlab,ylab=ylab,type=type,col=col,...) 29 | if (confint) confband(data[[1]],pp[,3],pp[,4],polygon=TRUE,col=Col(col),lty=0) 30 | return(invisible(pp)) 31 | } 32 | if (!is.null(x$coefmat)) { 33 | pp <- x$coefmat[,c(1,3,4),drop=FALSE] 34 | } else { 35 | pp <- cbind(coef(x),confint(x)) 36 | } 37 | if (!missing(idx)) pp <- pp[idx,,drop=FALSE] 38 | if (!intercept) { 39 | idx <- match("(Intercept)",rownames(pp)) 40 | if (length(idx)>0 && !any(is.na(idx))) pp <- pp[-idx,,drop=FALSE] 41 | } 42 | forestplot(pp[rev(seq(nrow(pp))),,drop=FALSE],...) 43 | } 44 | 45 | -------------------------------------------------------------------------------- /R/predict.mixture.R: -------------------------------------------------------------------------------- 1 | ##' @export 2 | predict.lvm.mixture <- function(object,p=coef(object,full=TRUE),model="normal",predict.fun=NULL,...) { 3 | p0 <- coef(object,full=FALSE) 4 | pp <- p[seq_along(p0)] 5 | pr <- p[length(p0)+seq(length(p)-length(p0))]; 6 | if (length(pr)0,type="right") 16 | ##'S3 <- survival::Surv(y,y<0,type="left") 17 | ##' 18 | ##'rbind(S1,S1) 19 | ##'rbind(S2,S2) 20 | ##'rbind(S3,S3) 21 | ##' 22 | ##' @export 23 | rbind.Surv <- function(...) 24 | { 25 | dots <- list(...) 26 | type <- attributes(dots[[1]])$type 27 | ncol <- dim(dots[[1]])[2] 28 | nrow <- unlist(lapply(dots,nrow)) 29 | cnrow <- c(0,cumsum(nrow)) 30 | M <- matrix(ncol=ncol,nrow=sum(nrow)) 31 | for (i in 1:length(dots)) { 32 | M[(cnrow[i]+1):cnrow[i+1],] <- dots[[i]] 33 | } 34 | x <- c(); for (i in 1:ncol(M)) x <- c(x,list(M[,i])) 35 | x <- c(x,list(type=type)) 36 | do.call(survival::Surv, x) 37 | } 38 | -------------------------------------------------------------------------------- /R/residuals.R: -------------------------------------------------------------------------------- 1 | Isqrt <- function(X) { 2 | eX <- eigen(X); 3 | with(eX, vectors %*% diag(1/sqrt(values),nrow=length(values)) %*% t(vectors)) 4 | } 5 | 6 | 7 | ##' @export 8 | residuals.multigroupfit <- function(object,data=model.frame(object),p=coef(object), k, ...) { 9 | pp <- modelPar(object,p,...) 10 | if (!missing(k)) return(residuals(object$model$lvm[[k]],data=data[[k]],p=pp$p[[k]],...)) 11 | res <- c() 12 | for (i in seq(length(pp$p))) { 13 | res <- c(res, list(residuals(object$model$lvm[[i]],data=data[[i]],p=pp$p[[i]],...))) 14 | } 15 | return(res) 16 | } 17 | 18 | 19 | ##' @export 20 | residuals.lvmfit <- function(object,data=model.frame(object),p=coef(object),...) { 21 | residuals(Model(object), data=data, p=p, ...) 22 | } 23 | 24 | ##' @export 25 | residuals.lvm <- function(object,data=model.frame(object),std=FALSE,p=coef(object),...) { 26 | Y <- setdiff(manifest(object), exogenous(object)) 27 | Pr <- predict(object,p=p,data=data) 28 | PrY <- Pr[,Y,drop=FALSE] 29 | ## y <- endogenous(object)[match(endogenous(object),manifest(object))] 30 | r <- as.matrix(data[,Y,drop=FALSE]-(PrY)) 31 | res <- r 32 | 33 | if (std) { 34 | S <- attributes(Pr)$cond.var; 35 | if (length(Y)>1) { 36 | res <- r%*%Isqrt(S) 37 | } else res <- 1/sqrt(S[1,1])*r 38 | } 39 | colnames(res) <- colnames(r) 40 | res 41 | } 42 | 43 | -------------------------------------------------------------------------------- /R/revdiag.R: -------------------------------------------------------------------------------- 1 | ##' Create/extract 'reverse'-diagonal matrix or off-diagonal elements 2 | ##' @title Create/extract 'reverse'-diagonal matrix or off-diagonal elements 3 | ##' @aliases revdiag revdiag<- offdiag offdiag<- 4 | ##' @usage 5 | ##' revdiag(x,...) 6 | ##' offdiag(x,type=0,...) 7 | ##' 8 | ##' revdiag(x,...) <- value 9 | ##' offdiag(x,type=0,...) <- value 10 | ##' @param x vector 11 | ##' @param value For the assignment function the values to put in the diagonal 12 | ##' @param type 0: upper and lower triangular, 1: upper triangular, 2: lower triangular, 3: upper triangular + diagonal, 4: lower triangular + diagonal 13 | ##' @param \dots additional arguments to lower level functions 14 | ##' @author Klaus K. Holst 15 | ##' @export 16 | revdiag <- function(x,...) { 17 | if (NCOL(x)==1) { 18 | res <- matrix(0,length(x),length(x)) 19 | revdiag(res) <- x 20 | return(res) 21 | } 22 | n <- max(ncol(x),nrow(x)) 23 | x[cbind(rev(seq(n)),seq(n))] 24 | } 25 | 26 | ##' @export 27 | "revdiag<-" <- function(x,...,value) { 28 | n <- max(ncol(x),nrow(x)) 29 | x[cbind(rev(seq(n)),seq(n))] <- value 30 | x 31 | } 32 | 33 | 34 | ##' @export 35 | offdiag <- function(x,type=0,...) { 36 | ##if (NCOL(x)==1) return(NULL) 37 | if (type%in%c(1,3)) { 38 | ii <- which(upper.tri(x,diag=(type==3))) 39 | } else if (type%in%c(2,4)) { 40 | ii <- which(lower.tri(x,diag=(type==4))) 41 | } else { 42 | ii <- c(which(lower.tri(x,diag=FALSE)),which(upper.tri(x,diag=FALSE))) 43 | } 44 | res <- x[ii] 45 | class(res) <- c("offdiag",class(res)) 46 | attributes(res) <- 47 | c(attributes(res),list(type=type,dimension=dim(x),index=ii,nam=dimnames(x))) 48 | return(res) 49 | } 50 | 51 | ##' @export 52 | "offdiag<-" <- function(x,type=0,...,value) { 53 | if (type%in%c(1,3)) { 54 | ii <- which(upper.tri(x,diag=(type==3))) 55 | } else if (type%in%c(2,4)) { 56 | ii <- which(lower.tri(x,diag=(type==4))) 57 | } else { 58 | ii <- c(which(lower.tri(x,diag=FALSE)),which(upper.tri(x,diag=FALSE))) 59 | } 60 | x[ii] <- value 61 | return(x) 62 | } 63 | 64 | ##' @export 65 | print.offdiag <- function(x,...) { 66 | ## type <- attr(x,"type") 67 | nn <- attr(x,"dimension") 68 | M <- matrix(NA,nn[1],nn[2]) 69 | M[attr(x,"index")] <- x 70 | dimnames(M) <- attr(x,"nam") 71 | print(M,na.print="",...) 72 | } 73 | -------------------------------------------------------------------------------- /R/rotation.R: -------------------------------------------------------------------------------- 1 | ##' Performs a rotation in the plane 2 | ##' 3 | ##' @title Performs a rotation in the plane 4 | ##' @aliases rotate2 rot2D rot3D 5 | ##' @param x Matrix to be rotated (2 times n) 6 | ##' @param theta Rotation in radians 7 | ##' @return Returns a matrix of the same dimension as \code{x} 8 | ##' @author Klaus K. Holst 9 | ##' @export 10 | ##' @examples 11 | ##' rotate2(cbind(c(1,2),c(2,1))) 12 | ##' @keywords hplot 13 | `rotate2` <- 14 | function(x,theta=pi) { 15 | R <- matrix(c(cos(theta), -sin(theta), sin(theta), cos(theta)), byrow=TRUE, ncol=2) 16 | x%*%R 17 | } 18 | 19 | ## clockwise rotation 2d: 20 | ##' @export 21 | rot2D <- function(theta) { 22 | matrix(c(cos(theta),sin(theta),-sin(theta),cos(theta)),2) 23 | } 24 | 25 | ##' @export 26 | rot3D <- function(x=0,y=0,z=0) { 27 | Rx <- function() { 28 | R2 <- rot2D(x) 29 | R <- diag(3) 30 | R[2:3,2:3] <- R2 31 | return(R) 32 | } 33 | Ry <- function() { 34 | R2 <- rot2D(y) 35 | R <- diag(3) 36 | R[c(1,3),c(1,3)] <- R2 37 | return(R) 38 | } 39 | Rz <- function() { 40 | R2 <- rot2D(z) 41 | R <- diag(3) 42 | R[1:2,1:2] <- R2 43 | return(R) 44 | } 45 | res <- diag(3) 46 | if (x!=0) res <- res%*%Rx() 47 | if (y!=0) res <- res%*%Ry() 48 | if (z!=0) res <- res%*%Rz() 49 | return(res) 50 | } 51 | -------------------------------------------------------------------------------- /R/scheffe.R: -------------------------------------------------------------------------------- 1 | ##' Function to compute the Scheffe corrected confidence 2 | ##' interval for the regression line 3 | ##' 4 | ##' @title Calculate simultaneous confidence limits by Scheffe's method 5 | ##' @param model Linear model 6 | ##' @param newdata new data frame 7 | ##' @param level confidence level (0.95) 8 | ##' @export 9 | ##' @examples 10 | ##' x <- rnorm(100) 11 | ##' d <- data.frame(y=rnorm(length(x),x),x=x) 12 | ##' l <- lm(y~x,d) 13 | ##' plot(y~x,d) 14 | ##' abline(l) 15 | ##' d0 <- data.frame(x=seq(-5,5,length.out=100)) 16 | ##' d1 <- cbind(d0,predict(l,newdata=d0,interval="confidence")) 17 | ##' d2 <- cbind(d0,scheffe(l,d0)) 18 | ##' lines(lwr~x,d1,lty=2,col="red") 19 | ##' lines(upr~x,d1,lty=2,col="red") 20 | ##' lines(lwr~x,d2,lty=2,col="blue") 21 | ##' lines(upr~x,d2,lty=2,col="blue") 22 | scheffe <- function(model,newdata=model.frame(model),level=0.95) { 23 | df <- model$df.residual 24 | p <- model$rank 25 | alpha <- 1-level 26 | ## Scheffe value uses 1-tailed F critical value 27 | scheffe.crit <- sqrt(p*qf(1-alpha,p,df)) 28 | ci <- predict(model,newdata,interval="confidence",level=level) 29 | delta <- scheffe.crit/qt(1-alpha/2,df) 30 | ci[,2] <- ci[,1] -(ci[,1]-ci[,2])*delta 31 | ci[,3] <- ci[,1] +(ci[,3]-ci[,1])*delta 32 | return(ci) 33 | } 34 | -------------------------------------------------------------------------------- /R/score.survreg.R: -------------------------------------------------------------------------------- 1 | ##' @export 2 | pars.survreg <- function(x,...) { 3 | c(coef(x),scale=x$scale) 4 | } 5 | 6 | 7 | ##' @export 8 | score.survreg <- function(x,p,scale=TRUE,logscale=FALSE,indiv.logLik=FALSE,...) { 9 | npar <- NROW(x$var) 10 | m <- model.frame(x) 11 | X <- model.matrix(terms(x), m) 12 | hasscale <- npar>length(x$coefficients) 13 | if (!missing(p)) { 14 | if (hasscale) sigma <- tail(p,1) 15 | p <- p[seq(length(p)-1)] 16 | x$linear.predictors <- as.vector(X%*%p) 17 | x$coefficients <- p 18 | x$scale <- sigma 19 | } 20 | derivatives <- residuals(x, type = "matrix") 21 | w <- model.weights(m) 22 | if (is.null(w)) w <- 1 23 | dldLP <- w*derivatives[,"dg"] ## Derivative wrt linear-predictor p=Xbeta 24 | S <- apply(X,2,function(x) x*dldLP) 25 | if (!is.null(x$naive.var)) { 26 | V <- x$naive.var 27 | } else { 28 | V <- x$var 29 | } 30 | if (hasscale && scale) { 31 | ds <- cbind("logsigma"=derivatives[,"ds"]) 32 | if (!logscale) { 33 | ds <- ds/x$scale 34 | names(ds) <- "sigma" 35 | } 36 | S <- cbind(S,ds) 37 | } 38 | if (hasscale && !scale) { 39 | V <- V[-npar,-npar,drop=FALSE] 40 | } 41 | attributes(S)$logLik <- 42 | if (indiv.logLik) derivatives[,"g"] 43 | else sum(derivatives[,"g"]) 44 | attributes(S)$bread <- V*NROW(S) 45 | return(S) 46 | } 47 | 48 | -------------------------------------------------------------------------------- /R/subgraph.R: -------------------------------------------------------------------------------- 1 | subgraph <- function(g,from,to,Tree=new("graphNEL",node=c(to,from),edgemode="directed"),...) { 2 | adjnodes <- graph::adj(g,from)[[1]] 3 | if (length(adjnodes)==0) 4 | return(Tree) 5 | for (v in adjnodes) { 6 | if (v==to) { 7 | Tree <- graph::addEdge(from, v, Tree) 8 | } 9 | re1 <- graph::acc(g,v)[[1]] ## Reachable nodes from v 10 | if ((to %in% names(re1)[re1>0])) { 11 | if (!(v %in% graph::nodes(Tree))) 12 | Tree <- graph::addNode(v,Tree) 13 | Tree <- graph::addEdge(from, v, Tree) 14 | Tree <- path(g,v,to,Tree) 15 | } 16 | } 17 | return(Tree) 18 | } 19 | -------------------------------------------------------------------------------- /R/subset.R: -------------------------------------------------------------------------------- 1 | ##' Extract subset of latent variable model 2 | ##' 3 | ##' Extract measurement models or user-specified subset of model 4 | ##' 5 | ##' 6 | ##' @aliases measurement 7 | ##' @param x \code{lvm}-object. 8 | ##' @param vars Character vector or formula specifying variables to include in 9 | ##' subset. 10 | ##' @param \dots Additional arguments to be passed to the low level functions 11 | ##' @return A \code{lvm}-object. 12 | ##' @author Klaus K. Holst 13 | ##' @keywords models regression 14 | ##' @examples 15 | ##' 16 | ##' m <- lvm(c(y1,y2)~x1+x2) 17 | ##' subset(m,~y1+x1) 18 | ##' 19 | ##' @export 20 | ##' @method subset lvm 21 | subset.lvm <- function(x, vars, ...) { 22 | if (missing(vars)) return(x) 23 | if (inherits(vars,"formula")) vars <- all.vars(vars) 24 | if (!all(vars%in%vars(x))) stop("Not a subset of model") 25 | latentvars <- intersect(vars,latent(x)) 26 | ## g0 <- subGraph(vars, Graph(x)) 27 | ## res <- graph2lvm(g0) 28 | res <- lvm(vars) 29 | M <- t(x$M[vars,vars,drop=FALSE]) 30 | for (i in seq_len(nrow(M))) { 31 | if (any(M[,i]==1)) { 32 | res <- regression(res, y=rownames(M)[M[,i]==1], x=rownames(M)[i], ...) 33 | } 34 | } 35 | if (length(latentvars)>0) 36 | latent(res) <- latentvars 37 | res$cov[vars,vars] <- x$cov[vars,vars] 38 | ## Fixed parameters: 39 | res$par[vars,vars] <- x$par[vars,vars] 40 | res$fix[vars,vars] <- x$fix[vars,vars] 41 | res$covpar[vars,vars] <- x$covpar[vars,vars] 42 | res$covfix[vars,vars] <- x$covfix[vars,vars] 43 | res$mean[vars] <- x$mean[vars] 44 | res$attributes <- x$attributes 45 | for (i in seq_along(x$attributes)) { 46 | val <- x$attributes[[i]] 47 | if (length(val)>0) { 48 | val <- val[intersect(vars,names(val))] 49 | res$attributes[[i]] <- val 50 | } 51 | } 52 | index(res) <- reindex(res) 53 | return(res) 54 | } 55 | -------------------------------------------------------------------------------- /R/toformula.R: -------------------------------------------------------------------------------- 1 | ##' Converts strings to formula 2 | ##' 3 | ##' Converts a vector of predictors and a vector of responses (characters) i#nto 4 | ##' a formula expression. 5 | ##' 6 | ##' 7 | ##' @param y vector of predictors 8 | ##' @param x vector of responses 9 | ##' @return An object of class \code{formula} 10 | ##' @author Klaus K. Holst 11 | ##' @seealso \code{\link{as.formula}}, 12 | ##' @keywords models utilities 13 | ##' @examples 14 | ##' 15 | ##' toformula(c("age","gender"), "weight") 16 | ##' 17 | ##' @export 18 | toformula <- function (y = ".", x = ".") 19 | { 20 | xst <- x[1] 21 | xn <- length(x) 22 | if (xn > 1) 23 | for (i in 2:length(x)) { 24 | xst <- paste(xst, "+", x[i]) 25 | } 26 | yst <- y[1] 27 | yn <- length(y) 28 | if (yn > 1) { 29 | yst <- paste0("c(", yst) 30 | for (i in 2:length(y)) { 31 | yst <- paste0(yst, ", ", y[i]) 32 | } 33 | yst <- paste0(yst, ")") 34 | } 35 | ff <- paste(yst, "~", xst) 36 | return(as.formula(ff)) 37 | } 38 | -------------------------------------------------------------------------------- /R/tr.R: -------------------------------------------------------------------------------- 1 | ##' Trace operator 2 | ##' 3 | ##' Calculates the trace of a square matrix. 4 | ##' @param x Square numeric matrix 5 | ##' @param \dots Additional arguments to lower level functions 6 | ##' @return \code{numeric} 7 | ##' @author Klaus K. Holst 8 | ##' @seealso \code{\link{crossprod}}, \code{\link{tcrossprod}} 9 | ##' @keywords math algebra 10 | ##' @examples 11 | ##' 12 | ##' tr(diag(1:5)) 13 | ##' @export 14 | "tr" <- function(x,...) UseMethod("tr") 15 | 16 | ##' @export 17 | `tr.matrix` <- 18 | function(x,na.rm=FALSE,...) { 19 | if (length(x)==1) 20 | return(x) 21 | n <- nrow(x) 22 | if (!n) 23 | stop("0 x 0 matrix") 24 | if (n != ncol(x)) 25 | stop("non-square matrix") 26 | if (!na.rm && any(!is.finite(x))) 27 | stop("infinite or missing values") 28 | return(sum(diag(x),na.rm=na.rm)) 29 | } 30 | -------------------------------------------------------------------------------- /R/trim.R: -------------------------------------------------------------------------------- 1 | ##' Trim string of (leading/trailing/all) white spaces 2 | ##' @title Trim string of (leading/trailing/all) white spaces 3 | ##' @param x String 4 | ##' @param all Trim all whitespaces? 5 | ##' @param \dots additional arguments to lower level functions 6 | ##' @author Klaus K. Holst 7 | ##' @export 8 | trim <- function(x,all=FALSE,...) { 9 | ## y <- gsub("^ .", "", x) # remove leading white space 10 | ## y <- gsub(". $", "", x) # remove trailing white space 11 | if (!all) return(gsub("^\\s+|\\s+$", "", x)) 12 | return(gsub("\\s","",x)) 13 | } 14 | -------------------------------------------------------------------------------- /R/var_ic.R: -------------------------------------------------------------------------------- 1 | #' @export 2 | var_ic <- function(x, ...) { 3 | N <- crossprod(!is.na(x)) 4 | V <- var(x, use="pairwise.complete.obs")*(N-1)/N^2 5 | V[N==0] <- 0 6 | return(V) 7 | } 8 | -------------------------------------------------------------------------------- /R/variances.R: -------------------------------------------------------------------------------- 1 | ### Return position of variance elements in the parameter vector (without mean parameters) 2 | ### Optimization constraints are needed on these parameters 3 | ##' @export 4 | variances <- function(x,mean=FALSE) { 5 | ## if (is.null(x$parpos)) 6 | ## x$parpos <- parpos(x) 7 | x$parpos <- parpos(Model(x),mean=TRUE) 8 | res <- diag(x$parpos$P)[which(diag(index(x)$P0)==1)] 9 | if (!mean) { 10 | return(res - index(x)$npar.mean) 11 | } 12 | return(res) 13 | } 14 | ## And the off-diagonal (covariance) parameters 15 | ##' @export 16 | offdiags <- function(x,mean=FALSE) { 17 | parpos <- parpos(x,mean=mean) 18 | pp <- parpos$P 19 | pp[lower.tri(pp)][(index(x)$P0)[lower.tri(pp)]==1] 20 | } 21 | -------------------------------------------------------------------------------- /R/vcov.R: -------------------------------------------------------------------------------- 1 | ##' @export 2 | vcov.lvmfit <- function(object,...) { 3 | res <- object$vcov 4 | if (inherits(object,"lvm.missing")) { 5 | resnames <- names(coef(object)) 6 | 7 | } else { 8 | resnames <- coef(Model(object),fix=FALSE, mean=object$control$meanstructure) 9 | } 10 | colnames(res) <- rownames(res) <- resnames 11 | return(res) 12 | } 13 | 14 | ##' @export 15 | vcov.multigroupfit <- function(object,...) { 16 | res <- object$vcov 17 | colnames(res) <- rownames(res) <- object$model$name 18 | return(res) 19 | } 20 | -------------------------------------------------------------------------------- /R/vec.R: -------------------------------------------------------------------------------- 1 | ##' vec operator 2 | ##' 3 | ##' Convert array into vector 4 | ##' @title vec operator 5 | ##' @param x Array 6 | ##' @param matrix If TRUE a row vector (matrix) is returned 7 | ##' @param sep Seperator 8 | ##' @param ... Additional arguments 9 | ##' @author Klaus Holst 10 | ##' @export 11 | vec <- function(x,matrix=FALSE,sep=".",...) { 12 | if (is.vector(x) && !is.list(x)) { 13 | res <- x 14 | } else if (is.list(x)) { 15 | res <- stats::setNames(unlist(x),names(x)) 16 | } else { 17 | if (is.matrix(x) && is.null(rownames(x))) { 18 | nn <- colnames(x) 19 | } else { 20 | nn <- apply(expand.grid(dimnames(x)),1,function(x) paste(x,collapse=sep)) 21 | } 22 | res <- as.vector(x); names(res) <- nn 23 | } 24 | if (matrix) return(cbind(res)) 25 | return(res) 26 | } 27 | -------------------------------------------------------------------------------- /R/wait.R: -------------------------------------------------------------------------------- 1 | ##' Wait for user input (keyboard or mouse) 2 | ##' 3 | ##' @title Wait for user input (keyboard or mouse) 4 | ##' @aliases waitclick 5 | ##' @author Klaus K. Holst 6 | ##' @export 7 | ##' @keywords iplot 8 | wait <- function() { 9 | cat(gettext("\nPress to continue...")) 10 | res <- try(scan("", what=0, quiet=TRUE, nlines=1), silent=TRUE) 11 | } 12 | waitclick <- function() if(is.null(locator(1))) invisible(NULL) 13 | 14 | -------------------------------------------------------------------------------- /R/weights.R: -------------------------------------------------------------------------------- 1 | ##' @export 2 | `Weights` <- function(x,...) UseMethod("Weights") 3 | 4 | ##' @export 5 | Weights.default <- function(x,...) eval(x$weights) 6 | -------------------------------------------------------------------------------- /R/wrapvec.R: -------------------------------------------------------------------------------- 1 | ##' Wrap vector 2 | ##' 3 | ##' Wrap vector 4 | ##' @param x Vector or integer 5 | ##' @param delta Shift 6 | ##' @param ... Additional parameters 7 | ##' @export 8 | ##' @examples 9 | ##' wrapvec(5,2) 10 | wrapvec <- function(x,delta=0L,...) { 11 | if (length(x)==1 && floor(x)==x && x>0) { 12 | x <- seq(x) 13 | } 14 | if (delta==0L) return(x) 15 | x[(seq_along(x)+delta-1L)%%length(x)+1L] 16 | } 17 | -------------------------------------------------------------------------------- /R/zgetsas.R: -------------------------------------------------------------------------------- 1 | ##' Run SAS code like in the following: 2 | ##' 3 | ##' ODS CSVALL BODY="myest.csv"; 4 | ##' proc nlmixed data=aj qpoints=2 dampstep=0.5; 5 | ##' ... 6 | ##' run; 7 | ##' ODS CSVALL Close; 8 | ##' 9 | ##' and read results into R with: 10 | ##' 11 | ##' \code{getsas("myest.csv","Parameter Estimates")} 12 | ##' 13 | ##' @title Read SAS output 14 | ##' @param infile file (csv file generated by ODS) 15 | ##' @param entry Name of entry to capture 16 | ##' @param \dots additional arguments to lower level functions 17 | ##' @author Klaus K. Holst 18 | ##' @export 19 | ##' @seealso getMplus 20 | getSAS <- function(infile,entry="Parameter Estimates",...) { 21 | con <- file(infile, blocking = FALSE) 22 | inp <- readLines(con) 23 | close(con) 24 | linestart <- 1; lineend <- length(inp) 25 | idx <- sapply(inp,function(x) length(grep(entry, x))>0) 26 | if (sum(idx)==1) { 27 | linestart <- which(idx) 28 | for (i in seq(linestart,length(inp))) { 29 | lineend <- i-1 30 | if (inp[i]=="") break; 31 | } 32 | } else { 33 | stop("No match or duplicate entries!") 34 | } 35 | subinp <- inp[(linestart+1):(lineend)] 36 | con <- textConnection(subinp) 37 | res <- read.csv(con,header=TRUE) 38 | close(con) 39 | return(res) 40 | } 41 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | destination: docs 2 | 3 | template: 4 | params: 5 | bootswatch: spacelab 6 | -------------------------------------------------------------------------------- /data/bmd.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kkholst/lava/771d62a062f5705e07cc0a1ad7565d68c331436d/data/bmd.rda -------------------------------------------------------------------------------- /data/bmidata.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kkholst/lava/771d62a062f5705e07cc0a1ad7565d68c331436d/data/bmidata.rda -------------------------------------------------------------------------------- /data/brisa.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kkholst/lava/771d62a062f5705e07cc0a1ad7565d68c331436d/data/brisa.rda -------------------------------------------------------------------------------- /data/calcium.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kkholst/lava/771d62a062f5705e07cc0a1ad7565d68c331436d/data/calcium.rda -------------------------------------------------------------------------------- /data/hubble.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kkholst/lava/771d62a062f5705e07cc0a1ad7565d68c331436d/data/hubble.rda -------------------------------------------------------------------------------- /data/hubble2.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kkholst/lava/771d62a062f5705e07cc0a1ad7565d68c331436d/data/hubble2.rda -------------------------------------------------------------------------------- /data/indoorenv.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kkholst/lava/771d62a062f5705e07cc0a1ad7565d68c331436d/data/indoorenv.rda -------------------------------------------------------------------------------- /data/missingdata.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kkholst/lava/771d62a062f5705e07cc0a1ad7565d68c331436d/data/missingdata.rda -------------------------------------------------------------------------------- /data/nldata.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kkholst/lava/771d62a062f5705e07cc0a1ad7565d68c331436d/data/nldata.rda -------------------------------------------------------------------------------- /data/nsem.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kkholst/lava/771d62a062f5705e07cc0a1ad7565d68c331436d/data/nsem.rda -------------------------------------------------------------------------------- /data/semdata.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kkholst/lava/771d62a062f5705e07cc0a1ad7565d68c331436d/data/semdata.rda -------------------------------------------------------------------------------- /data/serotonin.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kkholst/lava/771d62a062f5705e07cc0a1ad7565d68c331436d/data/serotonin.rda -------------------------------------------------------------------------------- /data/serotonin2.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kkholst/lava/771d62a062f5705e07cc0a1ad7565d68c331436d/data/serotonin2.rda -------------------------------------------------------------------------------- /data/twindata.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kkholst/lava/771d62a062f5705e07cc0a1ad7565d68c331436d/data/twindata.rda -------------------------------------------------------------------------------- /demo/00Index: -------------------------------------------------------------------------------- 1 | lava All demos 2 | model Model specification 3 | simulation Simulation 4 | estimation Estimation 5 | inference Inference 6 | -------------------------------------------------------------------------------- /demo/estimation.R: -------------------------------------------------------------------------------- 1 | example(estimate) 2 | example(constrain) 3 | example(zigreg) 4 | -------------------------------------------------------------------------------- /demo/inference.R: -------------------------------------------------------------------------------- 1 | example(gof) 2 | example(effects) 3 | example(estimate.default) 4 | example(modelsearch) 5 | example(predict.lvm) 6 | -------------------------------------------------------------------------------- /demo/lava.R: -------------------------------------------------------------------------------- 1 | demo(lava:::model) 2 | demo(lava:::simulation) 3 | demo(lava:::estimation) 4 | demo(lava:::inference) 5 | 6 | -------------------------------------------------------------------------------- /demo/model.R: -------------------------------------------------------------------------------- 1 | example(lvm) 2 | example(regression) 3 | example(covariance) 4 | example(intercept) 5 | example(labels) 6 | example(plot.lvm) 7 | -------------------------------------------------------------------------------- /demo/simulation.R: -------------------------------------------------------------------------------- 1 | example(sim) 2 | example(eventTime) 3 | -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | author1 <- "Klaus K. Holst and Esben Budtz-Joergensen" 2 | year1 <- 2013 3 | journal1 <- "Computational Statistics" 4 | title1 <- "Linear Latent Variable Models: The lava-package" 5 | doi1 <- "10.1007/s00180-012-0344-y" 6 | volume1 <- 28 7 | number1 <- 4 8 | pages1 <- "1385-1452" 9 | textver1 <- paste(author1, " (", year1, "). ", 10 | title1, ". ", journal1, 11 | ", ", volume1, " (", number1 ,")", 12 | ", pp. ", pages1, 13 | ". doi: ", doi1, ".", sep="") 14 | 15 | author2 <- "Klaus K. Holst and Esben Budtz-Joergensen" 16 | year2 <- 2020 17 | journal2 <- "Biostatistics" 18 | title2 <- "A two-stage estimation procedure for non-linear structural equation models" 19 | doi2 <- "10.1093/biostatistics/kxy082" 20 | volume2 <- 21 21 | number2 <- 4 22 | pages2 <- "676-691" 23 | textver2 <- paste(author2, " (", year2, "). ", 24 | title2, ". ", journal2, 25 | ", ", 26 | volume2, " (", number2 ,")", 27 | ", pp. ", pages2, 28 | ". doi: ", doi2, ".", sep="") 29 | 30 | 31 | citHeader("To cite 'lava' in publications use:") 32 | 33 | bibentry(bibtype="Article", 34 | title = title1, 35 | author = author1, 36 | year = year1, 37 | volume = volume1, 38 | number = number1, 39 | pages = pages1, 40 | journal = journal1, 41 | doi = doi1, 42 | textVersion = textver1) 43 | 44 | 45 | bibentry(bibtype="Article", 46 | title = title2, 47 | author = author2, 48 | year = year2, 49 | volume = volume2, 50 | number = number2, 51 | pages = pages2, 52 | journal = journal2, 53 | doi = doi2, 54 | textVersion = textver2) 55 | 56 | 57 | -------------------------------------------------------------------------------- /man/By.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/By.R 3 | \name{By} 4 | \alias{By} 5 | \title{Apply a Function to a Data Frame Split by Factors} 6 | \usage{ 7 | By(x, INDICES, FUN, COLUMNS, array = FALSE, ...) 8 | } 9 | \arguments{ 10 | \item{x}{Data frame} 11 | 12 | \item{INDICES}{Indices (vector or list of indices, vector of column names, or formula of column names)} 13 | 14 | \item{FUN}{A function to be applied to data frame subsets of 'data'.} 15 | 16 | \item{COLUMNS}{(Optional) subset of columns of x to work on} 17 | 18 | \item{array}{if TRUE an array/matrix is always returned} 19 | 20 | \item{...}{Additional arguments to lower-level functions} 21 | } 22 | \description{ 23 | Apply a Function to a Data Frame Split by Factors 24 | } 25 | \details{ 26 | Simple wrapper of the 'by' function 27 | } 28 | \examples{ 29 | By(datasets::CO2,~Treatment+Type,colMeans,~conc) 30 | By(datasets::CO2,~Treatment+Type,colMeans,~conc+uptake) 31 | } 32 | \author{ 33 | Klaus K. Holst 34 | } 35 | -------------------------------------------------------------------------------- /man/Col.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/Col.R 3 | \name{Col} 4 | \alias{Col} 5 | \title{Generate a transparent RGB color} 6 | \usage{ 7 | Col(col, alpha = 0.2, locate = 0) 8 | } 9 | \arguments{ 10 | \item{col}{Color (numeric or character)} 11 | 12 | \item{alpha}{Degree of transparency (0,1)} 13 | 14 | \item{locate}{Choose colour (with mouse)} 15 | } 16 | \value{ 17 | A character vector with elements of 7 or 9 characters, `#` 18 | followed by the red, blue, green and optionally alpha values in 19 | hexadecimal (after rescaling to '0 ... 255'). 20 | } 21 | \description{ 22 | This function transforms a standard color (e.g. "red") into an 23 | transparent RGB-color (i.e. alpha-blend<1). 24 | } 25 | \details{ 26 | This only works for certain graphics devices (Cairo-X11 (x11 as of R>=2.7), quartz, pdf, ...). 27 | } 28 | \examples{ 29 | plot(runif(1000),cex=runif(1000,0,4),col=Col(c("darkblue","orange"),0.5),pch=16) 30 | } 31 | \author{ 32 | Klaus K. Holst 33 | } 34 | \keyword{color} 35 | -------------------------------------------------------------------------------- /man/Combine.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/combine.R 3 | \name{Combine} 4 | \alias{Combine} 5 | \title{Report estimates across different models} 6 | \usage{ 7 | Combine(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{list of model objects} 11 | 12 | \item{...}{additional arguments to lower-level functions} 13 | } 14 | \description{ 15 | Report estimates across different models 16 | } 17 | \examples{ 18 | data(serotonin) 19 | m1 <- lm(cau ~ age*gene1 + age*gene2,data=serotonin) 20 | m2 <- lm(cau ~ age + gene1,data=serotonin) 21 | m3 <- lm(cau ~ age*gene2,data=serotonin) 22 | 23 | Combine(list(A=m1,B=m2,C=m3),fun=function(x) 24 | c("_____"="",R2=" "\%++\%format(summary(x)$r.squared,digits=2))) 25 | } 26 | \author{ 27 | Klaus K. Holst 28 | } 29 | -------------------------------------------------------------------------------- /man/Expand.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/Expand.R 3 | \name{Expand} 4 | \alias{Expand} 5 | \title{Create a Data Frame from All Combinations of Factors} 6 | \usage{ 7 | Expand(`_data`, ...) 8 | } 9 | \arguments{ 10 | \item{_data}{Data.frame} 11 | 12 | \item{...}{vectors, factors or a list containing these} 13 | } 14 | \description{ 15 | Create a Data Frame from All Combinations of Factors 16 | } 17 | \details{ 18 | Simple wrapper of the 'expand.grid' function. If x is a table 19 | then a data frame is returned with one row pr individual 20 | observation. 21 | } 22 | \examples{ 23 | dd <- Expand(iris, Sepal.Length=2:8, Species=c("virginica","setosa")) 24 | summary(dd) 25 | 26 | T <- with(warpbreaks, table(wool, tension)) 27 | Expand(T) 28 | } 29 | \author{ 30 | Klaus K. Holst 31 | } 32 | -------------------------------------------------------------------------------- /man/Graph.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/graph.R 3 | \name{Graph} 4 | \alias{Graph} 5 | \alias{Graph<-} 6 | \title{Extract graph} 7 | \usage{ 8 | Graph(x, ...) 9 | 10 | Graph(x, ...) <- value 11 | } 12 | \arguments{ 13 | \item{x}{Model object} 14 | 15 | \item{\dots}{Additional arguments to be passed to the low level functions} 16 | 17 | \item{value}{New \code{graphNEL} object} 18 | } 19 | \description{ 20 | Extract or replace graph object 21 | } 22 | \examples{ 23 | 24 | m <- lvm(y~x) 25 | Graph(m) 26 | 27 | } 28 | \seealso{ 29 | \code{\link{Model}} 30 | } 31 | \author{ 32 | Klaus K. Holst 33 | } 34 | \keyword{graphs} 35 | \keyword{models} 36 | -------------------------------------------------------------------------------- /man/Grep.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/Grep.R 3 | \name{Grep} 4 | \alias{Grep} 5 | \title{Finds elements in vector or column-names in data.frame/matrix} 6 | \usage{ 7 | Grep(x, pattern, subset = TRUE, ignore.case = TRUE, ...) 8 | } 9 | \arguments{ 10 | \item{x}{vector, matrix or data.frame.} 11 | 12 | \item{pattern}{regular expression to search for} 13 | 14 | \item{subset}{If TRUE returns subset of data.frame/matrix otherwise just the matching column names} 15 | 16 | \item{ignore.case}{Default ignore case} 17 | 18 | \item{...}{Additional arguments to 'grep'} 19 | } 20 | \value{ 21 | A data.frame with 2 columns with the indices in the first and the 22 | matching names in the second. 23 | } 24 | \description{ 25 | Pattern matching in a vector or column names of a data.frame or matrix. 26 | } 27 | \examples{ 28 | data(iris) 29 | head(Grep(iris,"(len)|(sp)")) 30 | } 31 | \seealso{ 32 | \code{\link{grep}}, and \code{\link{agrep}} for approximate string 33 | matching, 34 | } 35 | \author{ 36 | Klaus K. Holst 37 | } 38 | \keyword{misc} 39 | \keyword{utilities} 40 | -------------------------------------------------------------------------------- /man/IC.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/IC.R 3 | \name{IC} 4 | \alias{IC} 5 | \alias{IC.default} 6 | \alias{var_ic} 7 | \title{Extract i.i.d. decomposition (influence function) from model object} 8 | \usage{ 9 | IC(x,...) 10 | 11 | \method{IC}{default}(x, bread, id=NULL, folds=0, maxsize=(folds>0)*1e6,...) 12 | } 13 | \arguments{ 14 | \item{x}{model object} 15 | 16 | \item{...}{additional arguments} 17 | 18 | \item{id}{(optional) id/cluster variable} 19 | 20 | \item{bread}{(optional) Inverse of derivative of mean score function} 21 | 22 | \item{folds}{(optional) Calculate aggregated iid decomposition (0:=disabled)} 23 | 24 | \item{maxsize}{(optional) Data is split in groups of size up to 'maxsize' 25 | (0:=disabled)} 26 | } 27 | \description{ 28 | Extract i.i.d. decomposition (influence function) from model object 29 | } 30 | \examples{ 31 | m <- lvm(y~x+z) 32 | distribution(m, ~y+z) <- binomial.lvm("logit") 33 | d <- sim(m,1e3) 34 | g <- glm(y~x+z,data=d,family=binomial) 35 | var_ic(IC(g)) 36 | 37 | } 38 | -------------------------------------------------------------------------------- /man/Missing.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/Missing.R 3 | \name{Missing} 4 | \alias{Missing} 5 | \alias{Missing,} 6 | \alias{Missing<-} 7 | \title{Missing value generator} 8 | \usage{ 9 | Missing(object, formula, Rformula, missing.name, suffix = "0", ...) 10 | } 11 | \arguments{ 12 | \item{object}{\code{lvm}-object.} 13 | 14 | \item{formula}{The right hand side specifies the name of a latent 15 | variable which is not always observed. The left hand side 16 | specifies the name of a new variable which is equal to the latent 17 | variable but has missing values. If given as a string then this 18 | is used as the name of the latent (full-data) name, and the 19 | observed data name is 'missing.data'} 20 | 21 | \item{Rformula}{Missing data mechanism with left hand side 22 | specifying the name of the observed data indicator (may also just 23 | be given as a character instead of a formula)} 24 | 25 | \item{missing.name}{Name of observed data variable (only used if 26 | 'formula' was given as a character specifying the name of the 27 | full-data variable)} 28 | 29 | \item{suffix}{If missing.name is missing, then the name of the 30 | oberved data variable will be the name of the full-data variable + 31 | the suffix} 32 | 33 | \item{...}{Passed to binomial.lvm.} 34 | } 35 | \value{ 36 | lvm object 37 | } 38 | \description{ 39 | Missing value generator 40 | } 41 | \details{ 42 | This function adds a binary variable to a given \code{lvm} model 43 | and also a variable which is equal to the original variable where 44 | the binary variable is equal to zero 45 | } 46 | \examples{ 47 | library(lava) 48 | set.seed(17) 49 | m <- lvm(y0~x01+x02+x03) 50 | m <- Missing(m,formula=x1~x01,Rformula=R1~0.3*x02+-0.7*x01,p=0.4) 51 | sim(m,10) 52 | 53 | 54 | m <- lvm(y~1) 55 | m <- Missing(m,"y","r") 56 | ## same as 57 | ## m <- Missing(m,y~1,r~1) 58 | sim(m,10) 59 | 60 | ## same as 61 | m <- lvm(y~1) 62 | Missing(m,"y") <- r~x 63 | sim(m,10) 64 | 65 | m <- lvm(y~1) 66 | m <- Missing(m,"y","r",suffix=".") 67 | ## same as 68 | ## m <- Missing(m,"y","r",missing.name="y.") 69 | ## same as 70 | ## m <- Missing(m,y.~y,"r") 71 | sim(m,10) 72 | 73 | } 74 | \author{ 75 | Thomas A. Gerds 76 | } 77 | -------------------------------------------------------------------------------- /man/Model.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/model.R 3 | \name{Model} 4 | \alias{Model} 5 | \alias{Model<-} 6 | \title{Extract model} 7 | \usage{ 8 | Model(x, ...) 9 | 10 | Model(x, ...) <- value 11 | } 12 | \arguments{ 13 | \item{x}{Fitted model} 14 | 15 | \item{\dots}{Additional arguments to be passed to the low level functions} 16 | 17 | \item{value}{New model object (e.g. \code{lvm} or \code{multigroup})} 18 | } 19 | \value{ 20 | Returns a model object (e.g. \code{lvm} or \code{multigroup}) 21 | } 22 | \description{ 23 | Extract or replace model object 24 | } 25 | \examples{ 26 | 27 | m <- lvm(y~x) 28 | e <- estimate(m, sim(m,100)) 29 | Model(e) 30 | 31 | } 32 | \seealso{ 33 | \code{\link{Graph}} 34 | } 35 | \author{ 36 | Klaus K. Holst 37 | } 38 | \keyword{models} 39 | -------------------------------------------------------------------------------- /man/NA2x.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/NA2x.R 3 | \name{NA2x} 4 | \alias{NA2x} 5 | \alias{x2NA} 6 | \title{Convert to/from NA} 7 | \usage{ 8 | NA2x(s, x = 0) 9 | } 10 | \arguments{ 11 | \item{s}{The input vector (of arbitrary class)} 12 | 13 | \item{x}{The elements to transform into \code{NA} resp. what to transform 14 | \code{NA} into.} 15 | } 16 | \value{ 17 | A vector with same dimension and class as \code{s}. 18 | } 19 | \description{ 20 | Convert vector to/from NA 21 | } 22 | \examples{ 23 | ##' 24 | x2NA(1:10, 1:5) 25 | NA2x(x2NA(c(1:10),5),5)##' 26 | } 27 | \author{ 28 | Klaus K. Holst 29 | } 30 | \keyword{manip} 31 | -------------------------------------------------------------------------------- /man/NR.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/optims.R 3 | \name{NR} 4 | \alias{NR} 5 | \title{Newton-Raphson method} 6 | \usage{ 7 | NR( 8 | start, 9 | objective = NULL, 10 | gradient = NULL, 11 | hessian = NULL, 12 | control, 13 | args = NULL, 14 | ... 15 | ) 16 | } 17 | \arguments{ 18 | \item{start}{Starting value} 19 | 20 | \item{objective}{Optional objective function (used for selecting step length)} 21 | 22 | \item{gradient}{gradient} 23 | 24 | \item{hessian}{hessian (if NULL a numerical derivative is used)} 25 | 26 | \item{control}{optimization arguments (see details)} 27 | 28 | \item{args}{Optional list of arguments parsed to objective, gradient and hessian} 29 | 30 | \item{...}{additional arguments parsed to lower level functions} 31 | } 32 | \description{ 33 | Newton-Raphson method 34 | } 35 | \details{ 36 | \code{control} should be a list with one or more of the following components: 37 | \itemize{ 38 | \item{trace} integer for which output is printed each 'trace'th iteration 39 | \item{iter.max} number of iterations 40 | \item{stepsize}: Step size (default 1) 41 | \item{nstepsize}: Increase stepsize every nstepsize iteration (from stepsize to 1) 42 | \item{tol}: Convergence criterion (gradient) 43 | \item{epsilon}: threshold used in pseudo-inverse 44 | \item{backtrack}: In each iteration reduce stepsize unless solution is improved according to criterion (gradient, armijo, curvature, wolfe) 45 | } 46 | } 47 | \examples{ 48 | # Objective function with gradient and hessian as attributes 49 | f <- function(z) { 50 | x <- z[1]; y <- z[2] 51 | val <- x^2 + x*y^2 + x + y 52 | structure(val, gradient=c(2*x+y^2+1, 2*y*x+1), 53 | hessian=rbind(c(2,2*y),c(2*y,2*x))) 54 | } 55 | NR(c(0,0),f) 56 | 57 | # Parsing arguments to the function and 58 | g <- function(x,y) (x*y+1)^2 59 | NR(0, gradient=g, args=list(y=2), control=list(trace=1,tol=1e-20)) 60 | 61 | 62 | } 63 | -------------------------------------------------------------------------------- /man/PD.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/zib.R 3 | \name{PD} 4 | \alias{PD} 5 | \title{Dose response calculation for binomial regression models} 6 | \usage{ 7 | PD( 8 | model, 9 | intercept = 1, 10 | slope = 2, 11 | prob = NULL, 12 | x, 13 | level = 0.5, 14 | ci.level = 0.95, 15 | vcov, 16 | family, 17 | EB = NULL 18 | ) 19 | } 20 | \arguments{ 21 | \item{model}{Model object or vector of parameter estimates} 22 | 23 | \item{intercept}{Index of intercept parameters} 24 | 25 | \item{slope}{Index of intercept parameters} 26 | 27 | \item{prob}{Index of mixture parameters (only relevant for 28 | \code{zibreg} models)} 29 | 30 | \item{x}{Optional weights 31 | length(x)=length(intercept)+length(slope)+length(prob)} 32 | 33 | \item{level}{Probability at which level to calculate dose} 34 | 35 | \item{ci.level}{Level of confidence limits} 36 | 37 | \item{vcov}{Optional estimate of variance matrix of parameter 38 | estimates} 39 | 40 | \item{family}{Optional distributional family argument} 41 | 42 | \item{EB}{Optional ratio of treatment effect and adverse effects 43 | used to find optimal dose (regret-function argument)} 44 | } 45 | \description{ 46 | Dose response calculation for binomial regression models 47 | } 48 | \author{ 49 | Klaus K. Holst 50 | } 51 | -------------------------------------------------------------------------------- /man/Print.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sim.default.R 3 | \name{Print} 4 | \alias{Print} 5 | \title{Generic print method} 6 | \usage{ 7 | Print(x, n = 5, digits = max(3, getOption("digits") - 3), ...) 8 | } 9 | \arguments{ 10 | \item{x}{object to print} 11 | 12 | \item{n}{number of rows to show from top and bottom of tabular data} 13 | 14 | \item{digits}{precision} 15 | 16 | \item{...}{additional arguments to print method} 17 | } 18 | \description{ 19 | Nicer print method for tabular data. Falls back to standard print method for 20 | all other data types. 21 | } 22 | -------------------------------------------------------------------------------- /man/Range.lvm.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/constrain.R 3 | \name{Range.lvm} 4 | \alias{Range.lvm} 5 | \title{Define range constraints of parameters} 6 | \usage{ 7 | Range.lvm(a = 0, b = 1) 8 | } 9 | \arguments{ 10 | \item{a}{Lower bound} 11 | 12 | \item{b}{Upper bound} 13 | } 14 | \value{ 15 | function 16 | } 17 | \description{ 18 | Define range constraints of parameters 19 | } 20 | \author{ 21 | Klaus K. Holst 22 | } 23 | -------------------------------------------------------------------------------- /man/addvar.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/addvar.R 3 | \name{addvar} 4 | \alias{addvar} 5 | \alias{addvar<-} 6 | \title{Add variable to (model) object} 7 | \usage{ 8 | addvar(x, ...) 9 | } 10 | \arguments{ 11 | \item{x}{Model object} 12 | 13 | \item{\dots}{Additional arguments} 14 | } 15 | \description{ 16 | Generic method for adding variables to model object 17 | } 18 | \author{ 19 | Klaus K. Holst 20 | } 21 | -------------------------------------------------------------------------------- /man/backdoor.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/backdoor.R 3 | \name{backdoor} 4 | \alias{backdoor} 5 | \title{Backdoor criterion} 6 | \usage{ 7 | backdoor(object, f, cond, ..., return.graph = FALSE) 8 | } 9 | \arguments{ 10 | \item{object}{lvm object} 11 | 12 | \item{f}{formula. Conditioning, z, set can be given as y~x|z} 13 | 14 | \item{cond}{Vector of variables to conditon on} 15 | 16 | \item{...}{Additional arguments to lower level functions} 17 | 18 | \item{return.graph}{Return moral ancestral graph with z and effects from x removed} 19 | } 20 | \description{ 21 | Check backdoor criterion of a lvm object 22 | } 23 | \examples{ 24 | m <- lvm(y~c2,c2~c1,x~c1,m1~x,y~m1, v1~c3, x~c3,v1~y, 25 | x~z1, z2~z1, z2~z3, y~z3+z2+g1+g2+g3) 26 | ll <- backdoor(m, y~x) 27 | backdoor(m, y~x|c1+z1+g1) 28 | } 29 | -------------------------------------------------------------------------------- /man/baptize.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/baptize.R 3 | \name{baptize} 4 | \alias{baptize} 5 | \title{Label elements of object} 6 | \usage{ 7 | baptize(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{Object} 11 | 12 | \item{\dots}{Additional arguments} 13 | } 14 | \description{ 15 | Generic method for labeling elements of an object 16 | } 17 | \author{ 18 | Klaus K. Holst 19 | } 20 | -------------------------------------------------------------------------------- /man/binomial.rd.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/binomial.rrw.R 3 | \name{binomial.rd} 4 | \alias{binomial.rd} 5 | \alias{binomial.rr} 6 | \title{Define constant risk difference or relative risk association for binary exposure} 7 | \usage{ 8 | binomial.rd( 9 | x, 10 | response, 11 | exposure, 12 | target.model, 13 | nuisance.model, 14 | exposure.model = binomial.lvm(), 15 | ... 16 | ) 17 | } 18 | \arguments{ 19 | \item{x}{model} 20 | 21 | \item{response}{response variable (character or formula)} 22 | 23 | \item{exposure}{exposure variable (character or formula)} 24 | 25 | \item{target.model}{variable defining the linear predictor for the target model} 26 | 27 | \item{nuisance.model}{variable defining the linear predictor for the nuisance model} 28 | 29 | \item{exposure.model}{model for exposure (default binomial logit link)} 30 | 31 | \item{...}{additional arguments to lower level functions} 32 | } 33 | \description{ 34 | Set up model as defined in Richardson, Robins and Wang (2017). 35 | } 36 | -------------------------------------------------------------------------------- /man/blockdiag.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/blockdiag.R 3 | \name{blockdiag} 4 | \alias{blockdiag} 5 | \title{Combine matrices to block diagonal structure} 6 | \usage{ 7 | blockdiag(x, ..., pad = 0) 8 | } 9 | \arguments{ 10 | \item{x}{Matrix} 11 | 12 | \item{\dots}{Additional matrices} 13 | 14 | \item{pad}{Vyalue outside block-diagonal} 15 | } 16 | \description{ 17 | Combine matrices to block diagonal structure 18 | } 19 | \examples{ 20 | A <- diag(3)+1 21 | blockdiag(A,A,A,pad=NA) 22 | } 23 | \author{ 24 | Klaus K. Holst 25 | } 26 | -------------------------------------------------------------------------------- /man/bmd.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lava-package.R 3 | \docType{data} 4 | \name{bmd} 5 | \alias{bmd} 6 | \title{Longitudinal Bone Mineral Density Data (Wide format)} 7 | \format{ 8 | data.frame 9 | } 10 | \source{ 11 | Vonesh & Chinchilli (1997), Table 5.4.1 on page 228. 12 | } 13 | \description{ 14 | Bone Mineral Density Data consisting of 112 girls randomized to receive 15 | calcium og placebo. Longitudinal measurements of bone mineral density 16 | (g/cm^2) measured approximately every 6th month in 3 years. 17 | } 18 | \seealso{ 19 | calcium 20 | } 21 | \keyword{datasets} 22 | -------------------------------------------------------------------------------- /man/bmidata.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lava-package.R 3 | \docType{data} 4 | \name{bmidata} 5 | \alias{bmidata} 6 | \title{Data} 7 | \format{ 8 | data.frame 9 | } 10 | \description{ 11 | Description 12 | } 13 | \keyword{datasets} 14 | -------------------------------------------------------------------------------- /man/bootstrap.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/bootstrap.R 3 | \name{bootstrap} 4 | \alias{bootstrap} 5 | \title{Generic bootstrap method} 6 | \usage{ 7 | bootstrap(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{Model object} 11 | 12 | \item{\dots}{Additional arguments} 13 | } 14 | \description{ 15 | Generic method for calculating bootstrap statistics 16 | } 17 | \seealso{ 18 | \code{bootstrap.lvm} \code{bootstrap.lvmfit} 19 | } 20 | \author{ 21 | Klaus K. Holst 22 | } 23 | -------------------------------------------------------------------------------- /man/brisa.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lava-package.R 3 | \docType{data} 4 | \name{brisa} 5 | \alias{brisa} 6 | \title{Simulated data} 7 | \format{ 8 | data.frame 9 | } 10 | \source{ 11 | Simulated 12 | } 13 | \description{ 14 | Simulated data 15 | } 16 | \keyword{datasets} 17 | -------------------------------------------------------------------------------- /man/calcium.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lava-package.R 3 | \docType{data} 4 | \name{calcium} 5 | \alias{calcium} 6 | \title{Longitudinal Bone Mineral Density Data} 7 | \format{ 8 | A data.frame containing 560 (incomplete) observations. The 'person' 9 | column defines the individual girls of the study with measurements at 10 | visiting times 'visit', and age in years 'age' at the time of visit. The 11 | bone mineral density variable is 'bmd' (g/cm^2). 12 | } 13 | \source{ 14 | Vonesh & Chinchilli (1997), Table 5.4.1 on page 228. 15 | } 16 | \description{ 17 | Bone Mineral Density Data consisting of 112 girls randomized to receive 18 | calcium og placebo. Longitudinal measurements of bone mineral density 19 | (g/cm^2) measured approximately every 6th month in 3 years. 20 | } 21 | \keyword{datasets} 22 | -------------------------------------------------------------------------------- /man/cancel.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cancel.R 3 | \name{cancel} 4 | \alias{cancel} 5 | \alias{cancel<-} 6 | \title{Generic cancel method} 7 | \usage{ 8 | cancel(x, ...) 9 | } 10 | \arguments{ 11 | \item{x}{Object} 12 | 13 | \item{\dots}{Additioal arguments} 14 | } 15 | \description{ 16 | Generic cancel method 17 | } 18 | \author{ 19 | Klaus K. Holst 20 | } 21 | -------------------------------------------------------------------------------- /man/children.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/children.R 3 | \name{children} 4 | \alias{children} 5 | \alias{parents} 6 | \alias{ancestors} 7 | \alias{descendants} 8 | \alias{roots} 9 | \alias{sinks} 10 | \alias{adjMat} 11 | \alias{edgeList} 12 | \title{Extract children or parent elements of object} 13 | \usage{ 14 | children(object, ...) 15 | } 16 | \arguments{ 17 | \item{object}{Object} 18 | 19 | \item{\dots}{Additional arguments} 20 | } 21 | \description{ 22 | Generic method for memberships from object (e.g. a graph) 23 | } 24 | \author{ 25 | Klaus K. Holst 26 | } 27 | -------------------------------------------------------------------------------- /man/click.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/interactive.R 3 | \name{click} 4 | \alias{click} 5 | \alias{idplot} 6 | \alias{click.default} 7 | \alias{colsel} 8 | \title{Identify points on plot} 9 | \usage{ 10 | \method{click}{default}(x, y=NULL, label=TRUE, n=length(x), pch=19, col="orange", cex=3, ...) 11 | idplot(x, y ,..., id=list(), return.data=FALSE) 12 | } 13 | \arguments{ 14 | \item{x}{X coordinates} 15 | 16 | \item{\dots}{Additional arguments parsed to \code{plot} function} 17 | 18 | \item{y}{Y coordinates} 19 | 20 | \item{label}{Should labels be added?} 21 | 22 | \item{n}{Max number of inputs to expect} 23 | 24 | \item{pch}{Symbol} 25 | 26 | \item{col}{Colour} 27 | 28 | \item{cex}{Size} 29 | 30 | \item{id}{List of arguments parsed to \code{click} function} 31 | 32 | \item{return.data}{Boolean indicating if selected points should be returned} 33 | } 34 | \description{ 35 | Extension of the \code{identify} function 36 | } 37 | \details{ 38 | For the usual 'X11' device the identification process is 39 | terminated by pressing any mouse button other than the first. For 40 | the 'quartz' device the process is terminated by pressing either 41 | the pop-up menu equivalent (usually second mouse button or 42 | 'Ctrl'-click) or the 'ESC' key. 43 | } 44 | \examples{ 45 | if (interactive()) { 46 | n <- 10; x <- seq(n); y <- runif(n) 47 | plot(y ~ x); click(x,y) 48 | 49 | data(iris) 50 | l <- lm(Sepal.Length ~ Sepal.Width*Species,iris) 51 | res <- plotConf(l,var2="Species")## ylim=c(6,8), xlim=c(2.5,3.3)) 52 | with(res, click(x,y)) 53 | 54 | with(iris, idplot(Sepal.Length,Petal.Length)) 55 | } 56 | } 57 | \seealso{ 58 | \code{\link{idplot}}, \code{identify} 59 | } 60 | \author{ 61 | Klaus K. Holst 62 | } 63 | \keyword{iplot} 64 | -------------------------------------------------------------------------------- /man/closed.testing.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/multipletesting.R 3 | \name{closed.testing} 4 | \alias{closed.testing} 5 | \alias{p.correct} 6 | \title{Closed testing procedure} 7 | \usage{ 8 | closed.testing( 9 | object, 10 | idx = seq_along(coef(object)), 11 | null, 12 | return.all = FALSE, 13 | ... 14 | ) 15 | } 16 | \arguments{ 17 | \item{object}{estimate object} 18 | 19 | \item{idx}{Index of parameters to adjust for multiple testing} 20 | 21 | \item{null}{Null hypothesis value} 22 | 23 | \item{return.all}{If TRUE details on all intersection hypotheses are returned} 24 | 25 | \item{...}{Additional arguments} 26 | } 27 | \description{ 28 | Closed testing procedure 29 | } 30 | \examples{ 31 | m <- lvm() 32 | regression(m, c(y1,y2,y3,y4,y5,y6,y7)~x) <- c(0,0.25,0,0.25,0.25,0,0) 33 | regression(m, to=endogenous(m), from="u") <- 1 34 | variance(m,endogenous(m)) <- 1 35 | set.seed(2) 36 | d <- sim(m,200) 37 | l1 <- lm(y1~x,d) 38 | l2 <- lm(y2~x,d) 39 | l3 <- lm(y3~x,d) 40 | l4 <- lm(y4~x,d) 41 | l5 <- lm(y5~x,d) 42 | l6 <- lm(y6~x,d) 43 | l7 <- lm(y7~x,d) 44 | 45 | (a <- merge(l1,l2,l3,l4,l5,l6,l7,subset=2)) 46 | if (requireNamespace("mets",quietly=TRUE)) { 47 | p.correct(a) 48 | } 49 | as.vector(closed.testing(a)) 50 | 51 | } 52 | -------------------------------------------------------------------------------- /man/colorbar.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/zcolorbar.R 3 | \name{colorbar} 4 | \alias{colorbar} 5 | \title{Add color-bar to plot} 6 | \usage{ 7 | colorbar( 8 | clut = Col(rev(rainbow(11, start = 0, end = 0.69)), alpha), 9 | x.range = c(-0.5, 0.5), 10 | y.range = c(-0.1, 0.1), 11 | values = seq(clut), 12 | digits = 2, 13 | label.offset, 14 | srt = 45, 15 | cex = 0.5, 16 | border = NA, 17 | alpha = 0.5, 18 | position = 1, 19 | direction = c("horizontal", "vertical"), 20 | ... 21 | ) 22 | } 23 | \arguments{ 24 | \item{clut}{Color look-up table} 25 | 26 | \item{x.range}{x range} 27 | 28 | \item{y.range}{y range} 29 | 30 | \item{values}{label values} 31 | 32 | \item{digits}{number of digits} 33 | 34 | \item{label.offset}{label offset} 35 | 36 | \item{srt}{rotation of labels} 37 | 38 | \item{cex}{text size} 39 | 40 | \item{border}{border of color bar rectangles} 41 | 42 | \item{alpha}{Alpha (transparency) level 0-1} 43 | 44 | \item{position}{Label position left/bottom (1) or top/right (2) or no text (0)} 45 | 46 | \item{direction}{horizontal or vertical color bars} 47 | 48 | \item{\dots}{additional low level arguments (i.e. parsed to \code{text})} 49 | } 50 | \description{ 51 | Add color-bar to plot 52 | } 53 | \examples{ 54 | \dontrun{ 55 | plotNeuro(x,roi=R,mm=-18,range=5) 56 | colorbar(clut=Col(rev(rainbow(11,start=0,end=0.69)),0.5), 57 | x=c(-40,40),y.range=c(84,90),values=c(-5:5)) 58 | 59 | colorbar(clut=Col(rev(rainbow(11,start=0,end=0.69)),0.5), 60 | x=c(-10,10),y.range=c(-100,50),values=c(-5:5), 61 | direction="vertical",border=1) 62 | } 63 | } 64 | -------------------------------------------------------------------------------- /man/commutation.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/commutation.R 3 | \name{commutation} 4 | \alias{commutation} 5 | \title{Finds the unique commutation matrix} 6 | \usage{ 7 | commutation(m, n = m) 8 | } 9 | \arguments{ 10 | \item{m}{rows} 11 | 12 | \item{n}{columns} 13 | } 14 | \description{ 15 | Finds the unique commutation matrix K: 16 | \eqn{K vec(A) = vec(A^t)} 17 | } 18 | \author{ 19 | Klaus K. Holst 20 | } 21 | -------------------------------------------------------------------------------- /man/compare.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/compare.R 3 | \name{compare} 4 | \alias{compare} 5 | \title{Statistical tests} 6 | \usage{ 7 | compare(object, ...) 8 | } 9 | \arguments{ 10 | \item{object}{\code{lvmfit}-object} 11 | 12 | \item{\dots}{Additional arguments to low-level functions} 13 | } 14 | \value{ 15 | Matrix of test-statistics and p-values 16 | } 17 | \description{ 18 | Performs Likelihood-ratio, Wald and score tests 19 | } 20 | \examples{ 21 | m <- lvm(); 22 | regression(m) <- c(y1,y2,y3) ~ eta; latent(m) <- ~eta 23 | regression(m) <- eta ~ x 24 | m2 <- regression(m, c(y3,eta) ~ x) 25 | set.seed(1) 26 | d <- sim(m,1000) 27 | e <- estimate(m,d) 28 | e2 <- estimate(m2,d) 29 | 30 | compare(e) 31 | 32 | compare(e,e2) ## LRT, H0: y3<-x=0 33 | compare(e,scoretest=y3~x) ## Score-test, H0: y3~x=0 34 | compare(e2,par=c("y3~x")) ## Wald-test, H0: y3~x=0 35 | 36 | B <- diag(2); colnames(B) <- c("y2~eta","y3~eta") 37 | compare(e2,contrast=B,null=c(1,1)) 38 | 39 | B <- rep(0,length(coef(e2))); B[1:3] <- 1 40 | compare(e2,contrast=B) 41 | 42 | compare(e,scoretest=list(y3~x,y2~x)) 43 | } 44 | \seealso{ 45 | \code{\link{modelsearch}}, \code{\link{equivalence}} 46 | } 47 | \author{ 48 | Klaus K. Holst 49 | } 50 | \keyword{htest} 51 | -------------------------------------------------------------------------------- /man/complik.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/complik.R 3 | \name{complik} 4 | \alias{complik} 5 | \title{Composite Likelihood for probit latent variable models} 6 | \usage{ 7 | complik( 8 | x, 9 | data, 10 | k = 2, 11 | type = c("all", "nearest"), 12 | pairlist, 13 | messages = 0, 14 | estimator = "normal", 15 | quick = FALSE, 16 | ... 17 | ) 18 | } 19 | \arguments{ 20 | \item{x}{\code{lvm}-object} 21 | 22 | \item{data}{data.frame} 23 | 24 | \item{k}{Size of composite groups} 25 | 26 | \item{type}{Determines number of groups. With \code{type="nearest"} (default) 27 | only neighboring items will be grouped, e.g. for \code{k=2} 28 | (y1,y2),(y2,y3),... With \code{type="all"} all combinations of size \code{k} 29 | are included} 30 | 31 | \item{pairlist}{A list of indices specifying the composite groups. Optional 32 | argument which overrides \code{k} and \code{type} but gives complete 33 | flexibility in the specification of the composite likelihood} 34 | 35 | \item{messages}{Control amount of messages printed} 36 | 37 | \item{estimator}{Model (pseudo-likelihood) to use for the pairs/groups} 38 | 39 | \item{quick}{If TRUE the parameter estimates are calculated but all additional 40 | information such as standard errors are skipped} 41 | 42 | \item{\dots}{Additional arguments parsed on to lower-level functions} 43 | } 44 | \value{ 45 | An object of class \code{estimate.complik} inheriting methods from \code{lvm} 46 | } 47 | \description{ 48 | Estimate parameters in a probit latent variable model via a composite 49 | likelihood decomposition. 50 | } 51 | \examples{ 52 | m <- lvm(c(y1,y2,y3)~b*x+1*u[0],latent=~u) 53 | ordinal(m,K=2) <- ~y1+y2+y3 54 | d <- sim(m,50,seed=1) 55 | if (requireNamespace("mets", quietly=TRUE)) { 56 | e1 <- complik(m,d,control=list(trace=1),type="all") 57 | } 58 | } 59 | \seealso{ 60 | estimate 61 | } 62 | \author{ 63 | Klaus K. Holst 64 | } 65 | \keyword{models} 66 | \keyword{regression} 67 | -------------------------------------------------------------------------------- /man/confpred.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/confpred.R 3 | \name{confpred} 4 | \alias{confpred} 5 | \title{Conformal prediction} 6 | \usage{ 7 | confpred(object, data, newdata = data, alpha = 0.05, mad, ...) 8 | } 9 | \arguments{ 10 | \item{object}{Model object (lm, glm or similar with predict method) or formula (lm)} 11 | 12 | \item{data}{data.frame} 13 | 14 | \item{newdata}{New data.frame to make predictions for} 15 | 16 | \item{alpha}{Level of prediction interval} 17 | 18 | \item{mad}{Conditional model (formula) for the MAD (locally-weighted CP)} 19 | 20 | \item{...}{Additional arguments to lower level functions} 21 | } 22 | \value{ 23 | data.frame with fitted (fit), lower (lwr) and upper (upr) predictions bands. 24 | } 25 | \description{ 26 | Conformal predicions using locally weighted conformal inference with a split-conformal algorithm 27 | } 28 | \examples{ 29 | set.seed(123) 30 | n <- 200 31 | x <- seq(0,6,length.out=n) 32 | delta <- 3 33 | ss <- exp(-1+1.5*cos((x-delta))) 34 | ee <- rnorm(n,sd=ss) 35 | y <- (x-delta)+3*cos(x+4.5-delta)+ee 36 | d <- data.frame(y=y,x=x) 37 | 38 | newd <- data.frame(x=seq(0,6,length.out=50)) 39 | cc <- confpred(lm(y~splines::ns(x,knots=c(1,3,5)),data=d), data=d, newdata=newd) 40 | if (interactive()) { 41 | plot(y~x,pch=16,col=lava::Col("black"),ylim=c(-10,10),xlab="X",ylab="Y") 42 | with(cc, 43 | lava::confband(newd$x,lwr,upr,fit, 44 | lwd=3,polygon=TRUE,col=Col("blue"),border=FALSE)) 45 | } 46 | } 47 | -------------------------------------------------------------------------------- /man/contr.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/contr.R 3 | \name{contr} 4 | \alias{contr} 5 | \alias{parsedesign} 6 | \alias{pairwise.diff} 7 | \title{Create contrast matrix} 8 | \usage{ 9 | contr(p, n, diff = TRUE, ...) 10 | } 11 | \arguments{ 12 | \item{p}{index of non-zero entries (see example)} 13 | 14 | \item{n}{Total number of parameters (if omitted the max number in p will be used)} 15 | 16 | \item{diff}{If FALSE all non-zero entries are +1, otherwise the second non-zero element in each row will be -1.} 17 | 18 | \item{...}{Additional arguments to lower level functions} 19 | } 20 | \description{ 21 | Create contrast matrix typically for use with 'estimate' (Wald tests). 22 | } 23 | \examples{ 24 | contr(2,n=5) 25 | contr(as.list(2:4),n=5) 26 | contr(list(1,2,4),n=5) 27 | contr(c(2,3,4),n=5) 28 | contr(list(c(1,3),c(2,4)),n=5) 29 | contr(list(c(1,3),c(2,4),5)) 30 | 31 | parsedesign(c("aa","b","c"),"?","?",diff=c(FALSE,TRUE)) 32 | 33 | ## All pairs comparisons: 34 | pdiff <- function(n) lava::contr(lapply(seq(n-1), \(x) seq(x, n))) 35 | pdiff(4) 36 | } 37 | -------------------------------------------------------------------------------- /man/correlation.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/correlation.R 3 | \name{correlation} 4 | \alias{correlation} 5 | \title{Generic method for extracting correlation coefficients of model object} 6 | \usage{ 7 | correlation(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{Object} 11 | 12 | \item{\dots}{Additional arguments} 13 | } 14 | \description{ 15 | Generic correlation method 16 | } 17 | \author{ 18 | Klaus K. Holst 19 | } 20 | -------------------------------------------------------------------------------- /man/csplit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/csplit.R 3 | \name{csplit} 4 | \alias{csplit} 5 | \alias{foldr} 6 | \title{Split data into folds} 7 | \usage{ 8 | csplit(x, p = NULL, replace = FALSE, return.index = FALSE, k = 2, ...) 9 | } 10 | \arguments{ 11 | \item{x}{Data or integer (size)} 12 | 13 | \item{p}{Number of folds, or if a number between 0 and 1 is given two folds of size p and (1-p) will be returned} 14 | 15 | \item{replace}{With or with-out replacement} 16 | 17 | \item{return.index}{If TRUE index of folds are returned otherwise the actual data splits are returned (default)} 18 | 19 | \item{k}{(Optional, only used when p=NULL) number of folds without shuffling} 20 | 21 | \item{...}{additional arguments to lower-level functions} 22 | } 23 | \description{ 24 | Split data into folds 25 | } 26 | \examples{ 27 | foldr(5,2,rep=2) 28 | csplit(10,3) 29 | csplit(iris[1:10,]) ## Split in two sets 1:(n/2) and (n/2+1):n 30 | csplit(iris[1:10,],0.5) 31 | } 32 | \author{ 33 | Klaus K. Holst 34 | } 35 | -------------------------------------------------------------------------------- /man/curly.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/curly.R 3 | \name{curly} 4 | \alias{curly} 5 | \title{Adds curly brackets to plot} 6 | \usage{ 7 | curly( 8 | x, 9 | y, 10 | len = 1, 11 | theta = 0, 12 | wid, 13 | shape = 1, 14 | col = 1, 15 | lwd = 1, 16 | lty = 1, 17 | grid = FALSE, 18 | npoints = 50, 19 | text = NULL, 20 | offset = c(0.05, 0) 21 | ) 22 | } 23 | \arguments{ 24 | \item{x}{center of the x axis of the curly brackets (or start end coordinates (x1,x2))} 25 | 26 | \item{y}{center of the y axis of the curly brackets (or start end coordinates (y1,y2))} 27 | 28 | \item{len}{Length of the curly brackets} 29 | 30 | \item{theta}{angle (in radians) of the curly brackets orientation} 31 | 32 | \item{wid}{Width of the curly brackets} 33 | 34 | \item{shape}{shape (curvature)} 35 | 36 | \item{col}{color (passed to lines/grid.lines)} 37 | 38 | \item{lwd}{line width (passed to lines/grid.lines)} 39 | 40 | \item{lty}{line type (passed to lines/grid.lines)} 41 | 42 | \item{grid}{If TRUE use grid graphics (compatability with ggplot2)} 43 | 44 | \item{npoints}{Number of points used in curves} 45 | 46 | \item{text}{Label} 47 | 48 | \item{offset}{Label offset (x,y)} 49 | } 50 | \description{ 51 | Adds curly brackets to plot 52 | } 53 | \examples{ 54 | if (interactive()) { 55 | plot(0,0,type="n",axes=FALSE,xlab="",ylab="") 56 | curly(x=c(1,0),y=c(0,1),lwd=2,text="a") 57 | curly(x=c(1,0),y=c(0,1),lwd=2,text="b",theta=pi) 58 | curly(x=-0.5,y=0,shape=1,theta=pi,text="c") 59 | curly(x=0,y=0,shape=1,theta=0,text="d") 60 | curly(x=0.5,y=0,len=0.2,theta=pi/2,col="blue",lty=2) 61 | curly(x=0.5,y=-0.5,len=0.2,theta=-pi/2,col="red",shape=1e3,text="e") 62 | } 63 | } 64 | -------------------------------------------------------------------------------- /man/devcoords.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/devcoords.R 3 | \name{devcoords} 4 | \alias{devcoords} 5 | \title{Returns device-coordinates and plot-region} 6 | \usage{ 7 | devcoords() 8 | } 9 | \value{ 10 | A \code{list} with elements 11 | \item{dev.x1}{Device: Left x-coordinate} 12 | \item{dev.x2}{Device: Right x-coordinate} 13 | \item{dev.y1}{Device Bottom y-coordinate} 14 | \item{dev.y2}{Device Top y-coordinate} 15 | \item{fig.x1}{Plot: Left x-coordinate} 16 | \item{fig.x2}{Plot: Right x-coordinate} 17 | \item{fig.y1}{Plot: Bottom y-coordinate} 18 | \item{fig.y2}{Plot: Top y-coordinate} 19 | } 20 | \description{ 21 | Returns device-coordinates and plot-region 22 | } 23 | \author{ 24 | Klaus K. Holst 25 | } 26 | \keyword{hplot} 27 | -------------------------------------------------------------------------------- /man/diagtest.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/diagtest.R 3 | \name{diagtest} 4 | \alias{diagtest} 5 | \alias{odds} 6 | \alias{riskcomp} 7 | \alias{OR} 8 | \alias{Ratio} 9 | \alias{Diff} 10 | \title{Calculate diagnostic tests for 2x2 table} 11 | \usage{ 12 | diagtest( 13 | table, 14 | positive = 2, 15 | exact = FALSE, 16 | p0 = NA, 17 | confint = c("logit", "arcsin", "pseudoscore", "exact"), 18 | ... 19 | ) 20 | } 21 | \arguments{ 22 | \item{table}{Table or (matrix/data.frame with two columns)} 23 | 24 | \item{positive}{Switch reference} 25 | 26 | \item{exact}{If TRUE exact binomial proportions CI/test will be used} 27 | 28 | \item{p0}{Optional null hypothesis (test prevalenc, sensitivity, ...)} 29 | 30 | \item{confint}{Type of confidence limits} 31 | 32 | \item{...}{Additional arguments to lower level functions} 33 | } 34 | \description{ 35 | Calculate prevalence, sensitivity, specificity, and positive and 36 | negative predictive values 37 | } 38 | \details{ 39 | Table should be in the format with outcome in columns and 40 | test in rows. Data.frame should be with test in the first 41 | column and outcome in the second column. 42 | } 43 | \examples{ 44 | M <- as.table(matrix(c(42,12, 45 | 35,28),ncol=2,byrow=TRUE, 46 | dimnames=list(rater=c("no","yes"),gold=c("no","yes")))) 47 | diagtest(M,exact=TRUE) 48 | } 49 | \author{ 50 | Klaus Holst 51 | } 52 | -------------------------------------------------------------------------------- /man/dsep.lvm.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/dsep.R 3 | \name{dsep.lvm} 4 | \alias{dsep.lvm} 5 | \alias{dsep} 6 | \title{Check d-separation criterion} 7 | \usage{ 8 | \method{dsep}{lvm}(object, x, cond = NULL, return.graph = FALSE, ...) 9 | } 10 | \arguments{ 11 | \item{object}{lvm object} 12 | 13 | \item{x}{Variables for which to check for conditional independence} 14 | 15 | \item{cond}{Conditioning set} 16 | 17 | \item{return.graph}{If TRUE the moralized ancestral graph with the 18 | conditioning set removed is returned} 19 | 20 | \item{...}{Additional arguments to lower level functions} 21 | } 22 | \description{ 23 | Check for conditional independence (d-separation) 24 | } 25 | \details{ 26 | The argument 'x' can be given as a formula, e.g. x~y|z+v 27 | or ~x+y|z+v With everything on the rhs of the bar defining the 28 | variables on which to condition on. 29 | } 30 | \examples{ 31 | m <- lvm(x5 ~ x4+x3, x4~x3+x1, x3~x2, x2~x1) 32 | if (interactive()) { 33 | plot(m,layoutType='neato') 34 | } 35 | dsep(m,x5~x1|x2+x4) 36 | dsep(m,x5~x1|x3+x4) 37 | dsep(m,~x1+x2+x3|x4) 38 | 39 | } 40 | -------------------------------------------------------------------------------- /man/equivalence.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/equivalence.R 3 | \name{equivalence} 4 | \alias{equivalence} 5 | \title{Identify candidates of equivalent models} 6 | \usage{ 7 | equivalence(x, rel, tol = 0.001, k = 1, omitrel = TRUE, ...) 8 | } 9 | \arguments{ 10 | \item{x}{\code{lvmfit}-object} 11 | 12 | \item{rel}{Formula or character-vector specifying two variables to omit from 13 | the model and subsequently search for possible equivalent models} 14 | 15 | \item{tol}{Define two models as empirical equivalent if the absolute 16 | difference in score test is less than \code{tol}} 17 | 18 | \item{k}{Number of parameters to test simultaneously. For \code{equivalence} 19 | the number of additional associations to be added instead of \code{rel}.} 20 | 21 | \item{omitrel}{if \code{k} greater than 1, this boolean defines wether to 22 | omit candidates containing \code{rel} from the output} 23 | 24 | \item{\dots}{Additional arguments to be passed to the lower-level functions} 25 | } 26 | \description{ 27 | Identifies candidates of equivalent models 28 | } 29 | \seealso{ 30 | \code{\link{compare}}, \code{\link{modelsearch}} 31 | } 32 | \author{ 33 | Klaus K. Holst 34 | } 35 | -------------------------------------------------------------------------------- /man/estimate.array.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/estimate.default.R 3 | \name{estimate.array} 4 | \alias{estimate.array} 5 | \alias{estimate.data.frame} 6 | \title{Estimate parameters and influence function.} 7 | \usage{ 8 | \method{estimate}{array}(x, type = "mean", probs = 0.5, ...) 9 | } 10 | \arguments{ 11 | \item{x}{numeric matrix} 12 | 13 | \item{type}{target parameter ("mean", "variance", "quantile")} 14 | 15 | \item{probs}{numeric vector of probabilities (for type="quantile")} 16 | 17 | \item{...}{Additional arguments to lower level functions (i.e., 18 | stats::density.default when type="quantile")} 19 | } 20 | \description{ 21 | Estimate parameters for the sample mean, variance, and quantiles 22 | } 23 | -------------------------------------------------------------------------------- /man/figures/gof1-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kkholst/lava/771d62a062f5705e07cc0a1ad7565d68c331436d/man/figures/gof1-1.png -------------------------------------------------------------------------------- /man/figures/lvm1-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kkholst/lava/771d62a062f5705e07cc0a1ad7565d68c331436d/man/figures/lvm1-1.png -------------------------------------------------------------------------------- /man/figures/mediation1-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kkholst/lava/771d62a062f5705e07cc0a1ad7565d68c331436d/man/figures/mediation1-1.png -------------------------------------------------------------------------------- /man/figures/nlin1-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kkholst/lava/771d62a062f5705e07cc0a1ad7565d68c331436d/man/figures/nlin1-1.png -------------------------------------------------------------------------------- /man/figures/simres1-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kkholst/lava/771d62a062f5705e07cc0a1ad7565d68c331436d/man/figures/simres1-1.png -------------------------------------------------------------------------------- /man/fplot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fplot.R 3 | \name{fplot} 4 | \alias{fplot} 5 | \title{fplot} 6 | \usage{ 7 | fplot( 8 | x, 9 | y, 10 | z = NULL, 11 | xlab, 12 | ylab, 13 | ..., 14 | z.col = topo.colors(64), 15 | data = parent.frame(), 16 | add = FALSE, 17 | aspect = c(1, 1), 18 | zoom = 0.8 19 | ) 20 | } 21 | \arguments{ 22 | \item{x}{X variable} 23 | 24 | \item{y}{Y variable} 25 | 26 | \item{z}{Z variable (optional)} 27 | 28 | \item{xlab}{x-axis label} 29 | 30 | \item{ylab}{y-axis label} 31 | 32 | \item{...}{additional arggument to lower-level plot functions} 33 | 34 | \item{z.col}{color (use argument alpha to set transparency)} 35 | 36 | \item{data}{data.frame} 37 | 38 | \item{add}{if TRUE use current active device} 39 | 40 | \item{aspect}{aspect ratio} 41 | 42 | \item{zoom}{zoom level} 43 | } 44 | \description{ 45 | Faster plot via RGL 46 | } 47 | \examples{ 48 | if (interactive()) { 49 | data(iris) 50 | fplot(Sepal.Length ~ Petal.Length+Species, data=iris, size=2, type="s") 51 | } 52 | } 53 | -------------------------------------------------------------------------------- /man/getMplus.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/zgetmplus.R 3 | \name{getMplus} 4 | \alias{getMplus} 5 | \title{Read Mplus output} 6 | \usage{ 7 | getMplus(infile = "template.out", coef = TRUE, ...) 8 | } 9 | \arguments{ 10 | \item{infile}{Mplus output file} 11 | 12 | \item{coef}{Coefficients only} 13 | 14 | \item{\dots}{additional arguments to lower level functions} 15 | } 16 | \description{ 17 | Read Mplus output files 18 | } 19 | \seealso{ 20 | getSAS 21 | } 22 | \author{ 23 | Klaus K. Holst 24 | } 25 | -------------------------------------------------------------------------------- /man/getSAS.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/zgetsas.R 3 | \name{getSAS} 4 | \alias{getSAS} 5 | \title{Read SAS output} 6 | \usage{ 7 | getSAS(infile, entry = "Parameter Estimates", ...) 8 | } 9 | \arguments{ 10 | \item{infile}{file (csv file generated by ODS)} 11 | 12 | \item{entry}{Name of entry to capture} 13 | 14 | \item{\dots}{additional arguments to lower level functions} 15 | } 16 | \description{ 17 | Run SAS code like in the following: 18 | } 19 | \details{ 20 | ODS CSVALL BODY="myest.csv"; 21 | proc nlmixed data=aj qpoints=2 dampstep=0.5; 22 | ... 23 | run; 24 | ODS CSVALL Close; 25 | 26 | and read results into R with: 27 | 28 | \code{getsas("myest.csv","Parameter Estimates")} 29 | } 30 | \seealso{ 31 | getMplus 32 | } 33 | \author{ 34 | Klaus K. Holst 35 | } 36 | -------------------------------------------------------------------------------- /man/hubble.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lava-package.R 3 | \docType{data} 4 | \name{hubble} 5 | \alias{hubble} 6 | \title{Hubble data} 7 | \format{ 8 | data.frame 9 | } 10 | \source{ 11 | Freedman, W. L., et al. 2001, AstroPhysicalJournal, 553, 47. 12 | } 13 | \description{ 14 | Velocity (v) and distance (D) measures of 36 Type Ia super-novae from the Hubble 15 | Space Telescope 16 | } 17 | \keyword{datasets} 18 | -------------------------------------------------------------------------------- /man/hubble2.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lava-package.R 3 | \docType{data} 4 | \name{hubble2} 5 | \alias{hubble2} 6 | \title{Hubble data} 7 | \format{ 8 | data.frame 9 | } 10 | \description{ 11 | Hubble data 12 | } 13 | \seealso{ 14 | hubble 15 | } 16 | \keyword{datasets} 17 | -------------------------------------------------------------------------------- /man/iid.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/iid.R 3 | \name{iid} 4 | \alias{iid} 5 | \title{Extract i.i.d. decomposition from model object} 6 | \usage{ 7 | iid(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{Model object} 11 | 12 | \item{...}{Additional arguments (see the man-page of the IC method)} 13 | } 14 | \description{ 15 | This function extracts 16 | } 17 | -------------------------------------------------------------------------------- /man/images.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/img.R 3 | \name{images} 4 | \alias{images} 5 | \title{Organize several image calls (for visualizing categorical data)} 6 | \usage{ 7 | images( 8 | x, 9 | group, 10 | ncol = 2, 11 | byrow = TRUE, 12 | colorbar = 1, 13 | colorbar.space = 0.1, 14 | label.offset = 0.02, 15 | order = TRUE, 16 | colorbar.border = 0, 17 | main, 18 | rowcol = FALSE, 19 | plotfun = NULL, 20 | axis1, 21 | axis2, 22 | mar, 23 | col = list(c("#EFF3FF", "#BDD7E7", "#6BAED6", "#2171B5"), c("#FEE5D9", "#FCAE91", 24 | "#FB6A4A", "#CB181D"), c("#EDF8E9", "#BAE4B3", "#74C476", "#238B45"), c("#FEEDDE", 25 | "#FDBE85", "#FD8D3C", "#D94701")), 26 | ... 27 | ) 28 | } 29 | \arguments{ 30 | \item{x}{data.frame or matrix} 31 | 32 | \item{group}{group variable} 33 | 34 | \item{ncol}{number of columns in layout} 35 | 36 | \item{byrow}{organize by row if TRUE} 37 | 38 | \item{colorbar}{Add color bar} 39 | 40 | \item{colorbar.space}{Space around color bar} 41 | 42 | \item{label.offset}{label offset} 43 | 44 | \item{order}{order} 45 | 46 | \item{colorbar.border}{Add border around color bar} 47 | 48 | \item{main}{Main title} 49 | 50 | \item{rowcol}{switch rows and columns} 51 | 52 | \item{plotfun}{Alternative plot function (instead of 'image')} 53 | 54 | \item{axis1}{Axis 1} 55 | 56 | \item{axis2}{Axis 2} 57 | 58 | \item{mar}{Margins} 59 | 60 | \item{col}{Colours} 61 | 62 | \item{...}{Additional arguments to lower level graphics functions} 63 | } 64 | \description{ 65 | Visualize categorical by group variable 66 | } 67 | \examples{ 68 | X <- matrix(rbinom(400,3,0.5),20) 69 | group <- rep(1:4,each=5) 70 | images(X,colorbar=0,zlim=c(0,3)) 71 | images(X,group=group,zlim=c(0,3)) 72 | \dontrun{ 73 | images(X,group=group,col=list(RColorBrewer::brewer.pal(4,"Purples"), 74 | RColorBrewer::brewer.pal(4,"Greys"), 75 | RColorBrewer::brewer.pal(4,"YlGn"), 76 | RColorBrewer::brewer.pal(4,"PuBuGn")),colorbar=2,zlim=c(0,3)) 77 | } 78 | images(list(X,X,X,X),group=group,zlim=c(0,3)) 79 | images(list(X,X,X,X),ncol=1,group=group,zlim=c(0,3)) 80 | images(list(X,X),group,axis2=c(FALSE,FALSE),axis1=c(FALSE,FALSE), 81 | mar=list(c(0,0,0,0),c(0,0,0,0)),yaxs="i",xaxs="i",zlim=c(0,3)) 82 | } 83 | \author{ 84 | Klaus Holst 85 | } 86 | -------------------------------------------------------------------------------- /man/indoorenv.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lava-package.R 3 | \docType{data} 4 | \name{indoorenv} 5 | \alias{indoorenv} 6 | \title{Data} 7 | \format{ 8 | data.frame 9 | } 10 | \source{ 11 | Simulated 12 | } 13 | \description{ 14 | Description 15 | } 16 | \keyword{datasets} 17 | -------------------------------------------------------------------------------- /man/internal.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lava-package.R 3 | \name{startvalues} 4 | \alias{startvalues} 5 | \alias{startvalues0} 6 | \alias{startvalues1} 7 | \alias{startvalues2} 8 | \alias{startvalues3} 9 | \alias{starter.multigroup} 10 | \alias{addattr} 11 | \alias{modelPar} 12 | \alias{modelVar} 13 | \alias{matrices} 14 | \alias{pars} 15 | \alias{pars.lvm} 16 | \alias{pars.lvmfit} 17 | \alias{pars.glm} 18 | \alias{score.glm} 19 | \alias{procdata.lvmfit} 20 | \alias{mat.lvm} 21 | \alias{reorderdata} 22 | \alias{graph2lvm} 23 | \alias{igraph.lvm} 24 | \alias{subgraph} 25 | \alias{finalize} 26 | \alias{index.lvm} 27 | \alias{index.lvmfit} 28 | \alias{index} 29 | \alias{reindex} 30 | \alias{index<-} 31 | \alias{rmvn0} 32 | \alias{dmvn0} 33 | \alias{logit} 34 | \alias{expit} 35 | \alias{tigol} 36 | \alias{randomslope} 37 | \alias{randomslope<-} 38 | \alias{lisrel} 39 | \alias{variances} 40 | \alias{offdiags} 41 | \alias{describecoef} 42 | \alias{parlabels} 43 | \alias{rsq} 44 | \alias{stdcoef} 45 | \alias{CoefMat} 46 | \alias{CoefMat.multigroupfit} 47 | \alias{deriv} 48 | \alias{updatelvm} 49 | \alias{checkmultigroup} 50 | \alias{profci} 51 | \alias{estimate.MAR} 52 | \alias{missingModel} 53 | \alias{Inverse} 54 | \alias{Identical} 55 | \alias{gaussian_logLik.lvm} 56 | \alias{addhook} 57 | \alias{gethook} 58 | \alias{multigroup} 59 | \alias{Weights} 60 | \alias{fixsome} 61 | \alias{parfix} 62 | \alias{parfix<-} 63 | \alias{merge} 64 | \alias{IV} 65 | \alias{parameter} 66 | \alias{Specials} 67 | \alias{procformula} 68 | \alias{getoutcome} 69 | \alias{decomp.specials} 70 | \alias{na.pass0} 71 | \title{For internal use} 72 | \description{ 73 | For internal use 74 | } 75 | \author{ 76 | Klaus K. Holst 77 | } 78 | \keyword{utilities} 79 | -------------------------------------------------------------------------------- /man/intervention.lvm.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/intervention.R 3 | \name{intervention.lvm} 4 | \alias{intervention.lvm} 5 | \alias{intervention<-} 6 | \alias{intervention} 7 | \alias{intervention<-.lvm} 8 | \title{Define intervention} 9 | \usage{ 10 | \method{intervention}{lvm}(object, to, value, dist = none.lvm(), ...) 11 | } 12 | \arguments{ 13 | \item{object}{lvm object} 14 | 15 | \item{to}{String defining variable or formula} 16 | 17 | \item{value}{function defining intervention} 18 | 19 | \item{dist}{Distribution} 20 | 21 | \item{...}{Additional arguments to lower level functions} 22 | } 23 | \description{ 24 | Define intervention in a `lvm` object 25 | } 26 | \examples{ 27 | m <- lvm(y ~ a + x, a ~ x) 28 | distribution(m, ~a+y) <- binomial.lvm() 29 | mm <- intervention(m, "a", value=3) 30 | sim(mm, 10) 31 | mm <- intervention(m, a~x, function(x) (x>0)*1) 32 | sim(mm, 10) 33 | } 34 | \seealso{ 35 | regression lvm sim 36 | } 37 | -------------------------------------------------------------------------------- /man/ksmooth2.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ksmooth.R 3 | \name{ksmooth2} 4 | \alias{ksmooth2} 5 | \alias{surface} 6 | \title{Plot/estimate surface} 7 | \usage{ 8 | ksmooth2( 9 | x, 10 | data, 11 | h = NULL, 12 | xlab = NULL, 13 | ylab = NULL, 14 | zlab = "", 15 | gridsize = rep(51L, 2), 16 | ... 17 | ) 18 | } 19 | \arguments{ 20 | \item{x}{formula or data} 21 | 22 | \item{data}{data.frame} 23 | 24 | \item{h}{bandwidth} 25 | 26 | \item{xlab}{X label} 27 | 28 | \item{ylab}{Y label} 29 | 30 | \item{zlab}{Z label} 31 | 32 | \item{gridsize}{grid size of kernel smoother} 33 | 34 | \item{...}{Additional arguments to graphics routine (persp3d or persp)} 35 | } 36 | \description{ 37 | Plot/estimate surface 38 | } 39 | \examples{ 40 | if (requireNamespace("KernSmooth")) {##' 41 | ksmooth2(rmvn0(1e4,sigma=diag(2)*.5+.5),c(-3.5,3.5),h=1, 42 | rgl=FALSE,theta=30) 43 | ##' 44 | if (interactive()) { 45 | ksmooth2(rmvn0(1e4,sigma=diag(2)*.5+.5),c(-3.5,3.5),h=1) 46 | ksmooth2(function(x,y) x^2+y^2, c(-20,20)) 47 | ksmooth2(function(x,y) x^2+y^2, xlim=c(-5,5), ylim=c(0,10)) 48 | 49 | f <- function(x,y) 1-sqrt(x^2+y^2) 50 | surface(f,xlim=c(-1,1),alpha=0.9,aspect=c(1,1,0.75)) 51 | surface(f,xlim=c(-1,1),clut=heat.colors(128)) 52 | ##play3d(spin3d(axis=c(0,0,1), rpm=8), duration=5) 53 | } 54 | 55 | if (interactive()) { 56 | surface(function(x) dmvn0(x,sigma=diag(2)),c(-3,3),lit=FALSE,smooth=FALSE,box=FALSE,alpha=0.8) 57 | surface(function(x) dmvn0(x,sigma=diag(2)),c(-3,3),box=FALSE,specular="black")##' 58 | } 59 | 60 | if (!inherits(try(find.package("fields"),silent=TRUE),"try-error")) { 61 | f <- function(x,y) 1-sqrt(x^2+y^2) 62 | ksmooth2(f,c(-1,1),rgl=FALSE,image=fields::image.plot) 63 | } 64 | 65 | } 66 | } 67 | -------------------------------------------------------------------------------- /man/labels-set.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/labels.R 3 | \name{labels<-} 4 | \alias{labels<-} 5 | \alias{labels} 6 | \alias{labels<-.default} 7 | \alias{labels.lvm} 8 | \alias{labels.lvmfit} 9 | \alias{labels.graphNEL} 10 | \alias{edgelabels} 11 | \alias{edgelabels<-} 12 | \alias{edgelabels<-.lvm} 13 | \alias{nodecolor} 14 | \alias{nodecolor<-} 15 | \alias{nodecolor<-.default} 16 | \title{Define labels of graph} 17 | \usage{ 18 | \method{labels}{default}(object, ...) <- value 19 | \method{edgelabels}{lvm}(object, to, ...) <- value 20 | \method{nodecolor}{default}(object, var=vars(object), 21 | border, labcol, shape, lwd, ...) <- value 22 | } 23 | \arguments{ 24 | \item{object}{\code{lvm}-object.} 25 | 26 | \item{\dots}{Additional arguments (\code{lwd}, \code{cex}, \code{col}, 27 | \code{labcol}), \code{border}.} 28 | 29 | \item{value}{node label/edge label/color} 30 | 31 | \item{to}{Formula specifying outcomes and predictors defining relevant 32 | edges.} 33 | 34 | \item{var}{Formula or character vector specifying the nodes/variables to 35 | alter.} 36 | 37 | \item{border}{Colors of borders} 38 | 39 | \item{labcol}{Text label colors} 40 | 41 | \item{shape}{Shape of node} 42 | 43 | \item{lwd}{Line width of border} 44 | } 45 | \description{ 46 | Alters labels of nodes and edges in the graph of a latent variable model 47 | } 48 | \examples{ 49 | m <- lvm(c(y,v)~x+z) 50 | regression(m) <- c(v,x)~z 51 | labels(m) <- c(y=expression(psi), z=expression(zeta)) 52 | nodecolor(m,~y+z+x,border=c("white","white","black"), 53 | labcol="white", lwd=c(1,1,5), 54 | lty=c(1,2)) <- c("orange","indianred","lightgreen") 55 | edgelabels(m,y~z+x, cex=c(2,1.5), col=c("orange","black"),labcol="darkblue", 56 | arrowhead=c("tee","dot"), 57 | lwd=c(3,1)) <- expression(phi,rho) 58 | edgelabels(m,c(v,x)~z, labcol="red", cex=0.8,arrowhead="none") <- 2 59 | if (interactive()) { 60 | plot(m,addstyle=FALSE) 61 | } 62 | 63 | m <- lvm(y~x) 64 | labels(m) <- list(x="multiple\nlines") 65 | if (interactive()) { 66 | op <- par(mfrow=c(1,2)) 67 | plot(m,plain=TRUE) 68 | plot(m) 69 | par(op) 70 | 71 | d <- sim(m,100) 72 | e <- estimate(m,d) 73 | plot(e,type="sd") 74 | } 75 | } 76 | \author{ 77 | Klaus K. Holst 78 | } 79 | \keyword{aplot} 80 | \keyword{graphs} 81 | -------------------------------------------------------------------------------- /man/lava-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lava-package.R 3 | \docType{package} 4 | \name{lava-package} 5 | \alias{lava-package} 6 | \alias{lava} 7 | \title{lava: Latent Variable Models} 8 | \description{ 9 | A general implementation of Structural Equation Models with latent variables (MLE, 2SLS, and composite likelihood estimators) with both continuous, censored, and ordinal outcomes (Holst and Budtz-Joergensen (2013) \doi{10.1007/s00180-012-0344-y}). Mixture latent variable models and non-linear latent variable models (Holst and Budtz-Joergensen (2020) \doi{10.1093/biostatistics/kxy082}). The package also provides methods for graph exploration (d-separation, back-door criterion), simulation of general non-linear latent variable models, and estimation of influence functions for a broad range of statistical models. 10 | 11 | A general implementation of Structural Equation Models wth latent variables 12 | (MLE, 2SLS, and composite likelihood estimators) with both continuous, 13 | censored, and ordinal outcomes (Holst and Budtz-Joergensen (2013) 14 | ). Mixture latent variable models and 15 | non-linear latent variable models (Holst and Budtz-Joergensen (2020) 16 | ). The package also provides methods for 17 | graph exploration (d-separation, back-door criterion), simulation of general 18 | non-linear latent variable models, and estimation of influence functions for 19 | a broad range of statistical models. 20 | } 21 | \examples{ 22 | 23 | lava() 24 | 25 | } 26 | \seealso{ 27 | Useful links: 28 | \itemize{ 29 | \item \url{https://kkholst.github.io/lava/} 30 | \item Report bugs at \url{https://github.com/kkholst/lava/issues} 31 | } 32 | 33 | } 34 | \author{ 35 | \strong{Maintainer}: Klaus K. Holst \email{klaus@holst.it} 36 | 37 | Other contributors: 38 | \itemize{ 39 | \item Brice Ozenne [contributor] 40 | \item Thomas Gerds [contributor] 41 | } 42 | 43 | 44 | Klaus K. Holst Maintainer: 45 | } 46 | \keyword{internal} 47 | \keyword{package} 48 | -------------------------------------------------------------------------------- /man/lava.options.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/addhook.R 3 | \name{lava.options} 4 | \alias{lava.options} 5 | \title{Set global options for \code{lava}} 6 | \usage{ 7 | lava.options(...) 8 | } 9 | \arguments{ 10 | \item{\dots}{Arguments} 11 | } 12 | \value{ 13 | \code{list} of parameters 14 | } 15 | \description{ 16 | Extract and set global parameters of \code{lava}. In particular optimization 17 | parameters for the \code{estimate} function. 18 | } 19 | \details{ 20 | \itemize{ 21 | \item \code{param}: 'relative' (factor loading and variance of one 22 | endogenous variables in each measurement model are fixed to one), 'absolute' 23 | (mean and variance of latent variables are set to 0 and 1, respectively), 24 | 'hybrid' (intercept of latent variables is fixed to 0, and factor loading of 25 | at least one endogenous variable in each measurement model is fixed to 1), 26 | 'none' (no constraints are added) 27 | \item \code{layout}: One of 'dot','fdp','circo','twopi','neato','osage' 28 | \item \code{messages}: Set to 0 to disable various output messages 29 | \item ... } 30 | 31 | see \code{control} parameter of the \code{estimate} function. 32 | } 33 | \examples{ 34 | 35 | \dontrun{ 36 | lava.options(iter.max=100,messages=0) 37 | } 38 | 39 | } 40 | \author{ 41 | Klaus K. Holst 42 | } 43 | \keyword{models} 44 | -------------------------------------------------------------------------------- /man/lvm.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lvm.R 3 | \name{lvm} 4 | \alias{lvm} 5 | \alias{print.lvm} 6 | \alias{summary.lvm} 7 | \title{Initialize new latent variable model} 8 | \usage{ 9 | lvm(x = NULL, ..., latent = NULL, messages = lava.options()$messages) 10 | } 11 | \arguments{ 12 | \item{x}{Vector of variable names. Optional but gives control of the 13 | sequence of appearance of the variables. The argument can be given as a 14 | character vector or formula, e.g. \code{~y1+y2} is equivalent to 15 | \code{c("y1","y2")}. Alternatively the argument can be a formula specifying 16 | a linear model.} 17 | 18 | \item{\dots}{Additional arguments to be passed to the low level functions} 19 | 20 | \item{latent}{(optional) Latent variables} 21 | 22 | \item{messages}{Controls what messages are printed (0: none)} 23 | } 24 | \value{ 25 | Returns an object of class \code{lvm}. 26 | } 27 | \description{ 28 | Function that constructs a new latent variable model object 29 | } 30 | \examples{ 31 | 32 | m <- lvm() # Empty model 33 | m1 <- lvm(y~x) # Simple linear regression 34 | m2 <- lvm(~y1+y2) # Model with two independent variables (argument) 35 | m3 <- lvm(list(c(y1,y2,y3)~u,u~x+z)) # SEM with three items 36 | 37 | } 38 | \seealso{ 39 | \code{\link{regression}}, \code{\link{covariance}}, 40 | \code{\link{intercept}}, ... 41 | } 42 | \author{ 43 | Klaus K. Holst 44 | } 45 | \keyword{models} 46 | \keyword{regression} 47 | -------------------------------------------------------------------------------- /man/makemissing.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/makemissing.R 3 | \name{makemissing} 4 | \alias{makemissing} 5 | \title{Create random missing data} 6 | \usage{ 7 | makemissing( 8 | data, 9 | p = 0.2, 10 | cols = seq_len(ncol(data)), 11 | rowwise = FALSE, 12 | nafun = function(x) x, 13 | seed = NULL 14 | ) 15 | } 16 | \arguments{ 17 | \item{data}{data.frame} 18 | 19 | \item{p}{Fraction of missing data in each column} 20 | 21 | \item{cols}{Which columns (name or index) to alter} 22 | 23 | \item{rowwise}{Should missing occur row-wise (either none or all selected columns are missing)} 24 | 25 | \item{nafun}{(Optional) function to be applied on data.frame before return (e.g. \code{na.omit} to return complete-cases only)} 26 | 27 | \item{seed}{Random seed} 28 | } 29 | \value{ 30 | data.frame 31 | } 32 | \description{ 33 | Generates missing entries in data.frame/matrix 34 | } 35 | \author{ 36 | Klaus K. Holst 37 | } 38 | \keyword{utilities} 39 | -------------------------------------------------------------------------------- /man/measurement.error.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/measurement.error.R 3 | \name{measurement.error} 4 | \alias{measurement.error} 5 | \title{Two-stage (non-linear) measurement error} 6 | \usage{ 7 | measurement.error( 8 | model1, 9 | formula, 10 | data = parent.frame(), 11 | predictfun = function(mu, var, data, ...) mu[, 1]^2 + var[1], 12 | id1, 13 | id2, 14 | ... 15 | ) 16 | } 17 | \arguments{ 18 | \item{model1}{Stage 1 model} 19 | 20 | \item{formula}{Formula specifying observed covariates in stage 2 model} 21 | 22 | \item{data}{data.frame} 23 | 24 | \item{predictfun}{Predictions to be used in stage 2} 25 | 26 | \item{id1}{Optional id-vector of stage 1} 27 | 28 | \item{id2}{Optional id-vector of stage 2} 29 | 30 | \item{...}{Additional arguments to lower level functions} 31 | } 32 | \description{ 33 | Two-stage measurement error 34 | } 35 | \examples{ 36 | m <- lvm(c(y1,y2,y3)~u,c(y3,y4,y5)~v,u~~v,c(u,v)~x) 37 | transform(m,u2~u) <- function(x) x^2 38 | transform(m,uv~u+v) <- prod 39 | regression(m) <- z~u2+u+v+uv+x 40 | set.seed(1) 41 | d <- sim(m,1000,p=c("u,u"=1)) 42 | 43 | ## Stage 1 44 | m1 <- lvm(c(y1[0:s],y2[0:s],y3[0:s])~1*u,c(y3[0:s],y4[0:s],y5[0:s])~1*v,u~b*x,u~~v) 45 | latent(m1) <- ~u+v 46 | e1 <- estimate(m1,d) 47 | 48 | pp <- function(mu,var,data,...) { 49 | cbind(u=mu[,"u"],u2=mu[,"u"]^2+var["u","u"],v=mu[,"v"],uv=mu[,"u"]*mu[,"v"]+var["u","v"]) 50 | } 51 | (e <- measurement.error(e1, z~1+x, data=d, predictfun=pp)) 52 | 53 | ## uu <- seq(-1,1,length.out=100) 54 | ## pp <- estimate(e,function(p,...) p["(Intercept)"]+p["u"]*uu+p["u2"]*uu^2)$coefmat 55 | if (interactive()) { 56 | plot(e,intercept=TRUE,line=0) 57 | 58 | f <- function(p) p[1]+p["u"]*u+p["u2"]*u^2 59 | u <- seq(-1,1,length.out=100) 60 | plot(e, f, data=data.frame(u), ylim=c(-.5,2.5)) 61 | } 62 | } 63 | \seealso{ 64 | stack.estimate 65 | } 66 | -------------------------------------------------------------------------------- /man/missingdata.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lava-package.R 3 | \docType{data} 4 | \name{missingdata} 5 | \alias{missingdata} 6 | \title{Missing data example} 7 | \format{ 8 | list of data.frames 9 | } 10 | \source{ 11 | Simulated 12 | } 13 | \description{ 14 | Simulated data generated from model 15 | \deqn{E(Y_i\mid X) = X, \quad cov(Y_1,Y_2\mid X)=0.5} 16 | } 17 | \details{ 18 | The list contains four data sets 19 | 1) Complete data 20 | 2) MCAR 21 | 3) MAR 22 | 4) MNAR (missing mechanism depends on variable V correlated with Y1,Y2) 23 | } 24 | \examples{ 25 | data(missingdata) 26 | e0 <- estimate(lvm(c(y1,y2)~b*x,y1~~y2),missingdata[[1]]) ## No missing 27 | e1 <- estimate(lvm(c(y1,y2)~b*x,y1~~y2),missingdata[[2]]) ## CC (MCAR) 28 | e2 <- estimate(lvm(c(y1,y2)~b*x,y1~~y2),missingdata[[2]],missing=TRUE) ## MCAR 29 | e3 <- estimate(lvm(c(y1,y2)~b*x,y1~~y2),missingdata[[3]]) ## CC (MAR) 30 | e4 <- estimate(lvm(c(y1,y2)~b*x,y1~~y2),missingdata[[3]],missing=TRUE) ## MAR 31 | } 32 | \keyword{datasets} 33 | -------------------------------------------------------------------------------- /man/modelsearch.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/modelsearch.R 3 | \name{modelsearch} 4 | \alias{modelsearch} 5 | \title{Model searching} 6 | \usage{ 7 | modelsearch(x, k = 1, dir = "forward", type = "all", ...) 8 | } 9 | \arguments{ 10 | \item{x}{\code{lvmfit}-object} 11 | 12 | \item{k}{Number of parameters to test simultaneously. For \code{equivalence} 13 | the number of additional associations to be added instead of \code{rel}.} 14 | 15 | \item{dir}{Direction to do model search. "forward" := add 16 | associations/arrows to model/graph (score tests), "backward" := remove 17 | associations/arrows from model/graph (wald test)} 18 | 19 | \item{type}{If equal to 'correlation' only consider score tests for covariance parameters. If equal to 'regression' go through direct effects only (default 'all' is to do both)} 20 | 21 | \item{...}{Additional arguments to be passed to the low level functions} 22 | } 23 | \value{ 24 | Matrix of test-statistics and p-values 25 | } 26 | \description{ 27 | Performs Wald or score tests 28 | } 29 | \examples{ 30 | 31 | m <- lvm(); 32 | regression(m) <- c(y1,y2,y3) ~ eta; latent(m) <- ~eta 33 | regression(m) <- eta ~ x 34 | m0 <- m; regression(m0) <- y2 ~ x 35 | dd <- sim(m0,100)[,manifest(m0)] 36 | e <- estimate(m,dd); 37 | modelsearch(e,messages=0) 38 | modelsearch(e,messages=0,type="cor") 39 | } 40 | \seealso{ 41 | \code{\link{compare}}, \code{\link{equivalence}} 42 | } 43 | \author{ 44 | Klaus K. Holst 45 | } 46 | \keyword{htest} 47 | -------------------------------------------------------------------------------- /man/multinomial.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/multinomial.R 3 | \name{multinomial} 4 | \alias{multinomial} 5 | \alias{kappa.multinomial} 6 | \alias{kappa.table} 7 | \alias{gkgamma} 8 | \title{Estimate probabilities in contingency table} 9 | \usage{ 10 | multinomial( 11 | x, 12 | data = parent.frame(), 13 | marginal = FALSE, 14 | transform, 15 | vcov = TRUE, 16 | IC = TRUE, 17 | ... 18 | ) 19 | } 20 | \arguments{ 21 | \item{x}{Formula (or matrix or data.frame with observations, 1 or 2 columns)} 22 | 23 | \item{data}{Optional data.frame} 24 | 25 | \item{marginal}{If TRUE the marginals are estimated} 26 | 27 | \item{transform}{Optional transformation of parameters (e.g., logit)} 28 | 29 | \item{vcov}{Calculate asymptotic variance (default TRUE)} 30 | 31 | \item{IC}{Return ic decomposition (default TRUE)} 32 | 33 | \item{...}{Additional arguments to lower-level functions} 34 | } 35 | \description{ 36 | Estimate probabilities in contingency table 37 | } 38 | \examples{ 39 | set.seed(1) 40 | breaks <- c(-Inf,-1,0,Inf) 41 | m <- lvm(); covariance(m,pairwise=TRUE) <- ~y1+y2+y3+y4 42 | d <- transform(sim(m,5e2), 43 | z1=cut(y1,breaks=breaks), 44 | z2=cut(y2,breaks=breaks), 45 | z3=cut(y3,breaks=breaks), 46 | z4=cut(y4,breaks=breaks)) 47 | 48 | multinomial(d[,5]) 49 | (a1 <- multinomial(d[,5:6])) 50 | (K1 <- kappa(a1)) ## Cohen's kappa 51 | 52 | K2 <- kappa(d[,7:8]) 53 | ## Testing difference K1-K2: 54 | estimate(merge(K1,K2,id=TRUE),diff) 55 | 56 | estimate(merge(K1,K2,id=FALSE),diff) ## Wrong std.err ignoring dependence 57 | sqrt(vcov(K1)+vcov(K2)) 58 | 59 | ## Average of the two kappas: 60 | estimate(merge(K1,K2,id=TRUE),function(x) mean(x)) 61 | estimate(merge(K1,K2,id=FALSE),function(x) mean(x)) ## Independence 62 | ##' 63 | ## Goodman-Kruskal's gamma 64 | m2 <- lvm(); covariance(m2) <- y1~y2 65 | breaks1 <- c(-Inf,-1,0,Inf) 66 | breaks2 <- c(-Inf,0,Inf) 67 | d2 <- transform(sim(m2,5e2), 68 | z1=cut(y1,breaks=breaks1), 69 | z2=cut(y2,breaks=breaks2)) 70 | 71 | (g1 <- gkgamma(d2[,3:4])) 72 | ## same as 73 | \dontrun{ 74 | gkgamma(table(d2[,3:4])) 75 | gkgamma(multinomial(d2[,3:4])) 76 | } 77 | 78 | ##partial gamma 79 | d2$x <- rbinom(nrow(d2),2,0.5) 80 | gkgamma(z1~z2|x,data=d2) 81 | } 82 | \author{ 83 | Klaus K. Holst 84 | } 85 | -------------------------------------------------------------------------------- /man/mvnmix.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mvnmix.R 3 | \name{mvnmix} 4 | \alias{mvnmix} 5 | \title{Estimate mixture latent variable model} 6 | \usage{ 7 | mvnmix( 8 | data, 9 | k = 2, 10 | theta, 11 | steps = 500, 12 | tol = 1e-16, 13 | lambda = 0, 14 | mu = NULL, 15 | silent = TRUE, 16 | extra = FALSE, 17 | n.start = 1, 18 | init = "kmpp", 19 | ... 20 | ) 21 | } 22 | \arguments{ 23 | \item{data}{\code{data.frame}} 24 | 25 | \item{k}{Number of mixture components} 26 | 27 | \item{theta}{Optional starting values} 28 | 29 | \item{steps}{Maximum number of iterations} 30 | 31 | \item{tol}{Convergence tolerance of EM algorithm} 32 | 33 | \item{lambda}{Regularisation parameter. Added to diagonal of covariance matrix (to avoid 34 | singularities)} 35 | 36 | \item{mu}{Initial centres (if unspecified random centres will be chosen)} 37 | 38 | \item{silent}{Turn on/off output messages} 39 | 40 | \item{extra}{Extra debug information} 41 | 42 | \item{n.start}{Number of restarts} 43 | 44 | \item{init}{Function to choose initial centres} 45 | 46 | \item{...}{Additional arguments parsed to lower-level functions} 47 | } 48 | \value{ 49 | A \code{mixture} object 50 | } 51 | \description{ 52 | Estimate mixture latent variable model 53 | } 54 | \details{ 55 | Estimate parameters in a mixture of latent variable models via the EM 56 | algorithm. 57 | } 58 | \examples{ 59 | 60 | data(faithful) 61 | set.seed(1) 62 | M1 <- mvnmix(faithful[,"waiting",drop=FALSE],k=2) 63 | M2 <- mvnmix(faithful,k=2) 64 | if (interactive()) { 65 | par(mfrow=c(2,1)) 66 | plot(M1,col=c("orange","blue"),ylim=c(0,0.05)) 67 | plot(M2,col=c("orange","blue")) 68 | } 69 | 70 | } 71 | \seealso{ 72 | \code{mixture} 73 | } 74 | \author{ 75 | Klaus K. Holst 76 | } 77 | \keyword{models} 78 | \keyword{regression} 79 | -------------------------------------------------------------------------------- /man/nldata.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lava-package.R 3 | \docType{data} 4 | \name{nldata} 5 | \alias{nldata} 6 | \title{Example data (nonlinear model)} 7 | \format{ 8 | data.frame 9 | } 10 | \source{ 11 | Simulated 12 | } 13 | \description{ 14 | Example data (nonlinear model) 15 | } 16 | \keyword{datasets} 17 | -------------------------------------------------------------------------------- /man/nsem.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lava-package.R 3 | \docType{data} 4 | \name{nsem} 5 | \alias{nsem} 6 | \title{Example SEM data (nonlinear)} 7 | \format{ 8 | data.frame 9 | } 10 | \source{ 11 | Simulated 12 | } 13 | \description{ 14 | Simulated data 15 | } 16 | \keyword{datasets} 17 | -------------------------------------------------------------------------------- /man/op_concat.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/operators.R 3 | \name{\%++\%} 4 | \alias{\%++\%} 5 | \title{Concatenation operator} 6 | \usage{ 7 | x \%++\% y 8 | } 9 | \arguments{ 10 | \item{x}{First object} 11 | 12 | \item{y}{Second object of same class} 13 | } 14 | \description{ 15 | For matrices a block-diagonal matrix is created. For all other 16 | data types he operator is a wrapper of \code{paste}. 17 | } 18 | \details{ 19 | Concatenation operator 20 | } 21 | \examples{ 22 | ## Block diagonal 23 | matrix(rnorm(25),5)\%++\%matrix(rnorm(25),5) 24 | ## String concatenation 25 | "Hello "\%++\%" World" 26 | ## Function composition 27 | f <- log \%++\% exp 28 | f(2) 29 | } 30 | \seealso{ 31 | \code{blockdiag}, \code{\link{paste}}, \code{\link{cat}}, 32 | } 33 | \author{ 34 | Klaus K. Holst 35 | } 36 | \keyword{misc} 37 | \keyword{utilities} 38 | -------------------------------------------------------------------------------- /man/op_match.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/operators.R 3 | \name{\%ni\%} 4 | \alias{\%ni\%} 5 | \alias{\%in.open\%} 6 | \alias{\%in.closed\%} 7 | \title{Matching operator (x not in y) oposed to the \code{\%in\%}-operator (x in y)} 8 | \usage{ 9 | x \%ni\% y 10 | } 11 | \arguments{ 12 | \item{x}{vector} 13 | 14 | \item{y}{vector of same type as \code{x}} 15 | } 16 | \value{ 17 | A logical vector. 18 | } 19 | \description{ 20 | Matching operator 21 | } 22 | \examples{ 23 | 24 | 1:10 \%ni\% c(1,5,10) 25 | 26 | } 27 | \seealso{ 28 | \code{\link{match}} 29 | } 30 | \author{ 31 | Klaus K. Holst 32 | } 33 | \keyword{misc} 34 | \keyword{utilities} 35 | -------------------------------------------------------------------------------- /man/ordinal-set.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ordinal.R 3 | \name{ordinal<-} 4 | \alias{ordinal<-} 5 | \alias{ordinal} 6 | \title{Define variables as ordinal} 7 | \usage{ 8 | ordinal(x, ...) <- value 9 | } 10 | \arguments{ 11 | \item{x}{Object} 12 | 13 | \item{...}{additional arguments to lower level functions} 14 | 15 | \item{value}{variable (formula or character vector)} 16 | } 17 | \description{ 18 | Define variables as ordinal in latent variable model object 19 | } 20 | \examples{ 21 | if (requireNamespace("mets")) { 22 | m <- lvm(y + z ~ x + 1*u[0], latent=~u) 23 | ordinal(m, K=3) <- ~y+z 24 | d <- sim(m, 100, seed=1) 25 | e <- estimate(m, d) 26 | } 27 | 28 | } 29 | -------------------------------------------------------------------------------- /man/ordreg.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ordreg.R 3 | \name{ordreg} 4 | \alias{ordreg} 5 | \title{Univariate cumulative link regression models} 6 | \usage{ 7 | ordreg( 8 | formula, 9 | data = parent.frame(), 10 | offset, 11 | family = stats::binomial("probit"), 12 | start, 13 | fast = FALSE, 14 | ... 15 | ) 16 | } 17 | \arguments{ 18 | \item{formula}{formula} 19 | 20 | \item{data}{data.frame} 21 | 22 | \item{offset}{offset} 23 | 24 | \item{family}{family (default proportional odds)} 25 | 26 | \item{start}{optional starting values} 27 | 28 | \item{fast}{If TRUE standard errors etc. will not be calculated} 29 | 30 | \item{...}{Additional arguments to lower level functions} 31 | } 32 | \description{ 33 | Ordinal regression models 34 | } 35 | \examples{ 36 | m <- lvm(y~x) 37 | ordinal(m,K=3) <- ~y 38 | d <- sim(m,100) 39 | e <- ordreg(y~x,d) 40 | } 41 | \author{ 42 | Klaus K. Holst 43 | } 44 | -------------------------------------------------------------------------------- /man/parpos.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/parpos.R 3 | \name{parpos} 4 | \alias{parpos} 5 | \title{Generic method for finding indeces of model parameters} 6 | \usage{ 7 | parpos(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{Model object} 11 | 12 | \item{\dots}{Additional arguments} 13 | } 14 | \description{ 15 | Generic method for finding indeces of model parameters 16 | } 17 | \author{ 18 | Klaus K. Holst 19 | } 20 | -------------------------------------------------------------------------------- /man/partialcor.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/partialcor.R 3 | \name{partialcor} 4 | \alias{partialcor} 5 | \title{Calculate partial correlations} 6 | \usage{ 7 | partialcor(formula, data, level = 0.95, ...) 8 | } 9 | \arguments{ 10 | \item{formula}{formula speciying the covariates and optionally the outcomes 11 | to calculate partial correlation for} 12 | 13 | \item{data}{data.frame} 14 | 15 | \item{level}{Level of confidence limits} 16 | 17 | \item{...}{Additional arguments to lower level functions} 18 | } 19 | \value{ 20 | A coefficient matrix 21 | } 22 | \description{ 23 | Calculate partial correlation coefficients and confidence limits via Fishers 24 | z-transform 25 | } 26 | \examples{ 27 | 28 | m <- lvm(c(y1,y2,y3)~x1+x2) 29 | covariance(m) <- c(y1,y2,y3)~y1+y2+y3 30 | d <- sim(m,500) 31 | partialcor(~x1+x2,d) 32 | 33 | } 34 | \author{ 35 | Klaus K. Holst 36 | } 37 | \keyword{models} 38 | \keyword{regression} 39 | -------------------------------------------------------------------------------- /man/pcor.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/pcor.R 3 | \name{pcor} 4 | \alias{pcor} 5 | \title{Polychoric correlation} 6 | \usage{ 7 | pcor(x, y, X, start, ...) 8 | } 9 | \arguments{ 10 | \item{x}{Variable 1} 11 | 12 | \item{y}{Variable 2} 13 | 14 | \item{X}{Optional covariates} 15 | 16 | \item{start}{Optional starting values} 17 | 18 | \item{...}{Additional arguments to lower level functions} 19 | } 20 | \description{ 21 | Maximum likelhood estimates of polychoric correlations 22 | } 23 | -------------------------------------------------------------------------------- /man/pdfconvert.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/pdfconvert.R 3 | \name{pdfconvert} 4 | \alias{pdfconvert} 5 | \title{Convert pdf to raster format} 6 | \usage{ 7 | pdfconvert( 8 | files, 9 | dpi = 300, 10 | resolution = 1024, 11 | gs, 12 | gsopt, 13 | resize, 14 | format = "png", 15 | ... 16 | ) 17 | } 18 | \arguments{ 19 | \item{files}{Vector of (pdf-)filenames to process} 20 | 21 | \item{dpi}{DPI} 22 | 23 | \item{resolution}{Resolution of raster image file} 24 | 25 | \item{gs}{Optional ghostscript command} 26 | 27 | \item{gsopt}{Optional ghostscript arguments} 28 | 29 | \item{resize}{Optional resize arguments (mogrify)} 30 | 31 | \item{format}{Raster format (e.g. png, jpg, tif, ...)} 32 | 33 | \item{\dots}{Additional arguments} 34 | } 35 | \description{ 36 | Convert PDF file to print quality png (default 300 dpi) 37 | } 38 | \details{ 39 | Access to ghostscript program 'gs' is needed 40 | } 41 | \seealso{ 42 | \code{dev.copy2pdf}, \code{printdev} 43 | } 44 | \author{ 45 | Klaus K. Holst 46 | } 47 | \keyword{iplot} 48 | -------------------------------------------------------------------------------- /man/plot.estimate.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot.estimate.R 3 | \name{plot.estimate} 4 | \alias{plot.estimate} 5 | \title{Plot method for 'estimate' objects} 6 | \usage{ 7 | \method{plot}{estimate}( 8 | x, 9 | f, 10 | idx, 11 | intercept = FALSE, 12 | data, 13 | confint = TRUE, 14 | type = "l", 15 | xlab = "x", 16 | ylab = "f(x)", 17 | col = 1, 18 | add = FALSE, 19 | ... 20 | ) 21 | } 22 | \arguments{ 23 | \item{x}{estimate object} 24 | 25 | \item{f}{function of parameter coefficients and data parsed on to 'estimate'. 26 | If omitted a forest-plot will be produced.} 27 | 28 | \item{idx}{Index of parameters (default all)} 29 | 30 | \item{intercept}{include intercept in forest-plot} 31 | 32 | \item{data}{data.frame} 33 | 34 | \item{confint}{Add confidence limits} 35 | 36 | \item{type}{plot type ('l')} 37 | 38 | \item{xlab}{x-axis label} 39 | 40 | \item{ylab}{y-axis label} 41 | 42 | \item{col}{color} 43 | 44 | \item{add}{add plot to current device} 45 | 46 | \item{...}{additional arguments to lower-level functions} 47 | } 48 | \description{ 49 | Plot method for 'estimate' objects 50 | } 51 | -------------------------------------------------------------------------------- /man/predict.lvm.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/predict.R 3 | \name{predict.lvm} 4 | \alias{predict.lvm} 5 | \alias{predict.lvmfit} 6 | \title{Prediction in structural equation models} 7 | \usage{ 8 | \method{predict}{lvm}( 9 | object, 10 | x = NULL, 11 | y = NULL, 12 | residual = FALSE, 13 | p, 14 | data, 15 | path = FALSE, 16 | quick = is.null(x) & !(residual | path), 17 | ... 18 | ) 19 | } 20 | \arguments{ 21 | \item{object}{Model object} 22 | 23 | \item{x}{optional list of (endogenous) variables to condition on} 24 | 25 | \item{y}{optional subset of variables to predict} 26 | 27 | \item{residual}{If true the residuals are predicted} 28 | 29 | \item{p}{Parameter vector} 30 | 31 | \item{data}{Data to use in prediction} 32 | 33 | \item{path}{Path prediction} 34 | 35 | \item{quick}{If TRUE the conditional mean and variance given covariates are returned (and all other calculations skipped)} 36 | 37 | \item{\dots}{Additional arguments to lower level function} 38 | } 39 | \description{ 40 | Prediction in structural equation models 41 | } 42 | \examples{ 43 | m <- lvm(list(c(y1,y2,y3)~u,u~x)); latent(m) <- ~u 44 | d <- sim(m,100) 45 | e <- estimate(m,d) 46 | 47 | ## Conditional mean (and variance as attribute) given covariates 48 | r <- predict(e) 49 | ## Best linear unbiased predictor (BLUP) 50 | r <- predict(e,vars(e)) 51 | ## Conditional mean of y3 giving covariates and y1,y2 52 | r <- predict(e,y3~y1+y2) 53 | ## Conditional mean gives covariates and y1 54 | r <- predict(e,~y1) 55 | ## Predicted residuals (conditional on all observed variables) 56 | r <- predict(e,vars(e),residual=TRUE) 57 | 58 | } 59 | \seealso{ 60 | predictlvm 61 | } 62 | -------------------------------------------------------------------------------- /man/predictlvm.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/predict.R 3 | \name{predictlvm} 4 | \alias{predictlvm} 5 | \title{Predict function for latent variable models} 6 | \usage{ 7 | predictlvm(object, formula, p = coef(object), data = model.frame(object), ...) 8 | } 9 | \arguments{ 10 | \item{object}{Model object} 11 | 12 | \item{formula}{Formula specifying which variables to predict and which to condition on} 13 | 14 | \item{p}{Parameter vector} 15 | 16 | \item{data}{Data.frame} 17 | 18 | \item{...}{Additional arguments to lower level functions} 19 | } 20 | \description{ 21 | Predictions of conditinoal mean and variance and calculation of 22 | jacobian with respect to parameter vector. 23 | } 24 | \examples{ 25 | m <- lvm(c(x1,x2,x3)~u1,u1~z, 26 | c(y1,y2,y3)~u2,u2~u1+z) 27 | latent(m) <- ~u1+u2 28 | d <- simulate(m,10,"u2,u2"=2,"u1,u1"=0.5,seed=123) 29 | e <- estimate(m,d) 30 | 31 | ## Conditional mean given covariates 32 | predictlvm(e,c(x1,x2)~1)$mean 33 | ## Conditional variance of u1,y1 given x1,x2 34 | predictlvm(e,c(u1,y1)~x1+x2)$var 35 | } 36 | \seealso{ 37 | predict.lvm 38 | } 39 | -------------------------------------------------------------------------------- /man/rbind.Surv.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/rbind.Surv.R 3 | \name{rbind.Surv} 4 | \alias{rbind.Surv} 5 | \title{Appending \code{Surv} objects} 6 | \usage{ 7 | \method{rbind}{Surv}(...) 8 | } 9 | \arguments{ 10 | \item{...}{\code{Surv} objects} 11 | } 12 | \value{ 13 | \code{Surv} object 14 | } 15 | \description{ 16 | \code{rbind} method for \code{Surv} objects 17 | } 18 | \examples{ 19 | 20 | y <- yl <- yr <- rnorm(10) 21 | yl[1:5] <- NA; yr[6:10] <- NA 22 | S1 <- survival::Surv(yl,yr,type="interval2") 23 | S2 <- survival::Surv(y,y>0,type="right") 24 | S3 <- survival::Surv(y,y<0,type="left") 25 | 26 | rbind(S1,S1) 27 | rbind(S2,S2) 28 | rbind(S3,S3) 29 | 30 | } 31 | \author{ 32 | Klaus K. Holst 33 | } 34 | \keyword{utilities} 35 | -------------------------------------------------------------------------------- /man/revdiag.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/revdiag.R 3 | \name{revdiag} 4 | \alias{revdiag} 5 | \alias{revdiag<-} 6 | \alias{offdiag} 7 | \alias{offdiag<-} 8 | \title{Create/extract 'reverse'-diagonal matrix or off-diagonal elements} 9 | \usage{ 10 | revdiag(x,...) 11 | offdiag(x,type=0,...) 12 | 13 | revdiag(x,...) <- value 14 | offdiag(x,type=0,...) <- value 15 | } 16 | \arguments{ 17 | \item{x}{vector} 18 | 19 | \item{\dots}{additional arguments to lower level functions} 20 | 21 | \item{value}{For the assignment function the values to put in the diagonal} 22 | 23 | \item{type}{0: upper and lower triangular, 1: upper triangular, 2: lower triangular, 3: upper triangular + diagonal, 4: lower triangular + diagonal} 24 | } 25 | \description{ 26 | Create/extract 'reverse'-diagonal matrix or off-diagonal elements 27 | } 28 | \author{ 29 | Klaus K. Holst 30 | } 31 | -------------------------------------------------------------------------------- /man/rmvar.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/kill.R 3 | \name{rmvar} 4 | \alias{rmvar} 5 | \alias{rmvar<-} 6 | \alias{kill} 7 | \alias{kill<-} 8 | \title{Remove variables from (model) object.} 9 | \usage{ 10 | rmvar(x, ...) <- value 11 | } 12 | \arguments{ 13 | \item{x}{Model object} 14 | 15 | \item{\dots}{additional arguments to lower level functions} 16 | 17 | \item{value}{Vector of variables or formula specifying which nodes to 18 | remove} 19 | } 20 | \description{ 21 | Generic method for removing elements of object 22 | } 23 | \examples{ 24 | m <- lvm() 25 | addvar(m) <- ~y1+y2+x 26 | covariance(m) <- y1~y2 27 | regression(m) <- c(y1,y2) ~ x 28 | ### Cancel the covariance between the residuals of y1 and y2 29 | cancel(m) <- y1~y2 30 | ### Remove y2 from the model 31 | rmvar(m) <- ~y2 32 | 33 | } 34 | \seealso{ 35 | \code{cancel} 36 | } 37 | \author{ 38 | Klaus K. Holst 39 | } 40 | \keyword{models} 41 | \keyword{regression} 42 | -------------------------------------------------------------------------------- /man/rotate2.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/rotation.R 3 | \name{rotate2} 4 | \alias{rotate2} 5 | \alias{rot2D} 6 | \alias{rot3D} 7 | \title{Performs a rotation in the plane} 8 | \usage{ 9 | rotate2(x, theta = pi) 10 | } 11 | \arguments{ 12 | \item{x}{Matrix to be rotated (2 times n)} 13 | 14 | \item{theta}{Rotation in radians} 15 | } 16 | \value{ 17 | Returns a matrix of the same dimension as \code{x} 18 | } 19 | \description{ 20 | Performs a rotation in the plane 21 | } 22 | \examples{ 23 | rotate2(cbind(c(1,2),c(2,1))) 24 | } 25 | \author{ 26 | Klaus K. Holst 27 | } 28 | \keyword{hplot} 29 | -------------------------------------------------------------------------------- /man/scheffe.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/scheffe.R 3 | \name{scheffe} 4 | \alias{scheffe} 5 | \title{Calculate simultaneous confidence limits by Scheffe's method} 6 | \usage{ 7 | scheffe(model, newdata = model.frame(model), level = 0.95) 8 | } 9 | \arguments{ 10 | \item{model}{Linear model} 11 | 12 | \item{newdata}{new data frame} 13 | 14 | \item{level}{confidence level (0.95)} 15 | } 16 | \description{ 17 | Function to compute the Scheffe corrected confidence 18 | interval for the regression line 19 | } 20 | \examples{ 21 | x <- rnorm(100) 22 | d <- data.frame(y=rnorm(length(x),x),x=x) 23 | l <- lm(y~x,d) 24 | plot(y~x,d) 25 | abline(l) 26 | d0 <- data.frame(x=seq(-5,5,length.out=100)) 27 | d1 <- cbind(d0,predict(l,newdata=d0,interval="confidence")) 28 | d2 <- cbind(d0,scheffe(l,d0)) 29 | lines(lwr~x,d1,lty=2,col="red") 30 | lines(upr~x,d1,lty=2,col="red") 31 | lines(lwr~x,d2,lty=2,col="blue") 32 | lines(upr~x,d2,lty=2,col="blue") 33 | } 34 | -------------------------------------------------------------------------------- /man/semdata.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lava-package.R 3 | \docType{data} 4 | \name{semdata} 5 | \alias{semdata} 6 | \title{Example SEM data} 7 | \format{ 8 | data.frame 9 | } 10 | \source{ 11 | Simulated 12 | } 13 | \description{ 14 | Simulated data 15 | } 16 | \keyword{datasets} 17 | -------------------------------------------------------------------------------- /man/serotonin.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lava-package.R 3 | \docType{data} 4 | \name{serotonin} 5 | \alias{serotonin} 6 | \title{Serotonin data} 7 | \format{ 8 | data.frame 9 | } 10 | \source{ 11 | Simulated 12 | } 13 | \description{ 14 | This simulated data mimics a PET imaging study where the 5-HT2A 15 | receptor and serotonin transporter (SERT) binding potential has 16 | been quantified into 8 different regions. The 5-HT2A 17 | cortical regions are considered high-binding regions 18 | measurements. These measurements can be regarded as proxy measures of 19 | the extra-cellular levels of serotonin in the brain 20 | \tabular{rll}{ 21 | day \tab numeric \tab Scan day of the year \cr 22 | age \tab numeric \tab Age at baseline scan \cr 23 | mem \tab numeric \tab Memory performance score \cr 24 | depr \tab numeric \tab Depression (mild) status 500 days after baseline \cr 25 | gene1 \tab numeric \tab Gene marker 1 (HTR2A) \cr 26 | gene2 \tab numeric \tab Gene marker 2 (HTTTLPR) \cr 27 | cau \tab numeric \tab SERT binding, Caudate Nucleus \cr 28 | th \tab numeric \tab SERT binding, Thalamus \cr 29 | put \tab numeric \tab SERT binding, Putamen \cr 30 | mid \tab numeric \tab SERT binding, Midbrain \cr 31 | aci \tab numeric \tab 5-HT2A binding, Anterior cingulate gyrus \cr 32 | pci \tab numeric \tab 5-HT2A binding, Posterior cingulate gyrus \cr 33 | sfc \tab numeric \tab 5-HT2A binding, Superior frontal cortex \cr 34 | par \tab numeric \tab 5-HT2A binding, Parietal cortex \cr 35 | } 36 | } 37 | \keyword{datasets} 38 | -------------------------------------------------------------------------------- /man/serotonin2.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lava-package.R 3 | \docType{data} 4 | \name{serotonin2} 5 | \alias{serotonin2} 6 | \title{Data} 7 | \format{ 8 | data.frame 9 | } 10 | \source{ 11 | Simulated 12 | } 13 | \description{ 14 | Description 15 | } 16 | \seealso{ 17 | serotonin 18 | } 19 | \keyword{datasets} 20 | -------------------------------------------------------------------------------- /man/stack.estimate.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/stack.R 3 | \name{stack.estimate} 4 | \alias{stack.estimate} 5 | \title{Stack estimating equations} 6 | \usage{ 7 | \method{stack}{estimate}( 8 | x, 9 | model2, 10 | D1u, 11 | inv.D2u, 12 | propensity, 13 | dpropensity, 14 | U, 15 | keep1 = FALSE, 16 | propensity.arg, 17 | estimate.arg, 18 | na.action = na.pass, 19 | ... 20 | ) 21 | } 22 | \arguments{ 23 | \item{x}{Model 1} 24 | 25 | \item{model2}{Model 2} 26 | 27 | \item{D1u}{Derivative of score of model 2 w.r.t. parameter vector of model 1} 28 | 29 | \item{inv.D2u}{Inverse of deri} 30 | 31 | \item{propensity}{propensity score (vector or function)} 32 | 33 | \item{dpropensity}{derivative of propensity score wrt parameters of model 1} 34 | 35 | \item{U}{Optional score function (model 2) as function of all parameters} 36 | 37 | \item{keep1}{If FALSE only parameters of model 2 is returned} 38 | 39 | \item{propensity.arg}{Arguments to propensity function} 40 | 41 | \item{estimate.arg}{Arguments to 'estimate'} 42 | 43 | \item{na.action}{Method for dealing with missing data in propensity score} 44 | 45 | \item{...}{Additional arguments to lower level functions} 46 | } 47 | \description{ 48 | Stack estimating equations (two-stage estimator) 49 | } 50 | \examples{ 51 | m <- lvm(z0~x) 52 | Missing(m, z ~ z0) <- r~x 53 | distribution(m,~x) <- binomial.lvm() 54 | p <- c(r=-1,'r~x'=0.5,'z0~x'=2) 55 | beta <- p[3]/2 56 | d <- sim(m,500,p=p,seed=1) 57 | m1 <- estimate(r~x,data=d,family=binomial) 58 | d$w <- d$r/predict(m1,type="response") 59 | m2 <- estimate(z~1, weights=w, data=d) 60 | (e <- stack(m1,m2,propensity=TRUE)) 61 | } 62 | -------------------------------------------------------------------------------- /man/subset.lvm.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/subset.R 3 | \name{subset.lvm} 4 | \alias{subset.lvm} 5 | \alias{measurement} 6 | \title{Extract subset of latent variable model} 7 | \usage{ 8 | \method{subset}{lvm}(x, vars, ...) 9 | } 10 | \arguments{ 11 | \item{x}{\code{lvm}-object.} 12 | 13 | \item{vars}{Character vector or formula specifying variables to include in 14 | subset.} 15 | 16 | \item{\dots}{Additional arguments to be passed to the low level functions} 17 | } 18 | \value{ 19 | A \code{lvm}-object. 20 | } 21 | \description{ 22 | Extract measurement models or user-specified subset of model 23 | } 24 | \examples{ 25 | 26 | m <- lvm(c(y1,y2)~x1+x2) 27 | subset(m,~y1+x1) 28 | 29 | } 30 | \author{ 31 | Klaus K. Holst 32 | } 33 | \keyword{models} 34 | \keyword{regression} 35 | -------------------------------------------------------------------------------- /man/summary.sim.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sim.default.R 3 | \name{summary.sim} 4 | \alias{summary.sim} 5 | \title{Summary method for 'sim' objects} 6 | \usage{ 7 | \method{summary}{sim}( 8 | object, 9 | estimate = NULL, 10 | se = NULL, 11 | confint = !is.null(se) && !is.null(true), 12 | true = NULL, 13 | fun, 14 | names = NULL, 15 | unique.names = TRUE, 16 | minimal = FALSE, 17 | level = 0.95, 18 | quantiles = c(0, 0.025, 0.5, 0.975, 1), 19 | ... 20 | ) 21 | } 22 | \arguments{ 23 | \item{object}{sim object} 24 | 25 | \item{estimate}{(optional) columns with estimates} 26 | 27 | \item{se}{(optional) columns with standard error estimates} 28 | 29 | \item{confint}{(optional) list of pairs of columns with confidence limits} 30 | 31 | \item{true}{(optional) vector of true parameter values} 32 | 33 | \item{fun}{(optional) summary function} 34 | 35 | \item{names}{(optional) names of estimates} 36 | 37 | \item{unique.names}{if TRUE, unique.names will be applied to column names} 38 | 39 | \item{minimal}{if TRUE, minimal summary will be returned} 40 | 41 | \item{level}{confidence level (0.95)} 42 | 43 | \item{quantiles}{quantiles (0,0.025,0.5,0.975,1)} 44 | 45 | \item{...}{additional levels to lower-level functions} 46 | } 47 | \description{ 48 | Summary method for 'sim' objects 49 | } 50 | -------------------------------------------------------------------------------- /man/toformula.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/toformula.R 3 | \name{toformula} 4 | \alias{toformula} 5 | \title{Converts strings to formula} 6 | \usage{ 7 | toformula(y = ".", x = ".") 8 | } 9 | \arguments{ 10 | \item{y}{vector of predictors} 11 | 12 | \item{x}{vector of responses} 13 | } 14 | \value{ 15 | An object of class \code{formula} 16 | } 17 | \description{ 18 | Converts a vector of predictors and a vector of responses (characters) i#nto 19 | a formula expression. 20 | } 21 | \examples{ 22 | 23 | toformula(c("age","gender"), "weight") 24 | 25 | } 26 | \seealso{ 27 | \code{\link{as.formula}}, 28 | } 29 | \author{ 30 | Klaus K. Holst 31 | } 32 | \keyword{models} 33 | \keyword{utilities} 34 | -------------------------------------------------------------------------------- /man/tr.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tr.R 3 | \name{tr} 4 | \alias{tr} 5 | \title{Trace operator} 6 | \usage{ 7 | tr(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{Square numeric matrix} 11 | 12 | \item{\dots}{Additional arguments to lower level functions} 13 | } 14 | \value{ 15 | \code{numeric} 16 | } 17 | \description{ 18 | Calculates the trace of a square matrix. 19 | } 20 | \examples{ 21 | 22 | tr(diag(1:5)) 23 | } 24 | \seealso{ 25 | \code{\link{crossprod}}, \code{\link{tcrossprod}} 26 | } 27 | \author{ 28 | Klaus K. Holst 29 | } 30 | \keyword{algebra} 31 | \keyword{math} 32 | -------------------------------------------------------------------------------- /man/trim.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/trim.R 3 | \name{trim} 4 | \alias{trim} 5 | \title{Trim string of (leading/trailing/all) white spaces} 6 | \usage{ 7 | trim(x, all = FALSE, ...) 8 | } 9 | \arguments{ 10 | \item{x}{String} 11 | 12 | \item{all}{Trim all whitespaces?} 13 | 14 | \item{\dots}{additional arguments to lower level functions} 15 | } 16 | \description{ 17 | Trim string of (leading/trailing/all) white spaces 18 | } 19 | \author{ 20 | Klaus K. Holst 21 | } 22 | -------------------------------------------------------------------------------- /man/twindata.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lava-package.R 3 | \docType{data} 4 | \name{twindata} 5 | \alias{twindata} 6 | \title{Twin menarche data} 7 | \format{ 8 | data.frame 9 | } 10 | \source{ 11 | Simulated 12 | } 13 | \description{ 14 | Simulated data 15 | \tabular{rll}{ 16 | id \tab numeric \tab Twin-pair id \cr 17 | zyg \tab character \tab Zygosity (MZ or DZ) \cr 18 | twinnum \tab numeric \tab Twin number (1 or 2) \cr 19 | agemena \tab numeric \tab Age at menarche (or censoring) \cr 20 | status \tab logical \tab Censoring status (observed:=T,censored:=F) \cr 21 | bw \tab numeric \tab Birth weight \cr 22 | msmoke \tab numeric \tab Did mother smoke? (yes:=1,no:=0) \cr 23 | } 24 | } 25 | \keyword{datasets} 26 | -------------------------------------------------------------------------------- /man/twostage.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/twostage.R 3 | \name{twostage} 4 | \alias{twostage} 5 | \title{Two-stage estimator} 6 | \usage{ 7 | twostage(object, ...) 8 | } 9 | \arguments{ 10 | \item{object}{Model object} 11 | 12 | \item{...}{Additional arguments to lower level functions} 13 | } 14 | \description{ 15 | Generic function. 16 | } 17 | \seealso{ 18 | twostage.lvm twostage.lvmfit twostage.lvm.mixture twostage.estimate 19 | } 20 | -------------------------------------------------------------------------------- /man/twostageCV.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/twostage.R 3 | \name{twostageCV} 4 | \alias{twostageCV} 5 | \title{Cross-validated two-stage estimator} 6 | \usage{ 7 | twostageCV( 8 | model1, 9 | model2, 10 | data, 11 | control1 = list(trace = 0), 12 | control2 = list(trace = 0), 13 | knots.boundary, 14 | nmix = 1:4, 15 | df = 1:9, 16 | fix = TRUE, 17 | std.err = TRUE, 18 | nfolds = 5, 19 | rep = 1, 20 | messages = 0, 21 | ... 22 | ) 23 | } 24 | \arguments{ 25 | \item{model1}{model 1 (exposure measurement error model)} 26 | 27 | \item{model2}{model 2} 28 | 29 | \item{data}{data.frame} 30 | 31 | \item{control1}{optimization parameters for model 1} 32 | 33 | \item{control2}{optimization parameters for model 1} 34 | 35 | \item{knots.boundary}{boundary points for natural cubic spline basis} 36 | 37 | \item{nmix}{number of mixture components} 38 | 39 | \item{df}{spline degrees of freedom} 40 | 41 | \item{fix}{automatically fix parameters for identification (TRUE)} 42 | 43 | \item{std.err}{calculation of standard errors (TRUE)} 44 | 45 | \item{nfolds}{Number of folds (cross-validation)} 46 | 47 | \item{rep}{Number of repeats of cross-validation} 48 | 49 | \item{messages}{print information (>0)} 50 | 51 | \item{...}{additional arguments to lower} 52 | } 53 | \description{ 54 | Cross-validated two-stage estimator for non-linear SEM 55 | } 56 | \examples{ 57 | \donttest{ ## Reduce Ex.Timings##' 58 | m1 <- lvm( x1+x2+x3 ~ u, latent= ~u) 59 | m2 <- lvm( y ~ 1 ) 60 | m <- functional(merge(m1,m2), y ~ u, value=function(x) sin(x)+x) 61 | distribution(m, ~u1) <- uniform.lvm(-6,6) 62 | d <- sim(m,n=500,seed=1) 63 | nonlinear(m2) <- y~u1 64 | if (requireNamespace('mets', quietly=TRUE)) { 65 | set.seed(1) 66 | val <- twostageCV(m1, m2, data=d, std.err=FALSE, df=2:6, nmix=1:2, 67 | nfolds=2) 68 | val 69 | } 70 | } 71 | } 72 | -------------------------------------------------------------------------------- /man/vec.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/vec.R 3 | \name{vec} 4 | \alias{vec} 5 | \title{vec operator} 6 | \usage{ 7 | vec(x, matrix = FALSE, sep = ".", ...) 8 | } 9 | \arguments{ 10 | \item{x}{Array} 11 | 12 | \item{matrix}{If TRUE a row vector (matrix) is returned} 13 | 14 | \item{sep}{Seperator} 15 | 16 | \item{...}{Additional arguments} 17 | } 18 | \description{ 19 | vec operator 20 | } 21 | \details{ 22 | Convert array into vector 23 | } 24 | \author{ 25 | Klaus Holst 26 | } 27 | -------------------------------------------------------------------------------- /man/wait.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wait.R 3 | \name{wait} 4 | \alias{wait} 5 | \alias{waitclick} 6 | \title{Wait for user input (keyboard or mouse)} 7 | \usage{ 8 | wait() 9 | } 10 | \description{ 11 | Wait for user input (keyboard or mouse) 12 | } 13 | \author{ 14 | Klaus K. Holst 15 | } 16 | \keyword{iplot} 17 | -------------------------------------------------------------------------------- /man/wkm.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wkm.R 3 | \name{wkm} 4 | \alias{wkm} 5 | \title{Weighted K-means} 6 | \usage{ 7 | wkm( 8 | x, 9 | mu, 10 | data, 11 | weights = rep(1, NROW(x)), 12 | iter.max = 20, 13 | n.start = 5, 14 | init = "kmpp", 15 | ... 16 | ) 17 | } 18 | \arguments{ 19 | \item{x}{Data (or formula)} 20 | 21 | \item{mu}{Initial centers (or number centers chosen randomly among x)} 22 | 23 | \item{data}{optional data frmae} 24 | 25 | \item{weights}{Optional weights} 26 | 27 | \item{iter.max}{Max number of iterations} 28 | 29 | \item{n.start}{Number of restarts} 30 | 31 | \item{init}{method to create initial centres (default kmeans++)} 32 | 33 | \item{...}{Additional arguments to lower level functions} 34 | } 35 | \description{ 36 | Weighted K-means via Lloyd's algorithm 37 | } 38 | \author{ 39 | Klaus K. Holst 40 | } 41 | -------------------------------------------------------------------------------- /man/wrapvec.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wrapvec.R 3 | \name{wrapvec} 4 | \alias{wrapvec} 5 | \title{Wrap vector} 6 | \usage{ 7 | wrapvec(x, delta = 0L, ...) 8 | } 9 | \arguments{ 10 | \item{x}{Vector or integer} 11 | 12 | \item{delta}{Shift} 13 | 14 | \item{...}{Additional parameters} 15 | } 16 | \description{ 17 | Wrap vector 18 | } 19 | \examples{ 20 | wrapvec(5,2) 21 | } 22 | -------------------------------------------------------------------------------- /man/zibreg.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/zib.R 3 | \name{zibreg} 4 | \alias{zibreg} 5 | \title{Regression model for binomial data with unkown group of immortals} 6 | \usage{ 7 | zibreg( 8 | formula, 9 | formula.p = ~1, 10 | data, 11 | family = stats::binomial(), 12 | offset = NULL, 13 | start, 14 | var = "hessian", 15 | ... 16 | ) 17 | } 18 | \arguments{ 19 | \item{formula}{Formula specifying} 20 | 21 | \item{formula.p}{Formula for model of disease prevalence} 22 | 23 | \item{data}{data frame} 24 | 25 | \item{family}{Distribution family (see the help page \code{family})} 26 | 27 | \item{offset}{Optional offset} 28 | 29 | \item{start}{Optional starting values} 30 | 31 | \item{var}{Type of variance (robust, expected, hessian, outer)} 32 | 33 | \item{...}{Additional arguments to lower level functions} 34 | } 35 | \description{ 36 | Regression model for binomial data with unkown group of immortals (zero-inflated binomial regression) 37 | } 38 | \examples{ 39 | 40 | ## Simulation 41 | n <- 2e3 42 | x <- runif(n,0,20) 43 | age <- runif(n,10,30) 44 | z0 <- rnorm(n,mean=-1+0.05*age) 45 | z <- cut(z0,breaks=c(-Inf,-1,0,1,Inf)) 46 | p0 <- lava:::expit(model.matrix(~z+age) \%*\% c(-.4, -.4, 0.2, 2, -0.05)) 47 | y <- (runif(n)=latex,text height=1.5ex,text depth=0.25ex] 13 | \matrix[row sep=0.4cm,column sep=1cm,,ampersand replacement=\&]{ 14 | \node(emptyLeft) [scale=0.7] {}; \& \& \node(emptyRight) [scale=0.7] {}; \\ 15 | \& \node(H) [plain] {$H_{1}\cap H_{2}\cap H_{3}$}; \& \\ 16 | \node(H12) [plain] {$H_{1}\cap H_{2}$}; \& 17 | \node(H13) [plain] {$H_{1}\cap H_{3}$}; \& 18 | \node(H23) [plain] {$H_{2}\cap H_{3}$}; \\ 19 | \node(H1) [plain] {$H_{1}$}; \& 20 | \node(H2) [plain] {$H_{2}$}; \& 21 | \node(H3) [plain] {$H_{3}$}; \\ 22 | \& \node(minimalText) {Minimal hypotheses}; \\ 23 | }; 24 | \path[->] (H) edge[thick,draw=blue!75,fill=blue!75] (H12); 25 | \path[->] (H) edge[thick,draw=blue!75,fill=blue!75] (H13); 26 | \path[->] (H) edge[thick,dashed] (H23); 27 | \path[->] (H12) edge[thick,draw=blue!75,fill=blue!75] (H1); 28 | \path[->] (H12) edge[thick,dashed] (H2); 29 | \path[->] (H13) edge[thick,draw=blue!75,fill=blue!75] (H1); 30 | \path[->] (H13) edge[thick,dashed] (H3); 31 | \path[->] (H23) edge[thick,dashed] (H2); 32 | \path[->] (H23) edge[thick,dashed] (H3); 33 | \node (minimalBox) [dashed,draw=black!50,fit = (H1.north west) (minimalText.south) (H3.south east)] {}; 34 | \node (compositeBox) [anchor=south,inner sep=0.7em,dashed,draw=black!50,fit = (emptyLeft.north) (H12.south west) (H23.south east)] {}; 35 | \node (compositeText) [anchor=base,draw=none,fit = (emptyLeft.north west) (emptyRight.south east)] {Composite hypotheses}; %%\vspace*{-1em} 36 | \end{tikzpicture} 37 | 38 | \end{document} 39 | --------------------------------------------------------------------------------