Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Integrating ZIPLN to PLNmodels #116

Merged
merged 37 commits into from
Jan 23, 2024
Merged
Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
37 commits
Select commit Hold shift + click to select a range
aefcbe0
started ZI inclusion
jchiquet Jan 3, 2024
f92c78e
adding depencies to DESC. to pass check
jchiquet Jan 3, 2024
5c422e5
preparing CRAN release
jchiquet Jan 8, 2024
dfe38dd
Merge branch 'master' into zipln
jchiquet Jan 11, 2024
06ecda0
more inclusive zi-pln fit
jchiquet Jan 11, 2024
84df01d
advances in ZIPLN integration
jchiquet Jan 11, 2024
65c1239
zipln: row, co and single running
jchiquet Jan 12, 2024
1c717b8
fixing coef method in ZI
jchiquet Jan 15, 2024
e0c6f54
start testing ZI PLN
jchiquet Jan 15, 2024
718e747
S3 methods for ZIPLN
jchiquet Jan 15, 2024
16bd6b2
added fixed and sparse covariance for ZIPLN
jchiquet Jan 16, 2024
c09eff6
passing firt bunch of tests
jchiquet Jan 16, 2024
d6170c9
slight modifs to pass test
jchiquet Jan 16, 2024
a6b0f72
pkgdown modif
jchiquet Jan 16, 2024
b240847
pkgdown modif
jchiquet Jan 16, 2024
7039630
updating tests in zipln
jchiquet Jan 16, 2024
557cdcd
updating rdname
jchiquet Jan 16, 2024
e5c88da
advances in predict and optim_ve_step for ZIPLN
jchiquet Jan 17, 2024
beebfa5
advances in predict and optim_ve_step for ZIPLN
jchiquet Jan 17, 2024
eb79d89
Finally passing all tests with predict function for ZIPLN (handling t…
jchiquet Jan 17, 2024
376eaab
update of pkgdown config
jchiquet Jan 17, 2024
706120d
more robust inversion in ZIPLN
jchiquet Jan 18, 2024
b971360
first test of ZIPLN on real data
jchiquet Jan 18, 2024
b9840a6
[ci skip] Small changes in documentation of `ZIPLN()`
mahendra-mariadassou Jan 22, 2024
b13e2d9
[ci skip] small changes to the documentation, and code formatting of …
mahendra-mariadassou Jan 22, 2024
ca63781
[ci skip] Simplify documentation (using recycling) for ZIPLN S3 methods.
mahendra-mariadassou Jan 23, 2024
b85ba97
[ci skip] Fix small typos and missing words
mahendra-mariadassou Jan 23, 2024
3523711
[ci skip] Ensure reproducibility of scRNA
mahendra-mariadassou Jan 23, 2024
2e1a724
[ci skip] Apply changes agreed upon with Julien in ZIPLNfit
mahendra-mariadassou Jan 23, 2024
86240ef
[ci skip] move convergence test helpers to zipln-utils.R
mahendra-mariadassou Jan 23, 2024
b94ce76
fixing bug in VE step of ZIPLN (was not saving approxiate parameters
jchiquet Jan 23, 2024
aa58da0
fixing name file in DESCRIPTION + doc generation
jchiquet Jan 23, 2024
9e90174
[ci skip] Fix bug in optimizeVE step (parameters/objective not saved)…
mahendra-mariadassou Jan 23, 2024
7dac1ce
[ci skip] Undo previous commit
mahendra-mariadassou Jan 23, 2024
8603cd6
[ci skip] Small changes to predict and fitted for ZIPLNfit
mahendra-mariadassou Jan 23, 2024
474da5a
[ci skip] test new parameter deflated in `prediction.ZIPLNfit()`
mahendra-mariadassou Jan 23, 2024
ceb39af
Update documentation, bump version number.
mahendra-mariadassou Jan 23, 2024
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Prev Previous commit
Next Next commit
[ci skip] move convergence test helpers to zipln-utils.R
  • Loading branch information
mahendra-mariadassou committed Jan 23, 2024
commit 86240ef989fd0b4e1217a9d63cb9b18745ffb9a0
68 changes: 0 additions & 68 deletions R/ZIPLNfit-class.R
Original file line number Diff line number Diff line change
Expand Up @@ -768,71 +768,3 @@ ZIPLNfit_sparse <- R6Class(
## END OF THE CLASS ZIPLNfit_sparse
## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
)


## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
## UTILS #############################
## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

# Test convergence for a named list of parameters
# oldp, newp: named list of parameters
# xtol_rel: double ; negative or NULL = disabled
# xtol_abs: double ; negative or NULL = disabled
# Returns boolean
parameter_list_converged <- function(oldp, newp, xtol_abs = NULL, xtol_rel = NULL) {
# Strategy is to compare each pair of list elements with matching names.
stopifnot(is.list(oldp), is.list(newp))
oldp <- oldp[order(names(oldp))]
newp <- newp[order(names(newp))]
stopifnot(all(names(oldp) == names(newp)))

# Check convergence with xtol_rel if enabled
if(is.double(xtol_rel) && xtol_rel > 0) {
if(all(mapply(function(o, n) { all(abs(n - o) <= xtol_rel * abs(o)) }, oldp, newp))) {
return(TRUE)
}
}

# Check convergence with xtol_abs (homogeneous) if enabled
if(is.double(xtol_abs) && xtol_abs > 0) {
if(all(mapply(function(o, n) { all(abs(n - o) <= xtol_abs) }, oldp, newp))) {
return(TRUE)
}
}

# If no criteria has triggered, indicate no convergence
FALSE
}

#' #' @importFrom glmnet glmnet
#' optim_zipln_B <- function(M, X, Omega, config) {
#'
#' if(config$lambda > 0) {
#' if (!is.null(config$ind_intercept)) {
#' m_bar <- colMeans(M)
#' x_bar <- colMeans(X[, -config$ind_intercept])
#' X <- scale(X[, -config$ind_intercept], x_bar, FALSE)
#' M <- scale(M, m_bar, FALSE)
#' }
#' p <- ncol(M); d <- ncol(X)
#' if (d > 0) {
#' Omega12 <- chol(Omega)
#' y <- as.vector(M %*% t(Omega12))
#' x <- kronecker(Omega12, X)
#' glmnet_out <- glmnet(x, y, lambda = config$lambda, intercept = FALSE, standardize = FALSE)
#' B <- matrix(as.numeric(glmnet_out$beta), nrow = d, ncol = p)
#' } else {
#' B <- matrix(0, nrow = d, ncol = p)
#' }
#'
#' if (!is.null(config$ind_intercept)) {
#' mu0 <- m_bar - as.vector(crossprod(B, x_bar))
#' B <- rbind(mu0, B)
#' }
#'
#' } else {
#' B <- optim_zipln_B_dense(M, X)
#' }
#' B
#' }
#'
62 changes: 62 additions & 0 deletions R/utils-zipln.R
Original file line number Diff line number Diff line change
Expand Up @@ -62,6 +62,68 @@ extract_model_zi <- function(call, envir) {
list(Y = Y, X = X, X0 = X0, O = O, w = w, formula = call$formula, zicovar = terms$zicovar)
}

# Test convergence for a named list of parameters
# oldp, newp: named list of parameters
# xtol_rel: double ; negative or NULL = disabled
# xtol_abs: double ; negative or NULL = disabled
# Returns boolean
parameter_list_converged <- function(oldp, newp, xtol_abs = NULL, xtol_rel = NULL) {
# Strategy is to compare each pair of list elements with matching names.
stopifnot(is.list(oldp), is.list(newp))
oldp <- oldp[order(names(oldp))]
newp <- newp[order(names(newp))]
stopifnot(all(names(oldp) == names(newp)))

# Check convergence with xtol_rel if enabled
if(is.double(xtol_rel) && xtol_rel > 0) {
if(all(mapply(function(o, n) { all(abs(n - o) <= xtol_rel * abs(o)) }, oldp, newp))) {
return(TRUE)
}
}

# Check convergence with xtol_abs (homogeneous) if enabled
if(is.double(xtol_abs) && xtol_abs > 0) {
if(all(mapply(function(o, n) { all(abs(n - o) <= xtol_abs) }, oldp, newp))) {
return(TRUE)
}
}

# If no criteria has triggered, indicate no convergence
FALSE
}

#' #' @importFrom glmnet glmnet
#' optim_zipln_B <- function(M, X, Omega, config) {
#'
#' if(config$lambda > 0) {
#' if (!is.null(config$ind_intercept)) {
#' m_bar <- colMeans(M)
#' x_bar <- colMeans(X[, -config$ind_intercept])
#' X <- scale(X[, -config$ind_intercept], x_bar, FALSE)
#' M <- scale(M, m_bar, FALSE)
#' }
#' p <- ncol(M); d <- ncol(X)
#' if (d > 0) {
#' Omega12 <- chol(Omega)
#' y <- as.vector(M %*% t(Omega12))
#' x <- kronecker(Omega12, X)
#' glmnet_out <- glmnet(x, y, lambda = config$lambda, intercept = FALSE, standardize = FALSE)
#' B <- matrix(as.numeric(glmnet_out$beta), nrow = d, ncol = p)
#' } else {
#' B <- matrix(0, nrow = d, ncol = p)
#' }
#'
#' if (!is.null(config$ind_intercept)) {
#' mu0 <- m_bar - as.vector(crossprod(B, x_bar))
#' B <- rbind(mu0, B)
#' }
#'
#' } else {
#' B <- optim_zipln_B_dense(M, X)
#' }
#' B
#' }
#'

#' #' Helper function for ZIPLN initialization.
#' #'
Expand Down