-
Notifications
You must be signed in to change notification settings - Fork 18
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Merge pull request #116 from PLN-team/zipln
Integrating ZIPLN to PLNmodels
- Loading branch information
Showing
37 changed files
with
3,134 additions
and
24 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,6 +1,6 @@ | ||
| Package: PLNmodels | ||
| Title: Poisson Lognormal Models | ||
| Version: 1.1.0 | ||
| Version: 1.2.0 | ||
| Authors@R: c( | ||
| person("Julien", "Chiquet", role = c("aut", "cre"), email = "[email protected]", | ||
| comment = c(ORCID = "0000-0002-3629-3429")), | ||
|
|
@@ -37,6 +37,7 @@ Imports: | |
| future.apply, | ||
| R6, | ||
| glassoFast, | ||
| pscl, | ||
| Matrix, | ||
| Rcpp, | ||
| nloptr, | ||
|
|
@@ -86,13 +87,18 @@ Collate: | |
| 'PLNnetworkfit-S3methods.R' | ||
| 'PLNnetworkfit-class.R' | ||
| 'RcppExports.R' | ||
| 'ZIPLNfit-class.R' | ||
| 'ZIPLN.R' | ||
| 'ZIPLNfit-S3methods.R' | ||
| 'barents.R' | ||
| 'import_utils.R' | ||
| 'mollusk.R' | ||
| 'oaks.R' | ||
| 'plot_utils.R' | ||
| 'scRNA.R' | ||
| 'trichoptera.R' | ||
| 'utils-pipe.R' | ||
| 'utils-zipln.R' | ||
| 'utils.R' | ||
| 'zzz.R' | ||
| Language: en-US | ||
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,128 @@ | ||
| #' Zero Inflated Poisson lognormal model | ||
| #' | ||
| #' Fit the multivariate Zero Inflated Poisson lognormal model with a variational algorithm. Use the (g)lm syntax for model specification (covariates, offsets, subset). | ||
| #' | ||
| #' @inheritParams PLN | ||
| #' @param control a list-like structure for controlling the optimization, with default generated by [ZIPLN_param()]. See the associated documentation | ||
| #' for details. | ||
| #' @param zi a character describing the model used for zero inflation, either of | ||
| #' - "single" (default, one parameter shared by all counts) | ||
| #' - "col" (one parameter per variable / feature) | ||
| #' - "row" (one parameter per sample / individual). | ||
| #' If covariates are specified in the formula RHS (see details) this parameter is ignored. | ||
| #' | ||
| #' @details | ||
| #' Covariates for the Zero-Inflation parameter (using a logistic regression model) can be specified in the formula RHS using the pipe | ||
| #' (`~ PLN effect | ZI effect`) to separate covariates for the PLN part of the model from those for the Zero-Inflation part. | ||
| #' Note that different covariates can be used for each part. | ||
| #' | ||
| #' @return an R6 object with class [`ZIPLNfit`] | ||
| #' | ||
| #' @rdname ZIPLN | ||
| #' @include ZIPLNfit-class.R | ||
| #' @examples | ||
| #' data(trichoptera) | ||
| #' trichoptera <- prepare_data(trichoptera$Abundance, trichoptera$Covariate) | ||
| #' myPLN <- PLN(Abundance ~ 1, data = trichoptera) | ||
| #' ## Use different models for zero-inflation... | ||
| #' myZIPLN_single <- ZIPLN(Abundance ~ 1, data = trichoptera, zi = "single") | ||
| #' myZIPLN_row <- ZIPLN(Abundance ~ 1, data = trichoptera, zi = "row") | ||
| #' myZIPLN_col <- ZIPLN(Abundance ~ 1, data = trichoptera, zi = "col") | ||
| #' ## ...including logistic regression on covariates | ||
| #' myZIPLN_covar <- ZIPLN(Abundance ~ 1 | 1 + Wind, data = trichoptera) | ||
| #' dplyr::bind_rows( | ||
| #' myPLN$criteria, | ||
| #' myZIPLN_single$criteria, | ||
| #' myZIPLN_row$criteria, | ||
| #' myZIPLN_col$criteria, | ||
| #' myZIPLN_covar$criteria | ||
| #' ) | ||
| #' @seealso The class [`ZIPLNfit`] | ||
| #' @importFrom stats model.frame model.matrix model.response model.offset terms as.formula | ||
| #' @export | ||
| ZIPLN <- function(formula, data, subset, zi = c("single", "row", "col"), control = ZIPLN_param()) { | ||
|
|
||
| ## extract the data matrices and weights | ||
| args <- extract_model_zi(match.call(expand.dots = FALSE), parent.frame()) | ||
| control$ziparam <- ifelse((args$zicovar), "covar", match.arg(zi)) | ||
|
|
||
| ## initialization | ||
| if (control$trace > 0) cat("\n Initialization...") | ||
| myPLN <- switch(control$covariance, | ||
| "diagonal" = ZIPLNfit_diagonal$new(args$Y , list(PLN = args$X, ZI = args$X0), args$O, args$w, args$formula, control), | ||
| "spherical" = ZIPLNfit_spherical$new(args$Y, list(PLN = args$X, ZI = args$X0), args$O, args$w, args$formula, control), | ||
| "fixed" = ZIPLNfit_fixed$new(args$Y , list(PLN = args$X, ZI = args$X0), args$O, args$w, args$formula, control), | ||
| "sparse" = ZIPLNfit_sparse$new(args$Y , list(PLN = args$X, ZI = args$X0), args$O, args$w, args$formula, control), | ||
| ZIPLNfit$new(args$Y, list(PLN = args$X, ZI = args$X0), args$O, args$w, args$formula, control)) # default: full covariance | ||
|
|
||
| ## optimization | ||
| if (control$trace > 0) cat("\n Adjusting a ZI-PLN model with", | ||
| control$covariance,"covariance model and", | ||
| control$ziparam, "specific parameter(s) in Zero inflation component.") | ||
| myPLN$optimize(args$Y, list(PLN = args$X, ZI = args$X0), args$O, args$w, control$config_optim) | ||
|
|
||
| if (control$trace > 0) cat("\n DONE!\n") | ||
| myPLN | ||
| } | ||
|
|
||
| ## ----------------------------------------------------------------- | ||
| ## Series of setter to default parameters for user's main functions | ||
|
|
||
| #' Control of a ZIPLN fit | ||
| #' | ||
| #' Helper to define list of parameters to control the PLN fit. All arguments have defaults. | ||
| #' | ||
| #' @inheritParams PLN_param | ||
| #' @param penalty a user-defined penalty to sparsify the residual covariance. Defaults to 0 (no sparsity). | ||
| #' @return list of parameters used during the fit and post-processing steps | ||
| #' | ||
| #' @inherit PLN_param details | ||
| #' @details See [PLN_param()] for a full description of the generic optimization parameters. ZIPLN_param() also has two additional parameters controlling the optimization due | ||
| #' the inner-outer loop structure of the optimizer: | ||
| #' * "ftol_out" outer solver stops when an optimization step changes the objective function by less than `ftol_out` multiplied by the absolute value of the parameter. Default is 1e-8 | ||
| #' * "maxit_out" outer solver stops when the number of iteration exceeds `maxit_out`. Default is 100 | ||
| #' | ||
| #' @export | ||
| ZIPLN_param <- function( | ||
| backend = c("nlopt"), | ||
| trace = 1, | ||
| covariance = c("full", "diagonal", "spherical", "fixed", "sparse"), | ||
| Omega = NULL, | ||
| penalty = 0, | ||
| config_post = list(), | ||
| config_optim = list(), | ||
| inception = NULL # pretrained ZIPLNfit used as initialization | ||
| ) { | ||
|
|
||
| covariance <- match.arg(covariance) | ||
| if (covariance == "fixed") stopifnot("Omega must be provied for fixed covariance" = inherits(Omega, "matrix") | inherits(Omega, "Matrix")) |> try() | ||
| if (inherits(Omega, "matrix") | inherits(Omega, "Matrix")) covariance <- "fixed" | ||
| if (covariance == "sparse") stopifnot("You should provide a positive penalty when chosing 'sparse' covariance" = penalty > 0) |> try() | ||
| if (penalty > 0) covariance <- "sparse" | ||
| if (!is.null(inception)) stopifnot(isZIPLNfit(inception)) | ||
|
|
||
| ## post-treatment config | ||
| config_pst <- config_post_default_PLN | ||
| config_pst[names(config_post)] <- config_post | ||
| config_pst$trace <- trace | ||
|
|
||
| ## optimization config | ||
| stopifnot(backend %in% c("nlopt")) | ||
| stopifnot(config_optim$algorithm %in% available_algorithms_nlopt) | ||
| config_opt <- config_default_nlopt | ||
| config_opt$trace <- trace | ||
| config_opt$ftol_out <- 1e-6 | ||
| config_opt$maxit_out <- 100 | ||
| config_opt[names(config_optim)] <- config_optim | ||
|
|
||
| structure(list( | ||
| backend = backend , | ||
| trace = trace , | ||
| covariance = covariance, | ||
| Omega = Omega , | ||
| penalty = penalty , | ||
| config_post = config_pst, | ||
| config_optim = config_opt, | ||
| inception = inception), class = "PLNmodels_param") | ||
|
|
||
| } |
Oops, something went wrong.