├── .Rbuildignore ├── .gitignore ├── .gitmodules ├── .travis.yml ├── DESCRIPTION ├── NAMESPACE ├── NEWS.md ├── R ├── RcppExports.R ├── bassetfit_s3.R ├── fit_basset.R ├── fit_maltipoo.R ├── fit_orthus.R ├── fit_pibble.R ├── generics_s3.R ├── iqlr.R ├── kernels.R ├── mallard-data.R ├── mallard_family-data.R ├── maltipoo_sim.R ├── maltipoofit_s3.R ├── orthus_sim.R ├── orthus_transform_wrapper.R ├── pibble_plotting.R ├── pibble_sim.R ├── stray.R ├── stray_transforms.R ├── stray_utils.R ├── strayfit_methods.R └── strayfit_s3.R ├── README.md ├── _pkgdown.yml ├── cleanup ├── configure ├── configure.ac ├── data ├── mallard.RData └── mallard_family.RData ├── docs ├── 404.html ├── articles │ ├── index.html │ ├── introduction-to-stray.html │ ├── introduction-to-stray_files │ │ ├── figure-html │ │ │ ├── unnamed-chunk-10-1.png │ │ │ ├── unnamed-chunk-12-1.png │ │ │ ├── unnamed-chunk-13-1.png │ │ │ ├── unnamed-chunk-14-1.png │ │ │ └── unnamed-chunk-7-1.png │ │ └── header-attrs-2.2 │ │ │ └── header-attrs.js │ ├── non-linear-models.html │ ├── non-linear-models_files │ │ ├── figure-html │ │ │ ├── unnamed-chunk-3-1.png │ │ │ └── unnamed-chunk-5-1.png │ │ └── header-attrs-2.2 │ │ │ └── header-attrs.js │ ├── orthus.html │ ├── orthus_files │ │ ├── figure-html │ │ │ └── unnamed-chunk-5-1.png │ │ └── header-attrs-2.2 │ │ │ └── header-attrs.js │ ├── picking_priors.html │ └── picking_priors_files │ │ └── header-attrs-2.2 │ │ └── header-attrs.js ├── authors.html ├── bootstrap-toc.css ├── bootstrap-toc.js ├── docsearch.css ├── docsearch.js ├── index.html ├── link.svg ├── news │ └── index.html ├── pkgdown.css ├── pkgdown.js ├── pkgdown.yml └── reference │ ├── access_dims.html │ ├── as.list.orthusfit.html │ ├── as.list.pibblefit.html │ ├── as.orthusfit.html │ ├── as.pibblefit.html │ ├── basset_fit.html │ ├── check_dims.html │ ├── coef.orthusfit.html │ ├── coef.pibblefit.html │ ├── compiled_with_openmp.html │ ├── conjugateLinearModel.html │ ├── convert_orthus_covariance.html │ ├── hessVectorProd.html │ ├── index.html │ ├── kernels.html │ ├── lambda_to_iqlr.html │ ├── lmvgamma.html │ ├── lmvgamma_deriv.html │ ├── loglikMaltipooCollapsed.html │ ├── loglikPibbleCollapsed.html │ ├── mallard.html │ ├── mallard_family.html │ ├── maltipoo_fit.html │ ├── maltipoofit.html │ ├── mongrel-deprecated.html │ ├── mongrel_tidy_samples.html │ ├── name.html │ ├── name.orthusfit.html │ ├── name.pibblefit.html │ ├── name_dims.html │ ├── optimMaltipooCollapsed.html │ ├── optimPibbleCollapsed.html │ ├── orthus_fit.html │ ├── orthus_lr_transforms.html │ ├── orthus_sim.html │ ├── orthus_tidy_samples.html │ ├── orthusfit.html │ ├── pibble_fit.html │ ├── pibble_sim.html │ ├── pibble_tidy_samples.html │ ├── pibblefit.html │ ├── plot.pibblefit-1.png │ ├── plot.pibblefit-2.png │ ├── plot.pibblefit.html │ ├── ppc.html │ ├── ppc.pibblefit.html │ ├── ppc_summary.html │ ├── predict.bassetfit.html │ ├── predict.pibblefit.html │ ├── print.orthusfit.html │ ├── print.pibblefit.html │ ├── random_pibble_init.html │ ├── refit.html │ ├── req.html │ ├── req.maltipoo.html │ ├── req.maltipoofit.html │ ├── req.orthusfit.html │ ├── req.pibblefit.html │ ├── sample_prior.html │ ├── sample_prior.pibblefit-1.png │ ├── sample_prior.pibblefit.html │ ├── store_coord.html │ ├── stray_package.html │ ├── stray_transforms.html │ ├── summary.orthusfit.html │ ├── summary.pibblefit.html │ ├── uncollapsePibble.html │ ├── verify.bassetfit.html │ ├── verify.html │ ├── verify.maltipoofit.html │ ├── verify.multipoo.html │ ├── verify.orthusfit.html │ └── verify.pibblefit.html ├── inst ├── CITATION ├── include │ ├── AdamOptim.h │ ├── LaplaceApproximation.h │ ├── MaltipooCollapsed.h │ ├── MatDist.h │ ├── MatDist_thread.h │ ├── MatrixAlgebra.h │ ├── MongrelModelClass.h │ ├── MultDirichletBoot.h │ ├── PibbleCollapsed.h │ ├── SpecialFunctions.h │ └── stray.h └── stray.png ├── man ├── access_dims.Rd ├── as.list.orthusfit.Rd ├── as.list.pibblefit.Rd ├── as.orthusfit.Rd ├── as.pibblefit.Rd ├── basset_fit.Rd ├── check_dims.Rd ├── coef.orthusfit.Rd ├── coef.pibblefit.Rd ├── conjugateLinearModel.Rd ├── convert_orthus_covariance.Rd ├── kernels.Rd ├── lambda_to_iqlr.Rd ├── lmvgamma.Rd ├── lmvgamma_deriv.Rd ├── loglikMaltipooCollapsed.Rd ├── loglikPibbleCollapsed.Rd ├── mallard.Rd ├── mallard_family.Rd ├── maltipoo_fit.Rd ├── maltipoofit.Rd ├── mongrel-deprecated.Rd ├── name.Rd ├── name.orthusfit.Rd ├── name.pibblefit.Rd ├── name_dims.Rd ├── optimMaltipooCollapsed.Rd ├── optimPibbleCollapsed.Rd ├── orthus_fit.Rd ├── orthus_lr_transforms.Rd ├── orthus_sim.Rd ├── orthus_tidy_samples.Rd ├── orthusfit.Rd ├── pibble_fit.Rd ├── pibble_sim.Rd ├── pibble_tidy_samples.Rd ├── pibblefit.Rd ├── plot.pibblefit.Rd ├── ppc.Rd ├── ppc.pibblefit.Rd ├── ppc_summary.Rd ├── predict.bassetfit.Rd ├── predict.pibblefit.Rd ├── print.orthusfit.Rd ├── print.pibblefit.Rd ├── random_pibble_init.Rd ├── refit.Rd ├── req.Rd ├── req.maltipoofit.Rd ├── req.orthusfit.Rd ├── req.pibblefit.Rd ├── sample_prior.Rd ├── sample_prior.pibblefit.Rd ├── store_coord.Rd ├── stray_package.Rd ├── stray_transforms.Rd ├── summary.orthusfit.Rd ├── summary.pibblefit.Rd ├── uncollapsePibble.Rd ├── verify.Rd ├── verify.bassetfit.Rd ├── verify.maltipoofit.Rd ├── verify.orthusfit.Rd └── verify.pibblefit.Rd ├── src ├── ConjugateLinearModel.cpp ├── Makevars.in ├── Makevars.win ├── MaltipooCollapsed_LGH.cpp ├── MaltipooCollapsed_Optim.cpp ├── MatrixAlgebra.cpp ├── PibbleCollapsed_LGH.cpp ├── PibbleCollapsed_Optim.cpp ├── PibbleCollapsed_Uncollapse.cpp ├── RcppExports.cpp ├── SpecialFunctions.cpp ├── test_LaplaceApproximation.cpp ├── test_MultDirichletBoot.cpp └── test_utils.cpp ├── stray.Rproj ├── tests ├── testthat.R └── testthat │ ├── .gitignore │ ├── Rplots.pdf │ ├── test-basset.R │ ├── test-hessian.R │ ├── test-hvp.R │ ├── test-iqlr.R │ ├── test-kernels.R │ ├── test-laplaceapproximation.R │ ├── test-linesearch.R │ ├── test-maltipoo.R │ ├── test-matdist.R │ ├── test-mongrelfit-methods.R │ ├── test-multdirichletboot.R │ ├── test-orthus-transforms.R │ ├── test-orthus.R │ ├── test-pibble.R │ ├── test-sylvester-speedups.R │ ├── test-transforms.R │ └── test-utils.R └── vignettes ├── .gitignore ├── bibliography.bib ├── introduction-to-stray.Rmd ├── non-linear-models.Rmd ├── orthus.Rmd └── picking_priors.Rmd /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^\.travis\.yml$ 4 | ^inst/extdata/Kashyap2013/.git$ 5 | ^docs$ 6 | ^_pkgdown\.yml$ 7 | ^README.md$ 8 | ^src/Makevars$ -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | src/*.o 6 | src/*.so 7 | src/*.dll 8 | inst/doc 9 | /autom4te.cache 10 | /config.log 11 | /config.status 12 | /R/open_mp_status.R 13 | /src/Makevars 14 | /src/RcppExports-c6dce4e0.o.tmp 15 | -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "inst/extdata/Kashyap2013"] 2 | path = inst/extdata/Kashyap2013 3 | url = https://github.com/jsilve24/kashyap2013data.git 4 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # R for travis: see documentation at https://docs.travis-ci.com/user/languages/r 2 | 3 | language: R 4 | cache: packages 5 | 6 | os: 7 | - osx 8 | - linux 9 | 10 | # warnings_are_errors: false 11 | 12 | 13 | # Packages to install from specific sources other than CRAN 14 | use_bioc: true 15 | bioc_required: true 16 | bioc_packages: 17 | - phyloseq 18 | 19 | # Linus System dependencies: 20 | apt_packages: 21 | - libgsl0-dev 22 | 23 | # Increase build time-out time - because of long package vignette built times 24 | 25 | script: 26 | - R CMD build --no-build-vignettes . 27 | - R CMD check --no-vignettes *.tar.gz 28 | 29 | after_failure: 30 | find *Rcheck -name '*.fail' -print -exec cat '{}' \; -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: stray 2 | Type: Package 3 | Title: Bayesian Multinomial Logistic Normal Regression 4 | Version: 0.1.13 5 | Date: 2019-07-06 6 | Author: Justin Silverman 7 | Authors@R: c(person("Justin", "Silverman", role=c("aut", "cre"), 8 | email = "Justin.Silverman@duke.edu"), 9 | person("Kim", "Roche", role=("ctb"), 10 | email = "kimberly.roche@duke.edu")) 11 | Maintainer: Justin Silverman 12 | 13 | Description: Provides methods for fitting and inspection of Bayesian Multinomial 14 | Logistic Normal Models using MAP estimation 15 | and Laplace Approximation. Key functionality is implemented in C++ for 16 | scalability. 17 | License: GPL (>=2) 18 | URL: https://jsilve24.github.io/stray/ 19 | Depends: R (>= 3.5.0) 20 | Imports: Rcpp (>= 0.12.17), RcppEigen (>= 0.3.3.4.0), driver, dplyr, ggplot2, 21 | purrr, tidybayes, rlang 22 | LinkingTo: Rcpp, RcppEigen, RcppNumerical, RcppZiggurat, BH 23 | RoxygenNote: 6.1.1 24 | Suggests: 25 | testthat (>= 2.1.0), 26 | knitr, 27 | rmarkdown, 28 | phyloseq, 29 | ape, 30 | numDeriv, 31 | MCMCpack, 32 | MicrobeDS 33 | Remotes: 34 | jsilve24/driver, 35 | twbattaglia/MicrobeDS 36 | VignetteBuilder: knitr 37 | LazyData: true 38 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method("names_categories<-",pibblefit) 4 | S3method("names_covariates<-",pibblefit) 5 | S3method("names_samples<-",pibblefit) 6 | S3method(as.list,orthusfit) 7 | S3method(as.list,pibblefit) 8 | S3method(coef,orthusfit) 9 | S3method(coef,pibblefit) 10 | S3method(name,orthusfit) 11 | S3method(names_categories,pibblefit) 12 | S3method(names_coords,pibblefit) 13 | S3method(names_covariates,pibblefit) 14 | S3method(names_samples,pibblefit) 15 | S3method(ncategories,orthusfit) 16 | S3method(ncategories,pibblefit) 17 | S3method(ncovariates,orthusfit) 18 | S3method(ncovariates,pibblefit) 19 | S3method(niter,orthusfit) 20 | S3method(niter,pibblefit) 21 | S3method(nsamples,orthusfit) 22 | S3method(nsamples,pibblefit) 23 | S3method(plot,pibblefit) 24 | S3method(ppc,pibblefit) 25 | S3method(ppc_summary,pibblefit) 26 | S3method(predict,bassetfit) 27 | S3method(predict,pibblefit) 28 | S3method(print,orthusfit) 29 | S3method(print,pibblefit) 30 | S3method(refit,bassetfit) 31 | S3method(refit,pibblefit) 32 | S3method(req,maltipoofit) 33 | S3method(req,orthusfit) 34 | S3method(req,pibblefit) 35 | S3method(sample_prior,pibblefit) 36 | S3method(summary,orthusfit) 37 | S3method(summary,pibblefit) 38 | S3method(to_alr,orthusfit) 39 | S3method(to_alr,pibblefit) 40 | S3method(to_clr,orthusfit) 41 | S3method(to_clr,pibblefit) 42 | S3method(to_ilr,orthusfit) 43 | S3method(to_ilr,pibblefit) 44 | S3method(to_proportions,orthusfit) 45 | S3method(to_proportions,pibblefit) 46 | S3method(verify,bassetfit) 47 | S3method(verify,maltipoofit) 48 | S3method(verify,orthusfit) 49 | S3method(verify,pibblefit) 50 | export("names_categories<-") 51 | export("names_covariates<-") 52 | export("names_samples<-") 53 | export(LINEAR) 54 | export(SE) 55 | export(basset) 56 | export(check_dims) 57 | export(conjugateLinearModel) 58 | export(gradMaltipooCollapsed) 59 | export(gradPibbleCollapsed) 60 | export(hessMaltipooCollapsed) 61 | export(hessPibbleCollapsed) 62 | export(lambda_to_iqlr) 63 | export(loglikMaltipooCollapsed) 64 | export(loglikPibbleCollapsed) 65 | export(maltipoo) 66 | export(maltipoofit) 67 | export(name) 68 | export(names_categories) 69 | export(names_coords) 70 | export(names_covariates) 71 | export(names_samples) 72 | export(ncategories) 73 | export(ncovariates) 74 | export(niter) 75 | export(nsamples) 76 | export(oalr) 77 | export(oalrInv) 78 | export(oalrvar2alrvar) 79 | export(oalrvar2clrvar) 80 | export(oalrvar2ilrvar) 81 | export(oclr) 82 | export(oclrInv) 83 | export(oclrvar2alrvar) 84 | export(oclrvar2ilrvar) 85 | export(oglr) 86 | export(oglrInv) 87 | export(oilr) 88 | export(oilrInv) 89 | export(oilrvar2alrvar) 90 | export(oilrvar2clrvar) 91 | export(oilrvar2ilrvar) 92 | export(optimMaltipooCollapsed) 93 | export(optimPibbleCollapsed) 94 | export(orthus) 95 | export(orthus_sim) 96 | export(orthus_tidy_samples) 97 | export(orthusfit) 98 | export(pibble) 99 | export(pibble_sim) 100 | export(pibble_tidy_samples) 101 | export(pibblefit) 102 | export(ppc) 103 | export(ppc_summary) 104 | export(random_pibble_init) 105 | export(reapply_coord) 106 | export(refit) 107 | export(req) 108 | export(sample_prior) 109 | export(store_coord) 110 | export(to_alr) 111 | export(to_clr) 112 | export(to_ilr) 113 | export(to_proportions) 114 | export(uncollapsePibble) 115 | export(verify) 116 | import(dplyr) 117 | import(driver) 118 | import(ggplot2) 119 | import(tidybayes) 120 | importFrom(Rcpp,sourceCpp) 121 | importFrom(dplyr,bind_rows) 122 | importFrom(dplyr,filter) 123 | importFrom(dplyr,group_by) 124 | importFrom(dplyr,select) 125 | importFrom(dplyr,ungroup) 126 | importFrom(driver,alr) 127 | importFrom(driver,alrInv) 128 | importFrom(driver,gather_array) 129 | importFrom(driver,summarise_posterior) 130 | importFrom(purrr,map) 131 | importFrom(rlang,syms) 132 | importFrom(stats,median) 133 | importFrom(stats,predict) 134 | importFrom(stats,quantile) 135 | importFrom(stats,rWishart) 136 | importFrom(stats,rmultinom) 137 | importFrom(stats,rnorm) 138 | importFrom(stats,runif) 139 | importFrom(tidybayes,mean_qi) 140 | useDynLib(stray) 141 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # stray 0.1.13 2 | 3 | * tons of tiny changes to prepare for version 0.2 (and ultimately CRAN) featured changes include: 4 | * plot and coef methods for *fit objects now abide by CRAN generic naming scheme - may cause 5 | some problems if prior code had positional arguments to these functions 6 | * now being tested using travis integration (vignettes not tested there due to time constraints) 7 | * merged Kim's fixes to maltipoo code (will almost certainly change maltipoo results; there 8 | had been a bug in prior versions) 9 | * Internally stored mallard and mallard_family data now import as `mallard` and `mallard_family` 10 | rather than both importing as `ps`. Solved a R CMD CHECK warning. 11 | * Lots of tiny updates to documentation 12 | 13 | # stray 0.1.12 14 | 15 | * orthus added for jointly fitting multinomial and gaussian data (e.g., 16S microbiome and metabolomics data) 16 | 17 | # stray 0.1.11 18 | 19 | * Kim fixed windows installation problems (Thanks Kim!) 20 | * Fixed bug in predict that was effecting ppc 21 | * Fixed error when pars!=NULL in summary 22 | * lambda_to_iqlr now had default behavior when focus.cov=NULL 23 | * Fixed issue with Xi=NULL in pibblefit when trying to transform 24 | * small changes to make pibble wrapper around c++ functions faster 25 | 26 | # stray 0.1.10 27 | 28 | * basset added for fitting non-linear regression using stray 29 | * numerous changes to make installation easier 30 | * Added a `NEWS.md` file to track changes to the package. 31 | -------------------------------------------------------------------------------- /R/fit_basset.R: -------------------------------------------------------------------------------- 1 | 2 | #' Interface to fit basset models 3 | #' 4 | #' Basset (A Lazy Learner) - non-linear regression models in stray 5 | #' 6 | #' @param Y D x N matrix of counts (if NULL uses priors only) 7 | #' @param X Q x N matrix of covariates (cannot be NULL) 8 | #' @param upsilon dof for inverse wishart prior (numeric must be > D) 9 | #' (default: D+3) 10 | #' @param Theta A function from dimensions dim(X) -> (D-1)xN (prior mean of gaussian process) 11 | #' @param Gamma A function from dimension dim(X) -> NxN (kernel matrix of gaussian process) 12 | #' @param Xi (D-1)x(D-1) prior covariance matrix 13 | #' (default: ALR transform of diag(1)*(upsilon-D)/2 - this is 14 | #' essentially iid on "base scale" using Aitchison terminology) 15 | #' @param init (D-1) x Q initialization for Eta for optimization 16 | #' @param pars character vector of posterior parameters to return 17 | #' @param m object of class bassetfit 18 | #' @param ... other arguments passed to \link{pibble} (which is used internally to 19 | #' fit the basset model) 20 | #' 21 | #' @details the full model is given by: 22 | #' \deqn{Y_j \sim Multinomial(Pi_j)} 23 | #' \deqn{Pi_j = Phi^{-1}(Eta_j)} 24 | #' \deqn{Eta \sim MN_{D-1 x N}(Lambda, Sigma, I_N)} 25 | #' \deqn{Lambda \sim GP_{D-1 x Q}(Theta(X), Sigma, Gamma(X))} 26 | #' \deqn{Sigma \sim InvWish(upsilon, Xi)} 27 | #' Where Gamma(X) is short hand for the Gram matrix of the Kernel function. 28 | #' 29 | #' Default behavior is to use MAP estimate for uncollaping the LTP 30 | #' model if laplace approximation is not preformed. 31 | #' @return an object of class bassetfit 32 | #' @md 33 | #' @name basset_fit 34 | NULL 35 | 36 | #' @rdname basset_fit 37 | #' @export 38 | basset <- function(Y=NULL, X, upsilon=NULL, Theta=NULL, Gamma=NULL, Xi=NULL, 39 | init=NULL, pars=c("Eta", "Lambda", "Sigma"), ...){ 40 | 41 | if (!is.null(Theta)) { 42 | Theta_train <- Theta(X) 43 | } else { 44 | Theta <- function(X) matrix(0, nrow(Y)-1, ncol(X)) 45 | Theta_train <- Theta(X) 46 | } 47 | if (!is.null(Gamma)) { 48 | Gamma_train <- Gamma(X) 49 | } else { 50 | stop("No Default Kernel For Gamma Implemented") 51 | } 52 | 53 | out <- pibble(Y, X=diag(ncol(X)), upsilon, Theta_train, Gamma_train, Xi, init, pars, ...) 54 | out$Q <- as.integer(nrow(X)) 55 | out$X <- X 56 | out$Theta <- Theta 57 | out$Gamma <- Gamma 58 | class(out) <- c("bassetfit", "pibblefit") 59 | verify(out) 60 | return(out) 61 | } 62 | 63 | #' @rdname basset_fit 64 | #' @export 65 | refit.bassetfit <- function(m, pars=c("Eta", "Lambda", "Sigma"), ...){ 66 | # Store coordinates and tranfsorm to cannonical representation 67 | l <- store_coord(m) 68 | m <- to_alr(m, m$D) 69 | 70 | # Concatenate parameters to pass to basset function 71 | argl <- list(...) 72 | argl$pars <- pars 73 | ml <- as.list(m) 74 | argl <- c(ml, argl) 75 | 76 | # Need to handle iter as part of m but no n_samples passed 77 | # in this situation should pull iter from m and pass as n_samples to pibble 78 | if (is.null(argl[["n_samples"]]) & !is.null(m$iter)) argl[["n_samples"]] <- m$iter 79 | 80 | # pass to basset function 81 | m <- do.call(basset, argl) 82 | 83 | # Reapply original coordinates 84 | m <- reapply_coord(m, l) 85 | verify(m) 86 | return(m) 87 | } -------------------------------------------------------------------------------- /R/generics_s3.R: -------------------------------------------------------------------------------- 1 | #' Generic method for verifying new objects 2 | #' 3 | #' Intended to be called internally by package or object creator 4 | #' 5 | #' @param m object 6 | #' @param ... other arguments to be passed to verify 7 | #' 8 | #' @return throws error if verify test fails 9 | #' @export 10 | verify <- function(m, ...){ 11 | UseMethod("verify", m) 12 | } 13 | 14 | #' Generic method for ensuring object contains required elements 15 | #' 16 | #' Intended to be called internally by package 17 | #' 18 | #' @param m object 19 | #' @param r vector of elements to test for 20 | #' 21 | #' @return throws error if required element is not present 22 | #' @export 23 | req <- function(m, r){ 24 | UseMethod("req", m) 25 | } 26 | 27 | 28 | #' Generic method for applying names to an object 29 | #' 30 | #' Intended to be called internally by package 31 | #' 32 | #' @param m object 33 | #' @param ... other arguments to be passed 34 | #' 35 | #' @return object of same class but with names applied to dimensions 36 | #' @export 37 | name <- function(m, ...){ 38 | UseMethod("name", m) 39 | } 40 | 41 | 42 | #' Generic method for sampling from prior distribution of object 43 | #' 44 | #' @param m object 45 | #' @param n_samples number of samples to produce 46 | #' @param ... other arguments to be passed 47 | #' 48 | #' @export 49 | #' @return object of the same class 50 | sample_prior <- function(m, n_samples=2000L, ...){ 51 | UseMethod("sample_prior", m) 52 | } 53 | 54 | #' Generic method for fitting model from passed model fit object 55 | #' 56 | #' @param m object 57 | #' @param ... other arguments passed that control fitting 58 | #' 59 | #' @export 60 | #' @return object of the same class as \code{m} 61 | refit <- function(m, ...){ 62 | UseMethod("refit", m) 63 | } 64 | 65 | 66 | #' Generic method for visualizing posterior predictive checks 67 | #' @param m object 68 | #' @param ... other arguments passed that control visualization 69 | #' @export 70 | ppc <- function(m, ...){ 71 | UseMethod("ppc", m) 72 | } 73 | 74 | 75 | #' Generic method for accessing model fit dimensions 76 | #' 77 | #' @param m An object of class pibblefit 78 | #' @details An alternative approach to accessing these dimensions is to 79 | #' access them directly from the pibblefit object using list indexing. 80 | #' * \code{ncategories} is equivalent to \code{m$D} 81 | #' * \code{nsamples} is equivalent to \code{m$N} 82 | #' * \code{ncovariates} is equivalent to \code{m$Q} 83 | #' @return integer 84 | #' @name access_dims 85 | #' @examples 86 | #' \dontrun{ 87 | #' m <- pibble(Y, X) 88 | #' ncategories(m) 89 | #' nsamples(m) 90 | #' ncovariates(m) 91 | #' } 92 | NULL 93 | 94 | #' @rdname access_dims 95 | #' @export 96 | ncategories <- function(m){ 97 | UseMethod("ncategories", m) 98 | } 99 | 100 | #' @rdname access_dims 101 | #' @export 102 | nsamples <- function(m){ 103 | UseMethod("nsamples", m) 104 | } 105 | 106 | #' @rdname access_dims 107 | #' @export 108 | ncovariates <- function(m){ 109 | UseMethod("ncovariates", m) 110 | } 111 | 112 | #' @rdname access_dims 113 | #' @export 114 | niter <- function(m){ 115 | UseMethod("niter", m) 116 | } 117 | 118 | 119 | #' Generic method for getting and setting dimension names of fit object 120 | #' 121 | #' @param m object 122 | #' @param value character vector (or NULL) 123 | #' @name name_dims 124 | #' 125 | #' @details \code{names_coords} is different than \code{names_categories}. 126 | #' \code{names_categories} provides access to the basic names of each multinomial 127 | #' category. In contrast, \code{names_coords} provides access to the 128 | #' names of the coordinates in which an object is represented. These coordinate 129 | #' names are based on the category names. For example, category names may be, 130 | #' (OTU1, ..., OTUD) where as coordinate names could be (log(OTU1/OTUD), etc...) 131 | #' if object is in default coordinate system. 132 | NULL 133 | 134 | #' @rdname name_dims 135 | #' @export 136 | names_covariates <- function(m){ 137 | UseMethod("names_covariates", m) 138 | } 139 | 140 | #' @rdname name_dims 141 | #' @export 142 | names_samples <- function(m){ 143 | UseMethod("names_samples", m) 144 | } 145 | 146 | 147 | #' @rdname name_dims 148 | #' @export 149 | names_categories <- function(m){ 150 | UseMethod("names_categories", m) 151 | } 152 | 153 | #' @rdname name_dims 154 | #' @export 155 | names_coords <- function(m){ 156 | UseMethod("names_coords", m) 157 | } 158 | 159 | 160 | #' @rdname name_dims 161 | #' @export 162 | `names_covariates<-` <- function(m, value){ 163 | UseMethod("names_covariates<-", m) 164 | } 165 | 166 | #' @rdname name_dims 167 | #' @export 168 | `names_samples<-` <- function(m, value){ 169 | UseMethod("names_samples<-", m) 170 | } 171 | 172 | 173 | #' @rdname name_dims 174 | #' @export 175 | `names_categories<-` <- function(m, value){ 176 | UseMethod("names_categories<-", m) 177 | } 178 | 179 | 180 | 181 | #' Generic Method to Plot Posterior Predictive Summaries 182 | #' 183 | #' @param m model object 184 | #' @param ... other arguments to pass 185 | #' 186 | #' @return vector 187 | #' @name ppc_summary 188 | NULL 189 | 190 | #' @rdname ppc_summary 191 | #' @export 192 | ppc_summary <- function(m, ...){ 193 | UseMethod("ppc_summary", m) 194 | } 195 | 196 | 197 | 198 | -------------------------------------------------------------------------------- /R/iqlr.R: -------------------------------------------------------------------------------- 1 | #' Transform Lambda into IQLR (Inter-Quantile Log-Ratio) 2 | #' 3 | #' Primarily intended for doing differential expression analysis under 4 | #' assumption that only small group of categories (e.g., taxa / genes) are changing 5 | #' 6 | #' @param m object of class pibblefit (e.g., output of \code{\link{pibble}}) 7 | #' @param focus.cov vector of integers or characters specifying columns (covariates) 8 | #' of Lambda to include in calculating IQLR (if NULL, default, then uses all covariates) 9 | #' @param probs bounds for categories (i.e., features / genes / taxa) to include in 10 | #' calculation of iqlr (smaller bounds means more stringent inclusion criteria) 11 | #' 12 | #' @description Takes idea from Wu et al. (citation below) and calculates IQLR for 13 | #' Lambda, potentially useful if you believe there is an invariant group of 14 | #' categories (e.g., taxa / genes) that are not changing (in absolute abundance) 15 | #' between samples. IQLR is defined as 16 | #' \deqn{IQLR_x = log(x_i/g(IQVF))} 17 | #' for i in 1,...,D. 18 | #' IQVF are the CLR coordinates whose variance is within the inter-quantile range 19 | #' (defined by \code{probs} argument to this function). 20 | #' A different IQVF is fit for each posteior sample as the IQVFs are calculted 21 | #' based on posterior estimates for Lambda. The variance of a CLR coordinate 22 | #' is defined as the norm of each row of Lambda[,focus.cov] (i.e., 23 | #' the covariation in Eta, explained by those covariates). This definition of 24 | #' variance allows uses to exclude variation from technical / trivial sources 25 | #' in calculation of IQVF/IQLR. 26 | #' 27 | #' @export 28 | #' @return array of dimension (D, Q, iter) where D is number of taxa, Q is number 29 | #' of covariates, and iter is number of posterior samples. 30 | #' 31 | #' @examples 32 | #' sim <- pibble_sim() 33 | #' fit <- pibble(sim$Y, sim$X) 34 | #' # Use first two covariates to define iqlr, just show first 5 samples 35 | #' lambda_to_iqlr(fit, 1:2)[,,1:5] 36 | #' 37 | #' @references Jia R. Wu, Jean M. Macklaim, Briana L. Genge, Gregory B. Gloor (2017) 38 | #' Finding the center: corrections for asymmetry in high-throughput sequencing 39 | #' datasets. arxiv:1704.01841v1 40 | lambda_to_iqlr <- function(m, focus.cov=NULL, probs=c(.25, .75)){ 41 | req(m, "Lambda") # defensive 42 | if (!is.null(focus.cov)) focus.cov <- 1:m$Q 43 | if (is.character(focus.cov)) focus.cov <- which(focus.cov %in% names_categories) 44 | in.iqr <- matrix(0, ncategories(m), niter(m)) 45 | 46 | # Convert to clr for calculating inter-quartile variable features (iqvf) 47 | m <- to_clr(m) 48 | 49 | # Calculate quantiles based on vector magnitude / covariance 50 | for (i in 1:niter(m)){ 51 | L <- vec_to_mat(m$Lambda[,focus.cov,i]) 52 | L <- rowSums(L*L) 53 | q <- stats::quantile(L, probs) 54 | in.iqr[,i] <- (L>= q[1]) & (L <= q[2]) 55 | } 56 | 57 | # Transform 58 | m <- to_proportions(m) 59 | Lambda_iqlr <- array(0, dim=c(ncategories(m), ncovariates(m), niter(m))) 60 | for (i in 1:niter(m)){ 61 | V <- matrix(0, ncategories(m), ncategories(m)) 62 | iqvf <- in.iqr[,i] ==1 63 | V[,iqvf] <- 1/sum(iqvf) 64 | V <- diag(nrow(V)) - V 65 | Lambda_iqlr[,,i] <- V%*%log(m$Lambda[,,i]) 66 | } 67 | return(Lambda_iqlr) 68 | } 69 | -------------------------------------------------------------------------------- /R/kernels.R: -------------------------------------------------------------------------------- 1 | #' Multivariate RBF Kernel 2 | #' 3 | #' Designed to be partially specified. (see examples) 4 | #' @param X covariate (dimension Q x N; i.e., covariates x samples) 5 | #' @param sigma scalar parameter 6 | #' @param rho scalar bandwidth parameter 7 | #' @param jitter small scalar to add to off-diagonal of gram matrix 8 | #' (for numerical underflow issues) 9 | #' @param c vector parameter defining intercept for linear kernel 10 | #' 11 | #' @details Gram matrix G is given by 12 | #' 13 | #' SE (squared exponential): 14 | #' \deqn{G = \sigma^2 * exp(-[(X-c)'(X-c)]/(s*\rho^2))} 15 | #' 16 | #' LINEAR: 17 | #' \deqn{G = \sigma^2*(X-c)'(X-c)} 18 | #' 19 | #' 20 | #' @return Gram Matrix (N x N) (e.g., the Kernel evaluated at 21 | #' each pair of points) 22 | #' @name kernels 23 | #' @examples 24 | #' # Create Partial for use with basset 25 | #' K <- function(X) SE(X, 2, .2) 26 | #' 27 | #' # Example use 28 | #' X <- matrix(rnorm(10), 2, 5) 29 | #' G <- K(X) 30 | #' G # this is the gram matrix (the kernel evaluated on a finite set of points) 31 | NULL 32 | 33 | #' @rdname kernels 34 | #' @export 35 | SE <- function(X, sigma=1, rho=median(as.matrix(dist(t(X)))), jitter=1e-10){ 36 | dist <- as.matrix(dist(t(X))) 37 | G <- sigma^2 * exp(-dist^2/(2*rho^2)) + jitter*diag(ncol(dist)) 38 | return(G) 39 | } 40 | 41 | 42 | #' @rdname kernels 43 | #' @export 44 | LINEAR <- function(X, sigma=1, c=rep(0, nrow(X))){ 45 | E <- sweep(X, 1, c) 46 | G <- sigma^2*crossprod(E) 47 | return(G) 48 | } -------------------------------------------------------------------------------- /R/mallard-data.R: -------------------------------------------------------------------------------- 1 | #' Data from Silverman et al. (2018) Microbiome 2 | #' 3 | #' High Resolution (hourly and daily) sampling of 4 in vitro artificial gut models 4 | #' with many technical replicates to identify technical variation. 5 | #' 6 | #' This data is at the sequence variant level. Data at the family level 7 | #' processed as in Silverman et al. 2018 is given in \code{\link{mallard_family}} 8 | #' 9 | #' @docType data 10 | #' @name mallard 11 | #' @usage data(mallard) 12 | #' @format An object of class \code{\link[phyloseq]{phyloseq-class}} 13 | #' @references Silverman et al. "Dynamic linear models guide design and 14 | #' analysis of microbiota studies within artificial human guts". 15 | #' Microbiome 2018 6:202 16 | NULL -------------------------------------------------------------------------------- /R/mallard_family-data.R: -------------------------------------------------------------------------------- 1 | #' Data from Silverman et al. (2018) Microbiome 2 | #' 3 | #' High Resolution (hourly and daily) sampling of 4 in vitro artificial gut models 4 | #' with many technical replicates to identify technical variation. 5 | #' 6 | #' This data is at the family level and processed as in Silverman et al. 2018. Data at the sequence 7 | #' variant level without preprocessing is given in \code{\link{mallard}} 8 | #' 9 | #' @docType data 10 | #' @name mallard_family 11 | #' @usage data(mallard_family) 12 | #' @format An object of class \code{\link[phyloseq]{phyloseq-class}} 13 | #' @references Silverman et al. "Dynamic linear models guide design and 14 | #' analysis of microbiota studies within artificial human guts". 15 | #' Microbiome 2018 6:202 16 | NULL -------------------------------------------------------------------------------- /R/maltipoo_sim.R: -------------------------------------------------------------------------------- 1 | # #' Simulate Data and Priors for Maltipoo 2 | # #' 3 | # #' @inheritParams pibble_sim 4 | # #' @param P number of variance components to simulate 5 | # #' 6 | # #' @return list 7 | # #' @export 8 | # #' 9 | # #' @examples 10 | # #' maltipoo_sim(10, 30, 30, 3, TRUE, FALSE) 11 | # maltipoo_sim <- function(D=10, N=30, P=3, 12 | # use_names=TRUE, true_priors=FALSE){ 13 | # 14 | # Q <- N 15 | # 16 | # # Simulate Data 17 | # Sigma <- diag(sample(1:8, D-1, replace=TRUE)) 18 | # Sigma[2, 3] <- Sigma[3,2] <- -1 19 | # 20 | # rU <- rWishart(P, Q+3, diag(Q)) 21 | # U <- matrix(0, P*Q, Q) 22 | # Gamma_true <- matrix(0, Q, Q) 23 | # VCScale_true <- rgamma(P, 1, 1) 24 | # for (i in 1:P){ 25 | # U[((i-1)*Q+1):(i*Q), ] <- solve(rU[,,i]) 26 | # Gamma_true <- Gamma_true + VCScale_true[i]^2*U[((i-1)*Q+1):(i*Q), ] 27 | # } 28 | # rm(rU) 29 | # 30 | # Gamma_true <- diag(sqrt(rnorm(Q)^2)) 31 | # Theta <- matrix(0, D-1, Q) 32 | # Phi <- Theta + t(chol(Sigma))%*%matrix(rnorm(Q*(D-1)), nrow=D-1)%*%chol(Gamma_true) 33 | # X <- diag(Q) 34 | # #X <- rbind(1, X) 35 | # Eta <- Phi%*%X + t(chol(Sigma))%*%matrix(rnorm(N*(D-1)), nrow=D-1) 36 | # Pi <- t(driver::alrInv(t(Eta))) 37 | # Y <- matrix(0, D, N) 38 | # for (i in 1:N) Y[,i] <- rmultinom(1, sample(5000:10000), prob = Pi[,i]) 39 | # if (use_names){ 40 | # colnames(X) <- colnames(Y) <- paste0("s", 1:N) 41 | # rownames(Y) <- paste0("c", 1:D) 42 | # rownames(X) <- paste0("x", 1:Q) 43 | # } 44 | # 45 | # # Priors 46 | # if (true_priors){ 47 | # upsilon <- D+50 48 | # Xi <- Sigma*(upsilon-D) 49 | # } else { 50 | # upsilon <- D 51 | # Xi <- diag(D-1) 52 | # } 53 | # 54 | # # Precompute 55 | # K <- solve(Xi) 56 | # 57 | # return(list(Sigma=Sigma, Gamma_true=Gamma_true, D=D, N=N, Q=Q, Theta=Theta, Phi=Phi, 58 | # X=X, Y=Y, Eta=Eta, upsilon=upsilon, Xi=Xi, K=K, U=U, VCScale_true=VCScale_true)) 59 | # } 60 | -------------------------------------------------------------------------------- /R/maltipoofit_s3.R: -------------------------------------------------------------------------------- 1 | # internal function 2 | new_maltipoofit <- function(D, N, Q, P, coord_system, iter=NULL, 3 | alr_base=NULL, ilr_base=NULL, 4 | Eta=NULL, Lambda=NULL,Sigma=NULL, Sigma_default=NULL, 5 | Y=NULL, X=NULL, upsilon=NULL, 6 | Theta=NULL, Xi=NULL,Xi_default=NULL, Gamma=NULL, 7 | init=NULL, ellinit=NULL, names_categories=NULL, names_samples=NULL, 8 | names_covariates=NULL, VCScale=NULL, U=NULL){ 9 | m <- new_pibblefit(D, N, Q, coord_system, iter, alr_base, ilr_base, 10 | Eta, Lambda, Sigma, Sigma_default, 11 | Y, X, upsilon, Theta, Xi,Xi_default, Gamma, 12 | init, ellinit, names_categories, names_samples) 13 | m$VCScale <- VCScale 14 | m$U <- U 15 | m$ellinit <- ellinit 16 | m$P <- P 17 | m$names_covariates <- names_covariates 18 | class(m) <- c("maltipoofit", "pibblefit") 19 | } 20 | 21 | 22 | #' Create maltipoofit object 23 | #' 24 | #' @inheritParams pibblefit 25 | #' @inheritParams maltipoo_fit 26 | #' @param VCScale scale factors (delta) for variance components 27 | #' @param P number of variance components 28 | #' @return object of class maltipoofit 29 | #' @export 30 | #' @seealso \code{\link{maltipoo}} 31 | maltipoofit <- function(D, N, Q, P, coord_system, iter=NULL, 32 | alr_base=NULL, ilr_base=NULL, 33 | Eta=NULL, Lambda=NULL, Sigma=NULL, Sigma_default=NULL, 34 | Y=NULL, X=NULL, upsilon=NULL, 35 | Theta=NULL, Xi=NULL,Xi_default=NULL, Gamma=NULL, 36 | init=NULL, ellinit=NULL, names_categories=NULL, names_samples=NULL, 37 | names_covariates=NULL, VCScale=NULL, U=NULL){ 38 | m <- new_maltipoofit(D, N, Q, coord_system, iter, alr_base, ilr_base, 39 | Eta, Lambda, Sigma, Sigma_default, 40 | Y, X, upsilon, Theta, Xi,Xi_default, Gamma, 41 | init, ellinit, names_categories, names_samples, 42 | names_covariates, VCScale, U) 43 | verify(m) 44 | return(m) 45 | } 46 | 47 | 48 | 49 | #' Simple verification of passed multipoo object 50 | #' @param m an object of class multipoo 51 | #' @param ... not used 52 | #' @return throws error if any verification tests fail 53 | #' @export 54 | verify.maltipoofit <- function(m,...){ 55 | verify.pibblefit(m) 56 | stopifnot(is.integer(m$P)) 57 | ifnotnull(m$VCScale, check_dims(m$VCScale, m$P, "VCScale")) 58 | ifnotnull(m$U, check_dims(m$U, c(m$P*m$Q, m$Q), "U")) 59 | ifnotnull(m$ellinit, check_dims(m$ellinit, m$P, "ellinit")) 60 | } 61 | 62 | #' require elements to be non-null in pibblefit or throw error 63 | #' @inheritParams req 64 | #' @export 65 | req.maltipoofit <- function(m, r){ 66 | present <- sapply(m[r], is.null) 67 | if(any(present)){ 68 | stop("maltipoofit object does not contain required components:", r[present]) 69 | } 70 | } -------------------------------------------------------------------------------- /R/orthus_sim.R: -------------------------------------------------------------------------------- 1 | #' Simulate simple orthus dataset and priors (for testing) 2 | #' 3 | #' @param D number of multinomial categories 4 | #' @param P number of dimensions of second dataset Z 5 | #' @param N number of samples 6 | #' @param Q number of covariates (first one is an intercept, must be > 1) 7 | #' @param use_names should samples, covariates, and categories be named 8 | #' @param true_priors should Xi and upsilon be chosen to have mean at true 9 | #' simulated value 10 | #' @return list 11 | #' @export 12 | #' @importFrom driver alrInv 13 | #' @importFrom stats rnorm rmultinom 14 | #' @examples 15 | #' sim <- orthus_sim() 16 | orthus_sim <- function(D=10, P=10, N=30, Q=2, use_names=TRUE, true_priors=FALSE){ 17 | 18 | # Simulate Data 19 | Sigma <- diag(sample(1:8, D-1+P, replace=TRUE)) 20 | Sigma[2, 3] <- Sigma[3,2] <- -1 21 | Gamma <- diag(sqrt(rnorm(Q)^2)) 22 | Theta <- matrix(0, D-1+P, Q) 23 | Phi <- Theta + t(chol(Sigma))%*%matrix(rnorm(Q*(D-1+P)), nrow=D-1+P)%*%chol(Gamma) 24 | X <- matrix(rnorm(N*(Q-1)), Q-1, N) 25 | X <- rbind(1, X) 26 | Eta <- Phi%*%X + t(chol(Sigma))%*%matrix(rnorm(N*(D-1+P)), nrow=D-1+P) 27 | Z <- Eta[D:(D-1+P),] 28 | Eta <- Eta[1:(D-1),] 29 | Pi <- t(driver::alrInv(t(Eta))) 30 | Y <- matrix(0, D, N) 31 | for (i in 1:N) Y[,i] <- rmultinom(1, sample(5000:10000), prob = Pi[,i]) 32 | if (use_names){ 33 | colnames(X) <- colnames(Y) <- paste0("s", 1:N) 34 | rownames(Y) <- paste0("c", 1:D) 35 | rownames(X) <- paste0("x", 1:Q) 36 | } 37 | 38 | # Priors 39 | if (true_priors){ 40 | upsilon <- D+10 41 | Xi <- Sigma*(upsilon-D-P) 42 | } else { 43 | upsilon <- D 44 | Xi <- diag(D-1+P) 45 | } 46 | 47 | # Precompute 48 | KInv <- solve(Xi) 49 | AInv <- solve(diag(N)+ t(X)%*%Gamma%*%X) 50 | 51 | return(list(Sigma=Sigma, Gamma=Gamma, D=D, N=N, Q=Q, P=P, Theta=Theta, Phi=Phi, 52 | X=X, Y=Y,Z=Z, Eta=Eta, upsilon=upsilon, Xi=Xi, KInv=KInv, AInv=AInv)) 53 | } -------------------------------------------------------------------------------- /R/pibble_sim.R: -------------------------------------------------------------------------------- 1 | #' Simulate simple pibble dataset and priors (for testing) 2 | #' 3 | #' @param D number of multinomial categories 4 | #' @param N number of samples 5 | #' @param Q number of covariates (first one is an intercept, must be > 1) 6 | #' @param use_names should samples, covariates, and categories be named 7 | #' @param true_priors should Xi and upsilon be chosen to have mean at true 8 | #' simulated value 9 | #' @return list 10 | #' @export 11 | #' @importFrom driver alrInv 12 | #' @importFrom stats rnorm rmultinom 13 | #' @examples 14 | #' sim <- pibble_sim() 15 | pibble_sim <- function(D=10, N=30, Q=2, use_names=TRUE, true_priors=FALSE){ 16 | 17 | # Simulate Data 18 | Sigma <- diag(sample(1:8, D-1, replace=TRUE)) 19 | Sigma[2, 3] <- Sigma[3,2] <- -1 20 | Gamma <- diag(sqrt(rnorm(Q)^2)) 21 | Theta <- matrix(0, D-1, Q) 22 | Phi <- Theta + t(chol(Sigma))%*%matrix(rnorm(Q*(D-1)), nrow=D-1)%*%chol(Gamma) 23 | X <- matrix(rnorm(N*(Q-1)), Q-1, N) 24 | X <- rbind(1, X) 25 | Eta <- Phi%*%X + t(chol(Sigma))%*%matrix(rnorm(N*(D-1)), nrow=D-1) 26 | Pi <- t(driver::alrInv(t(Eta))) 27 | Y <- matrix(0, D, N) 28 | for (i in 1:N) Y[,i] <- rmultinom(1, sample(5000:10000), prob = Pi[,i]) 29 | if (use_names){ 30 | colnames(X) <- colnames(Y) <- paste0("s", 1:N) 31 | rownames(Y) <- paste0("c", 1:D) 32 | rownames(X) <- paste0("x", 1:Q) 33 | } 34 | 35 | # Priors 36 | if (true_priors){ 37 | upsilon <- D+10 38 | Xi <- Sigma*(upsilon-D) 39 | } else { 40 | upsilon <- D 41 | Xi <- diag(D-1) 42 | } 43 | 44 | # Precompute 45 | KInv <- solve(Xi) 46 | AInv <- solve(diag(N)+ t(X)%*%Gamma%*%X) 47 | 48 | return(list(Sigma=Sigma, Gamma=Gamma, D=D, N=N, Q=Q, Theta=Theta, Phi=Phi, 49 | X=X, Y=Y, Eta=Eta, upsilon=upsilon, Xi=Xi, KInv=KInv, AInv=AInv)) 50 | } -------------------------------------------------------------------------------- /R/stray.R: -------------------------------------------------------------------------------- 1 | #' stray: Fitting and Analysis of Multinomial Logistic Normal Models 2 | #' 3 | #' Provides methods for fitting and inspection of Bayesian Multinomial 4 | #' Logistic Normal Models using MAP estimation 5 | #' (with the ADAM optimizer) and Laplace Approximation. Key functionality is 6 | #' implemented in C++ for scalability. 7 | #' 8 | #' @docType package 9 | #' @name stray_package 10 | #' 11 | #' @useDynLib stray 12 | #' @importFrom Rcpp sourceCpp 13 | NULL 14 | 15 | globalVariables(".") 16 | 17 | 18 | 19 | .onAttach <- function(libname, pkgname) { 20 | packageStartupMessage("The stray package has been renamed fido due to name collision with another package on CRAN.", "\n", "\n", 21 | "At this time please switch to the fido package (devtools::install_github('jsilve24/fido')) where the project is now being actively developed.", "\n\n", 22 | "I appologize for the inconvenience - Justin Silverman") 23 | } -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | [![Travis build status](https://travis-ci.org/jsilve24/stray.svg?branch=master)](https://travis-ci.org/jsilve24/stray) 5 | [![License](http://img.shields.io/badge/license-GPL%20%28%3E=%202%29-brightgreen.svg?style=flat)](http://www.gnu.org/licenses/gpl-2.0.html) 6 | 7 | 8 | # UPDATE 9 | As of August 2020, due to a naming collision with another package on CRAN. stray has been renamed *fido* [and development is continuing under that name](https://github.com/jsilve24/fido). This respository (stray) is only here for backwards compatability and to serve as a notification of the name change. 10 | 11 | 12 | ## Citation ## 13 | Silverman, JD, Roche, K, Holmes, ZC, David, LA, and Mukherjee, S. Bayesian Multinomial Logistic Normal Models through Marginally Latent Matrix-T Processes. 2019, arXiv e-prints, arXiv:1903.11695 14 | 15 | ## License ## 16 | All source code freely availale under [GPL-3 License](https://www.gnu.org/licenses/gpl-3.0.en.html). 17 | 18 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | navbar: 2 | title: "stray" 3 | left: 4 | - text: "Installation" 5 | href: https://github.com/jsilve24/stray/wiki/Installation-Details 6 | - text: "Vignettes" 7 | menu: 8 | - text: "Intro to stray through stray::pibble" 9 | href: articles/introduction-to-stray.html 10 | - text: "Non-Linear Modeling with stray::basset" 11 | href: articles/non-linear-models.html 12 | - text: "Joint Modeling (e.g., Multiomics) with Stray::Orthus" 13 | href: articles/orthus.html 14 | - text: "Tips on Specifying Priors" 15 | href: articles/picking_priors.html 16 | - text: "Functions" 17 | href: "reference/index.html" 18 | - text: "News" 19 | href: news/index.html 20 | - text: "Other Packages" 21 | menu: 22 | - text: "RcppCoDA" 23 | href: https://github.com/jsilve24/RcppCoDA 24 | - text: "driver" 25 | href: https://jsilve24.github.io/driver/ 26 | - text: "philr" 27 | href: https://bioconductor.org/packages/release/bioc/html/philr.html 28 | - text: "RcppHungarian" 29 | href: https://cran.r-project.org/package=RcppHungarian 30 | right: 31 | - icon: fa-twitter 32 | href: https://twitter.com/inschool4life 33 | - icon: fa-github 34 | href: https://github.com/jsilve24/stray 35 | 36 | reference: 37 | - title: "Main Model Functions" 38 | desc: "Main interface for fitting models and returning model objects" 39 | contents: 40 | - 'pibble' 41 | - 'basset' 42 | - 'orthus' 43 | - 'maltipoo' 44 | - title: "Rcpp Model Interfaces" 45 | desc: "Low level interfaces for fitting models" 46 | contents: 47 | - optimPibbleCollapsed 48 | - optimMaltipooCollapsed 49 | - conjugateLinearModel 50 | - uncollapsePibble 51 | - loglikPibbleCollapsed 52 | - loglikMaltipooCollapsed 53 | - kernels 54 | - title: "Object Methods" 55 | desc: "Methods for working with model objects" 56 | contents: 57 | - access_dims 58 | - as.list.pibblefit 59 | - coef.pibblefit 60 | - name 61 | - name_dims 62 | - refit 63 | - ppc 64 | - ppc_summary 65 | - print.pibblefit 66 | - predict.pibblefit 67 | - plot.pibblefit 68 | - sample_prior 69 | - stray_transforms 70 | - req 71 | - verify 72 | - summary.pibblefit 73 | - summary.orthusfit 74 | - title: "Helpful Utility Methods" 75 | desc: "Just that, mostly support other package functions" 76 | contents: 77 | - random_pibble_init 78 | - lambda_to_iqlr 79 | - pibble_sim 80 | - orthus_sim 81 | - pibble_tidy_samples 82 | - orthus_tidy_samples 83 | - store_coord 84 | - check_dims 85 | - title: "Utility Math Functions" 86 | desc: "Fast, C++, mostly for internal use" 87 | contents: 88 | - lmvgamma 89 | - lmvgamma_deriv 90 | - title: "Datasets" 91 | desc: "Example Datasets" 92 | contents: 93 | - mallard 94 | - mallard_family 95 | -------------------------------------------------------------------------------- /cleanup: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | rm -f config.log 4 | rm -f config.status 5 | rm -f src/Makevars -------------------------------------------------------------------------------- /configure.ac: -------------------------------------------------------------------------------- 1 | # autoconf file inspiration from 2 | # https://github.com/USCbiostats/software-dev/wiki/Setting-up-optional-OpenMP-support 3 | 4 | AC_PREREQ([2.69]) 5 | AC_INIT(stray, m4_esyscmd_s([awk '/^Version:/ {print $2}' DESCRIPTION])) 6 | 7 | ## Set R_HOME, respecting an environment variable if one is set 8 | : ${R_HOME=$(R RHOME)} 9 | if test -z "${R_HOME}"; then 10 | AC_MSG_ERROR([Could not determine R_HOME.]) 11 | fi 12 | ## Use R to set CXX and CXXFLAGS 13 | CXX=$(${R_HOME}/bin/R CMD config CXX) 14 | CXXFLAGS=$("${R_HOME}/bin/R" CMD config CXXFLAGS) 15 | CXX11=$(${R_HOME}/bin/R CMD config CXX11) 16 | CXX11FLAGS=$("${R_HOME}/bin/R" CMD config CXX11FLAGS) 17 | 18 | ## We are using C++ 19 | AC_LANG(C++) 20 | AC_REQUIRE_CPP 21 | 22 | ## below pilfered from configure.ac in RcppArmadillo 23 | ## Check for Apple LLVM 24 | 25 | AC_MSG_CHECKING([for macOS]) 26 | RSysinfoName=$("${R_HOME}/bin/Rscript" --vanilla -e 'cat(Sys.info()[["sysname"]])') 27 | 28 | if test x"${RSysinfoName}" == x"Darwin"; then 29 | AC_MSG_RESULT([found]) 30 | AC_MSG_CHECKING([for macOS Apple compiler]) 31 | 32 | apple_compiler=$($CXX --version 2>&1 | grep -i -c -e 'apple llvm') 33 | 34 | if test x"${apple_compiler}" == x"1"; then 35 | AC_MSG_RESULT([found]) 36 | AC_MSG_WARN([OpenMP unavailable and turned off.]) 37 | can_use_openmp="no" 38 | else 39 | AC_MSG_RESULT([not found]) 40 | AC_MSG_CHECKING([for clang compiler]) 41 | clang_compiler=$($CXX --version 2>&1 | grep -i -c -e 'clang ') 42 | 43 | if test x"${clang_compiler}" == x"1"; then 44 | AC_MSG_RESULT([found]) 45 | AC_MSG_CHECKING([for OpenMP compatible version of clang]) 46 | clang_version=$(${CXX} -v 2>&1 | awk '/^.*clang version/ {print $3}') 47 | 48 | case ${clang_version} in 49 | 4.*|5.*|6.*|7.*|8.*) 50 | AC_MSG_RESULT([found and suitable]) 51 | can_use_openmp="yes" 52 | ;; 53 | *) 54 | AC_MSG_RESULT([not found]) 55 | AC_MSG_WARN([OpenMP unavailable and turned off.]) 56 | can_use_openmp="no" 57 | ;; 58 | esac 59 | else 60 | AC_MSG_RESULT([not found]) 61 | AC_MSG_WARN([unsupported macOS build detected; if anything breaks, you keep the pieces.]) 62 | fi 63 | fi 64 | fi 65 | 66 | 67 | ## Default the OpenMP flag to the empty string. 68 | ## If and only if OpenMP is found, expand to $(SHLIB_OPENMP_CXXFLAGS) 69 | openmp_flag="" 70 | ## Set the fallback, by default it is nope 71 | have_openmp="FALSE" 72 | 73 | if test x"${can_use_openmp}" == x"yes"; then 74 | AC_MSG_CHECKING([for OpenMP]) 75 | ## if R has -fopenmp we should be good 76 | allldflags=$(${R_HOME}/bin/R CMD config --ldflags) 77 | hasOpenMP=$(echo ${allldflags} | grep -- -fopenmp) 78 | if test x"${hasOpenMP}" == x""; then 79 | AC_MSG_RESULT([missing]) 80 | have_openmp="FALSE" 81 | else 82 | AC_MSG_RESULT([found and suitable]) 83 | have_openmp="TRUE" 84 | openmp_flag='$(SHLIB_OPENMP_CXXFLAGS)' 85 | fi 86 | fi 87 | 88 | 89 | ## now use all these 90 | AC_SUBST([OPENMP_FLAG], ["${openmp_flag}"]) 91 | AC_SUBST([OPENMP_TF], ["${have_openmp}"]) 92 | AC_CONFIG_FILES([src/Makevars]) 93 | AC_OUTPUT 94 | -------------------------------------------------------------------------------- /data/mallard.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jsilve24/stray/29fdc2e431b8e515f38f0a4969c1e431e918fa44/data/mallard.RData -------------------------------------------------------------------------------- /data/mallard_family.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jsilve24/stray/29fdc2e431b8e515f38f0a4969c1e431e918fa44/data/mallard_family.RData -------------------------------------------------------------------------------- /docs/articles/introduction-to-stray_files/figure-html/unnamed-chunk-10-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jsilve24/stray/29fdc2e431b8e515f38f0a4969c1e431e918fa44/docs/articles/introduction-to-stray_files/figure-html/unnamed-chunk-10-1.png -------------------------------------------------------------------------------- /docs/articles/introduction-to-stray_files/figure-html/unnamed-chunk-12-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jsilve24/stray/29fdc2e431b8e515f38f0a4969c1e431e918fa44/docs/articles/introduction-to-stray_files/figure-html/unnamed-chunk-12-1.png -------------------------------------------------------------------------------- /docs/articles/introduction-to-stray_files/figure-html/unnamed-chunk-13-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jsilve24/stray/29fdc2e431b8e515f38f0a4969c1e431e918fa44/docs/articles/introduction-to-stray_files/figure-html/unnamed-chunk-13-1.png -------------------------------------------------------------------------------- /docs/articles/introduction-to-stray_files/figure-html/unnamed-chunk-14-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jsilve24/stray/29fdc2e431b8e515f38f0a4969c1e431e918fa44/docs/articles/introduction-to-stray_files/figure-html/unnamed-chunk-14-1.png -------------------------------------------------------------------------------- /docs/articles/introduction-to-stray_files/figure-html/unnamed-chunk-7-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jsilve24/stray/29fdc2e431b8e515f38f0a4969c1e431e918fa44/docs/articles/introduction-to-stray_files/figure-html/unnamed-chunk-7-1.png -------------------------------------------------------------------------------- /docs/articles/introduction-to-stray_files/header-attrs-2.2/header-attrs.js: -------------------------------------------------------------------------------- 1 | // Pandoc 2.9 adds attributes on both header and div. We remove the former (to 2 | // be compatible with the behavior of Pandoc < 2.8). 3 | document.addEventListener('DOMContentLoaded', function(e) { 4 | var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); 5 | var i, h, a; 6 | for (i = 0; i < hs.length; i++) { 7 | h = hs[i]; 8 | if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 9 | a = h.attributes; 10 | while (a.length > 0) h.removeAttribute(a[0].name); 11 | } 12 | }); 13 | -------------------------------------------------------------------------------- /docs/articles/non-linear-models_files/figure-html/unnamed-chunk-3-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jsilve24/stray/29fdc2e431b8e515f38f0a4969c1e431e918fa44/docs/articles/non-linear-models_files/figure-html/unnamed-chunk-3-1.png -------------------------------------------------------------------------------- /docs/articles/non-linear-models_files/figure-html/unnamed-chunk-5-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jsilve24/stray/29fdc2e431b8e515f38f0a4969c1e431e918fa44/docs/articles/non-linear-models_files/figure-html/unnamed-chunk-5-1.png -------------------------------------------------------------------------------- /docs/articles/non-linear-models_files/header-attrs-2.2/header-attrs.js: -------------------------------------------------------------------------------- 1 | // Pandoc 2.9 adds attributes on both header and div. We remove the former (to 2 | // be compatible with the behavior of Pandoc < 2.8). 3 | document.addEventListener('DOMContentLoaded', function(e) { 4 | var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); 5 | var i, h, a; 6 | for (i = 0; i < hs.length; i++) { 7 | h = hs[i]; 8 | if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 9 | a = h.attributes; 10 | while (a.length > 0) h.removeAttribute(a[0].name); 11 | } 12 | }); 13 | -------------------------------------------------------------------------------- /docs/articles/orthus_files/figure-html/unnamed-chunk-5-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jsilve24/stray/29fdc2e431b8e515f38f0a4969c1e431e918fa44/docs/articles/orthus_files/figure-html/unnamed-chunk-5-1.png -------------------------------------------------------------------------------- /docs/articles/orthus_files/header-attrs-2.2/header-attrs.js: -------------------------------------------------------------------------------- 1 | // Pandoc 2.9 adds attributes on both header and div. We remove the former (to 2 | // be compatible with the behavior of Pandoc < 2.8). 3 | document.addEventListener('DOMContentLoaded', function(e) { 4 | var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); 5 | var i, h, a; 6 | for (i = 0; i < hs.length; i++) { 7 | h = hs[i]; 8 | if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 9 | a = h.attributes; 10 | while (a.length > 0) h.removeAttribute(a[0].name); 11 | } 12 | }); 13 | -------------------------------------------------------------------------------- /docs/articles/picking_priors_files/header-attrs-2.2/header-attrs.js: -------------------------------------------------------------------------------- 1 | // Pandoc 2.9 adds attributes on both header and div. We remove the former (to 2 | // be compatible with the behavior of Pandoc < 2.8). 3 | document.addEventListener('DOMContentLoaded', function(e) { 4 | var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); 5 | var i, h, a; 6 | for (i = 0; i < hs.length; i++) { 7 | h = hs[i]; 8 | if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 9 | a = h.attributes; 10 | while (a.length > 0) h.removeAttribute(a[0].name); 11 | } 12 | }); 13 | -------------------------------------------------------------------------------- /docs/bootstrap-toc.css: -------------------------------------------------------------------------------- 1 | /*! 2 | * Bootstrap Table of Contents v0.4.1 (http://afeld.github.io/bootstrap-toc/) 3 | * Copyright 2015 Aidan Feldman 4 | * Licensed under MIT (https://github.com/afeld/bootstrap-toc/blob/gh-pages/LICENSE.md) */ 5 | 6 | /* modified from https://github.com/twbs/bootstrap/blob/94b4076dd2efba9af71f0b18d4ee4b163aa9e0dd/docs/assets/css/src/docs.css#L548-L601 */ 7 | 8 | /* All levels of nav */ 9 | nav[data-toggle='toc'] .nav > li > a { 10 | display: block; 11 | padding: 4px 20px; 12 | font-size: 13px; 13 | font-weight: 500; 14 | color: #767676; 15 | } 16 | nav[data-toggle='toc'] .nav > li > a:hover, 17 | nav[data-toggle='toc'] .nav > li > a:focus { 18 | padding-left: 19px; 19 | color: #563d7c; 20 | text-decoration: none; 21 | background-color: transparent; 22 | border-left: 1px solid #563d7c; 23 | } 24 | nav[data-toggle='toc'] .nav > .active > a, 25 | nav[data-toggle='toc'] .nav > .active:hover > a, 26 | nav[data-toggle='toc'] .nav > .active:focus > a { 27 | padding-left: 18px; 28 | font-weight: bold; 29 | color: #563d7c; 30 | background-color: transparent; 31 | border-left: 2px solid #563d7c; 32 | } 33 | 34 | /* Nav: second level (shown on .active) */ 35 | nav[data-toggle='toc'] .nav .nav { 36 | display: none; /* Hide by default, but at >768px, show it */ 37 | padding-bottom: 10px; 38 | } 39 | nav[data-toggle='toc'] .nav .nav > li > a { 40 | padding-top: 1px; 41 | padding-bottom: 1px; 42 | padding-left: 30px; 43 | font-size: 12px; 44 | font-weight: normal; 45 | } 46 | nav[data-toggle='toc'] .nav .nav > li > a:hover, 47 | nav[data-toggle='toc'] .nav .nav > li > a:focus { 48 | padding-left: 29px; 49 | } 50 | nav[data-toggle='toc'] .nav .nav > .active > a, 51 | nav[data-toggle='toc'] .nav .nav > .active:hover > a, 52 | nav[data-toggle='toc'] .nav .nav > .active:focus > a { 53 | padding-left: 28px; 54 | font-weight: 500; 55 | } 56 | 57 | /* from https://github.com/twbs/bootstrap/blob/e38f066d8c203c3e032da0ff23cd2d6098ee2dd6/docs/assets/css/src/docs.css#L631-L634 */ 58 | nav[data-toggle='toc'] .nav > .active > ul { 59 | display: block; 60 | } 61 | -------------------------------------------------------------------------------- /docs/bootstrap-toc.js: -------------------------------------------------------------------------------- 1 | /*! 2 | * Bootstrap Table of Contents v0.4.1 (http://afeld.github.io/bootstrap-toc/) 3 | * Copyright 2015 Aidan Feldman 4 | * Licensed under MIT (https://github.com/afeld/bootstrap-toc/blob/gh-pages/LICENSE.md) */ 5 | (function() { 6 | 'use strict'; 7 | 8 | window.Toc = { 9 | helpers: { 10 | // return all matching elements in the set, or their descendants 11 | findOrFilter: function($el, selector) { 12 | // http://danielnouri.org/notes/2011/03/14/a-jquery-find-that-also-finds-the-root-element/ 13 | // http://stackoverflow.com/a/12731439/358804 14 | var $descendants = $el.find(selector); 15 | return $el.filter(selector).add($descendants).filter(':not([data-toc-skip])'); 16 | }, 17 | 18 | generateUniqueIdBase: function(el) { 19 | var text = $(el).text(); 20 | var anchor = text.trim().toLowerCase().replace(/[^A-Za-z0-9]+/g, '-'); 21 | return anchor || el.tagName.toLowerCase(); 22 | }, 23 | 24 | generateUniqueId: function(el) { 25 | var anchorBase = this.generateUniqueIdBase(el); 26 | for (var i = 0; ; i++) { 27 | var anchor = anchorBase; 28 | if (i > 0) { 29 | // add suffix 30 | anchor += '-' + i; 31 | } 32 | // check if ID already exists 33 | if (!document.getElementById(anchor)) { 34 | return anchor; 35 | } 36 | } 37 | }, 38 | 39 | generateAnchor: function(el) { 40 | if (el.id) { 41 | return el.id; 42 | } else { 43 | var anchor = this.generateUniqueId(el); 44 | el.id = anchor; 45 | return anchor; 46 | } 47 | }, 48 | 49 | createNavList: function() { 50 | return $(''); 51 | }, 52 | 53 | createChildNavList: function($parent) { 54 | var $childList = this.createNavList(); 55 | $parent.append($childList); 56 | return $childList; 57 | }, 58 | 59 | generateNavEl: function(anchor, text) { 60 | var $a = $(''); 61 | $a.attr('href', '#' + anchor); 62 | $a.text(text); 63 | var $li = $('
  • '); 64 | $li.append($a); 65 | return $li; 66 | }, 67 | 68 | generateNavItem: function(headingEl) { 69 | var anchor = this.generateAnchor(headingEl); 70 | var $heading = $(headingEl); 71 | var text = $heading.data('toc-text') || $heading.text(); 72 | return this.generateNavEl(anchor, text); 73 | }, 74 | 75 | // Find the first heading level (`

    `, then `

    `, etc.) that has more than one element. Defaults to 1 (for `

    `). 76 | getTopLevel: function($scope) { 77 | for (var i = 1; i <= 6; i++) { 78 | var $headings = this.findOrFilter($scope, 'h' + i); 79 | if ($headings.length > 1) { 80 | return i; 81 | } 82 | } 83 | 84 | return 1; 85 | }, 86 | 87 | // returns the elements for the top level, and the next below it 88 | getHeadings: function($scope, topLevel) { 89 | var topSelector = 'h' + topLevel; 90 | 91 | var secondaryLevel = topLevel + 1; 92 | var secondarySelector = 'h' + secondaryLevel; 93 | 94 | return this.findOrFilter($scope, topSelector + ',' + secondarySelector); 95 | }, 96 | 97 | getNavLevel: function(el) { 98 | return parseInt(el.tagName.charAt(1), 10); 99 | }, 100 | 101 | populateNav: function($topContext, topLevel, $headings) { 102 | var $context = $topContext; 103 | var $prevNav; 104 | 105 | var helpers = this; 106 | $headings.each(function(i, el) { 107 | var $newNav = helpers.generateNavItem(el); 108 | var navLevel = helpers.getNavLevel(el); 109 | 110 | // determine the proper $context 111 | if (navLevel === topLevel) { 112 | // use top level 113 | $context = $topContext; 114 | } else if ($prevNav && $context === $topContext) { 115 | // create a new level of the tree and switch to it 116 | $context = helpers.createChildNavList($prevNav); 117 | } // else use the current $context 118 | 119 | $context.append($newNav); 120 | 121 | $prevNav = $newNav; 122 | }); 123 | }, 124 | 125 | parseOps: function(arg) { 126 | var opts; 127 | if (arg.jquery) { 128 | opts = { 129 | $nav: arg 130 | }; 131 | } else { 132 | opts = arg; 133 | } 134 | opts.$scope = opts.$scope || $(document.body); 135 | return opts; 136 | } 137 | }, 138 | 139 | // accepts a jQuery object, or an options object 140 | init: function(opts) { 141 | opts = this.helpers.parseOps(opts); 142 | 143 | // ensure that the data attribute is in place for styling 144 | opts.$nav.attr('data-toggle', 'toc'); 145 | 146 | var $topContext = this.helpers.createChildNavList(opts.$nav); 147 | var topLevel = this.helpers.getTopLevel(opts.$scope); 148 | var $headings = this.helpers.getHeadings(opts.$scope, topLevel); 149 | this.helpers.populateNav($topContext, topLevel, $headings); 150 | } 151 | }; 152 | 153 | $(function() { 154 | $('nav[data-toggle="toc"]').each(function(i, el) { 155 | var $nav = $(el); 156 | Toc.init($nav); 157 | }); 158 | }); 159 | })(); 160 | -------------------------------------------------------------------------------- /docs/docsearch.js: -------------------------------------------------------------------------------- 1 | $(function() { 2 | 3 | // register a handler to move the focus to the search bar 4 | // upon pressing shift + "/" (i.e. "?") 5 | $(document).on('keydown', function(e) { 6 | if (e.shiftKey && e.keyCode == 191) { 7 | e.preventDefault(); 8 | $("#search-input").focus(); 9 | } 10 | }); 11 | 12 | $(document).ready(function() { 13 | // do keyword highlighting 14 | /* modified from https://jsfiddle.net/julmot/bL6bb5oo/ */ 15 | var mark = function() { 16 | 17 | var referrer = document.URL ; 18 | var paramKey = "q" ; 19 | 20 | if (referrer.indexOf("?") !== -1) { 21 | var qs = referrer.substr(referrer.indexOf('?') + 1); 22 | var qs_noanchor = qs.split('#')[0]; 23 | var qsa = qs_noanchor.split('&'); 24 | var keyword = ""; 25 | 26 | for (var i = 0; i < qsa.length; i++) { 27 | var currentParam = qsa[i].split('='); 28 | 29 | if (currentParam.length !== 2) { 30 | continue; 31 | } 32 | 33 | if (currentParam[0] == paramKey) { 34 | keyword = decodeURIComponent(currentParam[1].replace(/\+/g, "%20")); 35 | } 36 | } 37 | 38 | if (keyword !== "") { 39 | $(".contents").unmark({ 40 | done: function() { 41 | $(".contents").mark(keyword); 42 | } 43 | }); 44 | } 45 | } 46 | }; 47 | 48 | mark(); 49 | }); 50 | }); 51 | 52 | /* Search term highlighting ------------------------------*/ 53 | 54 | function matchedWords(hit) { 55 | var words = []; 56 | 57 | var hierarchy = hit._highlightResult.hierarchy; 58 | // loop to fetch from lvl0, lvl1, etc. 59 | for (var idx in hierarchy) { 60 | words = words.concat(hierarchy[idx].matchedWords); 61 | } 62 | 63 | var content = hit._highlightResult.content; 64 | if (content) { 65 | words = words.concat(content.matchedWords); 66 | } 67 | 68 | // return unique words 69 | var words_uniq = [...new Set(words)]; 70 | return words_uniq; 71 | } 72 | 73 | function updateHitURL(hit) { 74 | 75 | var words = matchedWords(hit); 76 | var url = ""; 77 | 78 | if (hit.anchor) { 79 | url = hit.url_without_anchor + '?q=' + escape(words.join(" ")) + '#' + hit.anchor; 80 | } else { 81 | url = hit.url + '?q=' + escape(words.join(" ")); 82 | } 83 | 84 | return url; 85 | } 86 | -------------------------------------------------------------------------------- /docs/link.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 5 | 8 | 12 | 13 | -------------------------------------------------------------------------------- /docs/pkgdown.js: -------------------------------------------------------------------------------- 1 | /* http://gregfranko.com/blog/jquery-best-practices/ */ 2 | (function($) { 3 | $(function() { 4 | 5 | $('.navbar-fixed-top').headroom(); 6 | 7 | $('body').css('padding-top', $('.navbar').height() + 10); 8 | $(window).resize(function(){ 9 | $('body').css('padding-top', $('.navbar').height() + 10); 10 | }); 11 | 12 | $('[data-toggle="tooltip"]').tooltip(); 13 | 14 | var cur_path = paths(location.pathname); 15 | var links = $("#navbar ul li a"); 16 | var max_length = -1; 17 | var pos = -1; 18 | for (var i = 0; i < links.length; i++) { 19 | if (links[i].getAttribute("href") === "#") 20 | continue; 21 | // Ignore external links 22 | if (links[i].host !== location.host) 23 | continue; 24 | 25 | var nav_path = paths(links[i].pathname); 26 | 27 | var length = prefix_length(nav_path, cur_path); 28 | if (length > max_length) { 29 | max_length = length; 30 | pos = i; 31 | } 32 | } 33 | 34 | // Add class to parent
  • , and enclosing
  • if in dropdown 35 | if (pos >= 0) { 36 | var menu_anchor = $(links[pos]); 37 | menu_anchor.parent().addClass("active"); 38 | menu_anchor.closest("li.dropdown").addClass("active"); 39 | } 40 | }); 41 | 42 | function paths(pathname) { 43 | var pieces = pathname.split("/"); 44 | pieces.shift(); // always starts with / 45 | 46 | var end = pieces[pieces.length - 1]; 47 | if (end === "index.html" || end === "") 48 | pieces.pop(); 49 | return(pieces); 50 | } 51 | 52 | // Returns -1 if not found 53 | function prefix_length(needle, haystack) { 54 | if (needle.length > haystack.length) 55 | return(-1); 56 | 57 | // Special case for length-0 haystack, since for loop won't run 58 | if (haystack.length === 0) { 59 | return(needle.length === 0 ? 0 : -1); 60 | } 61 | 62 | for (var i = 0; i < haystack.length; i++) { 63 | if (needle[i] != haystack[i]) 64 | return(i); 65 | } 66 | 67 | return(haystack.length); 68 | } 69 | 70 | /* Clipboard --------------------------*/ 71 | 72 | function changeTooltipMessage(element, msg) { 73 | var tooltipOriginalTitle=element.getAttribute('data-original-title'); 74 | element.setAttribute('data-original-title', msg); 75 | $(element).tooltip('show'); 76 | element.setAttribute('data-original-title', tooltipOriginalTitle); 77 | } 78 | 79 | if(ClipboardJS.isSupported()) { 80 | $(document).ready(function() { 81 | var copyButton = ""; 82 | 83 | $(".examples, div.sourceCode").addClass("hasCopyButton"); 84 | 85 | // Insert copy buttons: 86 | $(copyButton).prependTo(".hasCopyButton"); 87 | 88 | // Initialize tooltips: 89 | $('.btn-copy-ex').tooltip({container: 'body'}); 90 | 91 | // Initialize clipboard: 92 | var clipboardBtnCopies = new ClipboardJS('[data-clipboard-copy]', { 93 | text: function(trigger) { 94 | return trigger.parentNode.textContent; 95 | } 96 | }); 97 | 98 | clipboardBtnCopies.on('success', function(e) { 99 | changeTooltipMessage(e.trigger, 'Copied!'); 100 | e.clearSelection(); 101 | }); 102 | 103 | clipboardBtnCopies.on('error', function() { 104 | changeTooltipMessage(e.trigger,'Press Ctrl+C or Command+C to copy'); 105 | }); 106 | }); 107 | } 108 | })(window.jQuery || window.$) 109 | -------------------------------------------------------------------------------- /docs/pkgdown.yml: -------------------------------------------------------------------------------- 1 | pandoc: 2.9.2.1 2 | pkgdown: 1.5.1 3 | pkgdown_sha: ~ 4 | articles: 5 | introduction-to-stray: introduction-to-stray.html 6 | non-linear-models: non-linear-models.html 7 | orthus: orthus.html 8 | picking_priors: picking_priors.html 9 | last_built: 2020-08-06T17:26Z 10 | 11 | -------------------------------------------------------------------------------- /docs/reference/compiled_with_openmp.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Check if stray was compiled with OpenMP — compiled_with_openmp • stray 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 48 | 49 | 50 | 51 | 52 | 53 |
    54 |
    55 | 125 | 126 | 127 |
    128 | 129 |
    130 |
    131 | 136 | 137 |
    138 | 139 |

    hopefully helpful when first installing stray

    140 | 141 |
    142 | 143 |
    compiled_with_openmp()
    144 | 145 |

    Value

    146 | 147 |

    boolean

    148 | 149 | 150 |
    151 | 159 |
    160 | 161 |
    162 | 165 | 166 |
    167 |

    Site built with pkgdown 1.3.0.

    168 |
    169 |
    170 |
    171 | 172 | 173 | 174 | 175 | 176 | 177 | -------------------------------------------------------------------------------- /docs/reference/plot.pibblefit-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jsilve24/stray/29fdc2e431b8e515f38f0a4969c1e431e918fa44/docs/reference/plot.pibblefit-1.png -------------------------------------------------------------------------------- /docs/reference/plot.pibblefit-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jsilve24/stray/29fdc2e431b8e515f38f0a4969c1e431e918fa44/docs/reference/plot.pibblefit-2.png -------------------------------------------------------------------------------- /docs/reference/sample_prior.pibblefit-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jsilve24/stray/29fdc2e431b8e515f38f0a4969c1e431e918fa44/docs/reference/sample_prior.pibblefit-1.png -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | citHeader("To cite stray in publications use:") 2 | 3 | citEntry( 4 | entry = "article", 5 | title = "Bayesian Multinomial Logistic Normal Models through Marginally Latent Matrix-T Processes", 6 | author = c("Justin D Silverman", 7 | "Kim Roche", 8 | "Zachary C Holmes", 9 | "Lawrence A David", 10 | "Sayan Mukherjee"), 11 | year = 2019, 12 | journal = "arXiv e-prints", 13 | url = "https://arxiv.org/abs/1903.11695", 14 | 15 | textVersion = "Silverman, JD, Roche, K, Holmes, ZC, David, LA, and Mukherjee, S. Bayesian Multinomial Logistic Normal Models through Marginally Latent Matrix-T Processes. 2019, arXiv e-prints, arXiv:1903.11695" 16 | ) 17 | -------------------------------------------------------------------------------- /inst/include/MatDist.h: -------------------------------------------------------------------------------- 1 | #ifndef MONGREL_MATDIST_H 2 | #define MONGREL_MATDIST_H 3 | 4 | #include 5 | #include 6 | using namespace Rcpp; 7 | using Eigen::MatrixXd; 8 | using Eigen::VectorXd; 9 | using Eigen::Lower; 10 | using Eigen::Map; 11 | 12 | // [[Rcpp::depends(RcppZiggurat)]] 13 | 14 | static Ziggurat::MT::ZigguratMT ziggmt; 15 | 16 | 17 | // fills passed dense objects with unit normal random variables 18 | // Uses RcppZiggurat for ~ 10x speed-up 19 | template 20 | inline void fillUnitNormal(Eigen::DenseBase& Z){ 21 | int m = Z.rows(); 22 | int n = Z.cols(); 23 | for (int i=0; i& M, 58 | const Eigen::Ref& LU, 59 | const Eigen::Ref& LV){ 60 | int nrows = M.rows(); 61 | int ncols = M.cols(); 62 | MatrixXd Z(nrows, ncols); 63 | MatrixXd X(nrows, ncols); 64 | 65 | fillUnitNormal(Z); 66 | X.noalias() = M + LU*Z*LV.transpose(); 67 | return X; 68 | } 69 | 70 | //' Inverse Wishart Distribution (Wikipedia Parameterization one at a time) 71 | //' 72 | //' Density, and random generation from Inverse Wishart Distribution. 73 | //' W^{-1}(Psi, v) where Psi is a PxP positive definite scale matrix 74 | //' and v is the degrees of freedom with requirement that v > P-1. 75 | //' 76 | //' @param X is positive definite PxP covariance matrix at 77 | //' which to evaluate density 78 | //' @param v degres of freedom (req: v > P-1) 79 | //' @param Psi PxP positive definite scale matrix (covariance matrix) 80 | //' 81 | //' @details Generate Draws from an Inverse Wishart Distribution 82 | //' via the Bartlett Decomposition. Mean is given by Psi/(v-P-1). 83 | //' Mode is given by Psi/(v+P+1). Does minor imput validation to ensure v > P-1, 84 | //' throws range_error if not false. 85 | //' 86 | //' @name InvWishart 87 | //' 88 | //' @return Reverse cholesky factor of the inverse wishart sample. That is it 89 | //' returns an upper triangular matrix U such if V=UU^T, V ~ IW(v, Psi). 90 | inline Eigen::MatrixXd rInvWishRevCholesky(const int v, 91 | const Eigen::Ref& Psi){ 92 | int p = Psi.rows(); 93 | MatrixXd PsiInv = Psi.llt().solve(MatrixXd::Identity(p,p)); 94 | if (v <= p-1) 95 | Rcpp::stop("v must be > Psi.rows - 1"); 96 | VectorXd z(p*(p-1)/2); 97 | fillUnitNormal(z); 98 | MatrixXd X = MatrixXd::Zero(p, p); 99 | for (int i=0; i().solve(MatrixXd::Identity(p,p)).transpose(); 114 | } 115 | 116 | #endif 117 | -------------------------------------------------------------------------------- /inst/include/MatrixAlgebra.h: -------------------------------------------------------------------------------- 1 | #ifndef MONGREL_MATALG_H 2 | #define MONGREL_MATALG_H 3 | 4 | #include 5 | using namespace Rcpp; 6 | using Eigen::Map; 7 | using Eigen::MatrixXd; 8 | using Eigen::Ref; 9 | 10 | MatrixXd krondense(const Ref& L, const Ref& R); 11 | void krondense_inplace(Ref A, const Ref& L, 12 | const Ref& R); 13 | void krondense_inplace_add(Ref A, const Ref& L, 14 | const Ref& R); 15 | MatrixXd tveclmult(const int m, const int n, const Ref& A); 16 | void tveclmult_minus(const int m, const int n, Ref A, Ref B); 17 | 18 | #endif -------------------------------------------------------------------------------- /inst/include/MongrelModelClass.h: -------------------------------------------------------------------------------- 1 | #ifndef MONGREL_MMODEL_H 2 | #define MONGREL_MMODEL_H 3 | 4 | #include 5 | 6 | using Eigen::MatrixXd; 7 | using Eigen::VectorXd; 8 | using Eigen::Ref; 9 | 10 | namespace mongrel { 11 | 12 | class MongrelModel : public Numer::MFuncGrad { 13 | public: 14 | // Interface for optimization 15 | virtual double f_grad(Numer::Constvec& x, Numer::Refvec grad) = 0; 16 | 17 | // hessian vector multiplication interface for Spectra library 18 | virtual int getN() = 0; // rows in hessian 19 | virtual int getD() = 0; // cols in hessian 20 | virtual VectorXd calcHessVectorProd(const Ref& etavec, 21 | VectorXd v, double r) = 0; 22 | virtual ~MongrelModel(){} 23 | }; 24 | 25 | } 26 | 27 | #endif -------------------------------------------------------------------------------- /inst/include/MultDirichletBoot.h: -------------------------------------------------------------------------------- 1 | #ifndef MONGREL_MULTDIRICHLETBOOT_H 2 | #define MONGREL_MULTDIRICHLETBOOT_H 3 | 4 | #include 5 | using namespace Rcpp; 6 | using Eigen::Map; 7 | using Eigen::MatrixXd; 8 | using Eigen::ArrayXXd; 9 | using Eigen::ArrayXd; 10 | using Eigen::VectorXd; 11 | using Eigen::Ref; 12 | 13 | namespace MultDirichletBoot{ 14 | 15 | template 16 | MatrixXd alrInv_default(Eigen::MatrixBase& eta){ 17 | int D = eta.rows()+1; 18 | int N = eta.cols(); 19 | MatrixXd pi = MatrixXd::Zero(D, N); 20 | pi.topRows(D-1) = eta; 21 | pi.array() = pi.array().exp(); 22 | pi.array().rowwise() /= pi.colwise().sum().array(); 23 | return pi; 24 | } 25 | 26 | template 27 | MatrixXd alr_default(Eigen::MatrixBase& pi){ 28 | int D = pi.rows(); 29 | int N = pi.cols(); 30 | MatrixXd eta(D-1,N); 31 | eta = pi.topRows(D-1); 32 | eta.array().rowwise() /= pi.row(D-1).array(); 33 | return eta.array().log(); 34 | } 35 | 36 | // Sample dirichlet - alpha must be a vector 37 | template 38 | MatrixXd rDirichlet(int n_samples, Eigen::MatrixBase& alpha){ 39 | int D = alpha.rows(); 40 | int p = alpha.cols(); 41 | if (p > 1) Rcpp::stop("rDirichlet must only be passed alpha as a vector"); 42 | NumericVector r(n_samples); 43 | MatrixXd s(D, n_samples); 44 | for (int i=0; i rvec(as >(r)); 47 | s.row(i) = rvec.transpose(); 48 | } 49 | s.array().rowwise() /= s.colwise().sum().array(); 50 | return s; 51 | } 52 | 53 | 54 | template 55 | MatrixXd MultDirichletBoot(int n_samples, Eigen::MatrixBase& eta, 56 | ArrayXXd Y, double pseudocount){ 57 | int D = eta.rows()+1; 58 | int N = eta.cols(); 59 | MatrixXd alpha = alrInv_default(eta); 60 | alpha.array().rowwise() *= Y.colwise().sum(); 61 | alpha.array() += pseudocount; 62 | MatrixXd samp(N*(D-1), n_samples); 63 | MatrixXd s(D, n_samples); 64 | VectorXd a; 65 | for (int i=0; i 5 | using namespace Rcpp; 6 | 7 | //' Log of Multivarate Gamma Function 8 | //' Gamma_p(a) - https://en.wikipedia.org/wiki/Multivariate_gamma_function 9 | double lmvgamma(double a, int p); 10 | //' Derivative of Log of Multivariate Gamma Function 11 | //' https://en.wikipedia.org/wiki/Multivariate_gamma_function 12 | //' Gamma_p(a) 13 | double lmvgamma_deriv(double a, int p); 14 | 15 | #endif -------------------------------------------------------------------------------- /inst/include/stray.h: -------------------------------------------------------------------------------- 1 | // File used to import others in order 2 | 3 | #ifdef STRAY_USE_MKL // requres openmp support 4 | #define STRAY_USE_PARALLEL 5 | #define EIGEN_USE_MKL_ALL 6 | // #define EIGEN_DONT_PARALLELIZE 7 | #else 8 | #ifdef _OPENMP 9 | #define STRAY_USE_PARALLEL 10 | #include 11 | #endif 12 | #endif 13 | // [[Rcpp::depends(RcppEigen)]] 14 | // [[Rcpp::depends(BH)]] 15 | 16 | 17 | #include "MatrixAlgebra.h" 18 | #include "MatDist_thread.h" 19 | #include "MatDist.h" 20 | #include "MultDirichletBoot.h" 21 | #include "SpecialFunctions.h" 22 | #include "LaplaceApproximation.h" 23 | #include "PibbleCollapsed.h" 24 | #include "MaltipooCollapsed.h" 25 | #include "AdamOptim.h" -------------------------------------------------------------------------------- /inst/stray.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jsilve24/stray/29fdc2e431b8e515f38f0a4969c1e431e918fa44/inst/stray.png -------------------------------------------------------------------------------- /man/access_dims.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/generics_s3.R, R/strayfit_methods.R 3 | \name{access_dims} 4 | \alias{access_dims} 5 | \alias{ncategories} 6 | \alias{nsamples} 7 | \alias{ncovariates} 8 | \alias{niter} 9 | \alias{ncategories.pibblefit} 10 | \alias{nsamples.pibblefit} 11 | \alias{ncovariates.pibblefit} 12 | \alias{niter.pibblefit} 13 | \alias{ncategories.orthusfit} 14 | \alias{nsamples.orthusfit} 15 | \alias{ncovariates.orthusfit} 16 | \alias{niter.orthusfit} 17 | \title{Generic method for accessing model fit dimensions} 18 | \usage{ 19 | ncategories(m) 20 | 21 | nsamples(m) 22 | 23 | ncovariates(m) 24 | 25 | niter(m) 26 | 27 | \method{ncategories}{pibblefit}(m) 28 | 29 | \method{nsamples}{pibblefit}(m) 30 | 31 | \method{ncovariates}{pibblefit}(m) 32 | 33 | \method{niter}{pibblefit}(m) 34 | 35 | \method{ncategories}{orthusfit}(m) 36 | 37 | \method{nsamples}{orthusfit}(m) 38 | 39 | \method{ncovariates}{orthusfit}(m) 40 | 41 | \method{niter}{orthusfit}(m) 42 | } 43 | \arguments{ 44 | \item{m}{An object of class pibblefit} 45 | } 46 | \value{ 47 | integer 48 | } 49 | \description{ 50 | Generic method for accessing model fit dimensions 51 | } 52 | \details{ 53 | An alternative approach to accessing these dimensions is to 54 | access them directly from the pibblefit object using list indexing. 55 | * \code{ncategories} is equivalent to \code{m$D} 56 | * \code{nsamples} is equivalent to \code{m$N} 57 | * \code{ncovariates} is equivalent to \code{m$Q} 58 | } 59 | \examples{ 60 | \dontrun{ 61 | m <- pibble(Y, X) 62 | ncategories(m) 63 | nsamples(m) 64 | ncovariates(m) 65 | } 66 | } 67 | -------------------------------------------------------------------------------- /man/as.list.orthusfit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/strayfit_methods.R 3 | \name{as.list.orthusfit} 4 | \alias{as.list.orthusfit} 5 | \title{Convert object of class orthusfit to a list} 6 | \usage{ 7 | \method{as.list}{orthusfit}(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{an object of class orthusfit} 11 | 12 | \item{...}{currently unused} 13 | } 14 | \description{ 15 | Convert object of class orthusfit to a list 16 | } 17 | \examples{ 18 | \dontrun{ 19 | fit <- orthus(Y, Z, X) 20 | as.list(fit) 21 | } 22 | } 23 | -------------------------------------------------------------------------------- /man/as.list.pibblefit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/strayfit_methods.R 3 | \name{as.list.pibblefit} 4 | \alias{as.list.pibblefit} 5 | \title{Convert object of class pibblefit to a list} 6 | \usage{ 7 | \method{as.list}{pibblefit}(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{an object of class pibblefit} 11 | 12 | \item{...}{currently unused} 13 | } 14 | \description{ 15 | Convert object of class pibblefit to a list 16 | } 17 | \examples{ 18 | \dontrun{ 19 | fit <- pibble(Y, X) 20 | as.list(fit) 21 | } 22 | } 23 | -------------------------------------------------------------------------------- /man/as.orthusfit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/strayfit_s3.R 3 | \name{as.orthusfit} 4 | \alias{as.orthusfit} 5 | \title{convert list to orthusfit} 6 | \usage{ 7 | as.orthusfit(object) 8 | } 9 | \arguments{ 10 | \item{object}{list object} 11 | } 12 | \description{ 13 | convert list to orthusfit 14 | } 15 | -------------------------------------------------------------------------------- /man/as.pibblefit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/strayfit_s3.R 3 | \name{as.pibblefit} 4 | \alias{as.pibblefit} 5 | \title{convert list to pibblefit} 6 | \usage{ 7 | as.pibblefit(object) 8 | } 9 | \arguments{ 10 | \item{object}{list object} 11 | } 12 | \description{ 13 | convert list to pibblefit 14 | } 15 | -------------------------------------------------------------------------------- /man/basset_fit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fit_basset.R 3 | \name{basset_fit} 4 | \alias{basset_fit} 5 | \alias{basset} 6 | \alias{refit.bassetfit} 7 | \title{Interface to fit basset models} 8 | \usage{ 9 | basset(Y = NULL, X, upsilon = NULL, Theta = NULL, Gamma = NULL, 10 | Xi = NULL, init = NULL, pars = c("Eta", "Lambda", "Sigma"), ...) 11 | 12 | \method{refit}{bassetfit}(m, pars = c("Eta", "Lambda", "Sigma"), ...) 13 | } 14 | \arguments{ 15 | \item{Y}{D x N matrix of counts (if NULL uses priors only)} 16 | 17 | \item{X}{Q x N matrix of covariates (cannot be NULL)} 18 | 19 | \item{upsilon}{dof for inverse wishart prior (numeric must be > D) 20 | (default: D+3)} 21 | 22 | \item{Theta}{A function from dimensions dim(X) -> (D-1)xN (prior mean of gaussian process)} 23 | 24 | \item{Gamma}{A function from dimension dim(X) -> NxN (kernel matrix of gaussian process)} 25 | 26 | \item{Xi}{(D-1)x(D-1) prior covariance matrix 27 | (default: ALR transform of diag(1)*(upsilon-D)/2 - this is 28 | essentially iid on "base scale" using Aitchison terminology)} 29 | 30 | \item{init}{(D-1) x Q initialization for Eta for optimization} 31 | 32 | \item{pars}{character vector of posterior parameters to return} 33 | 34 | \item{...}{other arguments passed to \link{pibble} (which is used internally to 35 | fit the basset model)} 36 | 37 | \item{m}{object of class bassetfit} 38 | } 39 | \value{ 40 | an object of class bassetfit 41 | } 42 | \description{ 43 | Basset (A Lazy Learner) - non-linear regression models in stray 44 | } 45 | \details{ 46 | the full model is given by: 47 | \deqn{Y_j \sim Multinomial(Pi_j)} 48 | \deqn{Pi_j = Phi^{-1}(Eta_j)} 49 | \deqn{Eta \sim MN_{D-1 x N}(Lambda, Sigma, I_N)} 50 | \deqn{Lambda \sim GP_{D-1 x Q}(Theta(X), Sigma, Gamma(X))} 51 | \deqn{Sigma \sim InvWish(upsilon, Xi)} 52 | Where Gamma(X) is short hand for the Gram matrix of the Kernel function. 53 | 54 | Default behavior is to use MAP estimate for uncollaping the LTP 55 | model if laplace approximation is not preformed. 56 | } 57 | -------------------------------------------------------------------------------- /man/check_dims.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/stray_utils.R 3 | \name{check_dims} 4 | \alias{check_dims} 5 | \title{Check vector/matrix/data.frame for expected dimensions or throw error} 6 | \usage{ 7 | check_dims(x, d, par) 8 | } 9 | \arguments{ 10 | \item{x}{object to check} 11 | 12 | \item{d}{expected dimensions} 13 | 14 | \item{par}{character name of x (for error message)} 15 | } 16 | \value{ 17 | nothing if no error, otherwise throws error 18 | } 19 | \description{ 20 | Check vector/matrix/data.frame for expected dimensions or throw error 21 | } 22 | \examples{ 23 | y <- c(1,3,4) 24 | check_dims(y, 3, "y") 25 | } 26 | -------------------------------------------------------------------------------- /man/coef.orthusfit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/strayfit_methods.R 3 | \name{coef.orthusfit} 4 | \alias{coef.orthusfit} 5 | \title{Return regression coefficients of orthus object} 6 | \usage{ 7 | \method{coef}{orthusfit}(object, ...) 8 | } 9 | \arguments{ 10 | \item{object}{an object of class orthusfit} 11 | 12 | \item{...}{other options passed to coef.orthusfit (see details)} 13 | } 14 | \value{ 15 | Array of dimension (D-1) x Q x iter 16 | } 17 | \description{ 18 | Returned as array of dimension (D-1+P) x Q x iter (if in ALR or ILR) 19 | otherwise (D+P) x Q x iter. 20 | } 21 | \details{ 22 | Other arguments: 23 | \itemize{ 24 | \item use_names if column and row names were passed for Y and X in 25 | call to \code{\link{pibble}}, should these names be applied to output 26 | array. 27 | } 28 | } 29 | \examples{ 30 | \dontrun{ 31 | fit <- orthus(Y, Z, X) 32 | coef(fit) 33 | } 34 | } 35 | -------------------------------------------------------------------------------- /man/coef.pibblefit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/strayfit_methods.R 3 | \name{coef.pibblefit} 4 | \alias{coef.pibblefit} 5 | \title{Return regression coefficients of pibblefit object} 6 | \usage{ 7 | \method{coef}{pibblefit}(object, ...) 8 | } 9 | \arguments{ 10 | \item{object}{an object of class pibblefit} 11 | 12 | \item{...}{other options passed to coef.pibblefit (see details)} 13 | } 14 | \value{ 15 | Array of dimension (D-1) x Q x iter 16 | } 17 | \description{ 18 | Returned as array of dimension (D-1) x Q x iter (if in ALR or ILR) otherwise 19 | DxQxiter (if in proportions or clr). 20 | } 21 | \details{ 22 | Other arguments: 23 | \itemize{ 24 | \item `use_names` if column and row names were passed for Y and X in 25 | call to \code{\link{pibble}}, should these names be applied to output 26 | array. 27 | } 28 | } 29 | \examples{ 30 | \dontrun{ 31 | fit <- pibble(Y, X) 32 | coef(fit) 33 | } 34 | } 35 | -------------------------------------------------------------------------------- /man/conjugateLinearModel.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/RcppExports.R 3 | \name{conjugateLinearModel} 4 | \alias{conjugateLinearModel} 5 | \title{Solve Bayesian Multivariate Conjugate Linear Model} 6 | \usage{ 7 | conjugateLinearModel(Y, X, Theta, Gamma, Xi, upsilon, n_samples = 2000L) 8 | } 9 | \arguments{ 10 | \item{Y}{matrix of dimension D x N} 11 | 12 | \item{X}{matrix of covariates of dimension Q x N} 13 | 14 | \item{Theta}{matrix of prior mean of dimension D x Q} 15 | 16 | \item{Gamma}{covariance matrix of dimension Q x Q} 17 | 18 | \item{Xi}{covariance matrix of dimension D x D} 19 | 20 | \item{upsilon}{scalar (must be > D-1) degrees of freedom for InvWishart prior} 21 | 22 | \item{n_samples}{number of samples to draw (default: 2000)} 23 | } 24 | \value{ 25 | List with components 26 | \enumerate{ 27 | \item Lambda Array of dimension (D-1) x Q x n_samples (posterior samples) 28 | \item Sigma Array of dimension (D-1) x (D-1) x n_samples (posterior samples) 29 | } 30 | } 31 | \description{ 32 | See details for model. Notation: \code{N} is number of samples, 33 | \code{D} is the dimension of the response, \code{Q} is number 34 | of covariates. 35 | } 36 | \details{ 37 | \deqn{Y ~ MN_{D-1 x N}(Lambda*X, Sigma, I_N)} 38 | \deqn{Lambda ~ MN_{D-1 x Q}(Theta, Sigma, Gamma)} 39 | \deqn{Sigma ~ InvWish(upsilon, Xi)} 40 | This function provides a means of sampling from the posterior distribution of 41 | \code{Lambda} and \code{Sigma}. 42 | } 43 | \examples{ 44 | sim <- pibble_sim() 45 | eta.hat <- t(driver::alr(t(sim$Y+0.65))) 46 | fit <- conjugateLinearModel(eta.hat, sim$X, sim$Theta, sim$Gamma, 47 | sim$Xi, sim$upsilon, n_samples=2000) 48 | } 49 | -------------------------------------------------------------------------------- /man/convert_orthus_covariance.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/orthus_transform_wrapper.R 3 | \name{convert_orthus_covariance} 4 | \alias{convert_orthus_covariance} 5 | \alias{oilrvar2ilrvar} 6 | \alias{oilrvar2clrvar} 7 | \alias{oclrvar2ilrvar} 8 | \alias{oalrvar2clrvar} 9 | \alias{oclrvar2alrvar} 10 | \alias{oalrvar2alrvar} 11 | \alias{oalrvar2ilrvar} 12 | \alias{oilrvar2alrvar} 13 | \title{Convert orthus covariance matricies between representations} 14 | \usage{ 15 | oilrvar2ilrvar(Sigma, s, V1, V2) 16 | 17 | oilrvar2clrvar(Sigma, s, V) 18 | 19 | oclrvar2ilrvar(Sigma, s, V) 20 | 21 | oalrvar2clrvar(Sigma, s, d1) 22 | 23 | oclrvar2alrvar(Sigma, s, d2) 24 | 25 | oalrvar2alrvar(Sigma, s, d1, d2) 26 | 27 | oalrvar2ilrvar(Sigma, s, d1, V2) 28 | 29 | oilrvar2alrvar(Sigma, s, V1, d2) 30 | } 31 | \arguments{ 32 | \item{Sigma}{covariance matrix arrat in specified transformed space 33 | (dim(Sigma)[3]=iter)} 34 | 35 | \item{s}{first s rows and colums of Sigma are transformed} 36 | 37 | \item{V1}{ILR contrast matrix of basis Sigma is already in} 38 | 39 | \item{V2}{ILR contrast matrix of basis Sigma is desired in} 40 | 41 | \item{V}{ILR contrast matrix (i.e., transformation matrix of ILR)} 42 | 43 | \item{d1}{alr reference element Sigma is already expressed with respec to} 44 | 45 | \item{d2}{alr reference element Sigma is to be expressed with respect to} 46 | } 47 | \value{ 48 | matrix 49 | } 50 | \description{ 51 | Convert orthus covariance matricies between representations 52 | } 53 | -------------------------------------------------------------------------------- /man/kernels.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/kernels.R 3 | \name{kernels} 4 | \alias{kernels} 5 | \alias{SE} 6 | \alias{LINEAR} 7 | \title{Multivariate RBF Kernel} 8 | \usage{ 9 | SE(X, sigma = 1, rho = median(as.matrix(dist(t(X)))), jitter = 1e-10) 10 | 11 | LINEAR(X, sigma = 1, c = rep(0, nrow(X))) 12 | } 13 | \arguments{ 14 | \item{X}{covariate (dimension Q x N; i.e., covariates x samples)} 15 | 16 | \item{sigma}{scalar parameter} 17 | 18 | \item{rho}{scalar bandwidth parameter} 19 | 20 | \item{jitter}{small scalar to add to off-diagonal of gram matrix 21 | (for numerical underflow issues)} 22 | 23 | \item{c}{vector parameter defining intercept for linear kernel} 24 | } 25 | \value{ 26 | Gram Matrix (N x N) (e.g., the Kernel evaluated at 27 | each pair of points) 28 | } 29 | \description{ 30 | Designed to be partially specified. (see examples) 31 | } 32 | \details{ 33 | Gram matrix G is given by 34 | 35 | SE (squared exponential): 36 | \deqn{G = \sigma^2 * exp(-[(X-c)'(X-c)]/(s*\rho^2))} 37 | 38 | LINEAR: 39 | \deqn{G = \sigma^2*(X-c)'(X-c)} 40 | } 41 | \examples{ 42 | # Create Partial for use with basset 43 | K <- function(X) SE(X, 2, .2) 44 | 45 | # Example use 46 | X <- matrix(rnorm(10), 2, 5) 47 | G <- K(X) 48 | G # this is the gram matrix (the kernel evaluated on a finite set of points) 49 | } 50 | -------------------------------------------------------------------------------- /man/lambda_to_iqlr.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/iqlr.R 3 | \name{lambda_to_iqlr} 4 | \alias{lambda_to_iqlr} 5 | \title{Transform Lambda into IQLR (Inter-Quantile Log-Ratio)} 6 | \usage{ 7 | lambda_to_iqlr(m, focus.cov = NULL, probs = c(0.25, 0.75)) 8 | } 9 | \arguments{ 10 | \item{m}{object of class pibblefit (e.g., output of \code{\link{pibble}})} 11 | 12 | \item{focus.cov}{vector of integers or characters specifying columns (covariates) 13 | of Lambda to include in calculating IQLR (if NULL, default, then uses all covariates)} 14 | 15 | \item{probs}{bounds for categories (i.e., features / genes / taxa) to include in 16 | calculation of iqlr (smaller bounds means more stringent inclusion criteria)} 17 | } 18 | \value{ 19 | array of dimension (D, Q, iter) where D is number of taxa, Q is number 20 | of covariates, and iter is number of posterior samples. 21 | } 22 | \description{ 23 | Takes idea from Wu et al. (citation below) and calculates IQLR for 24 | Lambda, potentially useful if you believe there is an invariant group of 25 | categories (e.g., taxa / genes) that are not changing (in absolute abundance) 26 | between samples. IQLR is defined as 27 | \deqn{IQLR_x = log(x_i/g(IQVF))} 28 | for i in 1,...,D. 29 | IQVF are the CLR coordinates whose variance is within the inter-quantile range 30 | (defined by \code{probs} argument to this function). 31 | A different IQVF is fit for each posteior sample as the IQVFs are calculted 32 | based on posterior estimates for Lambda. The variance of a CLR coordinate 33 | is defined as the norm of each row of Lambda[,focus.cov] (i.e., 34 | the covariation in Eta, explained by those covariates). This definition of 35 | variance allows uses to exclude variation from technical / trivial sources 36 | in calculation of IQVF/IQLR. 37 | } 38 | \details{ 39 | Primarily intended for doing differential expression analysis under 40 | assumption that only small group of categories (e.g., taxa / genes) are changing 41 | } 42 | \examples{ 43 | sim <- pibble_sim() 44 | fit <- pibble(sim$Y, sim$X) 45 | # Use first two covariates to define iqlr, just show first 5 samples 46 | lambda_to_iqlr(fit, 1:2)[,,1:5] 47 | 48 | } 49 | \references{ 50 | Jia R. Wu, Jean M. Macklaim, Briana L. Genge, Gregory B. Gloor (2017) 51 | Finding the center: corrections for asymmetry in high-throughput sequencing 52 | datasets. arxiv:1704.01841v1 53 | } 54 | -------------------------------------------------------------------------------- /man/lmvgamma.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/RcppExports.R 3 | \name{lmvgamma} 4 | \alias{lmvgamma} 5 | \title{Log of Multivarate Gamma Function - Gamma_p(a)} 6 | \usage{ 7 | lmvgamma(a, p) 8 | } 9 | \arguments{ 10 | \item{a}{defined by Gamma_p(a)} 11 | 12 | \item{p}{defined by Gamma_p(a)} 13 | } 14 | \description{ 15 | Log of Multivarate Gamma Function - Gamma_p(a) 16 | } 17 | \references{ 18 | https://en.wikipedia.org/wiki/Multivariate_gamma_function 19 | } 20 | -------------------------------------------------------------------------------- /man/lmvgamma_deriv.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/RcppExports.R 3 | \name{lmvgamma_deriv} 4 | \alias{lmvgamma_deriv} 5 | \title{Derivative of Log of Multivariate Gamma Function - Gamma_p(a)} 6 | \usage{ 7 | lmvgamma_deriv(a, p) 8 | } 9 | \arguments{ 10 | \item{a}{defined by Gamma_p(a)} 11 | 12 | \item{p}{defined by Gamma_p(a)} 13 | } 14 | \description{ 15 | Derivative of Log of Multivariate Gamma Function - Gamma_p(a) 16 | } 17 | \references{ 18 | https://en.wikipedia.org/wiki/Multivariate_gamma_function 19 | } 20 | -------------------------------------------------------------------------------- /man/loglikMaltipooCollapsed.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/RcppExports.R 3 | \name{loglikMaltipooCollapsed} 4 | \alias{loglikMaltipooCollapsed} 5 | \alias{gradMaltipooCollapsed} 6 | \alias{hessMaltipooCollapsed} 7 | \title{Calculations for the Collapsed Maltipoo Model} 8 | \usage{ 9 | loglikMaltipooCollapsed(Y, upsilon, Theta, X, KInv, U, eta, ell, 10 | sylv = FALSE) 11 | 12 | gradMaltipooCollapsed(Y, upsilon, Theta, X, KInv, U, eta, ell, 13 | sylv = FALSE) 14 | 15 | hessMaltipooCollapsed(Y, upsilon, Theta, X, KInv, U, eta, ell, 16 | sylv = FALSE) 17 | } 18 | \arguments{ 19 | \item{Y}{D x N matrix of counts} 20 | 21 | \item{upsilon}{(must be > D)} 22 | 23 | \item{Theta}{D-1 x Q matrix the prior mean for regression coefficients} 24 | 25 | \item{X}{Q x N matrix of covariates} 26 | 27 | \item{KInv}{D-1 x D-1 symmetric positive-definite matrix} 28 | 29 | \item{U}{a PQxQ matrix of stacked variance components} 30 | 31 | \item{eta}{matrix (D-1)xN of parameter values at which to calculate quantities} 32 | 33 | \item{ell}{P-vector of scale factors for each variance component (aka VCScale)} 34 | 35 | \item{sylv}{(default:false) if true and if N < D-1 will use sylvester determinant 36 | identity to speed computation} 37 | } 38 | \description{ 39 | Functions providing access to the Log Likelihood, Gradient, and Hessian 40 | of the collapsed maltipoo model. Note: These are convenience functions 41 | but are not as optimized as direct coding of the MaltipooCollapsed 42 | C++ class due to a lack of Memoization. By contrast function optimMaltipooCollapsed 43 | is much more optimized and massively cuts down on repeated calculations. 44 | A more efficient Rcpp module based implementation of these functions 45 | may following if the future. For model details see \code{\link{optimMaltipooCollapsed}} 46 | documentation 47 | } 48 | -------------------------------------------------------------------------------- /man/loglikPibbleCollapsed.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/RcppExports.R 3 | \name{loglikPibbleCollapsed} 4 | \alias{loglikPibbleCollapsed} 5 | \alias{gradPibbleCollapsed} 6 | \alias{hessPibbleCollapsed} 7 | \title{Calculations for the Collapsed Pibble Model} 8 | \usage{ 9 | loglikPibbleCollapsed(Y, upsilon, ThetaX, KInv, AInv, eta, sylv = FALSE) 10 | 11 | gradPibbleCollapsed(Y, upsilon, ThetaX, KInv, AInv, eta, sylv = FALSE) 12 | 13 | hessPibbleCollapsed(Y, upsilon, ThetaX, KInv, AInv, eta, sylv = FALSE) 14 | } 15 | \arguments{ 16 | \item{Y}{D x N matrix of counts} 17 | 18 | \item{upsilon}{(must be > D)} 19 | 20 | \item{ThetaX}{D-1 x N matrix formed by Theta*X (Theta is Prior mean 21 | for regression coefficients)} 22 | 23 | \item{KInv}{Inverse of K for LTP (for Pibble defined as KInv = solve(Xi))} 24 | 25 | \item{AInv}{Inverse of A for LTP (for Pibble defined as 26 | AInv = solve(diag(N)+ t(X)\%\emph{\%Gamma\%}\%X) )} 27 | 28 | \item{eta}{matrix (D-1)xN of parameter values at which to calculate quantities} 29 | 30 | \item{sylv}{(default:false) if true and if N < D-1 will use sylvester determinant 31 | identity to speed computation} 32 | } 33 | \value{ 34 | see below 35 | \itemize{ 36 | \item loglikPibbleCollapsed - double 37 | \item gradPibbleCollapsed - vector 38 | \item hessPibbleCollapsed- matrix 39 | } 40 | } 41 | \description{ 42 | Functions providing access to the Log Likelihood, Gradient, and Hessian 43 | of the collapsed pibble model. Note: These are convenience functions 44 | but are not as optimized as direct coding of the PibbleCollapsed 45 | C++ class due to a lack of Memoization. By contrast function optimPibbleCollapsed 46 | is much more optimized and massively cuts down on repeated calculations. 47 | A more efficient Rcpp module based implementation of these functions 48 | may following if the future. For model details see \code{\link{optimPibbleCollapsed}} 49 | documentation 50 | } 51 | \examples{ 52 | D <- 10 53 | Q <- 2 54 | N <- 30 55 | 56 | # Simulate Data 57 | Sigma <- diag(sample(1:8, D-1, replace=TRUE)) 58 | Sigma[2, 3] <- Sigma[3,2] <- -1 59 | Gamma <- diag(sqrt(rnorm(Q)^2)) 60 | Theta <- matrix(0, D-1, Q) 61 | Phi <- Theta + t(chol(Sigma))\%*\%matrix(rnorm(Q*(D-1)), nrow=D-1)\%*\%chol(Gamma) 62 | X <- matrix(rnorm(N*(Q-1)), Q-1, N) 63 | X <- rbind(1, X) 64 | Eta <- Phi\%*\%X + t(chol(Sigma))\%*\%matrix(rnorm(N*(D-1)), nrow=D-1) 65 | Pi <- t(driver::alrInv(t(Eta))) 66 | Y <- matrix(0, D, N) 67 | for (i in 1:N) Y[,i] <- rmultinom(1, sample(5000:10000), prob = Pi[,i]) 68 | 69 | # Priors 70 | upsilon <- D+10 71 | Xi <- Sigma*(upsilon-D) 72 | 73 | # Precompute 74 | KInv <- solve(Xi) 75 | AInv <- solve(diag(N)+ t(X)\%*\%Gamma\%*\%X) 76 | ThetaX <- Theta\%*\%X 77 | 78 | 79 | loglikPibbleCollapsed(Y, upsilon, ThetaX, KInv, AInv, Eta) 80 | gradPibbleCollapsed(Y, upsilon, ThetaX, KInv, AInv, Eta)[1:5] 81 | hessPibbleCollapsed(Y, upsilon, ThetaX, KInv, AInv, Eta)[1:5,1:5] 82 | } 83 | -------------------------------------------------------------------------------- /man/mallard.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mallard-data.R 3 | \docType{data} 4 | \name{mallard} 5 | \alias{mallard} 6 | \title{Data from Silverman et al. (2018) Microbiome} 7 | \format{An object of class \code{\link[phyloseq]{phyloseq-class}}} 8 | \usage{ 9 | data(mallard) 10 | } 11 | \description{ 12 | High Resolution (hourly and daily) sampling of 4 in vitro artificial gut models 13 | with many technical replicates to identify technical variation. 14 | } 15 | \details{ 16 | This data is at the sequence variant level. Data at the family level 17 | processed as in Silverman et al. 2018 is given in \code{\link{mallard_family}} 18 | } 19 | \references{ 20 | Silverman et al. "Dynamic linear models guide design and 21 | analysis of microbiota studies within artificial human guts". 22 | Microbiome 2018 6:202 23 | } 24 | -------------------------------------------------------------------------------- /man/mallard_family.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mallard_family-data.R 3 | \docType{data} 4 | \name{mallard_family} 5 | \alias{mallard_family} 6 | \title{Data from Silverman et al. (2018) Microbiome} 7 | \format{An object of class \code{\link[phyloseq]{phyloseq-class}}} 8 | \usage{ 9 | data(mallard_family) 10 | } 11 | \description{ 12 | High Resolution (hourly and daily) sampling of 4 in vitro artificial gut models 13 | with many technical replicates to identify technical variation. 14 | } 15 | \details{ 16 | This data is at the family level and processed as in Silverman et al. 2018. Data at the sequence 17 | variant level without preprocessing is given in \code{\link{mallard}} 18 | } 19 | \references{ 20 | Silverman et al. "Dynamic linear models guide design and 21 | analysis of microbiota studies within artificial human guts". 22 | Microbiome 2018 6:202 23 | } 24 | -------------------------------------------------------------------------------- /man/maltipoo_fit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fit_maltipoo.R 3 | \name{maltipoo_fit} 4 | \alias{maltipoo_fit} 5 | \alias{maltipoo} 6 | \title{Interface to fit maltipoo models} 7 | \usage{ 8 | maltipoo(Y = NULL, X = NULL, upsilon = NULL, Theta = NULL, 9 | U = NULL, Xi = NULL, init = NULL, ellinit = NULL, 10 | pars = c("Eta", "Lambda", "Sigma"), ...) 11 | } 12 | \arguments{ 13 | \item{Y}{D x N matrix of counts (if NULL uses priors only)} 14 | 15 | \item{X}{Q x N matrix of covariates (design matrix) (if NULL uses priors only, must 16 | be present to sample Eta)} 17 | 18 | \item{upsilon}{dof for inverse wishart prior (numeric must be > D) 19 | (default: D+3)} 20 | 21 | \item{Theta}{(D-1) x Q matrix of prior mean for regression parameters 22 | (default: matrix(0, D-1, Q))} 23 | 24 | \item{U}{a PQ x Q matrix of stacked variance components (each of dimension Q x Q)} 25 | 26 | \item{Xi}{(D-1)x(D-1) prior covariance matrix 27 | (default: ALR transform of diag(1)*(upsilon-D)/2 - this is 28 | essentially iid on "base scale" using Aitchison terminology)} 29 | 30 | \item{init}{(D-1) x Q initialization for Eta for optimization} 31 | 32 | \item{ellinit}{P vector initialization values for ell for optimization} 33 | 34 | \item{pars}{character vector of posterior parameters to return} 35 | 36 | \item{...}{arguments passed to \code{\link{optimPibbleCollapsed}} and 37 | \code{\link{uncollapsePibble}}} 38 | } 39 | \value{ 40 | an object of class maltipoofit 41 | } 42 | \description{ 43 | This function is largely a more user friendly wrapper around 44 | \code{\link{optimMaltipooCollapsed}} and 45 | \code{\link{uncollapsePibble}}. 46 | See details for model specification. 47 | Notation: \code{N} is number of samples, 48 | \code{D} is number of multinomial categories, \code{Q} is number 49 | of covariates, \code{P} is the number of variance components 50 | \code{iter} is the number of samples of \code{eta} (e.g., 51 | the parameter \code{n_samples} in the function 52 | \code{\link{optimPibbleCollapsed}}) 53 | } 54 | \details{ 55 | the full model is given by: 56 | \deqn{Y_j \sim Multinomial(Pi_j)} 57 | \deqn{Pi_j = Phi^{-1}(Eta_j)} 58 | \deqn{Eta \sim MN_{D-1 x N}(Lambda*X, Sigma, I_N)} 59 | \deqn{Lambda \sim MN_{D-1 x Q}(Theta, Sigma, Gamma)} 60 | \deqn{Gamma = e^{ell_1} U_1 + ... + e^{ell_P} U_P} 61 | \deqn{Sigma \sim InvWish(upsilon, Xi)} 62 | 63 | Where A = (I_N + X * Gamma * X')^{-1}, K^{-1} = Xi is a (D-1)x(D-1) 64 | covariance matrix, U_1 is a Q x Q covariance matrix (a variance component), 65 | e^{ell_i} is a scale for that variance component and Phi^{-1} is 66 | ALRInv_D transform. 67 | 68 | Default behavior is to use MAP estimate for uncollaping collapsed maltipoo 69 | model if laplace approximation is not preformed. 70 | 71 | Parameters ell are treated as fixed and estimated by MAP estimation. 72 | } 73 | -------------------------------------------------------------------------------- /man/maltipoofit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/maltipoofit_s3.R 3 | \name{maltipoofit} 4 | \alias{maltipoofit} 5 | \title{Create maltipoofit object} 6 | \usage{ 7 | maltipoofit(D, N, Q, P, coord_system, iter = NULL, alr_base = NULL, 8 | ilr_base = NULL, Eta = NULL, Lambda = NULL, Sigma = NULL, 9 | Sigma_default = NULL, Y = NULL, X = NULL, upsilon = NULL, 10 | Theta = NULL, Xi = NULL, Xi_default = NULL, Gamma = NULL, 11 | init = NULL, ellinit = NULL, names_categories = NULL, 12 | names_samples = NULL, names_covariates = NULL, VCScale = NULL, 13 | U = NULL) 14 | } 15 | \arguments{ 16 | \item{D}{number of multinomial categories} 17 | 18 | \item{N}{number of samples} 19 | 20 | \item{Q}{number of covariates} 21 | 22 | \item{P}{number of variance components} 23 | 24 | \item{coord_system}{coordinate system objects are represented in (options 25 | include "alr", "clr", "ilr", and "proportions")} 26 | 27 | \item{iter}{number of posterior samples} 28 | 29 | \item{alr_base}{integer category used as reference 30 | (required if coord_system=="alr")} 31 | 32 | \item{ilr_base}{(D x D-1) contrast matrix (required if coord_system=="ilr")} 33 | 34 | \item{Eta}{Array of samples of Eta} 35 | 36 | \item{Lambda}{Array of samples of Lambda} 37 | 38 | \item{Sigma}{Array of samples of Sigma (null if coord_system=="proportions")} 39 | 40 | \item{Sigma_default}{Array of samples of Sigma in alr base D, used if 41 | coord_system=="proportions"} 42 | 43 | \item{Y}{DxN matrix of observed counts} 44 | 45 | \item{X}{QxN design matrix} 46 | 47 | \item{upsilon}{scalar prior dof of inverse wishart prior} 48 | 49 | \item{Theta}{prior mean of Lambda} 50 | 51 | \item{Xi}{Matrix of prior covariance for inverse wishart 52 | (null if coord_system=="proportions")} 53 | 54 | \item{Xi_default}{Matrix of prior covariance for inverse wishart in alr 55 | base D (used if coord_system=="proportions")} 56 | 57 | \item{Gamma}{QxQ covariance matrix prior for Lambda} 58 | 59 | \item{init}{matrix initial guess for Lambda used for optimization} 60 | 61 | \item{ellinit}{P vector initialization values for ell for optimization} 62 | 63 | \item{names_categories}{character vector} 64 | 65 | \item{names_samples}{character vector} 66 | 67 | \item{names_covariates}{character vector} 68 | 69 | \item{VCScale}{scale factors (delta) for variance components} 70 | 71 | \item{U}{a PQ x Q matrix of stacked variance components (each of dimension Q x Q)} 72 | } 73 | \value{ 74 | object of class maltipoofit 75 | } 76 | \description{ 77 | Create maltipoofit object 78 | } 79 | \seealso{ 80 | \code{\link{maltipoo}} 81 | } 82 | -------------------------------------------------------------------------------- /man/mongrel-deprecated.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fit_pibble.R 3 | \name{mongrel-deprecated} 4 | \alias{mongrel-deprecated} 5 | \alias{mongrel} 6 | \title{mongrel} 7 | \usage{ 8 | mongrel(Y = NULL, X = NULL, upsilon = NULL, Theta = NULL, 9 | Gamma = NULL, Xi = NULL, init = NULL, pars = c("Eta", "Lambda", 10 | "Sigma"), ...) 11 | } 12 | \arguments{ 13 | \item{Y}{D x N matrix of counts (if NULL uses priors only)} 14 | 15 | \item{X}{Q x N matrix of covariates (design matrix) (if NULL uses priors only, must 16 | be present to sample Eta)} 17 | 18 | \item{upsilon}{dof for inverse wishart prior (numeric must be > D) 19 | (default: D+3)} 20 | 21 | \item{Theta}{(D-1) x Q matrix of prior mean for regression parameters 22 | (default: matrix(0, D-1, Q))} 23 | 24 | \item{Gamma}{QxQ prior covariance matrix 25 | (default: diag(Q))} 26 | 27 | \item{Xi}{(D-1)x(D-1) prior covariance matrix 28 | (default: ALR transform of diag(1)*(upsilon-D)/2 - this is 29 | essentially iid on "base scale" using Aitchison terminology)} 30 | 31 | \item{init}{(D-1) x Q initialization for Eta for optimization} 32 | 33 | \item{pars}{character vector of posterior parameters to return} 34 | 35 | \item{...}{arguments passed to \code{\link{optimPibbleCollapsed}} and 36 | \code{\link{uncollapsePibble}}} 37 | } 38 | \description{ 39 | This function is deprecated, please use \code{pibble} 40 | instead. 41 | } 42 | -------------------------------------------------------------------------------- /man/name.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/generics_s3.R 3 | \name{name} 4 | \alias{name} 5 | \title{Generic method for applying names to an object} 6 | \usage{ 7 | name(m, ...) 8 | } 9 | \arguments{ 10 | \item{m}{object} 11 | 12 | \item{...}{other arguments to be passed} 13 | } 14 | \value{ 15 | object of same class but with names applied to dimensions 16 | } 17 | \description{ 18 | Intended to be called internally by package 19 | } 20 | -------------------------------------------------------------------------------- /man/name.orthusfit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/stray_utils.R 3 | \name{name.orthusfit} 4 | \alias{name.orthusfit} 5 | \title{S3 for orthusfit apply names to orthusfit object} 6 | \usage{ 7 | \method{name}{orthusfit}(m, ...) 8 | } 9 | \arguments{ 10 | \item{m}{object of class orthusfit} 11 | 12 | \item{...}{currently ignored} 13 | } 14 | \value{ 15 | object of class orthusfit 16 | } 17 | \description{ 18 | To avoid confusion, assigned default names to multinomial categories (c1 etc...) 19 | and zdimensions (z1 etc...) 20 | } 21 | -------------------------------------------------------------------------------- /man/name.pibblefit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/stray_utils.R 3 | \name{name.pibblefit} 4 | \alias{name.pibblefit} 5 | \title{S3 for pibblefit apply names to pibblefit object} 6 | \usage{ 7 | \method{name}{pibblefit}(m, ...) 8 | } 9 | \arguments{ 10 | \item{m}{object of class pibblefit} 11 | 12 | \item{...}{currently ignored} 13 | } 14 | \value{ 15 | object of class pibblefit 16 | } 17 | \description{ 18 | S3 for pibblefit apply names to pibblefit object 19 | } 20 | -------------------------------------------------------------------------------- /man/name_dims.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/generics_s3.R, R/strayfit_methods.R 3 | \name{name_dims} 4 | \alias{name_dims} 5 | \alias{names_covariates} 6 | \alias{names_samples} 7 | \alias{names_categories} 8 | \alias{names_coords} 9 | \alias{names_covariates<-} 10 | \alias{names_samples<-} 11 | \alias{names_categories<-} 12 | \alias{names_covariates.pibblefit} 13 | \alias{names_samples.pibblefit} 14 | \alias{names_categories.pibblefit} 15 | \alias{names_coords.pibblefit} 16 | \alias{names_covariates<-.pibblefit} 17 | \alias{names_samples<-.pibblefit} 18 | \alias{names_categories<-.pibblefit} 19 | \title{Generic method for getting and setting dimension names of fit object} 20 | \usage{ 21 | names_covariates(m) 22 | 23 | names_samples(m) 24 | 25 | names_categories(m) 26 | 27 | names_coords(m) 28 | 29 | names_covariates(m) <- value 30 | 31 | names_samples(m) <- value 32 | 33 | names_categories(m) <- value 34 | 35 | \method{names_covariates}{pibblefit}(m) 36 | 37 | \method{names_samples}{pibblefit}(m) 38 | 39 | \method{names_categories}{pibblefit}(m) 40 | 41 | \method{names_coords}{pibblefit}(m) 42 | 43 | \method{names_covariates}{pibblefit}(m) <- value 44 | 45 | \method{names_samples}{pibblefit}(m) <- value 46 | 47 | \method{names_categories}{pibblefit}(m) <- value 48 | } 49 | \arguments{ 50 | \item{m}{object} 51 | 52 | \item{value}{character vector (or NULL)} 53 | } 54 | \description{ 55 | Generic method for getting and setting dimension names of fit object 56 | } 57 | \details{ 58 | \code{names_coords} is different than \code{names_categories}. 59 | \code{names_categories} provides access to the basic names of each multinomial 60 | category. In contrast, \code{names_coords} provides access to the 61 | names of the coordinates in which an object is represented. These coordinate 62 | names are based on the category names. For example, category names may be, 63 | (OTU1, ..., OTUD) where as coordinate names could be (log(OTU1/OTUD), etc...) 64 | if object is in default coordinate system. 65 | } 66 | -------------------------------------------------------------------------------- /man/optimMaltipooCollapsed.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/RcppExports.R 3 | \name{optimMaltipooCollapsed} 4 | \alias{optimMaltipooCollapsed} 5 | \title{Function to Optimize the Collapsed Maltipoo Model} 6 | \usage{ 7 | optimMaltipooCollapsed(Y, upsilon, Theta, X, KInv, U, init, ellinit, 8 | n_samples = 2000L, calcGradHess = TRUE, b1 = 0.9, b2 = 0.99, 9 | step_size = 0.003, epsilon = 1e-06, eps_f = 1e-10, eps_g = 1e-04, 10 | max_iter = 10000L, verbose = FALSE, verbose_rate = 10L, 11 | decomp_method = "cholesky", eigvalthresh = 0, jitter = 0) 12 | } 13 | \arguments{ 14 | \item{Y}{D x N matrix of counts} 15 | 16 | \item{upsilon}{(must be > D)} 17 | 18 | \item{Theta}{D-1 x Q matrix the prior mean for regression coefficients} 19 | 20 | \item{X}{Q x N matrix of covariates} 21 | 22 | \item{KInv}{D-1 x D-1 symmetric positive-definite matrix} 23 | 24 | \item{U}{a PQxQ matrix of stacked variance components} 25 | 26 | \item{init}{D-1 x N matrix of initial guess for eta used for optimization} 27 | 28 | \item{ellinit}{P vector of initial guess for ell used for optimization} 29 | 30 | \item{n_samples}{number of samples for Laplace Approximation (=0 very fast 31 | as no inversion or decomposition of Hessian is required)} 32 | 33 | \item{calcGradHess}{if n_samples=0 should Gradient and Hessian 34 | still be calculated using closed form solutions?} 35 | 36 | \item{b1}{(ADAM) 1st moment decay parameter (recommend 0.9) "aka momentum"} 37 | 38 | \item{b2}{(ADAM) 2nd moment decay parameter (recommend 0.99 or 0.999)} 39 | 40 | \item{step_size}{(ADAM) step size for descent (recommend 0.001-0.003)} 41 | 42 | \item{epsilon}{(ADAM) parameter to avoid divide by zero} 43 | 44 | \item{eps_f}{(ADAM) normalized function improvement stopping criteria} 45 | 46 | \item{eps_g}{(ADAM) normalized gradient magnitude stopping criteria} 47 | 48 | \item{max_iter}{(ADAM) maximum number of iterations before stopping} 49 | 50 | \item{verbose}{(ADAM) if true will print stats for stopping criteria and 51 | iteration number} 52 | 53 | \item{verbose_rate}{(ADAM) rate to print verbose stats to screen} 54 | 55 | \item{decomp_method}{decomposition of hessian for Laplace approximation 56 | 'eigen' (more stable-slightly, slower) or 'cholesky' (less stable, faster, default)} 57 | 58 | \item{eigvalthresh}{threshold for negative eigenvalues in 59 | decomposition of negative inverse hessian (should be <=0)} 60 | 61 | \item{jitter}{(default: 0) if >0 then adds that factor to diagonal of Hessian 62 | before decomposition (to improve matrix conditioning)} 63 | } 64 | \value{ 65 | List containing (all with respect to found optima) 66 | \enumerate{ 67 | \item LogLik - Log Likelihood of collapsed model (up to proportionality constant) 68 | \item Gradient - (if \code{calcGradHess}=true) 69 | \item Hessian - (if \code{calcGradHess}=true) of the POSITIVE log posterior 70 | \item Pars - Parameter value of eta 71 | \item Samples - (D-1) x N x n_samples array containing posterior samples of eta 72 | based on Laplace approximation (if n_samples>0) 73 | \item VCScale - value of e^ell_i at optima 74 | \item logInvNegHessDet - the log determinant of the covariacne of the Laplace 75 | approximation, useful for calculating marginal likelihood 76 | } 77 | } 78 | \description{ 79 | See details for model. Should likely be followed by function 80 | \code{\link{uncollapsePibble}}. Notation: \code{N} is number of samples, 81 | \code{D} is number of multinomial categories, and \code{Q} is number 82 | of covariates. 83 | } 84 | \details{ 85 | Notation: Let Z_j denote the J-th row of a matrix Z. 86 | Model: 87 | \deqn{Y_j \sim Multinomial(Pi_j)} 88 | \deqn{Pi_j = Phi^{-1}(Eta_j)} 89 | \deqn{Eta \sim T_{D-1, N}(upsilon, Theta*X, K, A)} 90 | 91 | Where A = (I_N + e^{ell_1}\emph{X}U_1\emph{X' + ... + e^{ell_P}\emph{X}U_P}X' ), 92 | K is a D-1xD-1 covariance and Phi is ALRInv_D transform. 93 | 94 | Gradient and Hessian calculations are fast as they are computed using closed 95 | form solutions. That said, the Hessian matrix can be quite large 96 | [N*(D-1) x N*(D-1)] and storage may be an issue. 97 | 98 | Note: Warnings about large negative eigenvalues can either signal 99 | that the optimizer did not reach an optima or (more commonly in my experience) 100 | that the prior / degrees of freedom for the covariance (given by parameters 101 | \code{upsilon} and \code{KInv}) were too specific and at odds with the observed data. 102 | If you get this warning try the following. 103 | \enumerate{ 104 | \item Try restarting the optimization using a different initial guess for eta 105 | \item Try decreasing (or even increasing)\code{step_size} (by increments of 0.001 or 0.002) 106 | and increasing \code{max_iter} parameters in optimizer. Also can try 107 | increasing \code{b1} to 0.99 and decreasing \code{eps_f} by a few orders 108 | of magnitude 109 | \item Try relaxing prior assumptions regarding covariance matrix. (e.g., may want 110 | to consider decreasing parameter \code{upsilon} closer to a minimum value of 111 | D) 112 | \item Try adding small amount of jitter (e.g., set \code{jitter=1e-5}) to address 113 | potential floating point errors. 114 | } 115 | } 116 | \references{ 117 | S. Ruder (2016) \emph{An overview of gradient descent 118 | optimization algorithms}. arXiv 1609.04747 119 | } 120 | \seealso{ 121 | \code{\link{uncollapsePibble}} 122 | } 123 | -------------------------------------------------------------------------------- /man/optimPibbleCollapsed.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/RcppExports.R 3 | \name{optimPibbleCollapsed} 4 | \alias{optimPibbleCollapsed} 5 | \title{Function to Optimize the Collapsed Pibble Model} 6 | \usage{ 7 | optimPibbleCollapsed(Y, upsilon, ThetaX, KInv, AInv, init, 8 | n_samples = 2000L, calcGradHess = TRUE, b1 = 0.9, b2 = 0.99, 9 | step_size = 0.003, epsilon = 1e-06, eps_f = 1e-10, eps_g = 1e-04, 10 | max_iter = 10000L, verbose = FALSE, verbose_rate = 10L, 11 | decomp_method = "cholesky", optim_method = "adam", 12 | eigvalthresh = 0, jitter = 0, multDirichletBoot = -1, 13 | useSylv = TRUE, ncores = -1L, seed = -1L) 14 | } 15 | \arguments{ 16 | \item{Y}{D x N matrix of counts} 17 | 18 | \item{upsilon}{(must be > D)} 19 | 20 | \item{ThetaX}{D-1 x N matrix formed by Theta*X (Theta is Prior mean 21 | for regression coefficients)} 22 | 23 | \item{KInv}{D-1 x D-1 precision matrix (inverse of Xi)} 24 | 25 | \item{AInv}{N x N precision matrix given by (I_N + X'\emph{Gamma}X)^{-1}} 26 | 27 | \item{init}{D-1 x N matrix of initial guess for eta used for optimization} 28 | 29 | \item{n_samples}{number of samples for Laplace Approximation (=0 very fast 30 | as no inversion or decomposition of Hessian is required)} 31 | 32 | \item{calcGradHess}{if n_samples=0 should Gradient and Hessian 33 | still be calculated using closed form solutions?} 34 | 35 | \item{b1}{(ADAM) 1st moment decay parameter (recommend 0.9) "aka momentum"} 36 | 37 | \item{b2}{(ADAM) 2nd moment decay parameter (recommend 0.99 or 0.999)} 38 | 39 | \item{step_size}{(ADAM) step size for descent (recommend 0.001-0.003)} 40 | 41 | \item{epsilon}{(ADAM) parameter to avoid divide by zero} 42 | 43 | \item{eps_f}{(ADAM) normalized function improvement stopping criteria} 44 | 45 | \item{eps_g}{(ADAM) normalized gradient magnitude stopping criteria} 46 | 47 | \item{max_iter}{(ADAM) maximum number of iterations before stopping} 48 | 49 | \item{verbose}{(ADAM) if true will print stats for stopping criteria and 50 | iteration number} 51 | 52 | \item{verbose_rate}{(ADAM) rate to print verbose stats to screen} 53 | 54 | \item{decomp_method}{decomposition of hessian for Laplace approximation 55 | 'eigen' (more stable-slightly, slower) or 'cholesky' (less stable, faster, default)} 56 | 57 | \item{optim_method}{(default:"adam") or "lbfgs"} 58 | 59 | \item{eigvalthresh}{threshold for negative eigenvalues in 60 | decomposition of negative inverse hessian (should be <=0)} 61 | 62 | \item{jitter}{(default: 0) if >=0 then adds that factor to diagonal of Hessian 63 | before decomposition (to improve matrix conditioning)} 64 | 65 | \item{multDirichletBoot}{if >0 (overrides laplace approximation) and samples 66 | eta efficiently at MAP estimate from pseudo Multinomial-Dirichlet posterior.} 67 | 68 | \item{useSylv}{(default: true) if N0) 85 | \item Timer - Vector of Execution Times 86 | \item logInvNegHessDet - the log determinant of the covariacne of the Laplace 87 | approximation, useful for calculating marginal likelihood 88 | } 89 | } 90 | \description{ 91 | See details for model. Should likely be followed by function 92 | \code{\link{uncollapsePibble}}. Notation: \code{N} is number of samples, 93 | \code{D} is number of multinomial categories, and \code{Q} is number 94 | of covariates. 95 | } 96 | \details{ 97 | Notation: Let Z_j denote the J-th row of a matrix Z. 98 | Model: 99 | \deqn{Y_j \sim Multinomial(Pi_j)} 100 | \deqn{Pi_j = Phi^{-1}(Eta_j)} 101 | \deqn{Eta \sim T_{D-1, N}(upsilon, Theta*X, K, A)} 102 | Where A = I_N + X * Gamma * X', K is a (D-1)x(D-1) covariance 103 | matrix, Gamma is a Q x Q covariance matrix, and Phi^{-1} is ALRInv_D 104 | transform. 105 | 106 | Gradient and Hessian calculations are fast as they are computed using closed 107 | form solutions. That said, the Hessian matrix can be quite large 108 | [N*(D-1) x N*(D-1)] and storage may be an issue. 109 | 110 | Note: Warnings about large negative eigenvalues can either signal 111 | that the optimizer did not reach an optima or (more commonly in my experience) 112 | that the prior / degrees of freedom for the covariance (given by parameters 113 | \code{upsilon} and \code{KInv}) were too specific and at odds with the observed data. 114 | If you get this warning try the following. 115 | \enumerate{ 116 | \item Try restarting the optimization using a different initial guess for eta 117 | \item Try decreasing (or even increasing )\code{step_size} (by increments of 0.001 or 0.002) 118 | and increasing \code{max_iter} parameters in optimizer. Also can try 119 | increasing \code{b1} to 0.99 and decreasing \code{eps_f} by a few orders 120 | of magnitude 121 | \item Try relaxing prior assumptions regarding covariance matrix. (e.g., may want 122 | to consider decreasing parameter \code{upsilon} closer to a minimum value of 123 | D) 124 | \item Try adding small amount of jitter (e.g., set \code{jitter=1e-5}) to address 125 | potential floating point errors. 126 | } 127 | } 128 | \examples{ 129 | sim <- pibble_sim() 130 | 131 | # Fit model for eta 132 | fit <- optimPibbleCollapsed(sim$Y, sim$upsilon, sim$Theta\%*\%sim$X, sim$KInv, 133 | sim$AInv, random_pibble_init(sim$Y)) 134 | } 135 | \references{ 136 | S. Ruder (2016) \emph{An overview of gradient descent 137 | optimization algorithms}. arXiv 1609.04747 138 | 139 | JD Silverman K Roche, ZC Holmes, LA David, S Mukherjee. 140 | \emph{Bayesian Multinomial Logistic Normal Models through Marginally Latent Matrix-T Processes}. 141 | 2019, arXiv e-prints, arXiv:1903.11695 142 | } 143 | \seealso{ 144 | \code{\link{uncollapsePibble}} 145 | } 146 | -------------------------------------------------------------------------------- /man/orthus_fit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fit_orthus.R 3 | \name{orthus_fit} 4 | \alias{orthus_fit} 5 | \alias{orthus} 6 | \title{Interface to fit orthus models} 7 | \usage{ 8 | orthus(Y = NULL, Z = NULL, X = NULL, upsilon = NULL, 9 | Theta = NULL, Gamma = NULL, Xi = NULL, init = NULL, 10 | pars = c("Eta", "Lambda", "Sigma"), ...) 11 | } 12 | \arguments{ 13 | \item{Y}{D x N matrix of counts (if NULL uses priors only)} 14 | 15 | \item{Z}{P x N matrix of counts (if NULL uses priors only - must be present/absent 16 | if Y is present/absent)} 17 | 18 | \item{X}{Q x N matrix of covariates (design matrix) (if NULL uses priors only, must 19 | be present to sample Eta)} 20 | 21 | \item{upsilon}{dof for inverse wishart prior (numeric must be > D) 22 | (default: D+3)} 23 | 24 | \item{Theta}{(D-1+P) x Q matrix of prior mean for regression parameters 25 | (default: matrix(0, D-1+P, Q))} 26 | 27 | \item{Gamma}{QxQ prior covariance matrix 28 | (default: diag(Q))} 29 | 30 | \item{Xi}{(D-1+P)x(D-1+P) prior covariance matrix 31 | (default: ALR transform of diag(1)*(upsilon-D)/2 - this is 32 | essentially iid on "base scale" using Aitchison terminology)} 33 | 34 | \item{init}{(D-1) x Q initialization for Eta for optimization} 35 | 36 | \item{pars}{character vector of posterior parameters to return} 37 | 38 | \item{...}{arguments passed to \code{\link{optimPibbleCollapsed}} and 39 | \code{\link{uncollapsePibble}}} 40 | } 41 | \value{ 42 | an object of class pibblefit 43 | } 44 | \description{ 45 | This function is largely a more user friendly wrapper around 46 | \code{\link{optimPibbleCollapsed}} and 47 | \code{\link{uncollapsePibble}} for fitting orthus models. 48 | See details for model specification. 49 | Notation: \code{N} is number of samples, \code{P} is the number of dimensions 50 | of observations in the second dataset, 51 | \code{D} is number of multinomial categories, \code{Q} is number 52 | of covariates, \code{iter} is the number of samples of \code{eta} (e.g., 53 | the parameter \code{n_samples} in the function 54 | \code{\link{optimPibbleCollapsed}}) 55 | } 56 | \details{ 57 | the full model is given by: 58 | \deqn{Y_j \sim Multinomial(Pi_j)} 59 | \deqn{Pi_j = Phi^{-1}(Eta_j)} 60 | \deqn{cbind(Eta, Z) \sim MN_{D-1+P x N}(Lambda*X, Sigma, I_N)} 61 | \deqn{Lambda \sim MN_{D-1+P x Q}(Theta, Sigma, Gamma)} 62 | \deqn{Sigma \sim InvWish(upsilon, Xi)} 63 | Where Gamma is a Q x Q covariance matrix, and Phi^{-1} is 64 | ALRInv_D transform. 65 | That is, the orthus model models the latent multinomial log-ratios (Eta) and 66 | the observations of the second dataset jointly as a linear model. This allows 67 | Sigma to also describe the covariation between the two datasets. 68 | 69 | Default behavior is to use MAP estimate for uncollaping the LTP 70 | model if laplace approximation is not preformed. 71 | } 72 | \examples{ 73 | sim <- orthus_sim() 74 | fit <- orthus(sim$Y, sim$Z, sim$X) 75 | } 76 | \references{ 77 | JD Silverman K Roche, ZC Holmes, LA David, S Mukherjee. 78 | Bayesian Multinomial Logistic Normal Models through Marginally Latent Matrix-T Processes. 79 | 2019, arXiv e-prints, arXiv:1903.11695 80 | } 81 | \seealso{ 82 | \code{\link{stray_transforms}} provide convenience methods for 83 | transforming the representation of pibblefit objects (e.g., conversion to 84 | proportions, alr, clr, or ilr coordinates.) 85 | 86 | \code{\link{access_dims}} provides convenience methods for accessing 87 | dimensions of pibblefit object 88 | } 89 | -------------------------------------------------------------------------------- /man/orthus_lr_transforms.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/orthus_transform_wrapper.R 3 | \name{orthus_lr_transforms} 4 | \alias{orthus_lr_transforms} 5 | \alias{oglr} 6 | \alias{oglrInv} 7 | \alias{oalr} 8 | \alias{oalrInv} 9 | \alias{oilr} 10 | \alias{oilrInv} 11 | \alias{oclr} 12 | \alias{oclrInv} 13 | \title{Log-Ratio transforms for orthus objects} 14 | \usage{ 15 | oglr(x, s, V) 16 | 17 | oglrInv(x, s, V) 18 | 19 | oalr(x, s, d = NULL) 20 | 21 | oalrInv(y, s, d = NULL) 22 | 23 | oilr(x, s, V = NULL) 24 | 25 | oilrInv(y, s, V = NULL) 26 | 27 | oclr(x, s) 28 | 29 | oclrInv(x, s) 30 | } 31 | \arguments{ 32 | \item{x}{orthus data array (e.g., first s rows are multinomial parameters or log-ratios)} 33 | 34 | \item{s}{first s rows of x are transformed} 35 | 36 | \item{V}{transformation matrix (defines transform)} 37 | 38 | \item{d}{for ALR, which component (integer position) to take as reference 39 | (default is ncol(x)) for alrInv corresponds to column position in untransformed 40 | matrix.} 41 | 42 | \item{y}{orthus data array (e.g., first s rows are multinomial parameters or log-ratios)} 43 | } 44 | \description{ 45 | Log-Ratio transforms for orthus objects 46 | } 47 | -------------------------------------------------------------------------------- /man/orthus_sim.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/orthus_sim.R 3 | \name{orthus_sim} 4 | \alias{orthus_sim} 5 | \title{Simulate simple orthus dataset and priors (for testing)} 6 | \usage{ 7 | orthus_sim(D = 10, P = 10, N = 30, Q = 2, use_names = TRUE, 8 | true_priors = FALSE) 9 | } 10 | \arguments{ 11 | \item{D}{number of multinomial categories} 12 | 13 | \item{P}{number of dimensions of second dataset Z} 14 | 15 | \item{N}{number of samples} 16 | 17 | \item{Q}{number of covariates (first one is an intercept, must be > 1)} 18 | 19 | \item{use_names}{should samples, covariates, and categories be named} 20 | 21 | \item{true_priors}{should Xi and upsilon be chosen to have mean at true 22 | simulated value} 23 | } 24 | \value{ 25 | list 26 | } 27 | \description{ 28 | Simulate simple orthus dataset and priors (for testing) 29 | } 30 | \examples{ 31 | sim <- orthus_sim() 32 | } 33 | -------------------------------------------------------------------------------- /man/orthus_tidy_samples.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/strayfit_methods.R 3 | \name{orthus_tidy_samples} 4 | \alias{orthus_tidy_samples} 5 | \title{Convert orthus samples of Eta Lambda and Sigma to tidy format} 6 | \usage{ 7 | orthus_tidy_samples(m, use_names = FALSE, as_factor = FALSE) 8 | } 9 | \arguments{ 10 | \item{m}{an object of class orthusfit} 11 | 12 | \item{use_names}{should dimension indices be replaced by 13 | dimension names if provided in data used to fit pibble model.} 14 | 15 | \item{as_factor}{if use_names should names be returned as factor?} 16 | } 17 | \value{ 18 | tibble 19 | } 20 | \description{ 21 | Combines them all into a single tibble, see example for formatting and 22 | column headers. Primarily designed to be used by 23 | \code{\link{summary.orthusfit}}. 24 | } 25 | \examples{ 26 | sim <- orthus_sim() 27 | fit <- orthus(sim$Y, sim$Z, sim$X) 28 | fit_tidy <- orthus_tidy_samples(fit, use_names=TRUE) 29 | head(fit_tidy) 30 | } 31 | -------------------------------------------------------------------------------- /man/orthusfit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/strayfit_s3.R 3 | \name{orthusfit} 4 | \alias{orthusfit} 5 | \title{Create orthusfit object} 6 | \usage{ 7 | orthusfit(D, N, Q, P, coord_system, iter = NULL, alr_base = NULL, 8 | ilr_base = NULL, Eta = NULL, Lambda = NULL, Sigma = NULL, 9 | Sigma_default = NULL, Z = NULL, Y = NULL, X = NULL, 10 | upsilon = NULL, Theta = NULL, Xi = NULL, Xi_default = NULL, 11 | Gamma = NULL, init = NULL, names_categories = NULL, 12 | names_samples = NULL, names_Zdimensions = NULL, 13 | names_covariates = NULL) 14 | } 15 | \arguments{ 16 | \item{D}{number of multinomial categories} 17 | 18 | \item{N}{number of samples} 19 | 20 | \item{Q}{number of covariates} 21 | 22 | \item{P}{Dimension of second dataset (e.g., nrows(Z) )} 23 | 24 | \item{coord_system}{coordinate system objects are represented in (options 25 | include "alr", "clr", "ilr", and "proportions")} 26 | 27 | \item{iter}{number of posterior samples} 28 | 29 | \item{alr_base}{integer category used as reference 30 | (required if coord_system=="alr")} 31 | 32 | \item{ilr_base}{(D x D-1) contrast matrix (required if coord_system=="ilr")} 33 | 34 | \item{Eta}{Array of samples of Eta} 35 | 36 | \item{Lambda}{Array of samples of Lambda} 37 | 38 | \item{Sigma}{Array of samples of Sigma (null if coord_system=="proportions")} 39 | 40 | \item{Sigma_default}{Array of samples of Sigma in alr base D, used if 41 | coord_system=="proportions"} 42 | 43 | \item{Z}{PxN matrix of real valued observations} 44 | 45 | \item{Y}{DxN matrix of observed counts} 46 | 47 | \item{X}{QxN design matrix} 48 | 49 | \item{upsilon}{scalar prior dof of inverse wishart prior} 50 | 51 | \item{Theta}{prior mean of Lambda} 52 | 53 | \item{Xi}{Matrix of prior covariance for inverse wishart 54 | (null if coord_system=="proportions")} 55 | 56 | \item{Xi_default}{Matrix of prior covariance for inverse wishart in alr 57 | base D (used if coord_system=="proportions")} 58 | 59 | \item{Gamma}{QxQ covariance matrix prior for Lambda} 60 | 61 | \item{init}{matrix initial guess for Lambda used for optimization} 62 | 63 | \item{names_categories}{character vector} 64 | 65 | \item{names_samples}{character vector} 66 | 67 | \item{names_Zdimensions}{character vector} 68 | 69 | \item{names_covariates}{character vector} 70 | } 71 | \value{ 72 | object of class pibblefit 73 | } 74 | \description{ 75 | Create orthusfit object 76 | } 77 | \seealso{ 78 | \code{\link{pibble}} 79 | } 80 | -------------------------------------------------------------------------------- /man/pibble_fit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fit_pibble.R 3 | \name{pibble_fit} 4 | \alias{pibble_fit} 5 | \alias{pibble} 6 | \alias{refit.pibblefit} 7 | \title{Interface to fit pibble models} 8 | \usage{ 9 | pibble(Y = NULL, X = NULL, upsilon = NULL, Theta = NULL, 10 | Gamma = NULL, Xi = NULL, init = NULL, pars = c("Eta", "Lambda", 11 | "Sigma"), ...) 12 | 13 | \method{refit}{pibblefit}(m, pars = c("Eta", "Lambda", "Sigma"), ...) 14 | } 15 | \arguments{ 16 | \item{Y}{D x N matrix of counts (if NULL uses priors only)} 17 | 18 | \item{X}{Q x N matrix of covariates (design matrix) (if NULL uses priors only, must 19 | be present to sample Eta)} 20 | 21 | \item{upsilon}{dof for inverse wishart prior (numeric must be > D) 22 | (default: D+3)} 23 | 24 | \item{Theta}{(D-1) x Q matrix of prior mean for regression parameters 25 | (default: matrix(0, D-1, Q))} 26 | 27 | \item{Gamma}{QxQ prior covariance matrix 28 | (default: diag(Q))} 29 | 30 | \item{Xi}{(D-1)x(D-1) prior covariance matrix 31 | (default: ALR transform of diag(1)*(upsilon-D)/2 - this is 32 | essentially iid on "base scale" using Aitchison terminology)} 33 | 34 | \item{init}{(D-1) x Q initialization for Eta for optimization} 35 | 36 | \item{pars}{character vector of posterior parameters to return} 37 | 38 | \item{...}{arguments passed to \code{\link{optimPibbleCollapsed}} and 39 | \code{\link{uncollapsePibble}}} 40 | 41 | \item{m}{object of class pibblefit} 42 | } 43 | \value{ 44 | an object of class pibblefit 45 | } 46 | \description{ 47 | This function is largely a more user friendly wrapper around 48 | \code{\link{optimPibbleCollapsed}} and 49 | \code{\link{uncollapsePibble}}. 50 | See details for model specification. 51 | Notation: \code{N} is number of samples, 52 | \code{D} is number of multinomial categories, \code{Q} is number 53 | of covariates, \code{iter} is the number of samples of \code{eta} (e.g., 54 | the parameter \code{n_samples} in the function 55 | \code{\link{optimPibbleCollapsed}}) 56 | } 57 | \details{ 58 | the full model is given by: 59 | \deqn{Y_j \sim Multinomial(Pi_j)} 60 | \deqn{Pi_j = Phi^{-1}(Eta_j)} 61 | \deqn{Eta \sim MN_{D-1 x N}(Lambda*X, Sigma, I_N)} 62 | \deqn{Lambda \sim MN_{D-1 x Q}(Theta, Sigma, Gamma)} 63 | \deqn{Sigma \sim InvWish(upsilon, Xi)} 64 | Where Gamma is a Q x Q covariance matrix, and Phi^{-1} is 65 | ALRInv_D transform. 66 | 67 | Default behavior is to use MAP estimate for uncollaping the LTP 68 | model if laplace approximation is not preformed. 69 | } 70 | \examples{ 71 | sim <- pibble_sim() 72 | fit <- pibble(sim$Y, sim$X) 73 | } 74 | \references{ 75 | JD Silverman K Roche, ZC Holmes, LA David, S Mukherjee. 76 | Bayesian Multinomial Logistic Normal Models through Marginally Latent Matrix-T Processes. 77 | 2019, arXiv e-prints, arXiv:1903.11695 78 | } 79 | \seealso{ 80 | \code{\link{stray_transforms}} provide convenience methods for 81 | transforming the representation of pibblefit objects (e.g., conversion to 82 | proportions, alr, clr, or ilr coordinates.) 83 | 84 | \code{\link{access_dims}} provides convenience methods for accessing 85 | dimensions of pibblefit object 86 | 87 | Generic functions including \code{\link[=summary.pibblefit]{summary}}, 88 | \code{\link[=print.pibblefit]{print}}, 89 | \code{\link[=coef.pibblefit]{coef}}, 90 | \code{\link[=as.list.pibblefit]{as.list}}, 91 | \code{\link[=predict.pibblefit]{predict}}, 92 | \code{\link[=name.pibblefit]{name}}, and 93 | \code{\link[=sample_prior.pibblefit]{sample_prior}} 94 | \code{\link{name_dims}} 95 | 96 | Plotting functions provided by \code{\link[=plot.pibblefit]{plot}} 97 | and \code{\link[=ppc.pibblefit]{ppc}} (posterior predictive checks) 98 | } 99 | -------------------------------------------------------------------------------- /man/pibble_sim.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/pibble_sim.R 3 | \name{pibble_sim} 4 | \alias{pibble_sim} 5 | \title{Simulate simple pibble dataset and priors (for testing)} 6 | \usage{ 7 | pibble_sim(D = 10, N = 30, Q = 2, use_names = TRUE, 8 | true_priors = FALSE) 9 | } 10 | \arguments{ 11 | \item{D}{number of multinomial categories} 12 | 13 | \item{N}{number of samples} 14 | 15 | \item{Q}{number of covariates (first one is an intercept, must be > 1)} 16 | 17 | \item{use_names}{should samples, covariates, and categories be named} 18 | 19 | \item{true_priors}{should Xi and upsilon be chosen to have mean at true 20 | simulated value} 21 | } 22 | \value{ 23 | list 24 | } 25 | \description{ 26 | Simulate simple pibble dataset and priors (for testing) 27 | } 28 | \examples{ 29 | sim <- pibble_sim() 30 | } 31 | -------------------------------------------------------------------------------- /man/pibble_tidy_samples.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/strayfit_methods.R 3 | \name{pibble_tidy_samples} 4 | \alias{pibble_tidy_samples} 5 | \title{Convert pibble samples of Eta Lambda and Sigma to tidy format} 6 | \usage{ 7 | pibble_tidy_samples(m, use_names = FALSE, as_factor = FALSE) 8 | } 9 | \arguments{ 10 | \item{m}{an object of class pibblefit} 11 | 12 | \item{use_names}{should dimension indices be replaced by 13 | dimension names if provided in data used to fit pibble model.} 14 | 15 | \item{as_factor}{if use_names should names be returned as factor?} 16 | } 17 | \value{ 18 | tibble 19 | } 20 | \description{ 21 | Combines them all into a single tibble, see example for formatting and 22 | column headers. Primarily designed to be used by 23 | \code{\link{summary.pibblefit}}. 24 | } 25 | \examples{ 26 | sim <- pibble_sim() 27 | fit <- pibble(sim$Y, sim$X) 28 | fit_tidy <- pibble_tidy_samples(fit, use_names=TRUE) 29 | head(fit_tidy) 30 | } 31 | -------------------------------------------------------------------------------- /man/pibblefit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/strayfit_s3.R 3 | \name{pibblefit} 4 | \alias{pibblefit} 5 | \title{Create pibblefit object} 6 | \usage{ 7 | pibblefit(D, N, Q, coord_system, iter = NULL, alr_base = NULL, 8 | ilr_base = NULL, Eta = NULL, Lambda = NULL, Sigma = NULL, 9 | Sigma_default = NULL, Y = NULL, X = NULL, upsilon = NULL, 10 | Theta = NULL, Xi = NULL, Xi_default = NULL, Gamma = NULL, 11 | init = NULL, names_categories = NULL, names_samples = NULL, 12 | names_covariates = NULL) 13 | } 14 | \arguments{ 15 | \item{D}{number of multinomial categories} 16 | 17 | \item{N}{number of samples} 18 | 19 | \item{Q}{number of covariates} 20 | 21 | \item{coord_system}{coordinate system objects are represented in (options 22 | include "alr", "clr", "ilr", and "proportions")} 23 | 24 | \item{iter}{number of posterior samples} 25 | 26 | \item{alr_base}{integer category used as reference 27 | (required if coord_system=="alr")} 28 | 29 | \item{ilr_base}{(D x D-1) contrast matrix (required if coord_system=="ilr")} 30 | 31 | \item{Eta}{Array of samples of Eta} 32 | 33 | \item{Lambda}{Array of samples of Lambda} 34 | 35 | \item{Sigma}{Array of samples of Sigma (null if coord_system=="proportions")} 36 | 37 | \item{Sigma_default}{Array of samples of Sigma in alr base D, used if 38 | coord_system=="proportions"} 39 | 40 | \item{Y}{DxN matrix of observed counts} 41 | 42 | \item{X}{QxN design matrix} 43 | 44 | \item{upsilon}{scalar prior dof of inverse wishart prior} 45 | 46 | \item{Theta}{prior mean of Lambda} 47 | 48 | \item{Xi}{Matrix of prior covariance for inverse wishart 49 | (null if coord_system=="proportions")} 50 | 51 | \item{Xi_default}{Matrix of prior covariance for inverse wishart in alr 52 | base D (used if coord_system=="proportions")} 53 | 54 | \item{Gamma}{QxQ covariance matrix prior for Lambda} 55 | 56 | \item{init}{matrix initial guess for Lambda used for optimization} 57 | 58 | \item{names_categories}{character vector} 59 | 60 | \item{names_samples}{character vector} 61 | 62 | \item{names_covariates}{character vector} 63 | } 64 | \value{ 65 | object of class pibblefit 66 | } 67 | \description{ 68 | Create pibblefit object 69 | } 70 | \seealso{ 71 | \code{\link{pibble}} 72 | } 73 | -------------------------------------------------------------------------------- /man/plot.pibblefit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/pibble_plotting.R 3 | \name{plot.pibblefit} 4 | \alias{plot.pibblefit} 5 | \title{Plot Summaries of Posterior Distribution of pibblefit Parameters} 6 | \usage{ 7 | \method{plot}{pibblefit}(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{an object of class pibblefit} 11 | 12 | \item{...}{other arguments passed to plot.pibblefit (see details)} 13 | } 14 | \value{ 15 | ggplot object 16 | } 17 | \description{ 18 | Plot Summaries of Posterior Distribution of pibblefit Parameters 19 | } 20 | \details{ 21 | Other arguments: 22 | \itemize{ 23 | \item `par` parameter to plot (options: Lambda, Eta, and Sigma) 24 | (default="Lambda") 25 | \item `focus.cov` vector of covariates to include in plot (plots all if NULL) 26 | \item `focus.coord` vector of coordinates to include in plot (plots all if NULL) 27 | \item `focus.sample` vector of samples to include in plot (plots all if NULL) 28 | \item `use_names` if TRUE, uses dimension names found in data as plot labels 29 | rather than using dimension integer indices. 30 | } 31 | } 32 | \examples{ 33 | sim <- pibble_sim(N=10, D=4, Q=3) 34 | fit <- pibble(sim$Y, sim$X) 35 | plot(fit, par="Lambda") 36 | plot(fit, par="Sigma") 37 | } 38 | -------------------------------------------------------------------------------- /man/ppc.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/generics_s3.R 3 | \name{ppc} 4 | \alias{ppc} 5 | \title{Generic method for visualizing posterior predictive checks} 6 | \usage{ 7 | ppc(m, ...) 8 | } 9 | \arguments{ 10 | \item{m}{object} 11 | 12 | \item{...}{other arguments passed that control visualization} 13 | } 14 | \description{ 15 | Generic method for visualizing posterior predictive checks 16 | } 17 | -------------------------------------------------------------------------------- /man/ppc.pibblefit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/pibble_plotting.R 3 | \name{ppc.pibblefit} 4 | \alias{ppc.pibblefit} 5 | \title{Visualization of Posterior Predictive Check of fit model} 6 | \usage{ 7 | \method{ppc}{pibblefit}(m, ...) 8 | } 9 | \arguments{ 10 | \item{m}{an object of class pibblefit} 11 | 12 | \item{...}{other options passed to ppc (see details)} 13 | } 14 | \value{ 15 | ggplot object 16 | } 17 | \description{ 18 | Visualization of Posterior Predictive Check of fit model 19 | } 20 | \details{ 21 | ppc.pibblefit accepts the following additional arguments: 22 | \itemize{ 23 | \item "type" type of plot (options "lines", "points", "bounds") 24 | \item "iter" number of samples from posterior predictive distribution to plot 25 | (currently must be <= m$iter) if type=="lines" default is 50, if type=="ribbon" 26 | default is to use all available iterations. 27 | \item "from_scratch" should predictions of Y come from fitted Eta or from 28 | predictions of Eta from posterior of Lambda? (default: false) 29 | } 30 | } 31 | \examples{ 32 | \dontrun{ 33 | fit <- pibble(Y, X) 34 | ppc(fit) 35 | } 36 | } 37 | -------------------------------------------------------------------------------- /man/ppc_summary.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/generics_s3.R, R/strayfit_methods.R 3 | \name{ppc_summary} 4 | \alias{ppc_summary} 5 | \alias{ppc_summary.pibblefit} 6 | \title{Generic Method to Plot Posterior Predictive Summaries} 7 | \usage{ 8 | ppc_summary(m, ...) 9 | 10 | \method{ppc_summary}{pibblefit}(m, from_scratch = FALSE, ...) 11 | } 12 | \arguments{ 13 | \item{m}{model object} 14 | 15 | \item{...}{other arguments to pass} 16 | 17 | \item{from_scratch}{should predictions of Y come from fitted Eta or from 18 | predictions of Eta from posterior of Lambda? (default: false)} 19 | } 20 | \value{ 21 | vector 22 | } 23 | \description{ 24 | Generic Method to Plot Posterior Predictive Summaries 25 | } 26 | -------------------------------------------------------------------------------- /man/predict.bassetfit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/bassetfit_s3.R 3 | \name{predict.bassetfit} 4 | \alias{predict.bassetfit} 5 | \title{Predict using basset} 6 | \usage{ 7 | \method{predict}{bassetfit}(object, newdata, response = "Lambda", 8 | size = NULL, use_names = TRUE, summary = FALSE, iter = NULL, 9 | from_scratch = FALSE, ...) 10 | } 11 | \arguments{ 12 | \item{object}{An object of class pibblefit} 13 | 14 | \item{newdata}{An optional matrix for which to evaluate prediction.} 15 | 16 | \item{response}{Options = "Lambda":Mean of regression, "Eta", "Y": counts} 17 | 18 | \item{size}{the number of counts per sample if response="Y" (as vector or matrix), 19 | default if newdata=NULL and response="Y" is to use colsums of m$Y. Otherwise 20 | uses median colsums of object$Y as default. If passed as a matrix should have dimensions 21 | ncol(newdata) x iter.} 22 | 23 | \item{use_names}{if TRUE apply names to output} 24 | 25 | \item{summary}{if TRUE, posterior summary of predictions are returned rather 26 | than samples} 27 | 28 | \item{iter}{number of iterations to return if NULL uses object$iter} 29 | 30 | \item{from_scratch}{should predictions of Y come from fitted Eta or from 31 | predictions of Eta from posterior of Lambda? (default: false)} 32 | 33 | \item{...}{other arguments passed to summarise_posterior} 34 | } 35 | \value{ 36 | (if summary==FALSE) array D x N x iter; (if summary==TRUE) 37 | tibble with calculated posterior summaries 38 | } 39 | \description{ 40 | Predict using basset 41 | } 42 | \details{ 43 | currently only implemented for pibblefit objects in coord_system "default" 44 | "alr", or "ilr". 45 | } 46 | -------------------------------------------------------------------------------- /man/predict.pibblefit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/strayfit_methods.R 3 | \name{predict.pibblefit} 4 | \alias{predict.pibblefit} 5 | \title{Predict response from new data} 6 | \usage{ 7 | \method{predict}{pibblefit}(object, newdata = NULL, 8 | response = "LambdaX", size = NULL, use_names = TRUE, 9 | summary = FALSE, iter = NULL, from_scratch = FALSE, ...) 10 | } 11 | \arguments{ 12 | \item{object}{An object of class pibblefit} 13 | 14 | \item{newdata}{An optional matrix for which to evaluate predictions. If NULL 15 | (default), the original data of the model is used.} 16 | 17 | \item{response}{Options = "LambdaX":Mean of regression, "Eta", "Y": counts} 18 | 19 | \item{size}{the number of counts per sample if response="Y" (as vector or matrix), 20 | default if newdata=NULL and response="Y" is to use colsums of m$Y. Otherwise 21 | uses median colsums of m$Y as default. If passed as a matrix should have dimensions 22 | ncol(newdata) x iter.} 23 | 24 | \item{use_names}{if TRUE apply names to output} 25 | 26 | \item{summary}{if TRUE, posterior summary of predictions are returned rather 27 | than samples} 28 | 29 | \item{iter}{number of iterations to return if NULL uses object$iter} 30 | 31 | \item{from_scratch}{should predictions of Y come from fitted Eta or from 32 | predictions of Eta from posterior of Lambda? (default: false)} 33 | 34 | \item{...}{other arguments passed to summarise_posterior} 35 | } 36 | \value{ 37 | (if summary==FALSE) array D x N x iter; (if summary==TRUE) 38 | tibble with calculated posterior summaries 39 | } 40 | \description{ 41 | Predict response from new data 42 | } 43 | \details{ 44 | currently only implemented for pibblefit objects in coord_system "default" 45 | "alr", or "ilr". 46 | } 47 | \examples{ 48 | sim <- pibble_sim() 49 | fit <- pibble(sim$Y, sim$X) 50 | predict(fit)[,,1:2] # just show 2 samples 51 | } 52 | -------------------------------------------------------------------------------- /man/print.orthusfit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/strayfit_methods.R 3 | \name{print.orthusfit} 4 | \alias{print.orthusfit} 5 | \title{Print dimensions and coordinate system information for orthusfit object.} 6 | \usage{ 7 | \method{print}{orthusfit}(x, summary = FALSE, ...) 8 | } 9 | \arguments{ 10 | \item{x}{an object of class orthusfit} 11 | 12 | \item{summary}{if true also calculates and prints summary} 13 | 14 | \item{...}{other arguments to pass to summary function} 15 | } 16 | \description{ 17 | Print dimensions and coordinate system information for orthusfit object. 18 | } 19 | \examples{ 20 | \dontrun{ 21 | fit <- orthus(Y, Z, X) 22 | print(fit) 23 | } 24 | } 25 | \seealso{ 26 | \code{\link{summary.orthusfit}} summarizes posterior intervals 27 | } 28 | -------------------------------------------------------------------------------- /man/print.pibblefit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/strayfit_methods.R 3 | \name{print.pibblefit} 4 | \alias{print.pibblefit} 5 | \title{Print dimensions and coordinate system information for pibblefit object.} 6 | \usage{ 7 | \method{print}{pibblefit}(x, summary = FALSE, ...) 8 | } 9 | \arguments{ 10 | \item{x}{an object of class pibblefit} 11 | 12 | \item{summary}{if true also calculates and prints summary} 13 | 14 | \item{...}{other arguments to pass to summary function} 15 | } 16 | \description{ 17 | Print dimensions and coordinate system information for pibblefit object. 18 | } 19 | \examples{ 20 | \dontrun{ 21 | fit <- pibble(Y, X) 22 | print(fit) 23 | } 24 | } 25 | \seealso{ 26 | \code{\link{summary.pibblefit}} summarizes posterior intervals 27 | } 28 | -------------------------------------------------------------------------------- /man/random_pibble_init.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/stray_utils.R 3 | \name{random_pibble_init} 4 | \alias{random_pibble_init} 5 | \title{Provide random initialization for pibble model} 6 | \usage{ 7 | random_pibble_init(Y) 8 | } 9 | \arguments{ 10 | \item{Y}{matrix (D x N) of counts} 11 | } 12 | \value{ 13 | (D-1) x N matrix 14 | } 15 | \description{ 16 | Randomly initializes based on ALR transform of counts 17 | plus random pseudocounts uniformily distributed between 18 | 0 and 1. 19 | } 20 | \details{ 21 | Notation: \code{N} is number of samples and 22 | \code{D} is number of multinomial categories 23 | } 24 | \examples{ 25 | Y <- matrix(sample(1:100, 100), 10, 10) 26 | random_pibble_init(Y) 27 | } 28 | -------------------------------------------------------------------------------- /man/refit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/generics_s3.R 3 | \name{refit} 4 | \alias{refit} 5 | \title{Generic method for fitting model from passed model fit object} 6 | \usage{ 7 | refit(m, ...) 8 | } 9 | \arguments{ 10 | \item{m}{object} 11 | 12 | \item{...}{other arguments passed that control fitting} 13 | } 14 | \value{ 15 | object of the same class as \code{m} 16 | } 17 | \description{ 18 | Generic method for fitting model from passed model fit object 19 | } 20 | -------------------------------------------------------------------------------- /man/req.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/generics_s3.R 3 | \name{req} 4 | \alias{req} 5 | \title{Generic method for ensuring object contains required elements} 6 | \usage{ 7 | req(m, r) 8 | } 9 | \arguments{ 10 | \item{m}{object} 11 | 12 | \item{r}{vector of elements to test for} 13 | } 14 | \value{ 15 | throws error if required element is not present 16 | } 17 | \description{ 18 | Intended to be called internally by package 19 | } 20 | -------------------------------------------------------------------------------- /man/req.maltipoofit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/maltipoofit_s3.R 3 | \name{req.maltipoofit} 4 | \alias{req.maltipoofit} 5 | \title{require elements to be non-null in pibblefit or throw error} 6 | \usage{ 7 | \method{req}{maltipoofit}(m, r) 8 | } 9 | \arguments{ 10 | \item{m}{object} 11 | 12 | \item{r}{vector of elements to test for} 13 | } 14 | \description{ 15 | require elements to be non-null in pibblefit or throw error 16 | } 17 | -------------------------------------------------------------------------------- /man/req.orthusfit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/strayfit_s3.R 3 | \name{req.orthusfit} 4 | \alias{req.orthusfit} 5 | \title{require elements to be non-null in orthusfit or throw error} 6 | \usage{ 7 | \method{req}{orthusfit}(m, r) 8 | } 9 | \arguments{ 10 | \item{m}{object} 11 | 12 | \item{r}{vector of elements to test for} 13 | } 14 | \description{ 15 | require elements to be non-null in orthusfit or throw error 16 | } 17 | -------------------------------------------------------------------------------- /man/req.pibblefit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/strayfit_s3.R 3 | \name{req.pibblefit} 4 | \alias{req.pibblefit} 5 | \title{require elements to be non-null in pibblefit or throw error} 6 | \usage{ 7 | \method{req}{pibblefit}(m, r) 8 | } 9 | \arguments{ 10 | \item{m}{object} 11 | 12 | \item{r}{vector of elements to test for} 13 | } 14 | \description{ 15 | require elements to be non-null in pibblefit or throw error 16 | } 17 | -------------------------------------------------------------------------------- /man/sample_prior.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/generics_s3.R 3 | \name{sample_prior} 4 | \alias{sample_prior} 5 | \title{Generic method for sampling from prior distribution of object} 6 | \usage{ 7 | sample_prior(m, n_samples = 2000L, ...) 8 | } 9 | \arguments{ 10 | \item{m}{object} 11 | 12 | \item{n_samples}{number of samples to produce} 13 | 14 | \item{...}{other arguments to be passed} 15 | } 16 | \value{ 17 | object of the same class 18 | } 19 | \description{ 20 | Generic method for sampling from prior distribution of object 21 | } 22 | -------------------------------------------------------------------------------- /man/sample_prior.pibblefit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/strayfit_methods.R 3 | \name{sample_prior.pibblefit} 4 | \alias{sample_prior.pibblefit} 5 | \title{Sample from the prior distribution of pibblefit object} 6 | \usage{ 7 | \method{sample_prior}{pibblefit}(m, n_samples = 2000L, pars = c("Eta", 8 | "Lambda", "Sigma"), use_names = TRUE, ...) 9 | } 10 | \arguments{ 11 | \item{m}{object of class pibblefit} 12 | 13 | \item{n_samples}{number of samples to produce} 14 | 15 | \item{pars}{parameters to sample} 16 | 17 | \item{use_names}{should names be used if available} 18 | 19 | \item{...}{currently ignored} 20 | } 21 | \description{ 22 | Note this can be used to sample from prior and then predict can 23 | be called to get counts or LambdaX (\code{\link{predict.pibblefit}}) 24 | } 25 | \details{ 26 | Could be greatly speed up in the future if needed by sampling 27 | directly from cholesky form of inverse wishart (currently implemented as 28 | header in this library - see MatDist.h). 29 | } 30 | \examples{ 31 | # Sample prior of already fitted pibblefit object 32 | sim <- pibble_sim() 33 | attach(sim) 34 | fit <- pibble(Y, X) 35 | sample_prior(fit) 36 | 37 | # Sample prior as part of model fitting 38 | m <- pibblefit(N=as.integer(sim$N), D=as.integer(sim$D), Q=as.integer(sim$Q), 39 | iter=2000L, upsilon=upsilon, 40 | Xi=Xi, Gamma=Gamma, Theta=Theta, X=X, 41 | coord_system="alr", alr_base=D) 42 | m <- sample_prior(m) 43 | plot(m) # plot prior distribution (defaults to parameter Lambda) 44 | } 45 | -------------------------------------------------------------------------------- /man/store_coord.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/stray_transforms.R 3 | \name{store_coord} 4 | \alias{store_coord} 5 | \alias{reapply_coord} 6 | \title{Holds information on coordinates system to later be reapplied} 7 | \usage{ 8 | store_coord(m) 9 | 10 | reapply_coord(m, l) 11 | } 12 | \arguments{ 13 | \item{m}{object of class pibblefit} 14 | 15 | \item{l}{object returned by function \code{store_coord}} 16 | } 17 | \value{ 18 | \code{store_coord} list with important information to identify c 19 | coordinate system of pibblefit object. \code{reapply_coord} pibblefit object 20 | in coordinate system previously stored. 21 | } 22 | \description{ 23 | \code{store_coord} stores coordinate information for pibblefit object 24 | and can be reapplied with function \code{reapply_coord}. Some coordinate 25 | systems are not useful for computation and this makes it simple keep 26 | returned object from computations in the same coordinate system as the input. 27 | (Likely most useful inside of a package) 28 | } 29 | -------------------------------------------------------------------------------- /man/stray_package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/stray.R 3 | \docType{package} 4 | \name{stray_package} 5 | \alias{stray_package} 6 | \alias{stray_package-package} 7 | \title{stray: Fitting and Analysis of Multinomial Logistic Normal Models} 8 | \description{ 9 | Provides methods for fitting and inspection of Bayesian Multinomial 10 | Logistic Normal Models using MAP estimation 11 | (with the ADAM optimizer) and Laplace Approximation. Key functionality is 12 | implemented in C++ for scalability. 13 | } 14 | -------------------------------------------------------------------------------- /man/stray_transforms.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/stray_transforms.R 3 | \name{stray_transforms} 4 | \alias{stray_transforms} 5 | \alias{to_proportions} 6 | \alias{to_alr} 7 | \alias{to_ilr} 8 | \alias{to_clr} 9 | \alias{to_proportions.pibblefit} 10 | \alias{to_proportions.orthusfit} 11 | \alias{to_alr.pibblefit} 12 | \alias{to_alr.orthusfit} 13 | \alias{to_ilr.pibblefit} 14 | \alias{to_ilr.orthusfit} 15 | \alias{to_clr.pibblefit} 16 | \alias{to_clr.orthusfit} 17 | \title{Transform Fit Stray Parameters to other representations} 18 | \usage{ 19 | to_proportions(m) 20 | 21 | to_alr(m, d) 22 | 23 | to_ilr(m, V = NULL) 24 | 25 | to_clr(m) 26 | 27 | \method{to_proportions}{pibblefit}(m) 28 | 29 | \method{to_proportions}{orthusfit}(m) 30 | 31 | \method{to_alr}{pibblefit}(m, d) 32 | 33 | \method{to_alr}{orthusfit}(m, d) 34 | 35 | \method{to_ilr}{pibblefit}(m, V = NULL) 36 | 37 | \method{to_ilr}{orthusfit}(m, V = NULL) 38 | 39 | \method{to_clr}{pibblefit}(m) 40 | 41 | \method{to_clr}{orthusfit}(m) 42 | } 43 | \arguments{ 44 | \item{m}{object of class pibblefit or orthusfit (e.g., output of \code{\link{pibble}} 45 | or \code{\link{orthus}})} 46 | 47 | \item{d}{(integer) multinomial category to take as new alr reference} 48 | 49 | \item{V}{(matrix) contrast matrix for ILR basis to transform into to (defaults to 50 | \code{driver::create_default_ilr_base(D)})} 51 | } 52 | \value{ 53 | object 54 | } 55 | \description{ 56 | These are a collection of convenience functions for transforming 57 | stray fit objects to a number of different representations including 58 | ILR bases, CLR coordinates, ALR coordinates, and proportions. 59 | } 60 | \details{ 61 | For orthus, transforms only appleid to log-ratio parameters 62 | 63 | Note: that there is a degeneracy of representations for a covariance 64 | matrix represented in terms of proportions. As such the function 65 | \code{to_proportions} does not attempt to transform parameters Sigma 66 | or prior Xi and instead just removes them from the pibblefit object returned. 67 | } 68 | \examples{ 69 | \dontrun{ 70 | m <- pibble(Y, X) 71 | m.prop <- to_proportions(m) 72 | # convert back to default coordinates (alr with D-th part as reference) 73 | m <- to_alr(m.prop, ncategories(m)) 74 | V <- driver::create_default_ilr_base(ncategories(m)) 75 | m.ilr <- to_ilr(m, V) 76 | m.clr <- to_clr(m) 77 | } 78 | } 79 | -------------------------------------------------------------------------------- /man/summary.orthusfit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/strayfit_methods.R 3 | \name{summary.orthusfit} 4 | \alias{summary.orthusfit} 5 | \title{Summarise orthusfit object and print posterior quantiles} 6 | \usage{ 7 | \method{summary}{orthusfit}(object, pars = NULL, use_names = TRUE, 8 | as_factor = FALSE, gather_prob = FALSE, ...) 9 | } 10 | \arguments{ 11 | \item{object}{an object of class orthusfit} 12 | 13 | \item{pars}{character vector (default: c("Eta", "Lambda", "Sigma"))} 14 | 15 | \item{use_names}{should summary replace dimension indices with orthusfit 16 | names if names Y and X were named in call to \code{\link{orthus}}} 17 | 18 | \item{as_factor}{if use_names and as_factor then returns names as factors 19 | (useful for maintaining orderings when plotting)} 20 | 21 | \item{gather_prob}{if TRUE then prints quantiles in long format rather than 22 | wide (useful for some plotting functions)} 23 | 24 | \item{...}{other expressions to pass to summarise (using name 'val' unquoted is 25 | probably what you want)} 26 | } 27 | \description{ 28 | Default calculates median, mean, 50\% and 95\% credible interval 29 | } 30 | \examples{ 31 | \dontrun{ 32 | fit <- orthus(Y, Z, X) 33 | summary(fit, pars="Eta", median = median(val)) 34 | 35 | # Some later functions make use of precomputation 36 | fit$summary <- summary(fit) 37 | } 38 | } 39 | -------------------------------------------------------------------------------- /man/summary.pibblefit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/strayfit_methods.R 3 | \name{summary.pibblefit} 4 | \alias{summary.pibblefit} 5 | \title{Summarise pibblefit object and print posterior quantiles} 6 | \usage{ 7 | \method{summary}{pibblefit}(object, pars = NULL, use_names = TRUE, 8 | as_factor = FALSE, gather_prob = FALSE, ...) 9 | } 10 | \arguments{ 11 | \item{object}{an object of class pibblefit} 12 | 13 | \item{pars}{character vector (default: c("Eta", "Lambda", "Sigma"))} 14 | 15 | \item{use_names}{should summary replace dimension indices with pibblefit 16 | names if names Y and X were named in call to \code{\link{pibble}}} 17 | 18 | \item{as_factor}{if use_names and as_factor then returns names as factors 19 | (useful for maintaining orderings when plotting)} 20 | 21 | \item{gather_prob}{if TRUE then prints quantiles in long format rather than 22 | wide (useful for some plotting functions)} 23 | 24 | \item{...}{other expressions to pass to summarise (using name 'val' unquoted is 25 | probably what you want)} 26 | } 27 | \description{ 28 | Default calculates median, mean, 50\% and 95\% credible interval 29 | } 30 | \examples{ 31 | \dontrun{ 32 | fit <- pibble(Y, X) 33 | summary(fit, pars="Eta", median = median(val)) 34 | 35 | # Some later functions make use of precomputation 36 | fit$summary <- summary(fit) 37 | } 38 | } 39 | -------------------------------------------------------------------------------- /man/uncollapsePibble.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/RcppExports.R 3 | \name{uncollapsePibble} 4 | \alias{uncollapsePibble} 5 | \title{Uncollapse output from optimPibbleCollapsed to full pibble Model} 6 | \usage{ 7 | uncollapsePibble(eta, X, Theta, Gamma, Xi, upsilon, seed, 8 | ret_mean = FALSE, ncores = -1L) 9 | } 10 | \arguments{ 11 | \item{eta}{array of dimension (D-1) x N x iter (e.g., \code{Pars} output of 12 | function optimPibbleCollapsed)} 13 | 14 | \item{X}{matrix of covariates of dimension Q x N} 15 | 16 | \item{Theta}{matrix of prior mean of dimension (D-1) x Q} 17 | 18 | \item{Gamma}{covariance matrix of dimension Q x Q} 19 | 20 | \item{Xi}{covariance matrix of dimension (D-1) x (D-1)} 21 | 22 | \item{upsilon}{scalar (must be > D) degrees of freedom for InvWishart prior} 23 | 24 | \item{seed}{seed to use for random number generation} 25 | 26 | \item{ret_mean}{if true then uses posterior mean of Lambda and Sigma 27 | corresponding to each sample of eta rather than sampling from 28 | posterior of Lambda and Sigma (useful if Laplace approximation 29 | is not used (or fails) in optimPibbleCollapsed)} 30 | 31 | \item{ncores}{(default:-1) number of cores to use, if ncores==-1 then 32 | uses default from OpenMP typically to use all available cores.} 33 | } 34 | \value{ 35 | List with components 36 | \enumerate{ 37 | \item Lambda Array of dimension (D-1) x Q x iter (posterior samples) 38 | \item Sigma Array of dimension (D-1) x (D-1) x iter (posterior samples) 39 | \item Timer 40 | } 41 | } 42 | \description{ 43 | See details for model. Should likely be called following 44 | \code{\link{optimPibbleCollapsed}}. Notation: \code{N} is number of samples, 45 | \code{D} is number of multinomial categories, \code{Q} is number 46 | of covariates, \code{iter} is the number of samples of \code{eta} (e.g., 47 | the parameter \code{n_samples} in the function \code{optimPibbleCollapsed}) 48 | } 49 | \details{ 50 | Notation: Let Z_j denote the J-th row of a matrix Z. 51 | While the collapsed model is given by: 52 | \deqn{Y_j ~ Multinomial(Pi_j)} 53 | \deqn{Pi_j = Phi^{-1}(Eta_j)} 54 | \deqn{Eta ~ T_{D-1, N}(upsilon, Theta*X, K, A)} 55 | Where A = I_N + X * Gamma * X', K = Xi is a (D-1)x(D-1) covariance 56 | matrix, Gamma is a Q x Q covariance matrix, and Phi^{-1} is ALRInv_D 57 | transform. 58 | 59 | The uncollapsed model (Full pibble model) is given by: 60 | \deqn{Y_j ~ Multinomial(Pi_j)} 61 | \deqn{Pi_j = Phi^{-1}(Eta_j)} 62 | \deqn{Eta ~ MN_{D-1 x N}(Lambda*X, Sigma, I_N)} 63 | \deqn{Lambda ~ MN_{D-1 x Q}(Theta, Sigma, Gamma)} 64 | \deqn{Sigma ~ InvWish(upsilon, Xi)} 65 | This function provides a means of sampling from the posterior distribution of 66 | \code{Lambda} and \code{Sigma} given posterior samples of \code{Eta} from 67 | the collapsed model. 68 | } 69 | \examples{ 70 | sim <- pibble_sim() 71 | 72 | # Fit model for eta 73 | fit <- optimPibbleCollapsed(sim$Y, sim$upsilon, sim$Theta\%*\%sim$X, sim$KInv, 74 | sim$AInv, random_pibble_init(sim$Y)) 75 | 76 | # Finally obtain samples from Lambda and Sigma 77 | fit2 <- uncollapsePibble(fit$Samples, sim$X, sim$Theta, 78 | sim$Gamma, sim$Xi, sim$upsilon, 79 | seed=2849) 80 | } 81 | \references{ 82 | JD Silverman K Roche, ZC Holmes, LA David, S Mukherjee. 83 | Bayesian Multinomial Logistic Normal Models through Marginally Latent Matrix-T Processes. 84 | 2019, arXiv e-prints, arXiv:1903.11695 85 | } 86 | \seealso{ 87 | \code{\link{optimPibbleCollapsed}} 88 | } 89 | -------------------------------------------------------------------------------- /man/verify.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/generics_s3.R 3 | \name{verify} 4 | \alias{verify} 5 | \title{Generic method for verifying new objects} 6 | \usage{ 7 | verify(m, ...) 8 | } 9 | \arguments{ 10 | \item{m}{object} 11 | 12 | \item{...}{other arguments to be passed to verify} 13 | } 14 | \value{ 15 | throws error if verify test fails 16 | } 17 | \description{ 18 | Intended to be called internally by package or object creator 19 | } 20 | -------------------------------------------------------------------------------- /man/verify.bassetfit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/bassetfit_s3.R 3 | \name{verify.bassetfit} 4 | \alias{verify.bassetfit} 5 | \title{Simple verification of passed bassetfit object} 6 | \usage{ 7 | \method{verify}{bassetfit}(m, ...) 8 | } 9 | \arguments{ 10 | \item{m}{an object of class bassetfit} 11 | 12 | \item{...}{not used} 13 | } 14 | \value{ 15 | throws error if any verification tests fail 16 | } 17 | \description{ 18 | Simple verification of passed bassetfit object 19 | } 20 | -------------------------------------------------------------------------------- /man/verify.maltipoofit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/maltipoofit_s3.R 3 | \name{verify.maltipoofit} 4 | \alias{verify.maltipoofit} 5 | \title{Simple verification of passed multipoo object} 6 | \usage{ 7 | \method{verify}{maltipoofit}(m, ...) 8 | } 9 | \arguments{ 10 | \item{m}{an object of class multipoo} 11 | 12 | \item{...}{not used} 13 | } 14 | \value{ 15 | throws error if any verification tests fail 16 | } 17 | \description{ 18 | Simple verification of passed multipoo object 19 | } 20 | -------------------------------------------------------------------------------- /man/verify.orthusfit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/strayfit_s3.R 3 | \name{verify.orthusfit} 4 | \alias{verify.orthusfit} 5 | \title{Simple verification of passed orthusfit object} 6 | \usage{ 7 | \method{verify}{orthusfit}(m, ...) 8 | } 9 | \arguments{ 10 | \item{m}{an object of class orthusfit} 11 | 12 | \item{...}{not used} 13 | } 14 | \value{ 15 | throws error if any verification tests fail 16 | } 17 | \description{ 18 | Simple verification of passed orthusfit object 19 | } 20 | -------------------------------------------------------------------------------- /man/verify.pibblefit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/strayfit_s3.R 3 | \name{verify.pibblefit} 4 | \alias{verify.pibblefit} 5 | \title{Simple verification of passed pibblefit object} 6 | \usage{ 7 | \method{verify}{pibblefit}(m, ...) 8 | } 9 | \arguments{ 10 | \item{m}{an object of class pibblefit} 11 | 12 | \item{...}{not used} 13 | } 14 | \value{ 15 | throws error if any verification tests fail 16 | } 17 | \description{ 18 | Simple verification of passed pibblefit object 19 | } 20 | -------------------------------------------------------------------------------- /src/ConjugateLinearModel.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | // [[Rcpp::depends(RcppEigen)]] 4 | using namespace Rcpp; 5 | using Eigen::MatrixXd; 6 | using Eigen::VectorXd; 7 | using Eigen::ArrayXXd; 8 | using Eigen::Map; 9 | using Eigen::Lower; 10 | 11 | //Eta should be array with dim [D-1, N, iter] 12 | 13 | 14 | //' Solve Bayesian Multivariate Conjugate Linear Model 15 | //' 16 | //' See details for model. Notation: \code{N} is number of samples, 17 | //' \code{D} is the dimension of the response, \code{Q} is number 18 | //' of covariates. 19 | //' 20 | //' @param Y matrix of dimension D x N 21 | //' @param X matrix of covariates of dimension Q x N 22 | //' @param Theta matrix of prior mean of dimension D x Q 23 | //' @param Gamma covariance matrix of dimension Q x Q 24 | //' @param Xi covariance matrix of dimension D x D 25 | //' @param upsilon scalar (must be > D-1) degrees of freedom for InvWishart prior 26 | //' @param n_samples number of samples to draw (default: 2000) 27 | //' 28 | //' @details 29 | //' \deqn{Y ~ MN_{D-1 x N}(Lambda*X, Sigma, I_N)} 30 | //' \deqn{Lambda ~ MN_{D-1 x Q}(Theta, Sigma, Gamma)} 31 | //' \deqn{Sigma ~ InvWish(upsilon, Xi)} 32 | //' This function provides a means of sampling from the posterior distribution of 33 | //' \code{Lambda} and \code{Sigma}. 34 | //' @return List with components 35 | //' 1. Lambda Array of dimension (D-1) x Q x n_samples (posterior samples) 36 | //' 2. Sigma Array of dimension (D-1) x (D-1) x n_samples (posterior samples) 37 | //' @export 38 | //' @md 39 | //' @examples 40 | //' sim <- pibble_sim() 41 | //' eta.hat <- t(driver::alr(t(sim$Y+0.65))) 42 | //' fit <- conjugateLinearModel(eta.hat, sim$X, sim$Theta, sim$Gamma, 43 | //' sim$Xi, sim$upsilon, n_samples=2000) 44 | // [[Rcpp::export]] 45 | List conjugateLinearModel(const Eigen::Map Y, 46 | const Eigen::Map X, 47 | const Eigen::Map Theta, 48 | const Eigen::Map Gamma, 49 | const Eigen::Map Xi, 50 | const double upsilon, 51 | int n_samples = 2000){ 52 | List out(2); 53 | out.names() = CharacterVector::create("Lambda", "Sigma"); 54 | int Q = Gamma.rows(); 55 | int D = Xi.rows(); 56 | int N = X.cols(); 57 | int iter = n_samples; // assumes result is an integer !!! 58 | double upsilonN = upsilon + N; 59 | MatrixXd GammaInv = Gamma.lu().inverse(); 60 | MatrixXd GammaInvN = GammaInv + X*X.transpose(); 61 | MatrixXd GammaN = GammaInvN.lu().inverse(); 62 | MatrixXd LGammaN= GammaN.llt().matrixL(); 63 | MatrixXd ThetaGammaInvGammaN = Theta*GammaInv*GammaN; 64 | MatrixXd XTGammaN = X.transpose()*GammaN; 65 | // // Storage for computation 66 | MatrixXd LambdaN(D, Q); 67 | MatrixXd XiN(D, D); 68 | MatrixXd LambdaDraw(D, Q); 69 | MatrixXd LSigmaDraw(D, D); 70 | MatrixXd SigmaDraw(D, D); 71 | MatrixXd ELambda(D, Q); 72 | MatrixXd EY(D, N); 73 | // Storage for output 74 | MatrixXd LambdaDrawO(D*Q, iter); 75 | MatrixXd SigmaDrawO(D*D, iter); 76 | 77 | // computation out of for-loop compared to pibbleuncollapse 78 | LambdaN = Y*XTGammaN+ThetaGammaInvGammaN; 79 | ELambda = LambdaN-Theta; 80 | EY = Y-LambdaN*X; 81 | XiN = (EY*EY.transpose()).eval() + Xi + (ELambda*GammaInv*ELambda.transpose()).eval(); 82 | 83 | // iterate over all draws of eta 84 | for (int i=0; i < iter; i++){ 85 | R_CheckUserInterrupt(); 86 | // Draw Random Component 87 | LSigmaDraw = rInvWishRevCholesky(upsilonN, XiN).matrix(); 88 | // Note: correct even though LSigmaDraw is reverse cholesky factor 89 | LambdaDraw = rMatNormalCholesky(LambdaN, LSigmaDraw, LGammaN.matrix()); 90 | 91 | // map output to vectors 92 | Map LambdaDrawVec(LambdaDraw.data(), LambdaDraw.size()); 93 | LambdaDrawO.col(i) = LambdaDrawVec; 94 | SigmaDraw = LSigmaDraw*LSigmaDraw.transpose(); 95 | Map SigmaDrawVec(SigmaDraw.data(), SigmaDraw.size()); 96 | SigmaDrawO.col(i) = SigmaDrawVec; 97 | } 98 | 99 | IntegerVector dLambda = IntegerVector::create(D, Q, iter); 100 | IntegerVector dSigma = IntegerVector::create(D, D, iter); 101 | NumericVector nvLambda = wrap(LambdaDrawO); 102 | NumericVector nvSigma = wrap(SigmaDrawO); 103 | nvLambda.attr("dim") = dLambda; 104 | nvSigma.attr("dim") = dSigma; 105 | out[0] = nvLambda; 106 | out[1] = nvSigma; 107 | 108 | return out; 109 | } 110 | -------------------------------------------------------------------------------- /src/Makevars.in: -------------------------------------------------------------------------------- 1 | ## With R 3.1.0 or later, you can uncomment the following line to tell R to 2 | ## enable compilation with C++11 (or even C++14) where available 3 | CXX_STD = CXX11 4 | 5 | ## For standard 6 | PKG_CPPFLAGS = -I../inst/include/ 7 | PKG_LIBS = @OPENMP_FLAG@ 8 | PKG_CXXFLAGS = @OPENMP_FLAG@ 9 | 10 | ## For MKL - make sure you are using icc compiler in ~.R/Makevars 11 | # Using GCC -- PREFERRED for MKL 12 | #PKG_CPPFLAGS = -L/opt/intel/compilers_and_libraries_2019.1.144/mac/compiler/lib -m64 -I../inst/include/ -DSTRAY_USE_MKL 13 | #PKG_CXXFLAGS = -I/opt/intel/compilers_and_libraries_2019.1.144/mac/mkl/include -w 14 | #PKG_LIBS = -L/opt/intel/compilers_and_libraries_2019.1.144/mac/mkl/lib -Wl,-rpath,/opt/intel/compilers_and_libraries_2019.1.144/mac/mkl/lib -lmkl_rt -lpthread -lm -ldl 15 | -------------------------------------------------------------------------------- /src/Makevars.win: -------------------------------------------------------------------------------- 1 | ## With Rcpp 0.11.0 and later, we no longer need to set PKG_LIBS as there is 2 | ## no user-facing library. The include path to headers is already set by R. 3 | PKG_CPPFLAGS = -I../inst/include/ 4 | PKG_LIBS = $(SHLIB_OPENMP_CXXFLAGS) 5 | PKG_CXXFLAGS = $(SHLIB_OPENMP_CXXFLAGS) 6 | 7 | ## With R 3.1.0 or later, you can uncomment the following line to tell R to 8 | ## enable compilation with C++11 (or even C++14) where available 9 | #CXX_STD = CXX11 10 | 11 | -------------------------------------------------------------------------------- /src/MaltipooCollapsed_LGH.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | // [[Rcpp::depends(RcppNumerical)]] 3 | // [[Rcpp::depends(RcppEigen)]] 4 | 5 | using namespace Rcpp; 6 | using Eigen::Map; 7 | using Eigen::MatrixXd; 8 | using Eigen::ArrayXXd; 9 | using Eigen::VectorXd; 10 | 11 | //' Calculations for the Collapsed Maltipoo Model 12 | //' 13 | //' Functions providing access to the Log Likelihood, Gradient, and Hessian 14 | //' of the collapsed maltipoo model. Note: These are convenience functions 15 | //' but are not as optimized as direct coding of the MaltipooCollapsed 16 | //' C++ class due to a lack of Memoization. By contrast function optimMaltipooCollapsed 17 | //' is much more optimized and massively cuts down on repeated calculations. 18 | //' A more efficient Rcpp module based implementation of these functions 19 | //' may following if the future. For model details see \code{\link{optimMaltipooCollapsed}} 20 | //' documentation 21 | //' @inheritParams optimMaltipooCollapsed 22 | //' @param eta matrix (D-1)xN of parameter values at which to calculate quantities 23 | //' @param sylv (default:false) if true and if N < D-1 will use sylvester determinant 24 | //' identity to speed computation 25 | //' @param ell P-vector of scale factors for each variance component (aka VCScale) 26 | //' @name loglikMaltipooCollapsed 27 | //' @export 28 | // [[Rcpp::export]] 29 | double loglikMaltipooCollapsed(const Eigen::ArrayXXd Y, 30 | const double upsilon, 31 | const Eigen::MatrixXd Theta, 32 | const Eigen::MatrixXd X, 33 | const Eigen::MatrixXd KInv, 34 | const Eigen::MatrixXd U, 35 | Eigen::MatrixXd eta, 36 | Eigen::VectorXd ell, 37 | bool sylv=false){ 38 | MaltipooCollapsed cm(Y, upsilon, Theta, X, KInv, U, sylv); 39 | Map etavec(eta.data(), eta.size()); 40 | cm.updateWithEtaLL(etavec, ell); 41 | return cm.calcLogLik(etavec); 42 | } 43 | 44 | //' @rdname loglikMaltipooCollapsed 45 | //' @export 46 | // [[Rcpp::export]] 47 | Eigen::VectorXd gradMaltipooCollapsed(const Eigen::ArrayXXd Y, 48 | const double upsilon, 49 | const Eigen::MatrixXd Theta, 50 | const Eigen::MatrixXd X, 51 | const Eigen::MatrixXd KInv, 52 | const Eigen::MatrixXd U, 53 | Eigen::MatrixXd eta, 54 | Eigen::VectorXd ell, 55 | bool sylv=false){ 56 | MaltipooCollapsed cm(Y, upsilon, Theta, X, KInv, U, sylv); 57 | Map etavec(eta.data(), eta.size()); 58 | cm.updateWithEtaLL(etavec, ell); 59 | cm.updateWithEtaGH(); 60 | return cm.calcGrad(ell); 61 | } 62 | 63 | //' @rdname loglikMaltipooCollapsed 64 | //' @export 65 | // [[Rcpp::export]] 66 | Eigen::MatrixXd hessMaltipooCollapsed(const Eigen::ArrayXXd Y, 67 | const double upsilon, 68 | const Eigen::MatrixXd Theta, 69 | const Eigen::MatrixXd X, 70 | const Eigen::MatrixXd KInv, 71 | const Eigen::MatrixXd U, 72 | Eigen::MatrixXd eta, 73 | Eigen::VectorXd ell, 74 | bool sylv=false){ 75 | MaltipooCollapsed cm(Y, upsilon, Theta, X, KInv, U, sylv); 76 | Map etavec(eta.data(), eta.size()); 77 | cm.updateWithEtaLL(etavec, ell); 78 | cm.updateWithEtaGH(); 79 | return cm.calcHess(ell); 80 | } 81 | -------------------------------------------------------------------------------- /src/MatrixAlgebra.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include "MatrixAlgebra.h" 3 | #ifdef STRAY_USE_MKL 4 | #include 5 | #endif 6 | 7 | // [[Rcpp::depends(RcppEigen)]] 8 | 9 | using namespace Rcpp; 10 | using Eigen::Map; 11 | using Eigen::MatrixXd; 12 | using Eigen::Ref; 13 | 14 | // computes L %x% R for dense L and R 15 | MatrixXd krondense(const Ref& L, const Ref& R){ 16 | int lr = L.rows(); 17 | int lc = L.cols(); 18 | int rr = R.rows(); 19 | int rc = R.cols(); 20 | MatrixXd out(lr*rr, lc*rc); 21 | 22 | #pragma omp parallel for 23 | for (int i=0; i < lr; i++){ 24 | for (int j=0; j < lc; j++){ 25 | out.block(i*rr, j*rc, rr, rc) = L(i,j)*R; 26 | } 27 | } 28 | return out; 29 | } 30 | 31 | // computes A=L%x%R (overwrites A) 32 | void krondense_inplace(Ref A, const Ref& L, 33 | const Ref& R){ 34 | int lr = L.rows(); 35 | int lc = L.cols(); 36 | int rr = R.rows(); 37 | int rc = R.cols(); 38 | 39 | #pragma omp parallel for shared(R, A) 40 | for (int i=0; i < lr; i++){ 41 | for (int j=0; j < lc; j++){ 42 | A.block(i*rr, j*rc, rr, rc) = L(i,j)*R; 43 | } 44 | } 45 | } 46 | 47 | // computes A+=L%x%R (overwrites A) 48 | void krondense_inplace_add(Ref A, const Ref& L, 49 | const Ref& R){ 50 | int lr = L.rows(); 51 | int lc = L.cols(); 52 | int rr = R.rows(); 53 | int rc = R.cols(); 54 | 55 | #pragma omp parallel for shared(R, A) 56 | for (int i=0; i < lr; i++){ 57 | for (int j=0; j < lc; j++){ 58 | A.block(i*rr, j*rc, rr, rc) += L(i,j)*R; 59 | } 60 | } 61 | } 62 | 63 | 64 | // computes TVEC(m,n)*A for mxn matrix A 65 | MatrixXd tveclmult(const int m, const int n, const Ref& A){ 66 | int ar = A.rows(); 67 | int ac = A.cols(); 68 | MatrixXd out(ar, ac); 69 | 70 | #pragma omp parallel for shared(out, A) 71 | for (int i=0; i A, 82 | Ref B){ 83 | int ar=A.rows(); 84 | int ac=A.cols(); 85 | 86 | #ifdef STRAY_USE_MKL 87 | Eigen::VectorXi k(ar); 88 | for (int i=0; i 2 | using namespace Rcpp; 3 | 4 | //' Log of Multivarate Gamma Function - Gamma_p(a) 5 | //' @param a defined by Gamma_p(a) 6 | //' @param p defined by Gamma_p(a) 7 | //' @references https://en.wikipedia.org/wiki/Multivariate_gamma_function 8 | // [[Rcpp::export]] 9 | double lmvgamma(double a, int p){ 10 | static const double pi = log(3.14159265); 11 | double s=0; 12 | double x = pi*(p*(p-1.0))/2.0; 13 | for (int i=1; i<=p; i++){ 14 | s += lgamma(a+(1.0-i)/2); 15 | } 16 | return(x+s); 17 | } 18 | 19 | //' Derivative of Log of Multivariate Gamma Function - Gamma_p(a) 20 | //' @param a defined by Gamma_p(a) 21 | //' @param p defined by Gamma_p(a) 22 | //' @references https://en.wikipedia.org/wiki/Multivariate_gamma_function 23 | // [[Rcpp::export]] 24 | double lmvgamma_deriv(double a, int p){ 25 | double s=0; 26 | for (int i=1; i<=p; i++){ 27 | s += R::digamma(a + 0.5*(1-i)); 28 | } 29 | return s*lmvgamma(a,p); 30 | } -------------------------------------------------------------------------------- /src/test_LaplaceApproximation.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | // [[Rcpp::depends(RcppEigen)]] 4 | 5 | using namespace Rcpp; 6 | using Eigen::MatrixXd; 7 | using Eigen::VectorXd; 8 | 9 | 10 | // A few functions for testing LaplaceApproximation.h 11 | // [[Rcpp::export]] 12 | Eigen::MatrixXd eigen_lap_test(int n_samples, Eigen::VectorXd m, 13 | Eigen::MatrixXd S, double eigvalthresh){ 14 | lapap::lappars pars = lapap::init_lappars(eigvalthresh); 15 | int p = m.rows(); 16 | MatrixXd z = MatrixXd::Zero(p, n_samples); 17 | int status = lapap::eigen_lap(z, m, S, pars); 18 | if (status==1) Rcpp::stop("decomposition failed"); 19 | return z; 20 | } 21 | 22 | // [[Rcpp::export]] 23 | Eigen::MatrixXd cholesky_lap_test(int n_samples, Eigen::VectorXd m, 24 | Eigen::MatrixXd S, double eigvalthresh){ 25 | lapap::lappars pars = lapap::init_lappars(eigvalthresh); 26 | int p = m.rows(); 27 | MatrixXd z = MatrixXd::Zero(p, n_samples); 28 | int status = lapap::cholesky_lap(z, m, S, pars); 29 | if (status==1) Rcpp::stop("decomposition failed"); 30 | return z; 31 | } 32 | 33 | 34 | 35 | // [[Rcpp::export]] 36 | Eigen::MatrixXd LaplaceApproximation_test(int n_samples, Eigen::VectorXd m, 37 | Eigen::MatrixXd S, String decomp_method, 38 | double eigvalthresh){ 39 | int p=m.rows(); 40 | MatrixXd z = MatrixXd::Zero(p, n_samples); 41 | double logInvNegHessDet; 42 | int status = lapap::LaplaceApproximation(z, m, S, decomp_method, 43 | eigvalthresh,0, 44 | logInvNegHessDet); 45 | if (status==1) Rcpp::stop("decomposition failed"); 46 | return z; 47 | } -------------------------------------------------------------------------------- /src/test_MultDirichletBoot.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | // [[Rcpp::depends(RcppEigen)]] 4 | 5 | using namespace Rcpp; 6 | using Eigen::MatrixXd; 7 | using Eigen::VectorXd; 8 | 9 | // Wrapper functions 10 | // [[Rcpp::export]] 11 | Eigen::MatrixXd alrInv_default_test(Eigen::MatrixXd eta){ 12 | return MultDirichletBoot::alrInv_default(eta); 13 | } 14 | 15 | // Wrapper functions 16 | // [[Rcpp::export]] 17 | Eigen::MatrixXd alr_default_test(Eigen::MatrixXd pi){ 18 | return MultDirichletBoot::alr_default(pi); 19 | } 20 | 21 | // Wrapper functions 22 | // [[Rcpp::export]] 23 | Eigen::MatrixXd rDirichlet_test(int n_samples, Eigen::VectorXd alpha){ 24 | return MultDirichletBoot::rDirichlet(n_samples, alpha); 25 | } 26 | 27 | 28 | // Wrapper functions 29 | // [[Rcpp::export]] 30 | Eigen::MatrixXd MultDirichletBoot_test(int n_samples, Eigen::MatrixXd eta, 31 | Eigen::ArrayXXd Y, double pseudocount){ 32 | return MultDirichletBoot::MultDirichletBoot(n_samples, eta, Y, pseudocount); 33 | } -------------------------------------------------------------------------------- /src/test_utils.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | using namespace Rcpp; 4 | 5 | // [[Rcpp::depends(RcppZiggurat)]] 6 | 7 | // [[Rcpp::export]] 8 | void fillUnitNormal_test(Eigen::Map& Z){ 9 | fillUnitNormal(Z); 10 | } -------------------------------------------------------------------------------- /stray.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | BuildType: Package 16 | PackageUseDevtools: Yes 17 | PackageInstallArgs: --no-multiarch --with-keep.source 18 | PackageCheckArgs: --no-vignettes 19 | PackageRoxygenize: rd,collate,namespace 20 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(stray) 3 | 4 | #Sys.setenv(KMP_DUPLICATE_LIB_OK="TRUE") 5 | test_check("stray") 6 | #Sys.unsetenv("KMP_DUPLICATE_LIB_OK") 7 | -------------------------------------------------------------------------------- /tests/testthat/.gitignore: -------------------------------------------------------------------------------- 1 | Rplots.pdf 2 | -------------------------------------------------------------------------------- /tests/testthat/Rplots.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jsilve24/stray/29fdc2e431b8e515f38f0a4969c1e431e918fa44/tests/testthat/Rplots.pdf -------------------------------------------------------------------------------- /tests/testthat/test-basset.R: -------------------------------------------------------------------------------- 1 | context("test-basset") 2 | 3 | set.seed(569) 4 | 5 | test_that("basset and predict.bassetfit run", { 6 | sim <- pibble_sim() 7 | Gamma <- function(X) SE(X) 8 | Theta <- function(X) matrix(0, nrow(sim$Y)-1, ncol(X)) 9 | fit <- basset(sim$Y, sim$X, Gamma = Gamma, Theta = Theta) 10 | foo <- predict(fit, matrix(c(1,2))) 11 | expect_true(TRUE) 12 | }) 13 | 14 | -------------------------------------------------------------------------------- /tests/testthat/test-hessian.R: -------------------------------------------------------------------------------- 1 | context("test-hessian") 2 | 3 | #' @param eta is vec(eta) 4 | matt_nll <- function(eta, Y, X, upsilon, Theta, Xi, Gamma){ 5 | D <- nrow(Y) 6 | N <- ncol(Y) 7 | eta <- matrix(eta, D-1, N) 8 | A <- solve(diag(N) + t(X)%*%Gamma %*% X) 9 | K <- solve(Xi) 10 | delta <- (upsilon+N+D-2)/2 11 | E <- eta - Theta%*%X 12 | S <- diag(D-1) + K%*%E%*%A%*%t(E) 13 | nll <- delta*log(det(S)) 14 | return(nll) 15 | } 16 | 17 | #' @param eta is vec(eta) 18 | mult_nll <- function(eta, Y, X, upsilon, Theta, Xi, Gamma){ 19 | D <- nrow(Y) 20 | N <- ncol(Y) 21 | nll <- 0 22 | eta <- matrix(eta, D-1, N) 23 | pi <- t(driver::alrInv(t(eta))) 24 | for (i in 1:N){ 25 | nll <- nll - dmultinom(Y[,i], prob=pi[,i], log=TRUE) # NEGATIVE! 26 | } 27 | return(nll) 28 | } 29 | 30 | #' @param eta is vec(eta) 31 | nll <- function(eta, Y, X, upsilon, Theta, Xi, Gamma){ 32 | nll <- 0 33 | nll <- nll+ matt_nll(eta, Y, X, upsilon, Theta, Xi, Gamma) 34 | nll <- nll+mult_nll(eta, Y, X, upsilon, Theta, Xi, Gamma) 35 | return(nll) 36 | } 37 | 38 | #' function to calculate hessian for model at a given eta 39 | #' @param eta (D-1) x N matrix 40 | #' @details uses hessPibbleCollapsed function of stray 41 | hessMC <- function(mdataset, eta){ 42 | X <- mdataset$X 43 | A <- solve(diag(mdataset$N)+ t(X)%*%mdataset$Gamma%*%X) 44 | hessPibbleCollapsed(mdataset$Y, mdataset$upsilon, 45 | mdataset$Theta%*%X, solve(mdataset$Xi), 46 | A, eta) 47 | } 48 | 49 | sim <- pibble_sim(D=5, N=10, true_priors=FALSE) 50 | nll_partial <- function(x) nll(x, sim$Y, sim$X, sim$upsilon, 51 | sim$Theta, sim$Xi, sim$Gamma) 52 | 53 | test_that("hessian agrees with finite differences", { 54 | hess.nd <- numDeriv::hessian(nll_partial, c(sim$Eta)) 55 | A <- solve(diag(sim$N) + t(sim$X) %*% sim$Gamma %*% sim$X) 56 | hess <- hessPibbleCollapsed(sim$Y, sim$upsilon, sim$Theta%*%sim$X, 57 | solve(sim$Xi), A, sim$Eta) 58 | expect_equal(hess.nd, -hess, tolerance=1e-3) 59 | expect_true(TRUE) 60 | }) 61 | -------------------------------------------------------------------------------- /tests/testthat/test-hvp.R: -------------------------------------------------------------------------------- 1 | # context("test-hessianvectorproduct") 2 | # 3 | # 4 | # test_that("hessVectorProd output is reasonable", { 5 | # set.seed(88) 6 | # N <- 20 7 | # D <- 20 8 | # sim <- pibble_sim(D=D, N=N, true_priors=FALSE) 9 | # Z <- runif(N*(D-1)) 10 | # ThetaX <- sim$Theta%*%sim$X 11 | # prod1 <- hessPibbleCollapsed(sim$Y, sim$upsilon, ThetaX, sim$KInv, sim$AInv, sim$Eta) 12 | # prod1 <- prod1%*%Z; 13 | # prod2 <- hessVectorProd(sim$Y, sim$upsilon, ThetaX, sim$KInv, sim$AInv, sim$Eta, Z, 0.001) 14 | # expect_equal(prod1[,1], prod2, tolerance=1e-5) 15 | # }) 16 | # 17 | # 18 | 19 | 20 | -------------------------------------------------------------------------------- /tests/testthat/test-iqlr.R: -------------------------------------------------------------------------------- 1 | context("test-iqlr") 2 | 3 | test_that("iqlr gives correct format of output", { 4 | sim <- pibble_sim() 5 | fit <- pibble(sim$Y, sim$X) 6 | out <- lambda_to_iqlr(fit, 1:2) 7 | expect_equal(dim(out), c(ncategories(fit), ncovariates(fit), niter(fit))) 8 | }) 9 | 10 | test_that("iqlr handles iter equal 1 case", { 11 | sim <- pibble_sim() 12 | fit <- pibble(sim$Y, sim$X,n_samples=1) 13 | fit <- pibblefit(as.integer(sim$D), as.integer(sim$N), as.integer(sim$Q), iter=1L, 14 | coord_system="alr", alr_base=sim$D, 15 | Lambda = fit$Lambda) 16 | out <- lambda_to_iqlr(fit) # also testing handing of default focus.cov 17 | expect_equal(dim(out), c(ncategories(fit), ncovariates(fit), niter(fit))) 18 | }) -------------------------------------------------------------------------------- /tests/testthat/test-kernels.R: -------------------------------------------------------------------------------- 1 | context("test-kernels") 2 | 3 | test_that("RBF works", { 4 | X <- matrix(rnorm(10), 2, 5) 5 | G <- SE(X, 2, .2) 6 | expect_true(all(eigen(G)$values>0)) 7 | expect(all(diag(G)-4 < .000001), "Gram matrix diagonal not as expected") 8 | }) 9 | 10 | test_that("LINEAR works", { 11 | X <- matrix(rnorm(15), 5, 3) 12 | G <- LINEAR(X, 1, rep(0, nrow(X))) 13 | expect_true(all(eigen(G)$values>0)) 14 | }) -------------------------------------------------------------------------------- /tests/testthat/test-laplaceapproximation.R: -------------------------------------------------------------------------------- 1 | context("test-laplaceapproximation") 2 | library(driver) 3 | 4 | test_that("eigen_lap gets correct answer", { 5 | n_samples <- 100000 6 | m <- 1:3 7 | S <- diag(4:6) 8 | S[1,2] <- S[2,1] <- -1 9 | #S <- -S 10 | z <- eigen_lap_test(n_samples, m, S, 0) 11 | 12 | expect_equal(var(t(z)), solve(S), tolerance=0.005) 13 | expect_equal(rowMeans(z), m, tolerance=.01) 14 | }) 15 | 16 | 17 | test_that("cholesky_lap gets correct answer", { 18 | n_samples <- 100000 19 | m <- 1:3 20 | S <- diag(4:6) 21 | S[1,2] <- S[2,1] <- -1 22 | #S <- -S 23 | z <- eigen_lap_test(n_samples, m, S, 0) 24 | 25 | expect_equal(var(t(z)), solve(S), tolerance=0.005) 26 | expect_equal(rowMeans(z), m, tolerance=.01) 27 | }) 28 | 29 | test_that("LaplaceApproximation gets correct result for full hessian", { 30 | n_samples <- 1000000 31 | m <- 1:3 32 | S <- diag(1:3) 33 | S[1,2] <- S[2,1] <- -1 34 | #S <- -S 35 | 36 | z <- LaplaceApproximation_test(n_samples, m, S, "eigen", 0) 37 | expect_equal(var(t(z)), solve(S), tolerance=0.005) 38 | expect_equal(rowMeans(z), m, tolerance=.01) 39 | 40 | z <- LaplaceApproximation_test(n_samples, m, S, "cholesky", 0) 41 | expect_equal(var(t(z)), solve(S), tolerance=0.005) 42 | expect_equal(rowMeans(z), m, tolerance=.01) 43 | }) 44 | 45 | 46 | 47 | 48 | -------------------------------------------------------------------------------- /tests/testthat/test-linesearch.R: -------------------------------------------------------------------------------- 1 | # context("test-linesearch") 2 | # 3 | # test_that("linesearch terminates with nonridiculous output", { 4 | # N <- 20 5 | # D <- 20 6 | # sim <- pibble_sim(D=D, N=N, true_priors=FALSE) 7 | # Z <- runif(N*(D-1)) 8 | # ThetaX <- sim$Theta%*%sim$X 9 | # element <- 1 10 | # new_eta <- lineSearch(sim$Y, sim$upsilon, ThetaX, sim$KInv, sim$AInv, sim$Eta, element, 0.5, 0.0001) 11 | # vec_eta <- c(sim$Eta) 12 | # compare <- rep(TRUE, N*(D-1)) 13 | # compare[element] <- FALSE 14 | # expect_equal(vec_eta[compare], new_eta[compare], tolerance=0.0001) 15 | # }) 16 | # 17 | # 18 | # 19 | # 20 | -------------------------------------------------------------------------------- /tests/testthat/test-maltipoo.R: -------------------------------------------------------------------------------- 1 | context("test-maltipoo") 2 | 3 | require(driver) 4 | set.seed(4) 5 | 6 | test_that("maltipoo wrapper correctness", { 7 | D <- 5; N <- 70; Q <- N 8 | 9 | X <- matrix(rnorm(N*Q), Q, N) 10 | delta_true <- .1 11 | U <- diag(Q) 12 | Gamma <- delta_true*U 13 | upsilon <- D+3000 14 | Xi <- diag(D-1) 15 | Sigma <- Xi/(upsilon-D) 16 | 17 | # Mean Zero 18 | Theta <- matrix(0, D-1, Q) 19 | Z <- matrix(rnorm(Q*(D-1)), D-1, Q) 20 | B <- Theta + t(chol(Sigma))%*%Z%*%chol(Gamma) 21 | Z <- matrix(rnorm(Q*(D-1)), D-1, N) 22 | Eta <- B%*%X + t(chol(Sigma))%*%Z 23 | Pi <- alrInv_array(Eta, coords=1) 24 | Y <- matrix(0, D, N) 25 | for (i in 1:N){ 26 | Y[,i] <- rmultinom(1, 10000, prob=Pi[,i]) 27 | } 28 | 29 | fit <- maltipoo(Y, X, upsilon, Theta, U, Xi, init=Eta, ellinit = log(delta_true)) 30 | 31 | # Check that scale of VCs is correct 32 | expect_true(fit$VCScale-delta_true < 0.1) 33 | 34 | # Laplace approximation contains true value # given the true value 35 | p0.25 <- apply(fit$Eta, c(1,2), function(x) quantile(x, probs=0.0025)) 36 | p99.75 <- apply(fit$Eta, c(1,2), function(x) quantile(x, probs=0.9975)) 37 | expect_true(sum(!((p0.25 <= Eta) & (p99.75 >= Eta))) < 0.02*N*(D-1)) 38 | 39 | # Check Lambda 40 | expect_true(mean(abs(apply(fit$Lambda, c(1,2), mean) - B)) < 0.01) 41 | p0.25 <- apply(fit$Lambda, c(1,2), function(x) quantile(x, probs=0.0025)) 42 | p99.75 <- apply(fit$Lambda, c(1,2), function(x) quantile(x, probs=0.9975)) 43 | expect_true(sum(!((p0.25 <= B) & (p99.75 >= B))) < 0.02*N*(D-1)) 44 | }) 45 | -------------------------------------------------------------------------------- /tests/testthat/test-matdist.R: -------------------------------------------------------------------------------- 1 | context("test-matdist.R") 2 | 3 | test_that("MVN handles non-square output", { 4 | Sigma <- matrix(c(1, -.5, -.5, 2),ncol=2, byrow = TRUE) 5 | E <- rMatNormalCholesky_test(matrix(0, 10, 2), diag(10), Sigma, discard=1) 6 | expect_equal(dim(E), c(10, 2)) 7 | }) 8 | 9 | test_that("MVN correctness of Mean", { 10 | M <- matrix(c(1,2,3,4), ncol=2) 11 | X2 <- array(0, dim=c(2, 2, 1000)) 12 | for (i in 1:1000){ 13 | X2[,,i] <- rMatNormalCholesky_test(M, diag(2), diag(2), discard=i) 14 | } 15 | 16 | # Tol based on Standard error of the mean 17 | expect_equal(apply(X2, c(1,2), mean), M, tolerance = 1/sqrt(1000)) 18 | }) 19 | 20 | test_that("MVN correctness of Covariances", { 21 | M <- matrix(0, ncol=2, nrow=2) 22 | U <- matrix(c(1,.5,.5, 2), ncol=2) 23 | V <- matrix(c(5,-.5,-.5, 1), ncol=2) 24 | LU <- t(chol(U)) 25 | LV <- t(chol(V)) 26 | t <- 10000 27 | X2 <- array(0, dim=c(2, 2, t)) 28 | for (i in 1:t){ 29 | X2[,,i] <- rMatNormalCholesky_test(M, LU,LV, discard=i) 30 | } 31 | 32 | # Test U 33 | tr <- function(x) sum(diag(x)) 34 | 35 | # From Wikipedia 36 | # E[(X-M)(X-M)'] = Utr(V) 37 | X2_store <- array(0, dim=dim(X2)) 38 | for (i in 1:t){ 39 | X2_store[,,i] <- X2[,,i]%*%t(X2[,,i]) 40 | } 41 | expect_equal(apply(X2_store, c(1,2), mean), U*tr(V), tolerance = 0.1) 42 | 43 | # E[(X-M)'(X-M)'] = Vtr(U) 44 | X2_store <- array(0, dim=dim(X2)) 45 | for (i in 1:t){ 46 | X2_store[,,i] <- t(X2[,,i])%*%(X2[,,i]) 47 | } 48 | expect_equal(apply(X2_store, c(1,2), mean), V*tr(U), tolerance = 0.1) 49 | }) 50 | 51 | test_that("InvWishart Correctness of Mean", { 52 | Psi <- matrix(c(1,.5,.5, 2), ncol=2) 53 | v <- 4 54 | t <- 100000 55 | Sigma <- array(0, dim=c(2,2,t)) 56 | for (i in 1:t){ 57 | Sigma[,,i] <- rInvWishRevCholesky_test(v, Psi) 58 | Sigma[,,i] <- tcrossprod(Sigma[,,i]) 59 | } 60 | expect_equal(apply(Sigma, c(1,2), mean), Psi/(v-2-1), tolerance=0.1) 61 | }) 62 | 63 | 64 | test_that("Unit normal filler is correct",{ 65 | x <- rMatUnitNormal_test1(1000,1000) 66 | expect_equal(dim(x), c(1000, 1000)) 67 | x <- c(x) 68 | expect_equal(mean(x), 0, tolerance=0.02) 69 | expect_equal(var(x), 1, tolerance=0.02) 70 | 71 | # Test that unit normal filler handles VectorXd objects as well. 72 | x <- rMatUnitNormal_test2(100000) 73 | expect_equal(dim(x), c(100000, 1)) 74 | x <- c(x) 75 | expect_equal(mean(x), 0, tolerance=0.02) 76 | expect_equal(var(x), 1, tolerance=0.02) 77 | }) 78 | 79 | -------------------------------------------------------------------------------- /tests/testthat/test-mongrelfit-methods.R: -------------------------------------------------------------------------------- 1 | context("test-pibblefit-methods.R") 2 | 3 | sim <- pibble_sim() 4 | 5 | test_that("sample_prior correct", { 6 | fit <- pibble(sim$Y, sim$X) 7 | priors <- sample_prior(fit) 8 | 9 | expect_equal(apply(priors$Eta, c(1, 2), mean), priors$Theta%*%priors$X, 10 | tolerance=0.1) 11 | 12 | expect_equal(apply(priors$Lambda, c(1, 2), mean), priors$Theta, 13 | tolerance=0.1) 14 | }) 15 | 16 | 17 | test_that("Predict works with priors only",{ 18 | fit <- pibble(Y=NULL, sim$X, D=sim$D) 19 | foo <- predict(fit, response="Y", size = 5000) 20 | expect_equal(dim(foo), c(sim$D, sim$N, fit$iter)) 21 | }) 22 | 23 | # Fixing github issue #4 24 | test_that("Plot works with focus.cooord and coord system change",{ 25 | fit <- pibble(sim$Y, sim$X) 26 | fit <- to_clr(fit) 27 | p <- plot(fit, par="Lambda", focus.coord=c("clr_c1", "clr_c2")) 28 | #p <- plot(fit, par="Lambda", focus.coord=1:4) # Not yet implemented 29 | expect_error(print(p), NA) 30 | }) 31 | 32 | 33 | test_that("Predict works in CLR", { 34 | fit <- pibble(sim$Y, sim$X) 35 | fit <- to_clr(fit) 36 | expect_error(predict(fit), NA) 37 | }) 38 | 39 | test_that("summary works with pars=Lambda", { 40 | fit <- pibble(sim$Y, sim$X, pars="Lambda") 41 | summary(fit) 42 | expect_true(TRUE) 43 | }) 44 | 45 | 46 | # test_that("Plots work with iter=1", { 47 | # fit <- pibble(sim$Y, sim$X, n_samples=1) 48 | # plot(fit, par="Sigma") 49 | # plot(fit, par="Eta") 50 | # }) -------------------------------------------------------------------------------- /tests/testthat/test-multdirichletboot.R: -------------------------------------------------------------------------------- 1 | context("test-multdirichletboot") 2 | library(driver) 3 | 4 | test_that("alr_default and alrInv_default is correct", { 5 | x <- miniclo_array(matrix(1:10, 5, 2), parts=1) 6 | x.alr <- alr_default_test(x) 7 | expect_equal(alr_array(x, parts=1), x.alr) 8 | expect_equal(x, alrInv_default_test(x.alr)) 9 | }) 10 | 11 | rDirichlet <- function(n_samples, alpha){ 12 | p <- length(alpha) 13 | x <- matrix(0, p, n_samples) 14 | for (i in 1:p){ 15 | x[i,] <- rgamma(n_samples, alpha[i], 1) 16 | } 17 | return( miniclo_array(x, parts=1) ) 18 | } 19 | 20 | test_that("MultDirichletBoot is correct", { 21 | n_samples <- 50000 22 | pi <- miniclo_array(matrix(1:5, 5, 1), parts=1) 23 | eta <- alr_array(pi, parts=1) 24 | depth <- 10 25 | Y <- matrix(rep(depth, 5), 5, 1) 26 | s <- MultDirichletBoot_test(n_samples, eta, Y, 0.05) 27 | 28 | x <- rDirichlet(n_samples, pi*depth*5) 29 | x <- alr_array(x, parts=1) 30 | 31 | expect_equal(rowMeans(x), rowMeans(s), tolerance=0.01) 32 | expect_equal(apply(x, 1, var), apply(s, 1, var), tolerance=0.05) 33 | }) 34 | 35 | test_that("Timer does not have Error Johannes pointed out",{ 36 | sim <- pibble_sim() 37 | fit <- pibble(sim$Y, sim$X, calcGradHess=FALSE, multDirichletBoot=0.65) 38 | expect_true(TRUE) 39 | }) 40 | -------------------------------------------------------------------------------- /tests/testthat/test-orthus-transforms.R: -------------------------------------------------------------------------------- 1 | D <- 6 2 | P <- 4 3 | A.prop <- array(abs(rnorm(10*6*5)), dim=c(10, 6, 5)) 4 | A.prop[1:D,,] <- driver::miniclo_array(A.prop[1:D,,], parts=1) 5 | 6 | test_that("orthus data transform correctness", { 7 | # TEST ilr and ilrinv 8 | A.ilr <- oilr(A.prop, D) 9 | expect_equal(A.ilr[1:(D-1),,], ilr_array(A.prop[1:D,,],parts=1)) 10 | expect_equal(A.prop[(D+1):(D+P),,], A.ilr[(D):(D-1+P),,]) 11 | expect_equal(oilrInv(A.ilr,D-1), A.prop) 12 | rm(A.ilr) 13 | 14 | # TEST alr and alrinv 15 | A.alr <- oalr(A.prop, D) 16 | expect_equal(A.alr[1:(D-1),,], alr_array(A.prop[1:D,,],parts=1)) 17 | expect_equal(A.prop[(D+1):(D+P),,], A.alr[(D):(D-1+P),,]) 18 | expect_equal(oalrInv(A.alr,D-1), A.prop) 19 | rm(A.alr) 20 | 21 | # TEST clr and clrinv 22 | A.clr <- oclr(A.prop, D) 23 | expect_equal(A.clr[1:(D),,], clr_array(A.prop[1:D,,],parts=1)) 24 | expect_equal(A.prop[(D+1):(D+P),,], A.clr[(D+1):(D+P),,]) 25 | expect_equal(oclrInv(A.clr,D), A.prop) 26 | rm(A.clr) 27 | }) 28 | 29 | 30 | Sigma.ilr <- rWishart(5, 20, diag(D-1+P)) 31 | 32 | test_that("orthus covariance transform correctness", { 33 | # test oilrvar2clrvar 34 | V <- create_default_ilr_base(D) 35 | Sigma.clr <- oilrvar2clrvar(Sigma.ilr, D-1, V) 36 | expect_equal(Sigma.clr[1:D,1:D,1], ilrvar2clrvar(Sigma.ilr[1:(D-1),1:(D-1),1],V)) 37 | foo <- ilrInv_array(Sigma.ilr[1:(D-1), D:(D-1+P),],coords=1) 38 | foo <- clr_array(foo, parts=1) 39 | expect_equal(Sigma.clr[1:D,(D+1):(D+P),], foo) 40 | expect_equal(Sigma.clr[(D+1):(D+P),1:D,], aperm(foo, c(2,1,3))) 41 | expect_equal(Sigma.clr[(D+1):(D+P),(D+1):(D+P),], Sigma.ilr[(D):(D+P-1),(D):(D+P-1),]) 42 | 43 | # test oclrvar2ilrvar 44 | expect_equal(Sigma.ilr, oclrvar2ilrvar(Sigma.clr, D, V)) 45 | 46 | # test oalrvar2clrvar 47 | Sigma.alr <- Sigma.ilr; 48 | Sigma.clr <- oalrvar2clrvar(Sigma.alr, D-1, D) 49 | expect_equal(Sigma.clr[1:D,1:D,1], alrvar2clrvar(Sigma.alr[1:(D-1),1:(D-1),1],D)) 50 | foo <- alrInv_array(Sigma.alr[1:(D-1), D:(D-1+P),],coords=1) 51 | foo <- clr_array(foo, parts=1) 52 | expect_equal(Sigma.clr[1:D,(D+1):(D+P),], foo) 53 | expect_equal(Sigma.clr[(D+1):(D+P),1:D,], aperm(foo, c(2,1,3))) 54 | expect_equal(Sigma.clr[(D+1):(D+P),(D+1):(D+P),], Sigma.alr[(D):(D+P-1),(D):(D+P-1),]) 55 | 56 | # test oclrvar2alrvar 57 | expect_equal(Sigma.alr, oclrvar2alrvar(Sigma.clr, D, D)) 58 | 59 | # test oilrvar2ilrvar 60 | Sigma.ilr <- Sigma.alr 61 | expect_equal(Sigma.ilr, oilrvar2ilrvar(Sigma.ilr, D-1, V, V)) 62 | 63 | # Others not currently tested as they are just based on the above transforms 64 | }) 65 | 66 | 67 | test_that("orthusfit transforms don't give error", { 68 | sim <- orthus_sim() 69 | fit <- orthus(sim$Y, sim$Z, sim$X) 70 | fit <- to_proportions(fit) 71 | fit <- to_alr(fit, 4) 72 | fit <- to_ilr(fit) 73 | fit <- to_clr(fit) 74 | expect_true(TRUE) 75 | }) 76 | 77 | 78 | -------------------------------------------------------------------------------- /tests/testthat/test-orthus.R: -------------------------------------------------------------------------------- 1 | set.seed(859) 2 | 3 | test_that("orthus sim and wrapper run without error", { 4 | sim <- orthus_sim() 5 | fit <- orthus(sim$Y, sim$Z, sim$X) 6 | expect_true(TRUE) 7 | }) 8 | 9 | test_that("orthus wrapper correctness", { 10 | sim <- orthus_sim() 11 | fit <- orthus(sim$Y, sim$Z, sim$X, upsilon = sim$upsilon, Theta = sim$Theta, Xi=sim$Xi, 12 | Gamma=sim$Gamma, n_samples=3000) 13 | 14 | # Laplace approximation contains true value # given the true value 15 | p0.25 <- apply(fit$Eta, c(1,2), function(x) quantile(x, probs=0.0025)) 16 | p99.75 <- apply(fit$Eta, c(1,2), function(x) quantile(x, probs=0.9975)) 17 | expect_true(sum(!((p0.25 <= sim$Eta) & (p99.75 >= sim$Eta))) < 0.2*sim$N*(sim$D-1)) 18 | 19 | # Check Lambda 20 | expect_true(mean(abs(apply(fit$Lambda, c(1,2), mean) - sim$Phi)) < 0.5) 21 | p0.25 <- apply(fit$Lambda, c(1,2), function(x) quantile(x, probs=0.0025)) 22 | p99.75 <- apply(fit$Lambda, c(1,2), function(x) quantile(x, probs=0.9975)) 23 | expect_true(sum(!((p0.25 <= sim$Phi) & (p99.75 >= sim$Phi))) < 0.05*sim$N*(sim$D-1)) 24 | 25 | }) 26 | 27 | 28 | test_that("Orthus works with multDirichletBoot", { 29 | sim <- orthus_sim() 30 | fit <- orthus(sim$Y, sim$Z, sim$X, upsilon = sim$upsilon, Theta = sim$Theta, Xi=sim$Xi, 31 | Gamma=sim$Gamma, multDirichletBoot=.5) 32 | expect(TRUE, "cannot fail") 33 | }) 34 | 35 | # test_that("orthus identical results with fixed seed", { 36 | # set.seed(3) 37 | # sim <- orthus_sim() 38 | # fit <- orthus(sim$Y, sim$Z, sim$X, seed=5) 39 | # Lambda.test <- fit$Lambda[1:5,1:2,1:5] 40 | # Lambda.test[1:5,,1] 41 | # #save(Lambda, file="tests/Lambda_seed3-5.RData") 42 | # load("tests/Lambda_seed3-5.RData") 43 | # expect_equal(Lambda.test, Lambda) 44 | # }) 45 | 46 | 47 | 48 | -------------------------------------------------------------------------------- /tests/testthat/test-sylvester-speedups.R: -------------------------------------------------------------------------------- 1 | context("test-sylvester-speedups") 2 | 3 | test_that("Pibble Sylvester Results Agree", { 4 | sim <- pibble_sim(D = 20, N=5) 5 | ThetaX <- sim$Theta %*% sim$X 6 | eta <- random_pibble_init(sim$Y) 7 | ll <- loglikPibbleCollapsed(sim$Y, sim$upsilon, ThetaX, sim$KInv, sim$AInv, eta, 8 | sylv=FALSE) 9 | llsylv <- loglikPibbleCollapsed(sim$Y, sim$upsilon, ThetaX, sim$KInv, sim$AInv, eta, 10 | sylv=TRUE) 11 | g <- gradPibbleCollapsed(sim$Y, sim$upsilon, ThetaX, sim$KInv, sim$AInv, eta, 12 | sylv=FALSE) 13 | gsylv <- gradPibbleCollapsed(sim$Y, sim$upsilon, ThetaX, sim$KInv, sim$AInv, eta, 14 | sylv=TRUE) 15 | hess <- hessPibbleCollapsed(sim$Y, sim$upsilon, ThetaX, sim$KInv, sim$AInv, eta, 16 | sylv=FALSE) 17 | hesssylv <- hessPibbleCollapsed(sim$Y, sim$upsilon, ThetaX, sim$KInv, sim$AInv, eta, 18 | sylv=TRUE) 19 | 20 | # microbenchmark::microbenchmark(gradPibbleCollapsed(sim$Y, sim$upsilon, ThetaX, sim$KInv, sim$AInv, eta, 21 | # sylv=FALSE), 22 | # gradPibbleCollapsed(sim$Y, sim$upsilon, ThetaX, sim$KInv, sim$AInv, eta, 23 | # sylv=TRUE)) 24 | expect_equal(ll, llsylv) 25 | expect_equal(g, gsylv) 26 | expect_equal(hess, hesssylv) 27 | }) 28 | 29 | test_that("Maltipoo Sylvester Results Agree", { 30 | # lazy, just use pibble sim data 31 | sim <- pibble_sim(D = 20, N=5) 32 | eta <- random_pibble_init(sim$Y) 33 | ell <- c(1) 34 | 35 | ll <- loglikMaltipooCollapsed(sim$Y, sim$upsilon, sim$Theta, sim$X, sim$KInv, sim$Gamma, eta, ell, 36 | sylv=FALSE) 37 | llsylv <- loglikMaltipooCollapsed(sim$Y, sim$upsilon, sim$Theta, sim$X, sim$KInv, sim$Gamma, eta, ell, 38 | sylv=FALSE) 39 | g <- gradMaltipooCollapsed(sim$Y, sim$upsilon, sim$Theta, sim$X, sim$KInv, sim$Gamma, eta, ell, 40 | sylv=FALSE) 41 | gsylv <- gradMaltipooCollapsed(sim$Y, sim$upsilon, sim$Theta, sim$X, sim$KInv, sim$Gamma, eta, ell, 42 | sylv=FALSE) 43 | hess <- hessMaltipooCollapsed(sim$Y, sim$upsilon, sim$Theta, sim$X, sim$KInv, sim$Gamma, eta, ell, 44 | sylv=FALSE) 45 | hesssylv <- hessMaltipooCollapsed(sim$Y, sim$upsilon, sim$Theta, sim$X, sim$KInv, sim$Gamma, eta, ell, 46 | sylv=FALSE) 47 | 48 | expect_equal(ll, llsylv) 49 | expect_equal(g, gsylv) 50 | expect_equal(hess, hesssylv) 51 | }) 52 | -------------------------------------------------------------------------------- /tests/testthat/test-transforms.R: -------------------------------------------------------------------------------- 1 | context("test-transforms.R") 2 | 3 | 4 | sim <- pibble_sim(D=4, Q=2, N=10, true_priors=TRUE) 5 | fit <- pibble(sim$Y, sim$X) 6 | 7 | 8 | test_that("pibble transform correctness", { 9 | ma <- to_alr(fit, 2) 10 | mc <- to_clr(fit) 11 | mi <- to_ilr(fit, driver::create_default_ilr_base(fit$D)) 12 | expect_true(TRUE) # this is just here to get above to run 13 | }) 14 | -------------------------------------------------------------------------------- /tests/testthat/test-utils.R: -------------------------------------------------------------------------------- 1 | context("test-random_pibble_init.R") 2 | 3 | test_that("random_pibble_init works", { 4 | Y <- matrix(sample(1:100, 100), 10, 10) 5 | foo <- random_pibble_init(Y) 6 | expect_equal(dim(foo), c(9,10)) 7 | }) 8 | 9 | 10 | test_that("check_dims correct", { 11 | y <- c(1,2,3) 12 | expect_error(expect_error(check_dims(y, 3, "y"))) # expect no error! 13 | expect_error(check_dims(y, c(3,1), "y")) 14 | 15 | y <- matrix(c(1,3,4,5), 2, 2) 16 | expect_error(expect_error(check_dims(y, c(2,2), "y"))) #expect no error! 17 | expect_error(check_dims(y, c(2), "y")) 18 | }) 19 | 20 | # test_that("name correct on unnamed imput", { 21 | # sim <- pibble_sim() 22 | # sim$Y <- unname(sim$Y) 23 | # sim$X <- unname(sim$X) 24 | # attach(sim) 25 | # fit <- pibble(Y, X) 26 | # 27 | # 28 | # 29 | # # When not all parameters are present 30 | # fit$Eta <- NULL 31 | # name(fit) 32 | # 33 | # detach(sim) 34 | # expect_true(TRUE) # so that above does not give error 35 | # }) -------------------------------------------------------------------------------- /vignettes/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | *.R 3 | -------------------------------------------------------------------------------- /vignettes/bibliography.bib: -------------------------------------------------------------------------------- 1 | @article {silverman2018, 2 | author = {Silverman, Justin D and Durand, Heather and Bloom, Rachael J and Mukherjee, Sayan and David, Lawrence A}, 3 | title = {Dynamic linear models guide design and analysis of microbiota studies within artificial human guts}, 4 | year = {2018}, 5 | doi = {10.1101/306597}, 6 | publisher = {Cold Spring Harbor Laboratory}, 7 | abstract = {Artificial gut models provide unique opportunities to study human-associated microbiota. Outstanding questions for these models{\textquoteright} fundamental biology include the timescales on which microbiota vary and the factors that drive such change. Answering these questions though requires overcoming analytical obstacles like estimating the effects of technical variation on observed microbiota dynamics, as well as the lack of appropriate benchmark datasets. To address these obstacles, we created a modeling framework based on multinomial logistic-normal dynamic linear models (MALLARDs) and performed dense longitudinal sampling of replicate artificial human guts over the course of 1 month. The resulting analyses revealed that when observed on an hourly basis, 76\% of community variation could be ascribed to technical noise from sample processing, which could also skew the observed covariation between taxa. Our analyses also supported hypotheses that human gut microbiota fluctuate on sub-daily timescales in the absence of a host and that microbiota can follow replicable trajectories in the presence of environmental driving forces. Finally, multiple aspects of our approach are generalizable and could ultimately be used to facilitate the design and analysis of longitudinal microbiota studies in vivo.}, 8 | URL = {https://www.biorxiv.org/content/early/2018/04/24/306597}, 9 | eprint = {https://www.biorxiv.org/content/early/2018/04/24/306597.full.pdf}, 10 | journal = {bioRxiv} 11 | } 12 | 13 | @ARTICLE{silverman2019, 14 | author = {{Silverman}, Justin D. and {Roche}, Kimberly and {Holmes}, Zachary C. and 15 | {David}, Lawrence A. and {Mukherjee}, Sayan}, 16 | title = "{Bayesian Multinomial Logistic Normal Models through Marginally Latent Matrix-T Processes}", 17 | journal = {arXiv e-prints}, 18 | keywords = {Statistics - Methodology}, 19 | year = "2019", 20 | month = "Mar", 21 | eid = {arXiv:1903.11695}, 22 | pages = {arXiv:1903.11695}, 23 | archivePrefix = {arXiv}, 24 | eprint = {1903.11695}, 25 | primaryClass = {stat.ME}, 26 | adsurl = {https://ui.adsabs.harvard.edu/abs/2019arXiv190311695S}, 27 | adsnote = {Provided by the SAO/NASA Astrophysics Data System} 28 | } 29 | 30 | @article{gevers2014, 31 | title={The treatment-naive microbiome in new-onset Crohn’s disease}, 32 | author={Gevers, Dirk and Kugathasan, Subra and Denson, Lee A and V{\'a}zquez-Baeza, Yoshiki and Van Treuren, Will and Ren, Boyu and Schwager, Emma and Knights, Dan and Song, Se Jin and Yassour, Moran and others}, 33 | journal={Cell host \& microbe}, 34 | volume={15}, 35 | number={3}, 36 | pages={382--392}, 37 | year={2014}, 38 | publisher={Elsevier} 39 | } 40 | 41 | @book{aitchison1986, 42 | author = {Aitchison, J.}, 43 | title = {The statistical analysis of compositional data}, 44 | publisher = {Chapman and Hall}, 45 | address = {London ; New York}, 46 | series = {Monographs on statistics and applied probability}, 47 | keywords = {Multivariate analysis. 48 | Correlation (Statistics)}, 49 | ISBN = {0412280604 (U.S.)}, 50 | year = {1986}, 51 | type = {Book} 52 | } 53 | 54 | @article{kashyap2013, 55 | title={Genetically dictated change in host mucus carbohydrate landscape exerts a diet-dependent effect on the gut microbiota}, 56 | author={Kashyap, Purna C and Marcobal, Angela and Ursell, Luke K and Smits, Samuel A and Sonnenburg, Erica D and Costello, Elizabeth K and Higginbottom, Steven K and Domino, Steven E and Holmes, Susan P and Relman, David A and others}, 57 | journal={Proceedings of the National Academy of Sciences}, 58 | volume={110}, 59 | number={42}, 60 | pages={17059--17064}, 61 | year={2013}, 62 | publisher={National Acad Sciences} 63 | } 64 | 65 | @article{callahan2016, 66 | title={Bioconductor workflow for microbiome data analysis: from raw reads to community analyses}, 67 | author={Callahan, Ben J and Sankaran, Kris and Fukuyama, Julia A and McMurdie, Paul J and Holmes, Susan P}, 68 | journal={F1000Research}, 69 | volume={5}, 70 | year={2016}, 71 | publisher={Faculty of 1000 Ltd} 72 | } --------------------------------------------------------------------------------