diff --git a/.Rbuildignore b/.Rbuildignore index fbb80fe9..e274c348 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -26,12 +26,16 @@ ^inst/check$ ^inst/torch_for_r$ ^inst/case_studies$ -^inst/test/ ^inst/missing_data$ ^inst/simus_PLNnetwork$ ^inst/simus_ZIPLN$ +^inst/benchmark$ +^inst/binom$ ^\.github$ ^data-raw$ ^CRAN-SUBMISSION$ ^AUTHORS$ ^dev$ +^\.claude$ +^DEVLOG.*\.md$ +snowflake.log diff --git a/.gitignore b/.gitignore index 870ab623..5ab8eea5 100644 --- a/.gitignore +++ b/.gitignore @@ -72,3 +72,5 @@ README.html pkgdown tests/testthat/_snaps/ + +snowflake.log diff --git a/DESCRIPTION b/DESCRIPTION index 87fca2aa..6900245c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -25,7 +25,7 @@ URL: https://pln-team.github.io/PLNmodels/ BugReports: https://github.com/pln-team/PLNmodels/issues License: GPL (>= 3) Depends: R (>= 4.1.0) -Imports: +Imports: cli, corrplot, dplyr, @@ -48,29 +48,27 @@ Imports: R6, Rcpp, rlang, - scales, stats, tidyr, torch -Suggests: +Suggests: factoextra, knitr, rmarkdown, spelling, testthat -LinkingTo: +LinkingTo: nloptr, Rcpp, RcppArmadillo -VignetteBuilder: +VignetteBuilder: knitr biocViews: Encoding: UTF-8 Language: en-US LazyData: true Roxygen: list(markdown = TRUE) -RoxygenNote: 7.3.2 -Collate: +Collate: 'PLNfit-class.R' 'PLN.R' 'PLNLDA.R' @@ -112,3 +110,4 @@ Collate: 'utils-zipln.R' 'utils.R' 'zzz.R' +Config/roxygen2/version: 8.0.0 diff --git a/DEVLOG_2026-06-08-09.md b/DEVLOG_2026-06-08-09.md new file mode 100644 index 00000000..8fe590b4 --- /dev/null +++ b/DEVLOG_2026-06-08-09.md @@ -0,0 +1,595 @@ +# Journal de développement — 8-9 juin 2026 + +Branche : `code-enhancement` + +## Contexte + +Refonte complète des optimiseurs pour le modèle PLN (Poisson Log-Normal, variational EM) et ses variantes de covariance (full, diagonal, sphérique, fixed). L'objectif est d'améliorer la qualité des optima trouvés et la vitesse de convergence. + +--- + +## 1. Backend `homemade` — coordonnée-Newton maison (08/06) + +**Fichiers** : `src/newton_impl.h`, `src/CovarianceTraits.h`, `src/newton_*.cpp`, `R/PLNfit-class.R` + +### Ce qui a été fait + +Implémentation d'un optimiseur coordonnée-Newton template (`newton_optimize_impl`) remplaçant NLOPT comme backend principal pour les quatre variantes de covariance (full, diagonal, sphérique, fixed). + +**Architecture** : +- `CovarianceTraits.h` : traits template (`FullCovTraits`, `DiagonalCovTraits`, `SphericalCovTraits`, `FixedCovTraits`) encapsulant les spécificités de chaque covariance (gradient/hessien de M, mise à jour de Σ, ELBO). +- `newton_impl.h` : template générique de l'algorithme, instancié par covariance. +- Paramétrage `log(S²)` pour S (évite les contraintes de positivité, meilleur conditionnement). + +**Algorithme** (boucle EM externe + boucle interne Newton) : +- **Boucle interne** : step Newton diagonal pour M (avec Armijo), point fixe exact pour S² = `−1/(A + diag(Ω))`. +- **Boucle externe EM** : M-step analytique pour Σ (full/diag/sphérique) ; B mis à jour par Newton avec Hessien diagonal Poisson. +- **VE step** (`newton_vestep_impl`) : variante pour M et S seuls (B, Ω fixes), utilisée en validation croisée. + +**Ajout** : `backend = "homemade"` dans `PLN_param()`, compatible avec tous les appels existants. + +--- + +## 2. Backend spectral pour PLNPCA (09/06 matin) + +**Fichiers** : `src/spectral_rank_cov.cpp`, `src/newton_rank_cov.cpp` + +Implémentation d'un gradient spectral (méthode de Barzilai-Borwein avec acceptation GLL non-monotone) pour l'optimisation de PLNPCA (`homemade` backend). Compétitif avec NLOPT/CCSAQ, tolérance par défaut `1e-9` pour contrer les oscillations de l'acceptation non-monotone. + +--- + +## 3. Paramétrisations alternatives et backend `homemade_alt` (09/06 après-midi) + +**Fichiers** : `src/newton_impl_alt.h`, `src/newton_*_cov.cpp`, `R/PLNfit-class.R`, `R/PLN.R` + +### Motivation + +Dans la paramétrisation standard, M stocke le résidu `M_res = M_full − XB`, et B est mis à jour par Newton approché à chaque itération interne. La paramétrisation alternative stocke `M_full` et dispose d'une **forme close exacte pour B** dans le M-step : + +``` +B̂ = (X'WX)⁻¹ X'W M_full +``` + +### Ce qui a été fait + +Nouveau template `newton_optimize_alt_impl` dans `newton_impl_alt.h` : +- Boucle interne : M_full et S mis à jour (B gelé), gradient utilise `M_res = M_full − XB`. +- M-step : B par forme close, puis Σ/Ω analytique. +- Entrée/sortie en format résiduel (compatible avec le reste du package). +- Cas `fixed_cov` : itère (boucle interne + mise à jour B) jusqu'à convergence de l'ELBO. + +**Nouvelles fonctions exportées** : `newton_optimize_full_alt`, `newton_optimize_diagonal_alt`, `newton_optimize_spherical_alt`, `newton_optimize_fixed_alt`. + +**Ajout** : `backend = "homemade_alt"` dans `PLN_param()`. + +### Problème cold-start + +La variante `homemade_alt` seule souffre d'un problème de démarrage à froid pour les covariances full/diagonal : B est gelé pendant la boucle interne, puis fait un grand saut au M-step, désalignant M_full et XB_new. + +--- + +## 4. Backend `hybrid` (09/06 après-midi) + +**Fichiers** : `R/utils.R`, `R/PLNfit-class.R` + +### Solution au cold-start + +Fonction `make_hybrid_optimizer(opt1, opt2)` dans `utils.R` : chaîne deux optimiseurs. +- **Phase 1** (`homemade`, tolérance ×10) : converge rapidement vers le bon bassin. +- **Phase 2** (`homemade_alt`, tolérance cible) : raffine depuis ce bon point de départ. + +Correction importante : `params2 <- modifyList(params, list(B=..., M=..., S=...))` pour passer Omega à travers dans le cas `fixed_cov`. + +**Ajout** : `backend = "hybrid"` dans `PLN_param()`. + +### Résultats sur `oaks` (n=116, p=114) + +| Backend | ELBO full | Temps | ELBO diag | Temps | +|---|---|---|---|---| +| `homemade` | −32043 | 5.5s | −38411 | 4.1s | +| `homemade_alt` | froid | — | −38408 | 1.3s | +| **`hybrid`** | **−32033** | **3.0s** | **−38408** | **2.0s** | + +`hybrid` est universellement meilleur que `homemade` seul : +4 à +15 ELBO selon la config, 1.3–2.7× plus rapide. + +--- + +## 5. Paramétrisation alternative pour `fixed_cov` (09/06) + +Extension naturelle de `homemade_alt` / `hybrid` à `PLNfit_fixedcov` (Ω fourni en entrée, non estimé). La boucle externe itère (boucle interne + B forme close) jusqu'à convergence de l'ELBO partiel. Correction de `make_hybrid_optimizer` pour transmettre Ω via `modifyList`. + +--- + +## 6. Backend `nlopt` amélioré — B profilé analytiquement (09/06 soir) + +**Fichiers** : `src/nlopt_full_cov.cpp`, `src/nlopt_diag_cov.cpp`, `src/nlopt_spherical.cpp`, `src/nlopt_fixed_cov.cpp` + +### Idée + +Plutôt qu'inclure B dans le vecteur de paramètres NLOPT, on le profil analytiquement à chaque évaluation du gradient : + +```cpp +// Préconvergence une fois : P_X = solve(X'WX, X'W) [d×n] +// À chaque eval NLOPT : +B = P_X * M_full // forme close O(d·n·p) +M_res = M_full - X * B +// gradient pour M_full = gradient pour M_res (théorème de l'enveloppe) +``` + +Le vecteur de paramètres passe de `(B, M, S)` taille `n(d+2p)` à `(M_full, S)` taille `2np`. Le paysage de l'objectif est plus lisse (B toujours à son optimum conditionnel). + +**Implémentations** : +- `nlopt_optimize_full` : boucle EM conservée (inv_sympd coûteux), B profilé dans le E-step. +- `nlopt_optimize_diagonal` / `nlopt_optimize_spherical` : pas de boucle EM, B **et** σ² profilés à chaque eval. +- `nlopt_optimize_fixed` : pas de M-step Σ, B profilé à chaque eval. + +Les anciennes implémentations (B dans le vecteur NLOPT) sont archivées sous le suffixe `_old` dans le code C++, non exportées vers R. + +### Résultats sur `oaks` + +| Backend | ELBO full | ELBO diag | ELBO sphér. | Temps diag | +|---|---|---|---|---| +| `nlopt` (ancien) | −32183 | −38439 | −39456 | 2.9s | +| **`nlopt` (nouveau)** | **−32060** | **−38408** | **−39450** | **0.7s** | +| `hybrid` | −32033 | −38408 | −39450 | 2.0s–3.0s | + +Gains : +122 ELBO (full), +31 ELBO (diagonal), **4× plus rapide** (diagonal), **3× plus rapide** (sphérique et fixed). + +--- + +--- + +## 7. Corrections et factorisation des helpers nlopt (10/06) + +**Fichiers** : `src/nlopt_full_cov.cpp`, `src/nlopt_diag_cov.cpp`, `src/nlopt_spherical.cpp` + +### Factorisation du calcul objectif/gradient + +Les fonctions `nlopt_optimize_*` et `nlopt_optimize_vestep_*` partageaient un calcul objectif/gradient identique à un terme de pénalité et un Z près. On a factorisé ce code dans des helpers statiques : + +- `full_cov_obj_grad_impl(M_res, Z, logS2, Omega, ...)` : commun à E-step et vestep full. +- `diag_cov_obj_grad_impl(M_res, Z, S2, logS2, inv_sigma2, penalty, ...)` : commun diagonal. +- `spherical_cov_obj_grad_impl(M_res, Z, S2, logS2, inv_sigma2, penalty, ...)` : commun sphérique. + +Le `penalty` et le `Z` sont pré-calculés par l'appelant, qui seul connaît si on est en E-step profilé ou en vestep (B fixe). + +### Correction de bug : vestep sphérique + +**Bug pré-existant** dans `nlopt_optimize_vestep_spherical` : le gradient utilisait `M / omega2` au lieu de `M * omega2` (division par la précision = multiplication par la variance, direction opposée). La pénalité dans l'objectif (`omega2 * accu(...)`) était correcte, seul le gradient était faux. Corrigé en passant par le helper qui utilise `M_res * inv_sigma2 = M * omega2`. + +--- + +## 8. Piste explorée (abandonnée) : Hessienne complète pour le step Newton (10/06) + +**Question initiale** : `homemade_alt` avec B gelé converge vers des optima moins bons que `homemade` (écart de 120 unités ELBO sur `oaks`). Peut-on améliorer le step Newton en utilisant la Hessienne complète plutôt que la diagonale ? + +### Analyse théorique + +La Hessienne exacte par échantillon est (Eq. 19 du document `alter_param.pdf`) : + +``` +H_M_i = −w_i · (diag(A_i) + Ω) [p×p] +``` + +Pour les covariances diagonale et sphérique, Ω est diagonal : la Hessienne complète se réduit à la diagonale déjà utilisée — **aucun gain possible**. + +Pour la covariance full, les éléments hors-diagonale de Ω sont ignorés par l'approximation diagonale. Utiliser la Hessienne exacte nécessiterait un solve p×p par échantillon : coût O(np³) ≈ 170M flops par itération sur `oaks` (n=116, p=114), contre O(np) actuellement. + +**Estimation du rapport coût/bénéfice** (sur `oaks`) : +- Coût step exact : ~1000× plus cher par itération +- Gain en itérations : ~10× (Newton quadratique vs linéaire) +- Bilan : ~100× plus lent. **Non rentable.** + +### Mesures effectuées + +Comptage des itérations sur `oaks` (n=116, p=114) avec budget=50 EM × 50 inner : + +| Backend | Itérations internes | ELBO | +|---|---|---| +| `homemade_alt` | 657 (~13/EM step) | −31 522 | +| `homemade` | 3 136 (~63/EM step) | −31 402 | +| `hybrid` | 1 076 | −31 402 | + +La vrai cause du mauvais ELBO de `homemade_alt` n'est pas le step Newton mais le **B gelé** : l'optimum trouvé est sous-optimal parce que la boucle interne converge vite vers le meilleur M_full *pour le B courant*, puis B saute au M-step, désalignant tout. + +--- + +## 9. Théorème de l'enveloppe dans la boucle interne (10/06) + +**Fichier** : `src/newton_impl_alt.h` + +### Idée + +Dans `nlopt_optimize_full`, B est mis à jour à **chaque évaluation de gradient** : +```cpp +B = P_X * M_full // P_X = (X'WX)⁻¹X'W, précomputé +M_res = M_full − X * B +// gradient pour M_full ≡ gradient pour M_res (théorème de l'enveloppe) +``` + +Ce profil continu de B élimine le cold-start. On applique la même idée dans la boucle interne de `homemade_alt`. + +### Implémentation + +`P_X = solve(XtWX, Xw')` précomputée une fois. À chaque pas Newton : + +1. `B = P_X * M_full` — B mis à jour au début de l'itération +2. `XB = X * B` — gelé pendant la recherche de ligne (cohérent avec nlopt qui évalue le gradient une fois par pas quasi-Newton) +3. `M_res = M_full − XB` +4. Gradient/Hessien calculés sur `M_res` (formule inchangée par théorème de l'enveloppe) +5. Step Newton `step_M = grad_M / hess_M` + +### Première tentative : Armijo avec XB gelé + +Résultats initiaux sur `oaks` (budget=300) : ELBO = −32 029 (vs −32 031 pour `homemade`). Amélioration sur `oaks`. Mais sur `trichoptera` (d≈15, n=49) : ELBO = −897 vs −841 pour `homemade`. **Régression sévère sur les datasets avec beaucoup de covariables.** + +**Cause** : avec XB gelé, l'Armijo évalue l'objectif en `M_res − α·step_M` (le pas complet). Mais avec B live, le vrai `M_res` après le pas est `M_res − α·Q_step` où `Q_step = (I − X·P_X)·step_M`. Quand d/n est grand (trichoptera : d≈15, n=49), la composante X·P_X·step_M est importante : l'Armijo acceptait des pas bien trop larges, menant à une convergence oscillante et de mauvaise qualité. + +### Correction : pente projetée Q_step dans l'Armijo + +Le changement réel de `M_res` pour un pas `−α·step_M` sur M_full est : + +``` +ΔM_res = −α · Q_step = −α · (I − X·P_X) · step_M +``` + +On corrige l'Armijo pour évaluer l'objectif au bon point : + +```cpp +const arma::mat Q_step = step_M - X * (P_X * step_M); // changement réel de M_res +arma::mat QstepO = Traits::times_Omega(Q_step, state); // précomputé une fois +double slope_M = -arma::accu(grad_M % Q_step); // pente projetée correcte +// fallback si non-descente (cas dégénéré d/n grand) : +if (slope_M >= 0) slope_M = -arma::accu(grad_M % step_M); + +// Armijo loop : MresOt = MresO - α * QstepO (O(np), sans recalculer B) +// MresT = M_res - α * Q_step +``` + +### Résultats après correction (budget maxit=max_em=100) + +| Dataset | homemade (ancien) | homemade_alt corrigé | hybrid | +|---|---|---|---| +| oaks (d=1, n=116, p=114) | −32 034, 2 077 it | −32 030, 1 077 it | −32 029, 1 001 it | +| trichoptera (d≈15, n=49, p=17) | −844, 3 538 it | **−840**, 8 256 it | **−840**, 8 691 it | +| barents (d=5, n=89, p=30) | −4 379, 3 438 it | **−4 304**, 5 594 it | **−4 304**, 5 764 it | + +Avec la correction Q_step, `homemade_alt` est maintenant **équivalent ou supérieur** à l'ancien `homemade` sur tous les datasets. L'Armijo correct empêche les pas surdimensionnés : plus d'itérations par pas EM (82 vs 10 sur trichoptera), mais chaque itération est productive. + +--- + +## 10. Refactorisation finale : suppression de `homemade`, renommage (10/06) + +**Fichiers** : `src/newton_{full,diag,spherical,fixed}_cov.cpp`, `R/PLNfit-class.R`, `R/PLN.R`, `R/utils.R` + +### Décision + +Le benchmark sur trois datasets (oaks, trichoptera, barents) montre que `homemade_alt` corrigé **domine l'ancien `homemade`** en qualité ELBO et en nombre d'itérations, à budget égal : + +- meilleur ELBO sur barents et trichoptera +- equivalent ou légèrement meilleur sur oaks +- 2–4× moins d'itérations totales + +L'ancien `homemade` est supprimé. `homemade_alt` devient le nouveau `homemade`. + +### Changements C++ + +Les quatre fichiers `newton_*_cov.cpp` suppriment la fonction basée sur `newton_optimize_impl` et renomment `newton_optimize_*_alt` → `newton_optimize_*`. `newton_impl.h` est conservé (utilisé par `newton_vestep_impl` pour les vesteps). `RcppExports.{R,cpp}` régénérés par `Rcpp::compileAttributes()`. + +### Nouveau `hybrid` : nlopt → new homemade + +L'ancien `hybrid` chaînait `homemade → homemade_alt`, les deux ayant le même type de config. Le nouveau `hybrid` chaîne : + +- **Phase 1** : `nlopt_optimize_*` (CCSAQ, tolérance 10× relâchée) — exploration globale rapide +- **Phase 2** : `newton_optimize_*` (nouveau homemade, tolérance cible) — raffinement local Newton + +`make_hybrid_optimizer` construit explicitement un config nlopt pour la phase 1 (depuis `config_default_nlopt`), plutôt que de passer le config homemade. Cela évite l'erreur `algorithm="NEWTON" non reconnu par nlopt`. + +En pratique, `hybrid` et `homemade` convergent désormais au même ELBO (à ±0.1 unité) sur tous les datasets testés. `hybrid` reste utile comme filet de sécurité pour les paysages difficiles où le point d'initialisation importe. + +--- + +## 11. Correction des bugs `ifelse()` dans PLNLDAfit (10/06) + +**Fichier** : `R/PLNLDAfit-class.R` + +### Bug + +`PLNLDAfit_diagonal$initialize` et `PLNLDAfit_spherical$initialize` utilisaient `ifelse()` au lieu de `if/else` pour sélectionner l'optimiseur : + +```r +# Code bugué +private$optimizer$main <- ifelse(control$backend == "nlopt", + nlopt_optimize_diagonal, + private$torch_optimize) +``` + +`ifelse()` évalue les **deux branches** et retourne un scalaire. Avec `backend = "homemade"` (désormais défaut), la condition est `FALSE` → retourne `private$torch_optimize`. Le torch optimizer échoue avec `double(length = config$num_epoch + 1)` car `config_default_homemade` n'a pas de champ `num_epoch`. + +### Correction + +Remplacement par un bloc `if/else if/else` complet dans les deux classes, avec dispatch correct pour les quatre backends (`torch`, `homemade`, `hybrid`, `nlopt`) et mise à jour du vestep pour les backends Newton : + +```r +private$optimizer$main <- if (control$backend == "torch") { + private$torch_optimize +} else if (control$backend == "homemade") { + newton_optimize_diagonal # ou _spherical +} else if (control$backend == "hybrid") { + make_hybrid_optimizer(nlopt_optimize_diagonal, newton_optimize_diagonal) +} else { + nlopt_optimize_diagonal +} +private$optimizer$vestep <- if (control$backend %in% c("homemade", "hybrid")) + newton_optimize_vestep_diagonal else nlopt_optimize_vestep_diagonal +``` + +--- + +## 12. Alignement des backends pour PLNnetwork et PLNmixture (10/06) + +**Fichiers** : `R/PLNnetwork.R`, `R/PLNmixture.R` + +### Constats + +- `PLNnetwork_param()` et `PLNmixture_param()` proposaient uniquement `"nlopt"` et `"torch"`, bloquant `"homemade"` et `"hybrid"` par un `stopifnot()` redondant. +- `PLNmixture_param()` référençait `config_default_nlopt_pln` (objet inexistant) → crash immédiat à l'appel. + +### Corrections apportées + +Les deux `_param()` acceptent maintenant `c("homemade", "nlopt", "hybrid", "torch")` avec suppression du `stopifnot` redondant et ajout de la branche `else { config_opt <- config_default_homemade }`. + +### Choix du défaut : analyse de la boucle externe de PLNnetwork + +La question clé : faut-il choisir `"homemade"` comme défaut pour PLNnetwork (comme pour PLN) ? + +**Test expérimental** (trichoptera, 3 pénalités) : + +| Backend | Itérations outer | Temps | +|---|---|---| +| `nlopt` | 17 + 6 + 9 = **32** | 0.85 s | +| `homemade` | 20 + 18 + 20 = **58** (hits maxit_out) | 1.06 s | + +Avec `homemade`, beaucoup de pénalités atteignent `maxit_out=20` sans converger. Cause : le Newton avec enveloppe optimise très à fond à chaque appel (M, S, B jusqu'à ftol=1e-8), ce qui provoque des changements importants de Σ = M'M/n + diag(S²) à chaque étape, rendant le schéma d'alternance glasso ↔ PLN lent à converger globalement. En revanche, sur `PLN(covariance="fixed")` seul, `homemade` est plus rapide que `nlopt` (0.76s vs 1.01s sur oaks). C'est un **problème d'articulation**, pas de performance intrinsèque. + +**Décision** : PLNnetwork conserve `"nlopt"` comme défaut. PLNmixture utilise `"homemade"` (ses composantes sont des PLNfit standards, l'alternance EM–Mixture est différente). + +--- + +## 13. Correction : warning `solve()` sur formule sans covariable (10/06) + +**Fichier** : `src/newton_impl_alt.h` + +### Bug + +`PLN(Abundance ~ 0, data = ...)` (ou toute formule sans covariable) déclenche : + +``` +warning: solve(): system is singular; attempting approx solution +``` + +Cause : avec `d = 0`, `X` est une matrice n×0, `XtWX = X'WX` est une matrice 0×0, et `arma::solve(0×0, ...)` émet ce warning. + +### Correction + +Garde sur la taille de X avant l'appel à `solve` : + +```cpp +const arma::mat P_X = (X.n_cols > 0) + ? arma::solve(XtWX, Xw.t()) + : arma::mat(0, n); // d=0 : P_X vide, toutes les opérations avec B sont des no-ops +``` + +Toutes les opérations matricielles suivantes (produits avec X, B, P_X) produisent les bonnes valeurs nulles quand d=0 grâce à l'arithmétique Armadillo sur matrices vides. + +**Note** : le touch des `.cpp` incluant `newton_impl_alt.h` est nécessaire pour forcer la recompilation du header. + +--- + +## 14. Nettoyage : code mort (10/06) + +**Fichiers** : `R/utils.R`, `R/PLNfit-class.R`, `R/PLN.R`, `R/plot_utils.R`, `R/PLNnetwork.R`, `src/nlopt_wrapper.h`, `src/nlopt_wrapper.cpp` + +Audit complet du code mort côté R et C++. Suppressions : + +**R :** +- `utils.R` : `status_to_message()` (jamais appelée ; seul usage dans un commentaire de `PLNfit-class.R`), `trace()` (shadow du `base::trace`, aucun appel actif), `node_pair_to_egde()` (typo + jamais appelée, contrairement à `edge_to_node`) +- `PLNfit-class.R` : classe `PLNfit_genetprior` entière (~100 lignes commentées) — modèle à covariance génétique abandonné +- `PLN.R` : branche `# "genet" = PLNfit_$new(...)` (classe inexistante) +- `plot_utils.R` : `GeomCircle` + `geom_circle()` (~45 lignes, jamais appelées) +- `PLNnetwork.R` : champ orphelin `variance = TRUE` dans la liste retournée par `PLNnetwork_param()` + +**C++ :** +- `nlopt_wrapper.h` + `nlopt_wrapper.cpp` : déclarations et corps des 4 fonctions helper commentées (`set_uniform_x_weights`, `set_per_value_x_weights`, `set_uniform_xtol_abs`, `set_per_value_xtol_abs`) + leurs appels commentés dans le test + +**Corrections mineures :** +- `utils.R` : typo `w <-- rep(...)` → `w <- rep(...)` dans l'exemple `compute_PLN_starting_point` +- `PLN.R` : `@param backend` mis à jour (défaut `"homemade"`, `"hybrid"` ajouté) +- `plot_utils.R` : bug `center[1]` → `center[2]` dans la coordonnée y de `circle()` (inoffensif car toujours appelée avec `c(0,0)`) + +--- + +## 15. Activation de `PLNLDA_param()` (10/06) + +**Fichiers** : `R/PLNLDA.R`, `tests/testthat/test-plnlda-fit.R` + +### Situation initiale + +`PLNLDA_param()` était définie, exportée et documentée, mais `PLNLDA()` utilisait `PLN_param()` comme défaut. Les deux fonctions retournent un `PLNmodels_param` compatible, avec une différence : `PLNLDA_param()` n'expose pas l'option `"fixed"` ni le paramètre `Omega`, non pertinents en LDA. + +De plus, `test-plnlda-fit.R` passait `PLNLDA_param(covariance = "diagonal/spherical")` à `PLN()` (bug de test). + +### Corrections + +- `PLNLDA()` : signature changée en `control = PLNLDA_param()`; documentation et message d'erreur mis à jour. +- `test-plnlda-fit.R` : `PLNLDA_param` → `PLN_param` dans les deux lignes qui testaient `PLN()`. + +--- + +## 16. Audit global du code — branche `code-enhancement` vs `master` (10/06) + +Audit multi-angles (7 finders indépendants + 10 verifiers) sur le diff complet de la branche. Méthodologie : line-by-line, removed-behavior, cross-file, reuse, simplification, efficiency, altitude — chaque finding soumis à un verifier avant confirmation. + +8 findings confirmés ou plausibles, classés par sévérité : + +| # | Sévérité | Fichier | Résumé | +|---|---|---|---| +| 1 | Critique | `PLNfit-class.R` | `PLNfit_fixedcov$initialize` appelle `setup_optimizer` sans les args vestep → `optimizer$vestep = NULL` → crash dans `predict(level=1)` et `predict_cond()` | +| 2 | Critique | `PLNmixturefamily-class.R` | `config_fast$maxit_out <- 2` mais `optimize()` lit `config$maxit_em` → smoothing tourne 50 EM iters au lieu de 2 (~25× plus lent) | +| 3 | Haute | `PLNfit-class.R` | `do.call(compute_PLN_starting_point, data)` dans jackknife/bootstrap → sensitive aux noms des éléments de `data`, échoue si `method` est dans la liste | +| 4 | Haute | `PLNfit-class.R` | `predict(level=1)` : M retourné par C++ sans colnames → noms d'espèces perdus dans la prédiction | +| 5 | Haute | `PLNmixturefit-class.R` | `latent_pos` active binding retourne `mix_up('var_par$M')` (M_full) au lieu de `mix_up('latent_pos')` (M_res) → k-means de clustering sur les mauvaises coordonnées | +| 6 | Moyenne | `utils.R` | `compute_PLN_starting_point` : `Y` non protégé contre les NA → crash si Y contient des NA | +| 7 | Moyenne | `utils.R` | `compute_PLN_starting_point` : `singular.ok = FALSE` rend le guard `B[is.na(B)] <- 0` inaccessible | +| 8 | Faible | `utils.R` | `extract_model` : `is.symbol(call$formula)` ne couvre pas les expressions de type call (ex. `formula(paste(...))`) | + +Deux findings refutés (P6, P8 dans la numérotation interne) : `PLNLDAfit$predict` double-comptage — infirmé par la sémantique M_res + group_means ; `PLNmixturefit$predict` position — infirmé, le VE optimizer retourne déjà M_full. + +--- + +## 17. Application des 8 corrections (10/06) + +**Fix 1 — `PLNfit_fixedcov` vestep manquant** (`R/PLNfit-class.R`) + +`setup_optimizer` appelé avec seulement 3 args au lieu de 5 : les fonctions vestep (`nlopt_optimize_vestep_full`, `newton_optimize_vestep_full`) n'étaient pas passées, laissant `optimizer$vestep = NULL`. `predict(level=1)` et `predict_cond()` crashaient via `do.call(NULL, args)`. + +```r +# Avant +private$setup_optimizer(control$backend, nlopt_optimize_fixed, newton_optimize_fixed) +# Après +private$setup_optimizer(control$backend, nlopt_optimize_fixed, newton_optimize_fixed, + nlopt_optimize_vestep_full, newton_optimize_vestep_full) +``` + +**Fix 2 — smoothing PLNmixture : clé `maxit_em` au lieu de `maxit_out`** (`R/PLNmixturefamily-class.R`) + +Dans `add_one_cluster()` et `remove_one_cluster()`, `config_fast$maxit_out <- 2` n'avait aucun effet car `optimize()` lit `config$maxit_em`. Le screening rapide des candidats tournait donc à plein régime (50 EM iters par candidat). + +```r +# Avant (dans les deux fonctions) +config_fast$maxit_out <- 2 +# Après +config_fast$maxit_em <- 2 +``` + +**Fix 3 — jackknife/bootstrap : `do.call` supprimé** (`R/PLNfit-class.R`) + +`do.call(compute_PLN_starting_point, data)` — `data` est une liste nommée `(Y, X, O, miss, w, formula)` dont les noms ne correspondent pas aux paramètres de `compute_PLN_starting_point(Y, X, O, w, method)`. Remplacé par un appel positionnel direct qui passe correctement `w` et permet de spécifier `method`. + +**Fix 4 — colnames M dans `predict(level=1)`** (`R/PLNfit-class.R`) + +L'optimiseur C++ retourne M sans attributs de noms. `colnames(M) <- colnames(private$B)` ajouté après récupération du résultat VE. + +**Fix 5 — `latent_pos` de `PLNmixturefit`** (`R/PLNmixturefit-class.R`) + +`mix_up('var_par$M')` accédait au champ brut `private$M` de chaque composante (M_full = μ_k + M_res). Le k-means dans `add_one_cluster()` opérait donc sur les coordonnées incluant les effets de groupe, biaisant la séparation. Corrigé en `mix_up('latent_pos')` qui appelle le binding actif de chaque `PLNfit` (M − X*B = M_res). + +**Fix 6+7 — `compute_PLN_starting_point` : NA, singular.ok, pois_fam** (`R/utils.R`) + +- `Y0 <- replace(Y, is.na(Y), 0)` : protection NA pour `lm.fit` et `glm.fit` +- `expO <- exp(O)` : calculé une seule fois (était calculé deux fois) +- `singular.ok = TRUE` : active la garde `B[is.na(B)] <- 0` (auparavant inaccessible car `lm.fit` plantait avant de retourner NA) +- `pois_fam <- poisson()` : famille créée une fois hors du `vapply` (évite p réallocations) + +**Fix 8 — `extract_model` : `!inherits` au lieu de `is.symbol`** (`R/utils.R`) + +`is.symbol(call$formula)` ne couvrait pas les expressions de type `call` (ex. `formula(paste(...))`), laissant l'attribut `xlevels` être assigné à un objet non-formula. Remplacé par `!inherits(call$formula, "formula")` qui couvre tous les cas non-formula. + +--- + +## 18. Nettoyage de la suite de tests (10/06) + +**Fichiers** : `tests/testthat/test-pln.R`, `tests/testthat/test-plnlda-fit.R`, `tests/testthat/test-standard-error.R` + +### Test cassé par Fix 7 (`singular.ok = TRUE`) + +`test-pln.R` lignes 209–225 attendait `expect_error(PLN(Y ~ X_singular))`. Après Fix 7, PLN gère silencieusement les designs singuliers (coefficients à 0 via `B[is.na(B)] <- 0`) au lieu de planter. Le test est mis à jour : + +- Description : `"PLN: singular covariate model matrix is handled gracefully"` +- `expect_error` → `expect_no_error` pour les deux cas (covariables continues dupliquées, facteurs corrélés) + +### Faux label + doublon (`test-pln.R` lignes 72–95) + +Les deux blocs "diagonal" et "spherical" utilisaient `covariance = "spherical"` : code identique, couverture identique. Le bloc "diagonal" est corrigé pour utiliser réellement `covariance = "diagonal"` (ajout d'une couverture manquante). La variable `model3` (poids aléatoires sans `expect_*`) dans le bloc spherical est supprimée. + +### Duplicate cross-fichier (`test-plnlda-fit.R` lignes 103–122) + +Le test "PLNLDA fit: Check number of parameters" testait `PLN()` (copie quasi-identique de `test-plnfit.R:239`). Remplacé par un vrai test de `PLNLDA$nb_param` : Σ (`p*(p+1)/2`) + group means (`p*g`) + éventuels régresseurs. + +### Noms de tests dupliqués (`test-standard-error.R` lignes 151, 159) + +Deux blocs portaient le nom identique `"Check that variance estimation are coherent in PLNnetwork"`. Le premier testait en réalité PLNPCA. Renommé en `"Check that variance estimation are coherent in PLNPCA"`. + +--- + +## Récapitulatif des backends disponibles + +| `backend` | Algorithme | Défaut pour | +|---|---|---| +| `"homemade"` | Newton diagonal, B profilé (enveloppe), Armijo Q_step | PLN, PLNLDA, PLNmixture | +| `"nlopt"` | CCSAQ/NLOPT, B profilé (enveloppe) | PLNnetwork | +| `"hybrid"` | nlopt (exploration) → homemade (raffinement) | — | +| `"torch"` | RPROP/ADAM/... | — | + +--- + +## Fichiers créés ou significativement modifiés + +| Fichier | Nature | +|---|---| +| `src/CovarianceTraits.h` | Traits template pour les 4 covariances | +| `src/newton_impl.h` | Template coordonnée-Newton (vestep uniquement désormais) | +| `src/newton_impl_alt.h` | Template Newton diagonal avec B profilé (→ nouveau `homemade`) | +| `src/newton_{full,diag,spherical,fixed}_cov.cpp` | Instances + fonctions exportées (sans variantes `_alt`) | +| `src/nlopt_{full,diag,spherical,fixed}_cov.cpp` | B profilé + helpers statiques + bug fix vestep sphérique | +| `src/spectral_rank_cov.cpp` | Gradient spectral BB+GLL pour PLNPCA | +| `src/newton_rank_cov.cpp` | Coordonnée-Newton pour PLNPCA | +| `R/PLNfit-class.R` | Branchement backends dans les 4 classes PLNfit ; `PLNfit_genetprior` supprimée | +| `R/PLNLDAfit-class.R` | Correction `ifelse()` → `if/else` dans diagonal et sphérique | +| `R/PLN.R` | `PLN_param()` — `homemade_alt` supprimé ; doc backend mise à jour | +| `R/PLNLDA.R` | `PLNLDA()` utilise désormais `PLNLDA_param()` comme défaut | +| `R/PLNnetwork.R` | `"homemade"`/`"hybrid"` ajoutés ; défaut conservé à `"nlopt"` | +| `R/PLNmixture.R` | `"homemade"`/`"hybrid"` ajoutés ; défaut `"homemade"` ; bug `config_default_nlopt_pln` corrigé | +| `R/utils.R` | `make_hybrid_optimizer()` revu ; code mort supprimé | +| `R/plot_utils.R` | `GeomCircle`/`geom_circle` supprimés ; bug `center[1]` corrigé | +| `src/nlopt_wrapper.h` | Déclarations commentées supprimées | +| `src/nlopt_wrapper.cpp` | Corps commentés + appels orphelins supprimés | + +--- + +## 19. Audit C++ — corrections appliquées (10/06) + +Audit complet du code C++ : 8 améliorations identifiées (★★★ bugs/efficacité, ★★ factorisation, ★ style) et intégralement appliquées. + +### Corrections ★★★ + +**Fix 1 — Guard P_X pour d=0 (`nlopt_*.cpp`)** : quand la formule est `~ 0` (sans covariables), `X` est une matrice (n×0) et `arma::solve(X.t() * Xw, Xw.t())` déclenchait un avertissement Armadillo. Corrigé dans les 4 fichiers : +```cpp +// Avant (tous les fichiers nlopt) : +const arma::mat P_X = arma::solve(X.t() * Xw, Xw.t()); +// Après : +const arma::mat P_X = (X.n_cols > 0) ? arma::solve(X.t() * Xw, Xw.t()) : arma::mat(0, Y.n_rows); +``` + +**Fix 2 — O(p³) → O(np) dans `nlopt_fixed_cov.cpp`** : l'objectif utilisait `trace(Omega * (...))` coûtant O(p³), remplacé par le calcul élément-par-élément d'O(np) via `full_cov_obj_grad_impl` (déjà utilisée dans `nlopt_full_cov.cpp`). Gain asymptotique pour grand p. + +**Fix 3 — Factorisation `FullCovTraits`/`FixedCovTraits`** : ces deux traits partageaient 6 méthodes statiques identiques (~35 lignes de duplication). Nouveau `DenseOmegaImpl` base struct avec les 6 méthodes ; `FullCovTraits` et `FixedCovTraits` en héritent. Seuls `mstep`, `elbo_cov`, `output_cov`, et `has_em` restent spécialisés. + +### Corrections ★★ + +**Fix 4 — `NewtonConfig` dans `utils.h`** : struct centralisant l'extraction de config depuis `Rcpp::List` (pattern `containsElementNamed` répété 4 fois × 4 fichiers → 1 struct). + +**Fix 5 — Adoption de `NewtonConfig`** : les 4 fichiers `newton_*.cpp` + `nlopt_full_cov.cpp` utilisent désormais `const NewtonConfig cfg(config);` au lieu du bloc 4-lignes dupliqué. + +**Fix 6 — `nlopt_impl.h`** : nouveau header partagé exposant les 3 helpers `inline` (`full_cov_obj_grad_impl`, `diag_cov_obj_grad_impl`, `spherical_cov_obj_grad_impl`). Les copies `static` locales ont été supprimées des 3 fichiers `nlopt_*.cpp` qui les dupliquaient. + +**Fix 7 — Méthode `update()` dans chaque `State`** : les constructeurs et `mstep` des 3 traits à covariance estimée (Full, Diagonal, Sphérique) contenaient un code identique. Ajout d'une méthode `update(M, S2, w, w_bar)` à chaque `State` ; le constructeur et `mstep` délèguent vers elle. + +### Correction ★ + +**Fix 8 — `SphericalCovTraits::output_cov`** : `Sigma_out.diag() = arma::ones(p) * s.sigma2` remplacé par `Sigma_out.diag().fill(s.sigma2)` (supprime la construction inutile d'un vecteur temporaire de 1s). + +### Résultat + +- Compilation propre (0 erreur, 0 nouveau warning) +- 72 tests PLN passent (FAIL 0) diff --git a/DEVLOG_2026-06-11-12.md b/DEVLOG_2026-06-11-12.md new file mode 100644 index 00000000..a63e3d87 --- /dev/null +++ b/DEVLOG_2026-06-11-12.md @@ -0,0 +1,569 @@ +# Journal de développement — 11-12 juin 2026 + +Branche : `code-enhancement` + +--- + +## 20. Pas Newton conjoint sur (M, ψ) — remplacement du point fixe (11/06) + +**Fichiers** : `src/CovarianceTraits.h`, `src/newton_impl.h` + +### Motivation + +L'ancienne boucle interne faisait : +1. Step Newton diagonal pour M (avec Armijo) +2. Point fixe exact pour S² : `S² = -1 / (A + diag(Ω))` (pas d'Armijo, convergence immédiate) + +Cette séparation ignore le couplage entre M et S (via A = exp(M + S²/2 + O)). La correction de l'un modifie A, qui invalide l'autre. On travaille alternativement sur deux sous-problèmes couplés, ce qui ralentit la convergence. + +### Nouveau pas conjoint (M, ψ) avec terme croisé + +On paramétrise ψ = log(S²) et on résout simultanément le système 2×2 **par entrée (i,j)** : + +``` +Hessienne diagonale par blocs (indépendance entre (i,j)) : + H_MM = w·(A + ω_jj) + H_ψψ = 0.5·w·S²·(A·(1 + 0.5·S²) + ω_jj) + H_Mψ = 0.5·w·A·S² ← terme croisé (nul si A≈0) + +det = H_MM·H_ψψ - H_Mψ² (clampé à 1e-20) +step_M = (H_ψψ·grad_M - H_Mψ·grad_ψ) / det +step_ψ = (H_MM·grad_ψ - H_Mψ·grad_M) / det +``` + +L'Armijo est appliqué conjointement sur `(M - α·Q_step, ψ - α·step_ψ)` avec pente : + +``` +slope = -accu(grad_M % Q_step) - accu(grad_ψ % step_ψ) +``` + +où `Q_step = step_M - X * (P_X * step_M)` est la projection hors col(X) pour le B profilé. + +### Résultat + +Convergence plus robuste sur les grands datasets (microcosm, scRNA). Le terme croisé H_Mψ est faible quand A est petit (régions creuses), fort quand A est grand (signaux forts) — l'approximation diagonale par blocs est exacte dans la limite d'observations indépendantes. + +--- + +## 21. Investigation et suppression de `block_newton_thresh` (12/06) + +**Fichiers** : `src/CovarianceTraits.h`, `src/utils.h`, `src/newton_impl.h`, `src/newton_full_cov.cpp`, `src/newton_fixed_cov.cpp`, `R/utils.R`, `R/PLN.R` + +### Origine du paramètre + +Avant le pas conjoint, `DenseOmegaImpl` offrait un mode alternatif : pour `p ≤ block_newton_thresh`, on calculait le step exact par **solveur Schur p×p par observation** (complément de Schur sur H_MM, en O(np³)). L'approximation diagonale 2×2 était le fallback pour `p > thresh`. + +### Analyse du coût — cas barents (n=89, p=30) + +Avec `block_newton_thresh = 30` (défaut), barents full activait le solveur exact : +- Coût : 89 × (920 iters) × (30³ / 6) ≈ **2G FLOPs** par EM step +- Temps observé : 3 s (contre 0.9 s pour nlopt) + +Passage à `block_newton_thresh = 0` (approx diagonale) : +- Coût : O(n·p) ≈ 90 × fois moins +- Temps observé : **0.68 s** +- Loglik : **identique** (+14 vs nlopt, inchangé) +- Itérations internes : +15% seulement + +La précision supplémentaire du solveur exact n'apporte aucun bénéfice observable, pour un coût prohibitif sur des datasets de taille courante. + +### Décision : suppression complète + +Le paramètre `block_newton_thresh` est **supprimé** de l'ensemble du code (7 fichiers modifiés) : + +| Fichier | Modification | +|---------|-------------| +| `R/utils.R` | Suppression de `block_newton_thresh = 0L` dans `config_default_homemade` | +| `R/PLN.R` | Suppression de la ligne `@param` dans la doc | +| `src/utils.h` | Suppression du champ `int block_newton_thresh = 30` dans `NewtonConfig` et du parsing | +| `src/CovarianceTraits.h` | `DenseOmegaImpl::compute_joint_step_MS` et `compute_step_M` : suppression du paramètre et du bloc `if (thresh > 0)` avec les solveurs Schur | +| `src/CovarianceTraits.h` | `DiagonalCovTraits`, `SphericalCovTraits` : suppression du paramètre commenté `/*block_thresh*/ = 0` | +| `src/newton_impl.h` | `newton_optimize_impl` et `newton_vestep_impl` : suppression du paramètre ; correction de virgule résiduelle | +| `src/newton_full_cov.cpp`, `newton_fixed_cov.cpp` | Suppression de `cfg.block_newton_thresh` dans les appels | + +--- + +## 22. Augmentation de `maxit_em` : 50 → 200 (12/06) + +**Fichier** : `R/utils.R` + +### Problème + +Trichoptera full (nocov) et oaks full convergeaient `FALSE` avec `maxit_em = 50`. L'ELBO progressait encore à la 50ème itération externe : il manquait simplement du budget, pas un défaut algorithmique. + +### Correction + +`maxit_em = 50L → 200L` dans `config_default_homemade`. Résultat : oaks full et trichoptera full (nocov) convergent désormais (`conv = TRUE`). + +**État final de `config_default_homemade`** : +```r +config_default_homemade <- + list( + algorithm = "NEWTON", + backend = "homemade", + maxeval = 10000, + ftol_in = 1e-8, + maxit_em = 200, + ftol_em = 1e-8 + ) +``` + +--- + +## 23. Benchmark complet — 6 jeux de données (12/06) + +**Fichiers** : `inst/convergence_analysis.R`, `inst/backend_comparison.R`, `inst/.gitignore` (via `.gitignore` racine), `.Rbuildignore` + +### Jeux de données couverts + +| Dataset | n | p | Covariances testées | +|---------|---|---|---------------------| +| trichoptera | 49 | 17 | full, diag, sph | +| barents | 89 | 30 | full, diag, sph | +| mollusk | 163 | 32 | full, diag, sph | +| oaks | 116 | 114 | full, diag, sph | +| microcosm | 880 | 259 | diag, sph, **full** | +| scRNA | 3918 | 500 | diag, sph, **full** | + +Toutes les configurations testées avec et sans covariables (12 labels, 3 covariances = 36 paires chacune avec Newton et nlopt). + +### Sorties + +`inst/benchmark/` (dans `.gitignore` et `.Rbuildignore`) : +- `convergence_trajectory.pdf` — ELBO vs itérations EM +- `convergence_rel_change.pdf` — changement relatif ELBO par itération +- `convergence_step_dist.pdf` — distance des pas (M, S) par itération +- `backend_time.pdf` — temps de calcul Newton vs nlopt +- `backend_loglik.pdf` — différence de loglik (Newton − nlopt) +- `backend_speedup.pdf` — speedup nlopt/Newton par configuration +- `backend_comparison.csv` — tableau complet + +### Résultats clés + +**Newton trouve toujours un loglik ≥ nlopt** (invariant robuste sur tous les datasets) : + +| Régime | Speedup Newton/nlopt | ll_diff | Conv Newton | Conv nlopt | +|--------|---------------------|---------|-------------|------------| +| **scRNA full** (n=3918, p=500) | **2.1–2.6× plus rapide** | **+867 à +944** | ✓ | ✓ | +| scRNA diag/sph nocov | 1.3–1.4× plus rapide | +7–9 | ✓ | ✓ | +| scRNA diag/sph cov | nlopt légèrement plus rapide | +1–8 | ✓ | ✓ | +| oaks full (n=116, p=114) | ~1× (égal) | +20–21 | ✓ | ✓ | +| **microcosm full** (n=880, p=259) | nlopt 4–5× plus rapide | **+30000** | ✓ | **✗ (conv=FALSE)** | +| barents full | nlopt 1.4–1.8× | +11–14 | ✓ | ✓ | +| mollusk | variable | +0–8 | ✗ | ✗/✓ | + +### Cas remarquables + +**microcosm full** : nlopt est plus rapide (23 s vs 106 s) mais **ne converge pas** — il s'arrête à un plateau bien inférieur (loglik ≈ −248 000 contre −217 000 pour Newton). Newton est le seul backend fonctionnel sur ce cas. + +**scRNA full** : Newton est à la fois plus rapide (+2.1–2.6×) et meilleur en loglik (+867/+944). La grande taille (n=3918) conditionne mieux le problème intérieur et facilite la convergence Newton. + +**mollusk** : les deux backends peinent (ELBO décroissant, rel_drop > 100%). Problème d'initialisation loin de l'optimum — hors périmètre de cette session. + +**trichoptera diagonal** : nécessite > 200 EM iterations externes — non convergé dans le budget. À investiguer séparément. + +--- + +## Récapitulatif des décisions algorithmiques finales + +### Ce qui est fixé (stable) + +| Composante | Choix retenu | Raison | +|-----------|-------------|--------| +| Paramétrage S | ψ = log(S²) | Évite les contraintes ≥ 0, meilleur conditionnement | +| Step interne | Pas conjoint Newton 2×2 (M, ψ) | Capture le couplage M-S via H_Mψ, sans coût O(p³) | +| Approximation hessienne | Diagonale par blocs (indépendance i,j) | Exacte pour Schur diagonal, O(np), identique en qualité à l'exact | +| Armijo | Conjoint sur (M, ψ), pente Q_step projetée | Correct avec B profilé (sinon pas trop longs si d/n grand) | +| B profilé | P_X = solve(X'WX, X'W), mis à jour avant chaque step | Élimine le cold-start, enveloppe valide | +| Structure EM | Boucle interne VE (ftol=1e-8) + boucle externe EM (maxit=200, em_tol=1e-8) | Convergence robuste sur grand n | +| Ω, B | M-step analytique après convergence interne | Newton pure uniquement sur (M, ψ) | + +### Ce qui est abandonné + +| Idée | Pourquoi abandonnée | +|------|---------------------| +| Block Newton (solveur Schur p×p) | O(np³) prohibitif, aucun gain en loglik vs approximation diagonale | +| Point fixe séparé pour S² | Ignore le couplage M-S, convergence plus lente | +| `homemade_alt` distinct de `homemade` | Fusionné dans `homemade` après validation (B profilé + Q_step Armijo) | +| `hybrid` comme défaut | Newton seul suffit sur tous les cas validés | + +### Cas limites connus + +- **mollusk** : mauvaise initialisation, les deux backends convergent mal +- **trichoptera diagonal** : besoin de > 200 EM iterations (budget à augmenter localement si nécessaire) +- **microcosm full** : Newton 4–5× plus lent que nlopt (mais seul à converger correctement) +- **La comparaison de temps est sensible à la charge BLAS** (multithreadé) : ne pas lancer les scripts en parallèle + +--- + +## 24. ZIPLN — Étape VE conjointe (M, ψ, R) et alignement API (12/06) + +**Fichiers** : `src/optim_zi-pln.cpp`, `R/ZIPLNfit-class.R`, `R/ZIPLN.R`, `R/RcppExports.R`, `src/RcppExports.cpp` + +### Architecture finale de l'étape VE ZIPLN + +Les deux backends gèrent R **en interne** et retournent `(M, S², R)` : + +**Backend "homemade" — `ve_step_zipln_newton`** +``` +Pour chaque itération : + R = σ(A + logit(Pi)) × 1{Y=0} ← mis à jour à chaque iter depuis (M,S²) courant + one_m_R = 1 - R + Hessienne 2×2 par (i,j) : + h_mm = (1-R)·A + ω_jj + h_mp = 0.5·S²·(1-R)·A ← terme croisé (théorème de l'enveloppe) + h_pp = h_mp·(1 + 0.5·S²) + 0.5·S²·ω_jj + Pas Newton + Armijo conjoint (M, ψ) +convergence : |f(t)-f(t-1)| < ftol·(1+|f(t-1)|) +``` + +**Backend "nlopt" — `ve_step_zipln_nlopt`** +``` +R₀ = σ(A₀ + logit(Pi)) × 1{Y=0} ← calculé une fois sur (init_M, init_S²) +R₀ fixé pendant toute la solve nlopt ← garantit cohérence (objectif, gradient) +Après convergence : R = σ(A_final + logit(Pi)) × 1{Y=0} +Retourne (M, S², R) +``` + +La fixation de R₀ pendant l'optimisation nlopt est nécessaire : mettre à jour R dans chaque callback de gradient brise la cohérence (objectif, gradient) du point de vue de nlopt, dégradant l'ELBO de ~1000 unités (−36706 vs −33523 sur oaks). + +### Alignement API PLN ↔ ZIPLN + +`ZIPLN_param()` utilise désormais `make_config_optim()` avec `backend = c("homemade", "nlopt")`, comme `PLN_param()`. Les fonctions renommées : +- `optim_zipln_M_psi` → `ve_step_zipln_nlopt` +- `optim_zipln_M_psi_newton` → `ve_step_zipln_newton` + +### Benchmark (oaks, n=116, p=114, `Abundance ~ 1`) + +| Backend | ELBO | Temps | +|---------|------|-------| +| homemade (Newton) | −32 982 | 16.1 s | +| nlopt (CCSAQ) | −33 517 | 14.2 s | + +Newton trouve un ELBO meilleur (+535), à temps comparable. + +--- + +## 25. Corrections doc et code ZIPLN (12/06) + +**Fichiers** : `R/ZIPLN.R`, `R/ZIPLNfit-class.R`, `src/optim_zi-pln.cpp`, `tests/testthat/test-zipln.R` + +### En-tête `ve_step_zipln_nlopt` (optim_zi-pln.cpp) + +Mis à jour pour décrire l'implémentation réelle : +- Précise que la fonction prend Pi (pas R), fixe R₀ avant nlopt, retourne (M, S², R) +- Explication de la fixation R₀ pour la cohérence (objectif, gradient) + +### Doc ZIPLN_param (R/ZIPLN.R) + +- Titre corrigé : "PLN fit" → "ZIPLN fit" +- `@param backend` ajouté pour surcharger l'héritage de `PLN_param` (qui mentionne "hybrid" et "torch", non supportés par ZIPLN) +- `@details` reformulé pour distinguer entries communes et spécifiques à ZIPLN + +### `browser()` supprimé (R/ZIPLNfit-class.R:109) + +Résidu de debug dans `initialize()` : `if (max(M[,j]) > 10) browser()`. La condition est rendue impossible par le `pmin(..., 10)` sur la ligne précédente. + +### Test NLopt corrigé (tests/testthat/test-zipln.R) + +Le test "ZIPLN is working with different optimization algorithm in NLopt" utilisait le backend par défaut ("homemade"), rendant les noms d'algorithme nlopt sans effet. Ajout de `backend = "nlopt"` explicite. + +--- + +## 26. Investigation et suppression de `approx_ZI` (12/06) + +**Fichiers** : `R/ZIPLNfit-class.R`, `R/ZIPLN.R`, `R/ZIPLNnetwork.R`, `tests/testthat/test-zipln.R` + +### Contexte + +L'option `approx_ZI` existait depuis l'ancienne architecture (R séparé du step (M,S)) pour basculer entre deux formes de mise à jour de R : +- `approx_ZI=TRUE` → `optim_zipln_R_var` : R* = σ(A + logit(π)), maximiseur exact de l'ELBO w.r.t. R +- `approx_ZI=FALSE` → `optim_zipln_R_exact` : R = π / (Φ(O+XB, σ²)·(1-π) + π), vraie probabilité bayésienne P(C=1|Y=0) marginalisée sur Z via la fonction W de Lambert + +Dans la nouvelle architecture conjointe, `approx_ZI` n'était plus câblé — le step VE utilisait toujours la forme σ, mais le paramètre restait dans le config sans effet. + +### Benchmark de comparaison (trichoptera) + +| Backend | approx_ZI | ELBO | Itérations | +|---------|-----------|------|-----------| +| Newton | TRUE (σ formula) | **−1139.3** | 167 | +| Newton | FALSE (Lambert W) | −1216.2 | 16 | +| CCSAQ | TRUE (σ formula) | **−1140.8** | 64 | +| CCSAQ | FALSE (Lambert W) | −1226.5 | 27 | + +### Analyse + +La forme "exacte" bayésienne donne un ELBO inférieur de **77–86 points**. La raison est théoriquement claire : la formule σ(A + logit(π)) est l'**optimum exact de l'ELBO** par rapport à R (∂ELBO/∂R_ij = 0 donne exactement cette formule). La forme Lambert W maximise la vraisemblance marginale vraie, une fonctionnelle différente — convergence plus rapide mais vers un point sous-optimal au sens de l'ELBO. + +Le qualificatif "approché" pour la formule σ était trompeur : c'est la forme exacte du point de vue de la borne variationnelle. + +### Décision : suppression complète + +`approx_ZI` supprimé de : +- `R/ZIPLN.R` : doc + `make_config_optim(extra=...)` +- `R/ZIPLNnetwork.R` : ligne `config_opt$approx_ZI <- TRUE` +- `tests/testthat/test-zipln.R` : test entier supprimé (testait l'équivalence des deux formes, fausse) + +Les fonctions C++ `optim_zipln_R_var` et `optim_zipln_R_exact` sont conservées dans `src/optim_zi-pln.cpp` pour mémoire historique. + +--- + +## 27. PLNPCA — Remplacement du gradient spectral par L-BFGS joint + Wolfe (12/06) + +**Fichier** : `src/builtin_rank_cov.cpp` (ex `spectral_rank_cov.cpp`) + +### Historique des tentatives + +| Approche | Résultat | +|----------|---------| +| Gradient spectral BB+GLL | Converge vers un mauvais minimum local sur oaks | +| Armijo monotone (nm_window=1) | Identique — problème structural, pas ligne de recherche | +| EM alterné BB (blocs VE / M) | Même minimum — BB diagonal contaminé par couplage M·Cᵀ | +| L-BFGS alterné par blocs + Armijo | Histoire toujours vide (Armijo ne garantit pas s^T y > 0) | +| **L-BFGS joint + Wolfe fort** | **Succès — meilleur loglik que nlopt sur tous les datasets** | +| L-BFGS par blocs EM + Wolfe interne | Pas mieux que joint, 7–10× plus lent | + +### Architecture retenue + +Optimisation jointe de tous les paramètres `[vec(B); vec(C); vec(M); vec(ψ)]` avec : +- **L-BFGS** deux-boucles (m=10 paires), initialisation steepest-descent +- **Recherche de Wolfe forte** (Nocedal & Wright Algo 3.5/3.6, c₁=1e-4, c₂=0.9) + - Garantit s^T y > 0 à chaque pas accepté → historique toujours valide + - Capture la courbure croisée M·Cᵀ que les méthodes bloc-alternantes manquent +- Warm-start ψ : un pas de point fixe `ψ = −log(1 + A·C²)` avant le premier appel L-BFGS +- Convergence : ftol consécutif + fenêtre glissante de 100 itérations + +### Benchmark (séquentiel) + +| Dataset / rank | nlopt (CCSAQ) | L-BFGS joint | +|---|---|---| +| trichoptera q=3 | −766.9 / 0.68s | **−763.7** / 0.9s | +| trichoptera q=4 | −700.6 / 0.54s | **−693.6** / 2.5s | +| trichoptera q=5 | −686.2 / 0.70s | **−672.6** / 2.9s | +| oaks q=5 | −97677 / 14.6s | **−78226** / 8.6s† | +| oaks q=10 | −66399 / 15.9s | **−47238** / 17s | + +†Résultat de session précédente (joint L-BFGS pur) : −77058 / 8.6s. L-BFGS systématiquement meilleur en loglik, couplage M·Cᵀ bien capturé. + +### Pourquoi le bloc-EM L-BFGS est-il moins bon ? + +Chaque bloc (VE : M,ψ) et (M-step : B,C) est convexe isolément → L-BFGS converge vite en interne. Mais la convergence EM extérieure est linéaire et annule ce gain : 7–10× plus lent et loglik légèrement pire que joint sur oaks. + +--- + +## 28. Nettoyage et consolidation des fichiers C++ (12/06) + +### Consolidation newton_*_cov.cpp + +Les quatre fichiers thin-wrapper (full, diagonal, spherical, fixed) sont regroupés en un seul : + +| Avant | Après | +|-------|-------| +| `newton_full_cov.cpp` | → | +| `newton_diag_cov.cpp` | → `builtin_newton_pln.cpp` | +| `newton_fixed_cov.cpp` | → | +| `newton_spherical.cpp` | → | + +### Suppression du code mort + +- `newton_rank_cov.cpp` : coordinate-Newton PLNPCA développé pendant la phase BB/spectral, jamais appelé depuis R après le passage au L-BFGS. Supprimé. + +### Renommages de fichiers + +| Ancien | Nouveau | +|--------|---------| +| `spectral_rank_cov.cpp` | `builtin_rank_cov.cpp` | +| `newton_impl.h` | `builtin_newton_impl.h` | +| `CovarianceTraits.h` | `builtin_covariance_pln.h` | + +### Renommages de fonctions + +| Ancien | Nouveau | +|--------|---------| +| `spectral_optimize_rank` | `builtin_optimize_rank` | +| `spectral_optimize_vestep_rank` | `builtin_optimize_vestep_rank` | +| `newton_optimize_*` (7 fonctions) | `builtin_optimize_*` | +| `newton_optimize_impl` | `builtin_optimize_impl` | + +### Nettoyage config PLNPCA + +- `config_default_spectral` → `config_default_plnpca` +- Champ `algorithm = "LBFGS"` supprimé (jamais lu par le C++, qui ne lit que `maxeval` et `ftol_in`) + +--- + +## 29. Renommage global `"homemade"` → `"builtin"` (12/06) + +**Portée** : tous les fichiers R, C++ sources, tests, docs, scripts `inst/`. + +Motivation : "homemade" était informel et trompeur. "builtin" décrit mieux qu'il s'agit de l'optimiseur intégré au package, sans dépendance externe. + +- Chaînes `"homemade"` dans les valeurs et vecteurs de backend +- Variables `config_default_homemade` → `config_default_builtin`, paramètre `homemade_default` → `builtin_default` +- Commentaires dans les fichiers R et C++ +- Documentation `.Rd` régénérée via `devtools::document()` + +PLNPCA : `"builtin"` devient le backend **par défaut** (ex `"nlopt"`), car il donne systématiquement un meilleur loglik. + +--- + +## 30. Suppression du backend `"hybrid"` (12/06) + +### Benchmark de justification (PLN, séquentiel) + +| Dataset | Cov | nlopt | builtin | hybrid | +|---|---|---|---|---| +| trichoptera | full | −1053.0 / 0.68s | **−1051.7** / 0.93s | −1051.7 / 0.88s | +| trichoptera | diagonal | −1109.6 | −1109.7 | **−1109.6** | +| oaks | full | −32048 / 6.5s | **−32028** / 5.9s | **−32028** / 8.2s | +| oaks | diagonal | −38408 | −38408 | −38408 | + +### Verdict + +`hybrid` (nlopt phase 1 → Newton phase 2) ne dépasse jamais `builtin` seul en loglik et est systématiquement plus lent (il paie le coût nlopt inutilement). Le Newton `builtin` converge déjà bien depuis l'initialisation froide. + +### Suppressions + +- `make_hybrid_optimizer()` supprimée de `R/utils.R` +- Branche `hybrid` retirée de `setup_optimizer()` dans `R/PLNfit-class.R` +- `"hybrid"` retiré des vecteurs `backend` dans `PLN_param`, `PLNLDA_param`, `PLNmixture_param`, `PLNnetwork_param` +- Documentation `.Rd` régénérée + +--- + +## 31. Correction de l'initialisation de M pour PLNPCA (12/06) + +**Fichier** : `R/PLNPCAfit-class.R` (ligne 262) + +### Bug + +L'initialisation de `private$M` était : +```r +M <- svdM$u[, 1:q] %*% diag(d[1:q]) %*% t(svdM$v[1:q, 1:q]) +``` + +`svdM$v[1:q, 1:q]` prend les premières `q` **lignes** (espèces) de V, pas les premières `q` composantes. C'est une erreur d'index qui donne un résultat numériquement arbitraire. + +### Correction + +Dans PLNPCA, le modèle est `Z = O + X·B + M·Cᵀ` avec `M` de taille n×q. La contrainte cohérente avec `C = V[:,1:q]·D[1:q]/√n` est que `M·Cᵀ ≈ M_PLN`. En résolvant : + +M · (V[:,1:q]·D[1:q]/√n)ᵀ = U·D·Vᵀ ⟹ M = √n · U[:,1:q] + +```r +private$M <- sqrt(self$n) * svdM$u[, 1:rank, drop = FALSE] +``` + +### Impact mesuré (trichoptera) + +| q | Erreur ‖M·Cᵀ − M_PLN‖_F (ancienne) | Erreur ‖M·Cᵀ − M_PLN‖_F (nouvelle) | +|---|---|---| +| 3 | **1174** | **13.6** | +| 5 | **1176** | **8.4** | + +### Validation + +72 tests `test-plnpcafit.R` passent. Loglik post-convergence inchangés (l'optimiseur L-BFGS corrigeait de toute façon, mais le point de départ est maintenant cohérent). + +--- + +## 32. PLNPCA — Retour à nlopt comme backend par défaut (12/06) + +**Fichiers** : `R/PLNPCA.R`, `src/builtin_optim_plnpca.cpp` + +### Contexte + +Cette section a d'abord été rédigée avec des chiffres issus d'une init SVD bugguée (SVD sur M_PLN complet, sans la correction SVD sur M−XB ni la normalisation X). Ces valeurs (-3988 nlopt barents q=5, -5957 builtin) étaient artefactuelles. Le **benchmark re-effectué avec le code corrigé** (fixes de la section 31 + section 33) donne un tableau très différent. + +### Benchmark re-effectué (code-enhancement, code complet avec tous les fixes) + +| Dataset | q | nlopt ll | nlopt t | builtin ll | builtin t | gagnant | +|---------|---|----------|---------|------------|-----------|---------| +| trichoptera | 3 | -640.5 | 0.43s | **-638.1** | 0.46s | builtin | +| trichoptera | 5 | -584.2 | 0.44s | **-578.1** | 0.56s | builtin | +| barents | 3 | -6720.4 | 0.59s | **-6699.9** | 0.80s | builtin | +| barents | 5 | **-3800.2** | 0.70s | -3836.3 | 0.88s | nlopt | +| barents | 10 | -3253.6 | 0.79s | **-3080.3** | 1.89s | builtin | +| oaks | 3 | -111741.1 | 1.15s | **-111715.3** | 1.91s | builtin | +| oaks | 5 | -77189.8 | 1.29s | **-77178.5** | 2.00s | builtin | +| oaks | 10 | **-47307.7** | 9.05s* | -47483.8 | 4.37s | nlopt | + +*oaks q=10 nlopt : maxeval atteint (10000 iter), solution non convergée. + +**Bilan : builtin gagne 6/9 ; nlopt gagne 2/9 (barents q=5, oaks q=10).** + +La dichotomie "nlopt toujours meilleur" est donc **fausse** avec le code corrigé. Les deux backends trouvent des bassins locaux différents selon le rang et le jeu de données — sans gagnant universel. + +Les analyses intermédiaires (EM alterné, gradient balancing) avaient été conduites sur la base des mauvais chiffres de l'init bugguée et ne sont plus pertinentes. + +### Décision + +- `PLNPCA_param()` : default maintenu à `"nlopt"` (comportement conservateur, prévisible) +- `"builtin"` reste disponible : souvent meilleur en loglik (6/9 cas), plus rapide sur les petits rangs +- Code C++ `builtin_optim_plnpca.cpp` : joint L-BFGS pur sans EM (plus simple) + +### Validation + +85 tests (`test-plnpcafamily.R` + `test-plnpcafit.R`) passent. + +## 33. PLNPCA — Remplacement de l'init PLN-EM par LM + benchmark init_method (13/06) + +**Fichiers** : `R/PLNPCAfamily-class.R`, `R/PLNPCA.R`, `inst/benchmark/bench_plnpca_init.R` + +### Motivation + +`PLNPCAfamily$initialize` fittait systématiquement un `PLNfit` complet (EM variationnel) comme inception, uniquement pour en extraire B et M et calculer la SVD sur M−XB. Ce coût (0.6–1.8s par jeu de données) est inutile : `compute_PLN_starting_point` (lm.fit) donne directement B_lm et M_lm = log((1+Y)/exp(O)), soit exactement le résidu LM sur lequel la SVD est calculée. + +**Argument théorique :** La SVD est calculée sur les résidus de la régression de M sur X. Ces résidus sont orthogonaux à X par construction → re-estimer B pour chaque rang q donne B_q ≈ B_lm. Le B est donc universel en initialisation ; l'optimiseur affine rang par rang. + +### Changements + +**`R/PLNPCAfamily-class.R`** — `initialize()` : +- Si l'utilisateur fournit un `inception` PLNfit → comportement inchangé (SVD sur M_PLN − XB_PLN) +- Sinon → `compute_PLN_starting_point()` (un `lm.fit`), SVD sur M_lm − XB_lm. Plus de PLN EM. + +**`R/PLNPCA.R`** — `PLNPCA_param()` : +- Nouveau paramètre `init_method = c("LM", "GLM")` (cohérence avec `PLN_param`) + +### Benchmark init_method × backend (13/06/2026) + +Script : `inst/benchmark/bench_plnpca_init.R` +Conditions : `{LM, GLM, PLN-EM} × {nlopt, builtin}`, jeux trichoptera / barents / oaks. +"PLN-EM" = ancienne init master (PLNfit complet passé comme inception). + +**trichoptera** (q = 1, 3, 5) — toutes méthodes convergent au même endroit, < 10 unités de différence. + +**barents** (q = 3, 5, 10, Depth + Temperature) : + +| backend | init | q=3 | q=5 | q=10 | +|---------|------|-----|-----|------| +| nlopt | LM | **−6368.5** ✓ | −3714.5 | −3128.5 | +| nlopt | GLM | −6368.1 | −3844.5 | −3321.6 | +| nlopt | PLN-EM | −6393.0 ❌ | **−3642.5** | **−3048.6** | +| builtin | LM | −6368.0 | −3685.0 | −3131.9 | +| builtin | GLM | **−6311.5** | −3681.3 | −3062.1 | +| builtin | PLN-EM | −6415.9 ❌ | −3614.2 | −3047.5 | + +Sur q=3, LM bat PLN-EM (~25 unités). Sur q=5,10, PLN-EM aide (~70 unités). + +**oaks** (q = 5, 10, 20) : + +| backend | init | q=5 | q=10 | q=20 | +|---------|------|-----|------|------| +| nlopt | LM | −77189.8 | **−47307.7** ✓ | −30654.7 | +| nlopt | PLN-EM | −77239.0 | −47477.3 | −30537.6 | +| builtin | LM | −77178.5 | −47483.8 | −30368.8 | +| builtin | PLN-EM | **−77126.7** | −47337.4 | **−30281.9** | + +GLM systématiquement le pire sur oaks (initialisation Poisson GLM produit un M résiduel mal aligné). + +### Bilan + +- **LM est une bonne init par défaut** : aussi bon ou meilleur que PLN-EM sur barents q=3, compétitif partout, sans coût EM +- **PLN-EM aide aux grands rangs** sur datasets avec covariables fortes (barents q=5,10 : +70 ll), mais peut nuire aux petits rangs +- **GLM à éviter pour PLNPCA** : systématiquement pire que LM +- Décision : conserver `init_method = "LM"` comme défaut ; l'utilisateur peut passer `inception = PLN(...)` pour grands rangs si nécessaire + +### Validation + +85 tests passent. diff --git a/NAMESPACE b/NAMESPACE index b27ef1e0..de3ca7c0 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,11 @@ # Generated by roxygen2: do not edit by hand +S3method(AIC,PLNfit) +S3method(AIC,ZIPLNfit) +S3method(BIC,PLNfit) +S3method(BIC,ZIPLNfit) +S3method(ICL,PLNfit) +S3method(ICL,ZIPLNfit) S3method(coef,PLNLDAfit) S3method(coef,PLNfit) S3method(coef,PLNmixturefit) @@ -17,6 +23,8 @@ S3method(getModel,PLNPCAfamily) S3method(getModel,PLNmixturefamily) S3method(getModel,PLNnetworkfamily) S3method(getModel,ZIPLNnetworkfamily) +S3method(logLik,PLNfit) +S3method(logLik,ZIPLNfit) S3method(plot,Networkfamily) S3method(plot,PLNLDAfit) S3method(plot,PLNPCAfamily) @@ -43,6 +51,7 @@ S3method(standard_error,PLNmixturefit) S3method(standard_error,PLNnetworkfit) S3method(vcov,PLNfit) export("%>%") +export(ICL) export(PLN) export(PLNLDA) export(PLNLDA_param) @@ -107,9 +116,10 @@ importFrom(purrr,map_dbl) importFrom(purrr,map_int) importFrom(purrr,reduce) importFrom(rlang,.data) -importFrom(scales,alpha) importFrom(stats,.getXlevels) importFrom(stats,.lm.fit) +importFrom(stats,AIC) +importFrom(stats,BIC) importFrom(stats,as.formula) importFrom(stats,binomial) importFrom(stats,coef) @@ -119,6 +129,7 @@ importFrom(stats,glm.control) importFrom(stats,glm.fit) importFrom(stats,lm.fit) importFrom(stats,lm.wfit) +importFrom(stats,logLik) importFrom(stats,mad) importFrom(stats,median) importFrom(stats,model.frame) diff --git a/R/PLN.R b/R/PLN.R index fb6a3a61..b7c6dde7 100644 --- a/R/PLN.R +++ b/R/PLN.R @@ -3,7 +3,7 @@ #' Fit the multivariate Poisson lognormal model with a variational algorithm. Use the (g)lm syntax for model specification (covariates, offsets, weights). #' #' @param formula an object of class "formula": a symbolic description of the model to be fitted. -#' @param data an optional data frame, list or environment (or object coercible by as.data.frame to a data frame) containing the variables in the model. If not found in data, the variables are taken from environment(formula), typically the environment from which PLN is called. +#' @param data an optional data frame, list or environment (or object coercible by as.data.frame to a data frame) containing the variables in the model. If not found in data, the variables are taken from environment(formula), typically the environment from which the model is called. #' @param subset an optional vector specifying a subset of observations to be used in the fitting process. #' @param weights an optional vector of observation weights to be used in the fitting process. #' @param control a list-like structure for controlling the optimization, with default generated by [PLN_param()]. See the associated documentation @@ -36,7 +36,6 @@ PLN <- function(formula, data, subset, weights, control = PLN_param()) { "diagonal" = PLNfit_diagonal$new(args$Y, args$X, args$O, args$w, args$formula, control), "spherical" = PLNfit_spherical$new(args$Y, args$X, args$O, args$w, args$formula, control), "fixed" = PLNfit_fixedcov$new(args$Y, args$X, args$O, args$w, args$formula, control), - # "genet" = PLNfit_$new(args$Y, args$X, args$O, args$w, args$formula, control), PLNfit$new(args$Y, args$X, args$O, args$w, args$formula, control)) # default: full covariance ## optimization @@ -55,7 +54,8 @@ PLN <- function(formula, data, subset, weights, control = PLN_param()) { #' #' Helper to define list of parameters to control the PLN fit. All arguments have defaults. #' -#' @param backend optimization back used, either "nlopt" or "torch". Default is "nlopt" +#' @param backend optimization back used, either "builtin" (default), "nlopt" or "torch". +#' "builtin" is the built-in envelope-theorem Newton optimizer (does not depend on NLOPT). #' @param covariance character setting the model for the covariance matrix. Either "full", "diagonal", "spherical" or "fixed". Default is "full". #' @param Omega precision matrix of the latent variables. Inverse of Sigma. Must be specified if `covariance` is "fixed" #' @param config_optim a list for controlling the optimizer (either "nlopt" or "torch" backend). See details @@ -64,6 +64,7 @@ PLN <- function(formula, data, subset, weights, control = PLN_param()) { #' @param inception Set up the parameters initialization: by default, the model is initialized with a multivariate linear model applied on #' log-transformed data, and with the same formula as the one provided by the user. However, the user can provide a PLNfit (typically obtained from a previous fit), #' which sometimes speeds up the inference. +#' @param init_method character: strategy for the starting-point computation (ignored when `inception` is a PLNfit). Either `"LM"` (default) or `"GLM"` (p independent Poisson GLMs, better for complex or unbalanced designs). See [compute_PLN_starting_point()]. #' #' @return list of parameters configuring the fit. #' @@ -90,6 +91,12 @@ PLN <- function(formula, data, subset, weights, control = PLN_param()) { #' * "etas" pair of multiplicative increase and decrease factors. Default is (0.5, 1.2). Only used in RPROP #' * "centered" if TRUE, compute the centered RMSProp where the gradient is normalized by an estimation of its variance weight_decay (L2 penalty). Default to FALSE. Only used in RMSPROP #' +#' When "builtin" backend is used, the following entries are relevant +#' * "maxeval" stop when the number of Newton steps in the inner loop exceeds maxeval. Default is 10000 +#' * "ftol_in" stop the inner loop when the objective changes by less than ftol_in (relative). Default is 1e-8 +#' * "maxit_em" stop the EM outer loop when the number of EM iterations exceeds maxit_em. Default is 50 +#' * "ftol_em" stop the EM outer loop when the ELBO changes by less than ftol_em (relative). Default is 1e-8 +#' #' The list of parameters `config_post` controls the post-treatment processing (for most `PLN*()` functions), with the following entries (defaults may vary depending on the specific function, check `config_post_default_*` for defaults values): #' * jackknife boolean indicating whether jackknife should be performed to evaluate bias and variance of the model parameters. Default is FALSE. #' * bootstrap integer indicating the number of bootstrap resamples generated to evaluate the variance of the model parameters. Default is 0 (inactivated). @@ -99,16 +106,18 @@ PLN <- function(formula, data, subset, weights, control = PLN_param()) { #' #' @export PLN_param <- function( - backend = c("nlopt", "torch"), + backend = c("builtin", "nlopt", "torch"), trace = 1, covariance = c("full", "diagonal", "spherical", "fixed"), Omega = NULL, config_post = list(), config_optim = list(), - inception = NULL # pretrained PLNfit used as initialization + inception = NULL, + init_method = c("LM", "GLM") ) { - covariance <- match.arg(covariance) + covariance <- match.arg(covariance) + init_method <- match.arg(init_method) if (covariance == "fixed") stopifnot(inherits(Omega, "matrix") | inherits(Omega, "Matrix")) if (!is.null(inception)) stopifnot(isPLNfit(inception)) @@ -119,24 +128,15 @@ PLN_param <- function( ## optimization config backend <- match.arg(backend) - stopifnot(backend %in% c("nlopt", "torch")) - if (backend == "nlopt") { - stopifnot(config_optim$algorithm %in% available_algorithms_nlopt) - config_opt <- config_default_nlopt - } - if (backend == "torch") { - stopifnot(config_optim$algorithm %in% available_algorithms_torch) - config_opt <- config_default_torch - } - config_opt[names(config_optim)] <- config_optim - config_opt$trace <- trace + config_opt <- make_config_optim(backend, config_optim, trace) structure(list( - backend = backend , - trace = trace , - covariance = covariance, - Omega = Omega , - config_post = config_pst, - config_optim = config_opt, - inception = inception), class = "PLNmodels_param") + backend = backend , + trace = trace , + covariance = covariance , + Omega = Omega , + config_post = config_pst , + config_optim = config_opt , + init_method = init_method, + inception = inception ), class = "PLNmodels_param") } diff --git a/R/PLNLDA.R b/R/PLNLDA.R index 80549d8c..792a3105 100644 --- a/R/PLNLDA.R +++ b/R/PLNLDA.R @@ -2,26 +2,14 @@ #' #' Fit the Poisson lognormal for LDA with a variational algorithm. Use the (g)lm syntax for model specification (covariates, offsets). #' -#' @param formula an object of class "formula": a symbolic description of the model to be fitted. -#' @param data an optional data frame, list or environment (or object coercible by as.data.frame to a data frame) containing the variables in the model. If not found in data, the variables are taken from environment(formula), typically the environment from which lm is called. -#' @param subset an optional vector specifying a subset of observations to be used in the fitting process. -#' @param weights an optional vector of observation weights to be used in the fitting process. +#' @inheritParams PLN formula data subset weights #' @param grouping a factor specifying the class of each observation used for discriminant analysis. -#' @param control a list-like structure for controlling the optimization, with default generated by [PLN_param()]. See the associated documentation +#' @param control a list-like structure for controlling the optimization, with default generated by [PLNLDA_param()]. See the associated documentation. #' #' @return an R6 object with class [PLNLDAfit()] #' -#' @details The parameter `control` is a list controlling the optimization with the following entries: -#' * "covariance" character setting the model for the covariance matrix. Either "full" or "spherical". Default is "full". -#' * "trace" integer for verbosity. -#' * "inception" Set up the initialization. By default, the model is initialized with a multivariate linear model applied on log-transformed data. However, the user can provide a PLNfit (typically obtained from a previous fit), which often speed up the inference. -#' * "ftol_rel" stop when an optimization step changes the objective function by less than ftol multiplied by the absolute value of the parameter. Default is 1e-8 -#' * "ftol_abs" stop when an optimization step changes the objective function by less than ftol multiplied by the absolute value of the parameter. Default is 0 -#' * "xtol_rel" stop when an optimization step changes every parameters by less than xtol multiplied by the absolute value of the parameter. Default is 1e-6 -#' * "xtol_abs" stop when an optimization step changes every parameters by less than xtol multiplied by the absolute value of the parameter. Default is 0 -#' * "maxeval" stop when the number of iteration exceeds maxeval. Default is 10000 -#' * "maxtime" stop when the optimization time (in seconds) exceeds maxtime. Default is -1 (no restriction) -#' * "algorithm" the optimization method used by NLOPT among LD type, i.e. "CCSAQ", "MMA", "LBFGS", "VAR1", "VAR2". See NLOPT documentation for further details. Default is "CCSAQ". +#' @details See [PLNLDA_param()] for a full description of the optimization parameters. +#' Note that unlike [PLN_param()], [PLNLDA_param()] does not expose the `"fixed"` covariance option or the `Omega` parameter, which are not meaningful in the LDA context. #' #' @rdname PLNLDA #' @examples @@ -31,12 +19,12 @@ #' @seealso The class [`PLNLDAfit`] #' @importFrom stats model.frame model.matrix model.response model.offset #' @export -PLNLDA <- function(formula, data, subset, weights, grouping, control = PLN_param()) { +PLNLDA <- function(formula, data, subset, weights, grouping, control = PLNLDA_param()) { ## Temporary test for deprecated use of list() if (!inherits(control, "PLNmodels_param")) - stop("We now use the function PLN_param() to generate the list of parameters that controls the fit: - replace 'list(my_arg = xx)' by PLN_param(my_arg = xx) and see the documentation of PLN_param().") + stop("We now use the function PLNLDA_param() to generate the list of parameters that controls the fit: + replace 'list(my_arg = xx)' by PLNLDA_param(my_arg = xx) and see the documentation of PLNLDA_param().") ## look for grouping in the data or the parent frame if (inherits(try(eval(grouping), silent = TRUE), "try-error")) { @@ -45,7 +33,7 @@ PLNLDA <- function(formula, data, subset, weights, grouping, control = PLN_param } grouping <- as.factor(grouping) - # force the intercept term if excluded (prevent interferences with group means when coding discrete variables) + # force the intercept term if excluded (prevent interference with group means when coding discrete variables) the_call <- match.call(expand.dots = FALSE) the_call$formula <- update.formula(formula(the_call), ~ . +1) @@ -64,7 +52,7 @@ PLNLDA <- function(formula, data, subset, weights, grouping, control = PLN_param myLDA$optimize(grouping, args$Y, args$X, args$O, args$w, control$config_optim) ## Post-treatment: prepare LDA visualization - myLDA$postTreatment(grouping, args$Y, args$X, args$O, control$config_post, control$config_optim) + myLDA$postTreatment(grouping, args$Y, args$X, args$O, args$w, control$config_post, control$config_optim) if (control$trace > 0) cat("\n DONE!\n") myLDA @@ -76,18 +64,13 @@ PLNLDA <- function(formula, data, subset, weights, grouping, control = PLN_param #' #' @param backend optimization back used, either "nlopt" or "torch". Default is "nlopt" #' @param covariance character setting the model for the covariance matrix. Either "full", "diagonal" or "spherical". Default is "full". -#' @param config_optim a list for controlling the optimizer (either "nlopt" or "torch" backend). See details -#' @param config_post a list for controlling the post-treatments (optional bootstrap, jackknife, R2, etc.). See details -#' @param trace a integer for verbosity. -#' @param inception Set up the parameters initialization: by default, the model is initialized with a multivariate linear model applied on -#' log-transformed data, and with the same formula as the one provided by the user. However, the user can provide a PLNfit (typically obtained from a previous fit), -#' which sometimes speeds up the inference. +#' @inheritParams PLN_param trace config_optim config_post inception #' #' @return list of parameters configuring the fit. #' @inherit PLN_param details #' @export PLNLDA_param <- function( - backend = c("nlopt", "torch"), + backend = c("builtin", "nlopt", "torch"), trace = 1, covariance = c("full", "diagonal", "spherical"), config_post = list(), @@ -104,17 +87,7 @@ PLNLDA_param <- function( config_pst$trace <- trace ## optimization config - stopifnot(backend %in% c("nlopt", "torch")) - if (backend == "nlopt") { - stopifnot(config_optim$algorithm %in% available_algorithms_nlopt) - config_opt <- config_default_nlopt - } - if (backend == "torch") { - stopifnot(config_optim$algorithm %in% available_algorithms_torch) - config_opt <- config_default_torch - } - config_opt[names(config_optim)] <- config_optim - config_opt$trace <- trace + config_opt <- make_config_optim(backend, config_optim, trace) structure(list( backend = backend , diff --git a/R/PLNLDAfit-class.R b/R/PLNLDAfit-class.R index 9649f9b6..5b94ad56 100644 --- a/R/PLNLDAfit-class.R +++ b/R/PLNLDAfit-class.R @@ -84,13 +84,18 @@ PLNLDAfit <- R6Class( ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ## Post treatment -------------------- #' @description Update R2, fisher and std_err fields and visualization + #' @param grouping a factor with group memberships + #' @param responses the matrix of responses (counts) + #' @param covariates the matrix of covariates + #' @param offsets the matrix of offsets + #' @param weights an optional vector of observation weights. Default is uniform weights. #' @param config_post a list for controlling the post-treatments (optional bootstrap, jackknife, R2, etc.). #' @param config_optim list controlling the optimization parameters - postTreatment = function(grouping, responses, covariates, offsets, config_post, config_optim) { + postTreatment = function(grouping, responses, covariates, offsets, weights = rep(1, nrow(responses)), config_post, config_optim) { covariates <- cbind(covariates, model.matrix( ~ grouping + 0)) - super$postTreatment(responses, covariates, offsets, config_post = config_post, config_optim = config_optim) + super$postTreatment(responses, covariates, offsets, weights, config_post = config_post, config_optim = config_optim) rownames(private$C) <- colnames(private$C) <- colnames(responses) - colnames(private$S) <- 1:self$q + colnames(private$S2) <- 1:self$q if (config_post$trace > 1) cat("\n\tCompute LD scores for visualization...") self$setVisualization() }, @@ -406,8 +411,9 @@ PLNLDAfit_diagonal <- R6Class( #' @description Initialize a [`PLNfit`] model initialize = function(grouping, responses, covariates, offsets, weights, formula, control) { super$initialize(grouping, responses, covariates, offsets, weights, formula, control) - private$optimizer$main <- ifelse(control$backend == "nlopt", nlopt_optimize_diagonal, private$torch_optimize) - private$optimizer$vestep <- nlopt_optimize_vestep_diagonal + private$setup_optimizer(control$backend, + nlopt_optimize_diagonal, builtin_optimize_diagonal, + nlopt_optimize_vestep_diagonal, builtin_optimize_vestep_diagonal) } ), private = list( @@ -416,15 +422,16 @@ PLNLDAfit_diagonal <- R6Class( ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% torch_elbo = function(data, params, index=torch_tensor(1:self$n)) { - S2 <- torch_square(params$S[index]) - Z <- data$O[index] + params$M[index] + torch_matmul(data$X[index], params$B) + S2 <- torch_exp(params$psi[index]) + Z <- data$O[index] + params$M[index] res <- .5 * sum(data$w[index]) * sum(torch_log(private$torch_sigma_diag(data, params, index))) + - sum(data$w[index,NULL] * (torch_exp(Z + .5 * S2) - data$Y[index] * Z - .5 * torch_log(S2))) + sum(data$w[index,NULL] * (torch_exp(Z + .5 * S2) - data$Y[index] * Z - .5 * params$psi[index])) res }, torch_sigma_diag = function(data, params, index=torch_tensor(1:self$n)) { - torch_sum(data$w[index,NULL] * (torch_square(params$M[index]) + torch_square(params$S[index])), 1) / sum(data$w[index]) + M_res <- params$M[index] - torch_mm(data$X[index], params$B) + torch_sum(data$w[index,NULL] * (torch_square(M_res) + torch_exp(params$psi[index])), 1) / sum(data$w[index]) }, torch_Sigma = function(data, params, index=torch_tensor(1:self$n)) { @@ -432,13 +439,13 @@ PLNLDAfit_diagonal <- R6Class( }, torch_vloglik = function(data, params) { - S2 <- torch_pow(params$S, 2) + S2 <- torch_exp(params$psi) + M_res <- params$M - torch_mm(data$X, params$B) omega_diag <- torch_pow(private$torch_sigma_diag(data, params), -1) - Ji <- .5 * self$p - rowSums(.logfactorial(as.matrix(data$Y))) + as.numeric( .5 * sum(torch_log(omega_diag)) + - torch_sum(data$Y * params$Z - params$A + .5 * torch_log(S2), dim = 2) - - .5 * torch_matmul(torch_pow(params$M, 2) + S2, omega_diag) + torch_sum(data$Y * params$Z - params$A + .5 * params$psi - + .5 * (torch_square(M_res) + S2) * omega_diag[NULL,], dim = 2) ) attr(Ji, "weights") <- as.numeric(data$w) Ji @@ -496,8 +503,9 @@ PLNLDAfit_spherical <- R6Class( #' @description Initialize a [`PLNfit`] model initialize = function(grouping, responses, covariates, offsets, weights, formula, control) { super$initialize(grouping, responses, covariates, offsets, weights, formula, control) - private$optimizer$main <- ifelse(control$backend == "nlopt", nlopt_optimize_spherical, private$torch_optimize) - private$optimizer$vestep <- nlopt_optimize_vestep_spherical + private$setup_optimizer(control$backend, + nlopt_optimize_spherical, builtin_optimize_spherical, + nlopt_optimize_vestep_spherical, builtin_optimize_vestep_spherical) } ), private = list( @@ -506,15 +514,16 @@ PLNLDAfit_spherical <- R6Class( ## PRIVATE TORCH METHODS FOR OPTIMIZATION ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% torch_elbo = function(data, params, index=torch_tensor(1:self$n)) { - S2 <- torch_square(params$S[index]) - Z <- data$O[index] + params$M[index] + torch_mm(data$X[index], params$B) + S2 <- torch_exp(params$psi[index]) + Z <- data$O[index] + params$M[index] res <- .5 * sum(data$w[index]) * self$p * torch_log(private$torch_sigma2(data, params, index)) - - sum(data$w[index,NULL] * (data$Y[index] * Z - torch_exp(Z + .5 * S2) + .5 * torch_log(S2))) + sum(data$w[index,NULL] * (data$Y[index] * Z - torch_exp(Z + .5 * S2) + .5 * params$psi[index])) res }, torch_sigma2 = function(data, params, index=torch_tensor(1:self$n)) { - sum(data$w[index, NULL] * (torch_square(params$M) + torch_square(params$S))) / (sum(data$w) * self$p) + M_res <- params$M[index] - torch_mm(data$X[index], params$B) + sum(data$w[index, NULL] * (torch_square(M_res) + torch_exp(params$psi[index]))) / (sum(data$w[index]) * self$p) }, torch_Sigma = function(data, params, index=torch_tensor(1:self$n)) { @@ -522,10 +531,12 @@ PLNLDAfit_spherical <- R6Class( }, torch_vloglik = function(data, params) { - S2 <- torch_pow(params$S, 2) + S2 <- torch_exp(params$psi) + M_res <- params$M - torch_mm(data$X, params$B) sigma2 <- private$torch_sigma2(data, params) Ji <- .5 * self$p - rowSums(.logfactorial(as.matrix(data$Y))) + as.numeric( - torch_sum(data$Y * params$Z - params$A + .5 * torch_log(S2/sigma2) - .5 * (torch_pow(params$M, 2) + S2)/sigma2, dim = 2) + torch_sum(data$Y * params$Z - params$A + .5 * (params$psi - torch_log(sigma2)) - + .5 * (torch_pow(M_res, 2) + S2)/sigma2, dim = 2) ) attr(Ji, "weights") <- as.numeric(data$w) Ji diff --git a/R/PLNPCA.R b/R/PLNPCA.R index c0749232..3c55870d 100644 --- a/R/PLNPCA.R +++ b/R/PLNPCA.R @@ -2,10 +2,7 @@ #' #' Fit the PCA variants of the Poisson lognormal with a variational algorithm. Use the (g)lm syntax for model specification (covariates, offsets). #' -#' @param formula an object of class "formula": a symbolic description of the model to be fitted. -#' @param data an optional data frame, list or environment (or object coercible by as.data.frame to a data frame) containing the variables in the model. If not found in data, the variables are taken from environment(formula), typically the environment from which lm is called. -#' @param subset an optional vector specifying a subset of observations to be used in the fitting process. -#' @param weights an optional vector of observation weights to be used in the fitting process. +#' @inheritParams PLN formula data subset weights #' @param ranks a vector of integer containing the successive ranks (or number of axes to be considered) #' @param control a list-like structure for controlling the optimization, with default generated by [PLNPCA_param()]. See the associated documentation. #' for details. @@ -41,7 +38,7 @@ PLNPCA <- function(formula, data, subset, weights, ranks = 1:5, control = PLNPCA ## extract the data matrices and weights args <- extract_model(match.call(expand.dots = FALSE), parent.frame()) - ## Instantiate the collection of PLN models, initialized by PLN with full rank + ## Instantiate the collection of PLN models; shared SVD initialisation (LM or user inception) if (control$trace > 0) cat("\n Initialization...") myPCA <- PLNPCAfamily$new(ranks, args$Y, args$X, args$O, args$w, args$formula, control) @@ -61,27 +58,47 @@ PLNPCA <- function(formula, data, subset, weights, ranks = 1:5, control = PLNPCA #' #' Helper to define list of parameters to control the PLNPCA fit. All arguments have defaults. #' -#' @param backend optimization back used, either "nlopt" or "torch". Default is "nlopt" -#' @param trace a integer for verbosity. -#' @param config_optim a list for controlling the optimizer (either "nlopt" or "torch" backend). See details -#' @param config_post a list for controlling the post-treatments (optional bootstrap, jackknife, R2, etc.). See details -#' @param inception Set up the parameters initialization: by default, the model is initialized with a multivariate linear model applied on -#' log-transformed data, and with the same formula as the one provided by the user. However, the user can provide a PLNfit (typically obtained from a previous fit), -#' which sometimes speeds up the inference. +#' @param backend optimization backend, either `"nlopt"` (default, NLOPT/CCSAQ, recommended +#' for PLNPCA: conservative per-variable steps reliably find the global basin even when +#' the singular-value ratio d1/sqrt(n) is large), `"builtin"` (joint L-BFGS with strong +#' Wolfe line search on all parameters simultaneously — faster per iteration but may +#' converge to inferior local optima on ill-conditioned datasets), +#' or `"torch"` (automatic differentiation via the torch package). +#' @inheritParams PLN_param trace config_optim config_post +#' @param init_method character: strategy used to compute the starting point for the shared SVD. +#' Either `"LM"` (default, fast: one multivariate `lm.fit` on log-transformed counts) or +#' `"GLM"` (p independent Poisson GLMs, more accurate for complex or highly unbalanced +#' designs). Ignored when `inception` is provided. Benchmarks show `"LM"` is as good as +#' or better than `"GLM"` for PLNPCA in most cases; `"GLM"` is not recommended. +#' See [compute_PLN_starting_point()]. +#' @param inception an optional pre-fitted [`PLNfit`] object. When provided, its variational +#' means `M` and regression coefficients `B` are used to compute the shared SVD +#' `svd(M - X*B)` that initialises all ranks simultaneously. This replaces the default +#' LM-based starting point and can improve convergence for large ranks on datasets with +#' strong covariate effects (e.g. `inception = PLN(formula, data)`). When `NULL` (default), +#' a fast LM is used. `init_method` is ignored when `inception` is set. +#' @param sequential logical. If `TRUE`, ranks are fitted in ascending order and each model is +#' warm-started from the converged solution of the previous rank: loadings C are augmented +#' with new columns from the inception SVD, while latent scores M and variances S2 are +#' padded with zeros / 0.01 respectively. Disables parallel fitting across ranks. +#' Default is `FALSE`. #' #' @return list of parameters configuring the fit. #' #' @inherit PLN_param details #' @export PLNPCA_param <- function( - backend = c("nlopt", "torch"), + backend = c("nlopt", "builtin", "torch"), trace = 1 , config_optim = list() , config_post = list() , - inception = NULL # pretrained PLNfit used as initialization + inception = NULL , # pretrained PLNfit used as initialization + init_method = c("LM", "GLM"), + sequential = FALSE # fit ranks sequentially, warm-starting each from the previous ) { if (!is.null(inception)) stopifnot(isPLNfit(inception)) + init_method <- match.arg(init_method) ## post-treatment config config_pst <- config_post_default_PLNPCA @@ -90,22 +107,15 @@ PLNPCA_param <- function( ## optimization config backend <- match.arg(backend) - stopifnot(backend %in% c("nlopt", "torch")) - if (backend == "nlopt") { - stopifnot(config_optim$algorithm %in% available_algorithms_nlopt) - config_opt <- config_default_nlopt - } - if (backend == "torch") { - stopifnot(config_optim$algorithm %in% available_algorithms_torch) - config_opt <- config_default_torch - } - config_opt[names(config_optim)] <- config_optim - config_opt$trace <- trace + config_opt <- make_config_optim(backend, config_optim, trace, + builtin_default = config_default_plnpca) + config_opt$sequential <- sequential structure(list( - backend = backend , - trace = trace , - config_optim = config_opt, - config_post = config_pst, - inception = inception ), class = "PLNmodels_param") + backend = backend , + trace = trace , + config_optim = config_opt , + config_post = config_pst , + inception = inception , + init_method = init_method ), class = "PLNmodels_param") } diff --git a/R/PLNPCAfamily-class.R b/R/PLNPCAfamily-class.R index 08f5855e..a1ac06df 100644 --- a/R/PLNPCAfamily-class.R +++ b/R/PLNPCAfamily-class.R @@ -30,6 +30,14 @@ PLNPCAfamily <- R6Class( classname = "PLNPCAfamily", inherit = PLNfamily, + ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + ## PRIVATE MEMBERS ---- + ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + private = list( + svdM = NULL # SVD of the inception PLN M, shared across ranks + ), + ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ## PUBLIC MEMBERS ---- ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -38,13 +46,30 @@ PLNPCAfamily <- R6Class( ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ## Creation ----------------------- #' @description Initialize all models in the collection. + #' A single SVD of the residual matrix `M - X*B` is computed once and shared across + #' all ranks. `M` and `B` come from either a user-provided [`PLNfit`] inception or a + #' fast LM on log-transformed counts (default, controlled by `init_method`). initialize = function(ranks, responses, covariates, offsets, weights, formula, control) { ## initialize the required fields super$initialize(responses, covariates, offsets, weights, control) private$params <- ranks - ## save some time by using a common SVD to define the inceptive models - control$inception <- PLNfit$new(responses, covariates, offsets, weights, formula, control) - control$svdM <- svd(control$inception$var_par$M, nu = max(ranks), nv = ncol(responses)) + ## compute starting point for the common SVD: + ## user-provided inception PLNfit → use its converged M and B + ## otherwise: LM on log-transformed data (fast, no EM needed) + if (isPLNfit(control$inception)) { + init_B <- control$inception$model_par$B + init_M <- control$inception$var_par$M + } else { + lm_start <- compute_PLN_starting_point( + responses, covariates, offsets, weights, + method = if (is.null(control$init_method)) "LM" else control$init_method + ) + init_B <- lm_start$B + init_M <- lm_start$M + } + ## SVD of the residual M - XB, shared across all ranks + private$svdM <- svd(init_M - covariates %*% init_B, nu = max(ranks), nv = ncol(responses)) + control$svdM <- private$svdM ## instantiate as many models as ranks self$models <- lapply(ranks, function(rank){ model <- PLNPCAfit$new(rank, responses, covariates, offsets, weights, formula, control) @@ -57,18 +82,43 @@ PLNPCAfamily <- R6Class( #' @description Call to the C++ optimizer on all models of the collection #' @param config list controlling the optimization. optimize = function(config) { - self$models <- future.apply::future_lapply(self$models, function(model) { - if (config$trace == 1) { - cat("\t Rank approximation =",model$rank, "\r") - flush.console() - } - if (config$trace > 1) { - cat(" Rank approximation =",model$rank) - cat("\n\t conservative convex separable approximation for gradient descent") + if (isTRUE(config$sequential)) { + ## Sequential fitting: ranks in ascending order, each warm-started from the previous + ord <- order(sapply(self$models, function(m) m$rank)) + self$models <- self$models[ord] + prev_model <- NULL + for (i in seq_along(self$models)) { + model <- self$models[[i]] + if (config$trace == 1) { + cat("\t Rank approximation =", model$rank, "\r"); flush.console() + } + if (config$trace > 1) { + cat(" Rank approximation =", model$rank) + if (!is.null(prev_model)) + cat("\n\t warm-start from rank", prev_model$rank) + else + cat("\n\t no warm-start (first rank)") + } + if (!is.null(prev_model)) + model$warm_start_from(prev_model, private$svdM) + model$optimize(self$responses, self$covariates, self$offsets, self$weights, config) + prev_model <- model + self$models[[i]] <- model } - model$optimize(self$responses, self$covariates, self$offsets, self$weights, config) - model - }, future.seed = TRUE, future.scheduling = structure(TRUE, ordering = "random")) + } else { + self$models <- future.apply::future_lapply(self$models, function(model) { + if (config$trace == 1) { + cat("\t Rank approximation =", model$rank, "\r") + flush.console() + } + if (config$trace > 1) { + cat(" Rank approximation =", model$rank) + cat("\n\t conservative convex separable approximation for gradient descent") + } + model$optimize(self$responses, self$covariates, self$offsets, self$weights, config) + model + }, future.seed = TRUE, future.scheduling = structure(TRUE, ordering = "random")) + } }, ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/R/PLNPCAfit-class.R b/R/PLNPCAfit-class.R index d63bf1b5..f96b4419 100644 --- a/R/PLNPCAfit-class.R +++ b/R/PLNPCAfit-class.R @@ -48,12 +48,13 @@ PLNPCAfit <- R6Class( private = list( C = NULL, svdCM = NULL, + S2 = NA , # rank-reduced variational variances (n × q) ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ## PRIVATE TORCH METHODS FOR RANK-CONSTRAINED OPTIMIZATION ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - torch_elbo_rank_core = function(data, M, S, B, C, index) { - S2 <- torch_square(S[index]) # (batch, q) + torch_elbo_rank_core = function(data, M, psi, B, C, index) { + S2 <- torch_exp(psi[index]) # (batch, q); ψ = log(S²) C2 <- torch_square(C) # (p, q) Z <- data$O[index] + torch_mm(M[index], torch_t(C)) + @@ -61,22 +62,22 @@ PLNPCAfit <- R6Class( A <- torch_exp(Z + 0.5 * torch_mm(S2, torch_t(C2))) lik_part <- torch_sum(data$w[index, NULL] * (A - data$Y[index] * Z)) kl_part <- 0.5 * torch_sum(data$w[index, NULL] * - (torch_square(M[index]) + S2 - torch_log(S2) - 1)) + (torch_square(M[index]) + S2 - psi[index] - 1)) lik_part + kl_part }, torch_elbo_rank = function(data, params, index = torch_tensor(1:self$n)) { - private$torch_elbo_rank_core(data, params$M, params$S, params$B, params$C, index) + private$torch_elbo_rank_core(data, params$M, params$psi, params$B, params$C, index) }, torch_vloglik_rank = function(data, params) { - S2 <- torch_square(params$S) + S2 <- torch_exp(params$psi) C2 <- torch_square(params$C) Z <- data$O + torch_mm(params$M, torch_t(params$C)) + torch_mm(data$X, params$B) A <- torch_exp(Z + 0.5 * torch_mm(S2, torch_t(C2))) Ji <- - torch_sum(.logfactorial_torch(data$Y), dim = 2) + torch_sum(data$Y * Z - A, dim = 2) - - 0.5 * torch_sum(torch_square(params$M) + S2 - torch_log(S2) - 1, dim = 2) + 0.5 * torch_sum(torch_square(params$M) + S2 - params$psi - 1, dim = 2) Ji <- .5 * self$p + as.numeric(Ji$cpu()) attr(Ji, "weights") <- as.numeric(data$w$cpu()) Ji @@ -139,9 +140,12 @@ PLNPCAfit <- R6Class( if (config$trace > 1) message(paste("optimizing with device:", config$device)) - n <- nrow(data$Y) - data <- lapply(data, torch_tensor, dtype = torch_float32(), device = config$device) + n <- nrow(data$Y) + data <- lapply(data, torch_tensor, dtype = torch_float32(), device = config$device) + S2_init <- params$S2 + params$S2 <- NULL params <- lapply(params, torch_tensor, dtype = torch_float32(), requires_grad = TRUE, device = config$device) + params$psi <- torch_tensor(log(S2_init), dtype = torch_float32(), requires_grad = TRUE, device = config$device) B <- torch_tensor(B, dtype = torch_float32(), device = config$device) C <- torch_tensor(C, dtype = torch_float32(), device = config$device) @@ -151,15 +155,17 @@ PLNPCAfit <- R6Class( config = config, n_obs = n, loss_fn = function(index) { - private$torch_elbo_rank_core(data, params$M, params$S, B, C, index) + private$torch_elbo_rank_core(data, params$M, params$psi, B, C, index) } ) params_r <- lapply(optim_out$params, function(x) as.matrix(x$cpu())) + params_r$S2 <- exp(params_r$psi) + params_r$psi <- NULL Ji_r <- private$torch_vloglik_rank(data, c(optim_out$params, list(B = B, C = C))) list( M = params_r$M, - S = params_r$S, + S2 = params_r$S2, Ji = Ji_r, monitoring = list( objective = optim_out$objective, @@ -174,8 +180,11 @@ PLNPCAfit <- R6Class( if (config$trace > 1) message(paste("optimizing with device:", config$device)) - data <- lapply(data, torch_tensor, dtype = torch_float32(), device = config$device) - params <- lapply(params, torch_tensor, dtype = torch_float32(), requires_grad = TRUE, device = config$device) + data <- lapply(data, torch_tensor, dtype = torch_float32(), device = config$device) + S2_init <- params$S2 + params$S2 <- NULL + params <- lapply(params, torch_tensor, dtype = torch_float32(), requires_grad = TRUE, device = config$device) + params$psi <- torch_tensor(log(S2_init), dtype = torch_float32(), requires_grad = TRUE, device = config$device) optim_out <- private$torch_optimize_rank_core( data = data, @@ -192,7 +201,7 @@ PLNPCAfit <- R6Class( data_r <- lapply(data, function(x) as.matrix(x$cpu())) q <- ncol(params_r$M) - S2_r <- params_r$S^2 + S2_r <- exp(params_r$psi) # ψ → S² C2_r <- params_r$C^2 Z_r <- data_r$O + params_r$M %*% t(params_r$C) + data_r$X %*% params_r$B A_r <- exp(Z_r + 0.5 * S2_r %*% t(C2_r)) @@ -205,14 +214,14 @@ PLNPCAfit <- R6Class( Ji_r <- .5 * self$p - rowSums(.logfactorial(as.matrix(data_r$Y))) + rowSums(data_r$Y * Z_r - A_r) - - 0.5 * rowSums(params_r$M^2 + S2_r - log(S2_r) - 1) + 0.5 * rowSums(params_r$M^2 + S2_r - params_r$psi - 1) attr(Ji_r, "weights") <- w_r list( B = params_r$B, C = params_r$C, M = params_r$M, - S = params_r$S, + S2 = S2_r, Z = Z_r, A = A_r, Sigma = Sigma_r, @@ -233,48 +242,79 @@ PLNPCAfit <- R6Class( public = list( ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ## Creation functions ---------------- - #' @description Initialize a [`PLNPCAfit`] object + #' @description Initialize a [`PLNPCAfit`] object. + #' Uses the shared SVD from `control$svdM` (computed once in [`PLNPCAfamily`]) to set + #' the starting loadings `C` and scores `M`. The regression coefficients `B` are + #' initialised by the parent [`PLNfit`] constructor (LM or user-provided inception). initialize = function(rank, responses, covariates, offsets, weights, formula, control) { super$initialize(responses, covariates, offsets, weights, formula, control) if (control$backend == "torch") { private$optimizer$main <- private$torch_optimize_rank + } else if (control$backend == "builtin") { + private$optimizer$main <- builtin_optimize_rank } else { private$optimizer$main <- nlopt_optimize_rank } - private$optimizer$vestep <- nlopt_optimize_vestep_rank + private$optimizer$vestep <- if (control$backend == "builtin") builtin_optimize_vestep_rank else nlopt_optimize_vestep_rank if (!is.null(control$svdM)) { svdM <- control$svdM } else { - svdM <- svd(private$M, nu = rank, nv = self$p) + svdM <- svd(private$M - covariates %*% private$B, nu = rank, nv = self$p) } - ### TODO: check that it is really better than initializing with zeros... - private$M <- svdM$u[, 1:rank, drop = FALSE] %*% diag(svdM$d[1:rank], nrow = rank, ncol = rank) %*% t(svdM$v[1:rank, 1:rank, drop = FALSE]) - private$S <- matrix(0.1, self$n, rank) + # M*C^T ≈ M_PLN requires M = sqrt(n)*U when C = V*D/sqrt(n) + private$M <- sqrt(self$n) * svdM$u[, 1:rank, drop = FALSE] + private$S2 <- matrix(0.01, self$n, rank) private$C <- svdM$v[, 1:rank, drop = FALSE] %*% diag(svdM$d[1:rank], nrow = rank, ncol = rank)/sqrt(self$n) }, + #' @description Reinitialize parameters for sequential warm-starting from a lower-rank fit. + #' Fitted loadings C, scores M, variances S, and regression coefficients B from `prev_fit` + #' are carried over; new columns are padded using the inception SVD (C) or zeros/0.1 (M/S). + #' @param prev_fit a converged [`PLNPCAfit`] of rank `self$rank - k` (k >= 1) + #' @param svdM the inception SVD (from `PLNPCAfamily`) + warm_start_from = function(prev_fit, svdM) { + q_prev <- prev_fit$rank + q_new <- self$rank + new_idx <- (q_prev + 1):q_new + C_new_cols <- svdM$v[, new_idx, drop = FALSE] %*% + diag(svdM$d[new_idx], nrow = length(new_idx)) / sqrt(self$n) + private$C <- cbind(prev_fit$model_par$C, C_new_cols) + private$M <- cbind(prev_fit$var_par$M, + matrix(0, nrow = self$n, ncol = q_new - q_prev)) + private$S2 <- cbind(prev_fit$var_par$S2, + matrix(0.01, nrow = self$n, ncol = q_new - q_prev)) + private$B <- prev_fit$model_par$B + }, + #' @description Update a [`PLNPCAfit`] object #' @param M matrix of mean vectors for the variational approximation #' @param C matrix of PCA loadings (in the latent space) - #' @param S matrix of variance vectors for the variational approximation + #' @param S2 matrix of variational variances (n × q) #' @param Ji vector of variational lower bounds of the log-likelihoods (one value per sample) #' @param R2 approximate R^2 goodness-of-fit criterion #' @param Z matrix of latent vectors (includes covariates and offset effects) #' @param A matrix of fitted values #' @param monitoring a list with optimization monitoring quantities #' @return Update the current [`PLNPCAfit`] object - update = function(B=NA, Sigma=NA, Omega=NA, C=NA, M=NA, S=NA, Z=NA, A=NA, Ji=NA, R2=NA, monitoring=NA) { - super$update(B = B, Sigma = Sigma, Omega = Omega, M = M, S = S, Z = Z, A = A, Ji = Ji, R2 = R2, monitoring = monitoring) - if (!anyNA(C)) private$C <- C + update = function(B=NA, Sigma=NA, Omega=NA, C=NA, M=NA, S2=NA, Z=NA, A=NA, Ji=NA, R2=NA, monitoring=NA) { + super$update(B = B, Sigma = Sigma, Omega = Omega, M = M, Z = Z, A = A, Ji = Ji, R2 = R2, monitoring = monitoring) + if (!anyNA(C)) private$C <- C + if (!anyNA(S2)) private$S2 <- S2 }, ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ## Optimization ---------------------- #' @description Call to the C++ optimizer and update of the relevant fields optimize = function(responses, covariates, offsets, weights, config) { - args <- list(data = list(Y = responses, X = covariates, O = offsets, w = weights), - params = list(B = private$B, C = private$C, M = private$M, S = private$S), + ## Column-scale X to prevent first-step blowup when X has large-scale columns + ## (e.g. depth in metres). Equivalent problem; B is unscaled before storing. + scales <- pmax(sqrt(colSums(covariates^2)), 1) + X_sc <- sweep(covariates, 2, scales, "/") + B_sc <- sweep(private$B, 1, scales, "*") + args <- list(data = list(Y = responses, X = X_sc, O = offsets, w = weights), + params = list(B = B_sc, C = private$C, M = private$M, S2 = private$S2), config = config) optim_out <- do.call(private$optimizer$main, args) + optim_out$B <- sweep(optim_out$B, 1, scales, "/") do.call(self$update, optim_out) }, @@ -303,7 +343,7 @@ PLNPCAfit <- R6Class( ## Initialize the variational parameters with the appropriate new dimension of the data args <- list(data = list(Y = responses, X = covariates, O = offsets, w = weights), ## Initialize the variational parameters with the new dimension of the data - params = list(M = M_init, S = matrix(.1, n, q)), + params = list(M = M_init, S2 = matrix(.01, n, q)), B = private$B, C = private$C, config = control$config_optim) @@ -354,10 +394,14 @@ PLNPCAfit <- R6Class( #' * variational_var boolean indicating whether variational Fisher information matrix should be computed to estimate the variance of the model parameters (highly underestimated). Default is FALSE. #' * rsquared boolean indicating whether approximation of R2 based on deviance should be computed. Default is TRUE #' * trace integer for verbosity. should be > 1 to see output in post-treatments - postTreatment = function(responses, covariates, offsets, weights, config_post, config_optim, nullModel) { + postTreatment = function(responses, covariates, offsets, weights = rep(1, nrow(responses)), config_post, config_optim, nullModel = NULL) { super$postTreatment(responses, covariates, offsets, weights, config_post, config_optim, nullModel) colnames(private$C) <- colnames(private$M) <- 1:self$q rownames(private$C) <- colnames(responses) + if (!identical(private$S2, NA)) { + rownames(private$S2) <- rownames(responses) + colnames(private$S2) <- 1:self$q + } self$setVisualization() }, @@ -486,6 +530,8 @@ PLNPCAfit <- R6Class( ## ACTIVE BINDINGS ---- ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% active = list( + #' @field var_par variational parameters (M, S2) in the rank-q latent space + var_par = function() {list(M = private$M, S2 = private$S2)}, #' @field rank the dimension of the current model rank = function() {self$q}, #' @field vcov_model character: the model used for the residual covariance diff --git a/R/PLNfit-S3methods.R b/R/PLNfit-S3methods.R index efc41806..3a8cabd3 100644 --- a/R/PLNfit-S3methods.R +++ b/R/PLNfit-S3methods.R @@ -189,6 +189,100 @@ standard_error.PLNfit <- function(object, type = c("sandwich", "variational", "j attr(object$model_par[[par]], paste0("variance_", type)) %>% sqrt() } +#' Extract log-likelihood of a fitted PLN model +#' +#' @name logLik.PLNfit +#' @description Returns the variational lower bound of the log-likelihood as a `"logLik"` object, +#' compatible with [stats::AIC()] and [stats::BIC()]. +#' +#' @param object an R6 object with class [`PLNfit`] +#' @param ... additional parameters for S3 compatibility. Not used +#' @return An object of class `"logLik"`. The numeric value is the variational ELBO. +#' Attributes `df` and `nobs` hold the number of parameters and observations. +#' +#' @importFrom stats logLik +#' @export +#' @examples +#' data(trichoptera) +#' trichoptera <- prepare_data(trichoptera$Abundance, trichoptera$Covariate) +#' model <- PLN(Abundance ~ 1, data = trichoptera) +#' logLik(model) +logLik.PLNfit <- function(object, ...) { + stopifnot(isPLNfit(object)) + structure(object$loglik, class = "logLik", df = object$nb_param, nobs = object$n) +} + +#' Akaike Information Criterion for a fitted PLN model +#' +#' @name AIC.PLNfit +#' @description Computes the variational AIC as `loglik - nb_param` (larger is better). +#' This follows the maximization convention used throughout PLNmodels. +#' +#' @param object an R6 object with class [`PLNfit`] +#' @param k not used, present for S3 compatibility. +#' @param ... additional parameters for S3 compatibility. Not used +#' @return A scalar: the variational AIC (larger is better). +#' +#' @importFrom stats AIC +#' @export +#' @examples +#' data(trichoptera) +#' trichoptera <- prepare_data(trichoptera$Abundance, trichoptera$Covariate) +#' model <- PLN(Abundance ~ 1, data = trichoptera) +#' AIC(model) +AIC.PLNfit <- function(object, ..., k = 2) { + stopifnot(isPLNfit(object)) + object$AIC +} + +#' Bayesian Information Criterion for a fitted PLN model +#' +#' @name BIC.PLNfit +#' @description Computes the variational BIC as `loglik - 0.5 * log(n) * nb_param` (larger is better). +#' This follows the maximization convention used throughout PLNmodels. +#' +#' @param object an R6 object with class [`PLNfit`] +#' @param ... additional parameters for S3 compatibility. Not used +#' @return A scalar: the variational BIC (larger is better). +#' +#' @importFrom stats BIC +#' @export +#' @examples +#' data(trichoptera) +#' trichoptera <- prepare_data(trichoptera$Abundance, trichoptera$Covariate) +#' model <- PLN(Abundance ~ 1, data = trichoptera) +#' BIC(model) +BIC.PLNfit <- function(object, ...) { + stopifnot(isPLNfit(object)) + object$BIC +} + +#' Integrated Classification Likelihood +#' +#' @name ICL +#' @description Generic function to compute the Integrated Classification Likelihood (ICL) of a fitted model. +#' ICL = BIC - entropy of the variational distribution (larger is better). +#' +#' @param object a fitted model object +#' @param ... additional parameters passed to methods +#' @return A scalar: the variational ICL (larger is better). +#' @export +ICL <- function(object, ...) UseMethod("ICL") + +#' @rdname ICL +#' @description `ICL.PLNfit`: ICL for a fitted [`PLNfit`]. +#' @param object an R6 object with class [`PLNfit`] +#' @export +#' @examples +#' data(trichoptera) +#' trichoptera <- prepare_data(trichoptera$Abundance, trichoptera$Covariate) +#' model <- PLN(Abundance ~ 1, data = trichoptera) +#' ICL(model) +ICL.PLNfit <- function(object, ...) { + stopifnot(isPLNfit(object)) + object$ICL +} + #' @describeIn standard_error Component-wise standard errors of B in [`PLNfit_fixedcov`] #' @export standard_error.PLNfit_fixedcov <- function(object, type = c("sandwich", "variational", "jackknife", "bootstrap"), parameter = c("B", "Omega")) { diff --git a/R/PLNfit-class.R b/R/PLNfit-class.R index cf2817b4..bca8e8aa 100644 --- a/R/PLNfit-class.R +++ b/R/PLNfit-class.R @@ -52,12 +52,14 @@ PLNfit <- R6Class( B = NA , # regression parameters of the latent layer Sigma = NA , # covariance matrix of the latent layer Omega = NA , # precision matrix of the latent layer. Inverse of Sigma - S = NA , # variational parameters for the variances + S2 = NA , # variational parameters for the variances M = NA , # variational parameters for the means Z = NA , # matrix of latent variable A = NA , # matrix of expected counts (under variational approximation) Ji = NA , # element-wise approximated loglikelihood R2 = NA , # approximated goodness of fit criterion + w = NULL , # observation weights, stored at initialization + X = NULL , # design matrix, stored at initialization for latent_pos optimizer = list(), # list of links to the functions doing the optimization monitoring = list(), # list with optimization monitoring quantities @@ -65,18 +67,19 @@ PLNfit <- R6Class( ## PRIVATE TORCH METHODS FOR OPTIMIZATION ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% torch_elbo = function(data, params, index=torch_tensor(1:self$n)) { - S2 <- torch_square(params$S[index]) - Z <- data$O[index] + params$M[index] + torch_mm(data$X[index], params$B) - A <- torch_exp(Z + .5 * S2) + S2 <- torch_exp(params$psi[index]) + Z <- data$O[index] + params$M[index] + A <- torch_exp(Z + .5 * S2) res <- .5 * sum(data$w[index]) * torch_logdet(private$torch_Sigma(data, params, index)) + - sum(data$w[index,NULL] * (A - data$Y[index] * Z - .5 * torch_log(S2))) + sum(data$w[index,NULL] * (A - data$Y[index] * Z - .5 * params$psi[index])) res }, torch_Sigma = function(data, params, index=torch_tensor(1:self$n)) { ws <- torch_sqrt(data$w[index, NULL]) - S2_bar <- torch_sum(torch_square(ws * params$S[index]), 1) - MtM <- torch_mm(torch_t(ws * params$M[index]), ws * params$M[index]) + M_res <- params$M[index] - torch_mm(data$X[index], params$B) + S2_bar <- torch_sum(data$w[index, NULL] * torch_exp(params$psi[index]), 1) + MtM <- torch_mm(torch_t(ws * M_res), ws * M_res) (MtM + torch_diag(S2_bar)) / sum(ws*ws) }, @@ -85,11 +88,12 @@ PLNfit <- R6Class( }, torch_vloglik = function(data, params) { - S2 <- torch_square(params$S) + S2 <- torch_exp(params$psi) + M_res <- params$M - torch_mm(data$X, params$B) Ji_tmp = .5 * torch_logdet(params$Omega) + - torch_sum(data$Y * params$Z - params$A + .5 * torch_log(S2), dim = 2) - - .5 * torch_sum(torch_mm(params$M, params$Omega) * params$M + S2 * torch_diag(params$Omega), dim = 2) + torch_sum(data$Y * params$Z - params$A + .5 * params$psi, dim = 2) - + .5 * torch_sum(torch_mm(M_res, params$Omega) * M_res + S2 * torch_diag(params$Omega), dim = 2) Ji <- - torch_sum(.logfactorial_torch(data$Y), dim = 2) + Ji_tmp Ji <- .5 * self$p + as.numeric(Ji$cpu()) @@ -103,8 +107,12 @@ PLNfit <- R6Class( if (config$trace > 1) message (paste("optimizing with device: ", config$device)) ## Conversion of data and parameters to torch tensors (pointers) - data <- lapply(data, torch_tensor, dtype = torch_float32(), device = config$device) # list with Y, X, O, w - params <- lapply(params, torch_tensor, dtype = torch_float32(), requires_grad = TRUE, device = config$device) # list with B, M, S + data <- lapply(data, torch_tensor, dtype = torch_float32(), device = config$device) # Y, X, O, w + S2_init <- params$S2 # extract S2 as plain R matrix before torch conversion + params$S2 <- NULL # remove it: psi (leaf tensor) replaces it + params <- lapply(params, torch_tensor, dtype = torch_float32(), requires_grad = TRUE, device = config$device) + ## ψ = log(S²) — created as a fresh leaf tensor, unconstrained (same reparameterisation as Newton/nlopt) + params$psi <- torch_tensor(log(S2_init), dtype = torch_float32(), requires_grad = TRUE, device = config$device) ## Initialize optimizer optimizer <- switch(config$algorithm, @@ -167,13 +175,15 @@ PLNfit <- R6Class( params$Sigma <- private$torch_Sigma(data, params) params$Omega <- private$torch_Omega(data, params) - params$Z <- data$O + params$M + torch_matmul(data$X, params$B) - params$A <- torch_exp(params$Z + torch_pow(params$S, 2)/2) + params$Z <- data$O + params$M + params$A <- torch_exp(params$Z + torch_exp(params$psi)/2) out <- lapply(params, function(x) { x = x$cpu() as.matrix(x)} ) + out$S2 <- exp(out$psi) # convert ψ back to S² for the rest of the package + out$psi <- NULL out$Ji <- private$torch_vloglik(data, params) out$monitoring <- list( objective = objective, @@ -240,7 +250,7 @@ PLNfit <- R6Class( vcov_sandwich_B = function(Y, X) { vcov_sand <- get_sandwich_variance_B(Y, X, private$A, - private$S, private$Sigma, diag(private$Omega) + sqrt(private$S2), private$Sigma, diag(private$Omega) ) attr(private$B, "vcov_sandwich") <- vcov_sand attr(private$B, "variance_sandwich") <- matrix(diag(vcov_sand), nrow = self$d, ncol = self$p, @@ -254,7 +264,7 @@ PLNfit <- R6Class( O = O[-i, , drop = FALSE], w = w[-i]) args <- list(data = data, - params = do.call(compute_PLN_starting_point, data), + params = compute_PLN_starting_point(data$Y, data$X, data$O, data$w), config = config) optim_out <- do.call(private$optimizer$main, args) optim_out[c("B", "Omega")] @@ -289,7 +299,7 @@ PLNfit <- R6Class( data <- lapply(data, torch_tensor, device = config$device) args <- list(data = data, - params = do.call(compute_PLN_starting_point, data), + params = compute_PLN_starting_point(data$Y, data$X, data$O, data$w), config = config) if (config$backend == "torch") # Convert data to torch tensors args$params <- lapply(args$params, torch_tensor, requires_grad = TRUE, device = config$device) # list with B, M, S @@ -322,6 +332,22 @@ PLNfit <- R6Class( lmin <- logLikPoisson(responses, nullModel, weights) lmax <- logLikPoisson(responses, log(responses), weights) private$R2 <- (loglik - lmin) / (lmax - lmin) + }, + + ## Set optimizer$main and (optionally) optimizer$vestep from the four covariance-specific + ## C++ functions. Called by every subclass initialize() so the dispatch logic lives once. + setup_optimizer = function(backend, nlopt_fn, newton_fn, + nlopt_vestep_fn = NULL, newton_vestep_fn = NULL) { + private$optimizer$main <- if (backend == "torch") { + private$torch_optimize + } else if (backend == "builtin") { + newton_fn + } else { + nlopt_fn + } + if (!is.null(nlopt_vestep_fn)) + private$optimizer$vestep <- + if (backend == "builtin") newton_vestep_fn else nlopt_vestep_fn } ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -345,6 +371,8 @@ PLNfit <- R6Class( n <- nrow(responses); p <- ncol(responses); d <- ncol(covariates) ## set up various quantities private$formula <- formula # user formula call + private$w <- weights + private$X <- covariates ## initialize the variational parameters if (isPLNfit(control$inception)) { if (control$trace > 1) cat("\n User defined inceptive PLN model") @@ -352,16 +380,18 @@ PLNfit <- R6Class( private$Sigma <- control$inception$model_par$Sigma private$B <- control$inception$model_par$B private$M <- control$inception$var_par$M - private$S <- control$inception$var_par$S + private$S2 <- control$inception$var_par$S2 } else { if (control$trace > 1) cat("\n Use LM after log transformation to define the inceptive model") - start_point <- compute_PLN_starting_point(Y = responses, X = covariates, O = offsets, w = weights) - private$B <- start_point$B - private$M <- start_point$M - private$S <- start_point$S + start_point <- compute_PLN_starting_point(Y = responses, X = covariates, O = offsets, w = weights, + method = if (is.null(control$init_method)) "LM" else control$init_method) + private$B <- start_point$B + private$M <- start_point$M + private$S2 <- start_point$S2 } - private$optimizer$main <- ifelse(control$backend == "nlopt", nlopt_optimize, private$torch_optimize) - private$optimizer$vestep <- nlopt_optimize_vestep + private$setup_optimizer(control$backend, + nlopt_optimize_full, builtin_optimize_full, + nlopt_optimize_vestep_full, builtin_optimize_vestep_full) }, ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -371,24 +401,24 @@ PLNfit <- R6Class( #' @description #' Update a [`PLNfit`] object #' @param M matrix of variational parameters for the mean - #' @param S matrix of variational parameters for the variance + #' @param S2 matrix of variational parameters for the variance #' @param Ji vector of variational lower bounds of the log-likelihoods (one value per sample) #' @param R2 approximate R^2 goodness-of-fit criterion #' @param Z matrix of latent vectors (includes covariates and offset effects) #' @param A matrix of fitted values #' @param monitoring a list with optimization monitoring quantities #' @return Update the current [`PLNfit`] object - update = function(B=NA, Sigma=NA, Omega=NA, M=NA, S=NA, Ji=NA, R2=NA, Z=NA, A=NA, monitoring=NA) { - if (!anyNA(B)) private$B <- B - if (!anyNA(Sigma)) private$Sigma <- Sigma - if (!anyNA(Omega)) private$Omega <- Omega - if (!anyNA(M)) private$M <- M - if (!anyNA(S)) private$S <- S - if (!anyNA(Z)) private$Z <- Z - if (!anyNA(A)) private$A <- A - if (!anyNA(Ji)) private$Ji <- Ji - if (!anyNA(R2)) private$R2 <- R2 - if (!anyNA(monitoring)) private$monitoring <- monitoring + update = function(B=NA, Sigma=NA, Omega=NA, M=NA, S2=NA, Ji=NA, R2=NA, Z=NA, A=NA, monitoring=NA) { + if (!identical(B, NA)) private$B <- B + if (!identical(Sigma, NA)) private$Sigma <- Sigma + if (!identical(Omega, NA)) private$Omega <- Omega + if (!identical(M, NA)) private$M <- M + if (!identical(S2, NA)) private$S2 <- S2 + if (!identical(Z, NA)) private$Z <- Z + if (!identical(A, NA)) private$A <- A + if (!identical(Ji, NA)) private$Ji <- Ji + if (!identical(R2, NA)) private$R2 <- R2 + if (!identical(monitoring, NA)) private$monitoring <- monitoring }, ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -398,13 +428,13 @@ PLNfit <- R6Class( #' @description Call to the NLopt or TORCH optimizer and update of the relevant fields optimize = function(responses, covariates, offsets, weights, config) { args <- list(data = list(Y = responses, X = covariates, O = offsets, w = weights), - params = list(B = private$B, M = private$M, S = private$S), + params = list(B = private$B, M = private$M, S2 = private$S2), config = config) optim_out <- do.call(private$optimizer$main, args) do.call(self$update, optim_out) }, - #' @description Result of one call to the VE step of the optimization procedure: optimal variational parameters (M, S) and corresponding log likelihood values for fixed model parameters (Sigma, B). Intended to position new data in the latent space. + #' @description Result of one call to the VE step of the optimization procedure: optimal variational parameters (M, S2) and corresponding log likelihood values for fixed model parameters (Sigma, B). Intended to position new data in the latent space. #' @param B Optional fixed value of the regression parameters #' @param Sigma variance-covariance matrix of the latent variables #' @return A list with three components: @@ -418,9 +448,9 @@ PLNfit <- R6Class( n <- nrow(responses); p <- ncol(responses) ## initialize variational parameters with current value if dimension is the same if ((p != self$p) || (n != self$n)) { - params0 <- list(M = matrix(0, n, p), S = matrix(.1, n, p)) + params0 <- list(M = covariates %*% B, S2 = matrix(.01, n, p)) } else { - params0 <- list(M = self$var_par$M, S = self$var_par$S) + params0 <- list(M = self$var_par$M, S2 = self$var_par$S2) } args <- list(data = list(Y = responses, X = covariates, O = offsets, w = weights), ## Initialize the variational parameters with the new dimension of the data @@ -453,8 +483,11 @@ PLNfit <- R6Class( } rownames(private$Sigma) <- colnames(private$Sigma) <- colnames(responses) rownames(private$Omega) <- colnames(private$Omega) <- colnames(responses) - rownames(private$M) <- rownames(private$S) <- rownames(responses) - colnames(private$S) <- 1:self$q + rownames(private$M) <- rownames(responses) + if (!identical(private$S2, NA) && ncol(private$S2) == self$q) { + rownames(private$S2) <- rownames(responses) + colnames(private$S2) <- 1:self$q + } ## OPTIONAL POST-TREATMENT (potentially costly) ## 1. compute and store approximated R2 with Poisson-based deviance @@ -516,11 +549,6 @@ PLNfit <- R6Class( O <- model.offset(model.frame(formula(private$formula)[-2], newdata)) if (is.null(O)) O <- matrix(0, n_new, self$p) - ## mean latent positions in the parameter space (covariates/offset only) - EZ <- X %*% private$B + O - rownames(EZ) <- rownames(newdata) - colnames(EZ) <- colnames(private$Sigma) - ## Optimize M and S if responses are provided, if (level == 1) { VE <- self$optimize_vestep( @@ -531,19 +559,21 @@ PLNfit <- R6Class( B = private$B, Omega = private$Omega ) - M <- VE$M - S2 <- (VE$S)**2 + M <- VE$M # M_full + colnames(M) <- colnames(private$B) + S2 <- VE$S2 } else { - # otherwise set M = 0 and S2 = diag(Sigma) - M <- matrix(0, nrow = n_new, ncol = self$p) + # population prediction: M_full = X*B (M_res = 0) + M <- X %*% private$B S2 <- matrix(diag(private$Sigma), nrow = n_new, ncol = self$p, byrow = TRUE) } + rownames(M) <- rownames(newdata) type <- match.arg(type) results <- switch( type, - link = EZ + M, - response = exp(EZ + M + 0.5 * S2) + link = O + M, + response = exp(O + M + 0.5 * S2) ) attr(results, "type") <- type results @@ -597,10 +627,9 @@ PLNfit <- R6Class( Omega = prec11 ) - M <- tcrossprod(VE$M, A) - # S <- map(1:n_new, ~crossprod(sqrt(VE$S[., ]) * t(A)) + Sigma21) %>% - # simplify2array() - S <- map(1:n_new, ~crossprod(VE$S[., ] * t(A)) + Sigma21) %>% simplify2array() + M_res_VE <- VE$M - X %*% self$model_par$B[, cond, drop = FALSE] + M <- tcrossprod(M_res_VE, A) + S <- map(1:n_new, ~crossprod(sqrt(VE$S2)[., ] * t(A)) + Sigma21) %>% simplify2array() ## mean latent positions in the parameter space EZ <- X %*% private$B[, !cond, drop = FALSE] + M + O[, !cond, drop = FALSE] @@ -664,13 +693,13 @@ PLNfit <- R6Class( #' @field model_par a list with the matrices of the model parameters: B (covariates), Sigma (covariance), Omega (precision matrix), plus some others depending on the variant) model_par = function() {list(B = private$B, Sigma = private$Sigma, Omega = private$Omega, Theta = t(private$B))}, #' @field var_par a list with the matrices of the variational parameters: M (means) and S2 (variances) - var_par = function() {list(M = private$M, S2 = private$S**2, S = private$S)}, + var_par = function() {list(M = private$M, S2 = private$S2, S = sqrt(private$S2))}, #' @field optim_par a list with parameters useful for monitoring the optimization - optim_par = function() {c(private$monitoring, backend = private$backend)}, + optim_par = function() {private$monitoring}, #' @field latent a matrix: values of the latent vector (Z in the model) latent = function() {private$Z}, #' @field latent_pos a matrix: values of the latent position vector (Z) without covariates effects or offset - latent_pos = function() {private$M}, + latent_pos = function() {private$M - private$X %*% private$B}, #' @field fitted a matrix: fitted values of the observations (A in the model) fitted = function() {private$A}, #' @field vcov_coef matrix of sandwich estimator of the variance-covariance of B (need fixed -ie known- covariance at the moment) @@ -678,9 +707,13 @@ PLNfit <- R6Class( #' @field vcov_model character: the model used for the residual covariance vcov_model = function() {"full"}, #' @field weights observational weights - weights = function() {as.numeric(attr(private$Ji, "weights"))}, + weights = function() {private$w}, #' @field loglik (weighted) variational lower bound of the loglikelihood - loglik = function() {sum(self$weights[self$weights > .Machine$double.eps] * private$Ji[self$weights > .Machine$double.eps]) }, + loglik = function() { + if (!is.numeric(private$Ji)) return(0) + w <- self$weights + sum(w[w > .Machine$double.eps] * private$Ji[w > .Machine$double.eps]) + }, #' @field loglik_vec element-wise variational lower bound of the loglikelihood loglik_vec = function() {private$Ji}, #' @field AIC variational lower bound of the AIC @@ -736,8 +769,9 @@ PLNfit_diagonal <- R6Class( #' @description Initialize a [`PLNfit`] model initialize = function(responses, covariates, offsets, weights, formula, control) { super$initialize(responses, covariates, offsets, weights, formula, control) - private$optimizer$main <- ifelse(control$backend == "nlopt", nlopt_optimize_diagonal, private$torch_optimize) - private$optimizer$vestep <- nlopt_optimize_vestep_diagonal + private$setup_optimizer(control$backend, + nlopt_optimize_diagonal, builtin_optimize_diagonal, + nlopt_optimize_vestep_diagonal, builtin_optimize_vestep_diagonal) } ), private = list( @@ -746,15 +780,16 @@ PLNfit_diagonal <- R6Class( ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% torch_elbo = function(data, params, index=torch_tensor(1:self$n)) { - S2 <- torch_square(params$S[index]) - Z <- data$O[index] + params$M[index] + torch_matmul(data$X[index], params$B) + S2 <- torch_exp(params$psi[index]) + Z <- data$O[index] + params$M[index] res <- .5 * sum(data$w[index]) * sum(torch_log(private$torch_sigma_diag(data, params, index))) + - sum(data$w[index,NULL] * (torch_exp(Z + .5 * S2) - data$Y[index] * Z - .5 * torch_log(S2))) + sum(data$w[index,NULL] * (torch_exp(Z + .5 * S2) - data$Y[index] * Z - .5 * params$psi[index])) res }, torch_sigma_diag = function(data, params, index=torch_tensor(1:self$n)) { - torch_sum(data$w[index,NULL] * (torch_square(params$M[index]) + torch_square(params$S[index])), 1) / sum(data$w[index]) + M_res <- params$M[index] - torch_mm(data$X[index], params$B) + torch_sum(data$w[index,NULL] * (torch_square(M_res) + torch_exp(params$psi[index])), 1) / sum(data$w[index]) }, torch_Sigma = function(data, params, index=torch_tensor(1:self$n)) { @@ -762,12 +797,13 @@ PLNfit_diagonal <- R6Class( }, torch_vloglik = function(data, params) { - S2 <- torch_square(params$S) + S2 <- torch_exp(params$psi) + M_res <- params$M - torch_mm(data$X, params$B) omega_diag <- torch_pow(private$torch_sigma_diag(data, params), -1) Ji <- .5 * self$p - rowSums(.logfactorial(as.matrix(data$Y))) + as.numeric( .5 * sum(torch_log(omega_diag)) + - torch_sum(data$Y * params$Z - params$A + .5 * torch_log(S2) - - .5 * (torch_square(params$M) + S2) * omega_diag[NULL,], dim = 2) + torch_sum(data$Y * params$Z - params$A + .5 * params$psi - + .5 * (torch_square(M_res) + S2) * omega_diag[NULL,], dim = 2) ) attr(Ji, "weights") <- as.numeric(data$w) Ji @@ -819,8 +855,9 @@ PLNfit_spherical <- R6Class( #' @description Initialize a [`PLNfit`] model initialize = function(responses, covariates, offsets, weights, formula, control) { super$initialize(responses, covariates, offsets, weights, formula, control) - private$optimizer$main <- ifelse(control$backend == "nlopt", nlopt_optimize_spherical, private$torch_optimize) - private$optimizer$vestep <- nlopt_optimize_vestep_spherical + private$setup_optimizer(control$backend, + nlopt_optimize_spherical, builtin_optimize_spherical, + nlopt_optimize_vestep_spherical, builtin_optimize_vestep_spherical) } ), private = list( @@ -829,15 +866,16 @@ PLNfit_spherical <- R6Class( ## PRIVATE TORCH METHODS FOR OPTIMIZATION ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% torch_elbo = function(data, params, index=torch_tensor(1:self$n)) { - S2 <- torch_square(params$S[index]) - Z <- data$O[index] + params$M[index] + torch_mm(data$X[index], params$B) + S2 <- torch_exp(params$psi[index]) + Z <- data$O[index] + params$M[index] res <- .5 * sum(data$w[index]) * self$p * torch_log(private$torch_sigma2(data, params, index)) - - sum(data$w[index,NULL] * (data$Y[index] * Z - torch_exp(Z + .5 * S2) + .5 * torch_log(S2))) + sum(data$w[index,NULL] * (data$Y[index] * Z - torch_exp(Z + .5 * S2) + .5 * params$psi[index])) res }, torch_sigma2 = function(data, params, index=torch_tensor(1:self$n)) { - sum(data$w[index, NULL] * (torch_square(params$M) + torch_square(params$S))) / (sum(data$w) * self$p) + M_res <- params$M[index] - torch_mm(data$X[index], params$B) + sum(data$w[index, NULL] * (torch_square(M_res) + torch_exp(params$psi[index]))) / (sum(data$w[index]) * self$p) }, torch_Sigma = function(data, params, index=torch_tensor(1:self$n)) { @@ -845,10 +883,12 @@ PLNfit_spherical <- R6Class( }, torch_vloglik = function(data, params) { - S2 <- torch_pow(params$S, 2) + S2 <- torch_exp(params$psi) + M_res <- params$M - torch_mm(data$X, params$B) sigma2 <- private$torch_sigma2(data, params) Ji <- .5 * self$p - rowSums(.logfactorial(as.matrix(data$Y))) + as.numeric( - torch_sum(data$Y * params$Z - params$A + .5 * torch_log(S2/sigma2) - .5 * (torch_pow(params$M, 2) + S2)/sigma2, dim = 2) + torch_sum(data$Y * params$Z - params$A + .5 * (params$psi - torch_log(sigma2)) - + .5 * (torch_pow(M_res, 2) + S2)/sigma2, dim = 2) ) attr(Ji, "weights") <- as.numeric(data$w) Ji @@ -906,14 +946,14 @@ PLNfit_fixedcov <- R6Class( #' @description Initialize a [`PLNfit`] model initialize = function(responses, covariates, offsets, weights, formula, control) { super$initialize(responses, covariates, offsets, weights, formula, control) - private$optimizer$main <- ifelse(control$backend == "nlopt", nlopt_optimize_fixed, private$torch_optimize) - ## ve step is the same as in the fully parameterized covariance + private$setup_optimizer(control$backend, nlopt_optimize_fixed, builtin_optimize_fixed, + nlopt_optimize_vestep_full, builtin_optimize_vestep_full) private$Omega <- control$Omega }, #' @description Call to the NLopt or TORCH optimizer and update of the relevant fields optimize = function(responses, covariates, offsets, weights, config) { args <- list(data = list(Y = responses, X = covariates, O = offsets, w = weights), - params = list(B = private$B, M = private$M, S = private$S, Omega = private$Omega), + params = list(B = private$B, M = private$M, S2 = private$S2, Omega = private$Omega), config = config) optim_out <- do.call(private$optimizer$main, args) do.call(self$update, optim_out) @@ -926,10 +966,11 @@ PLNfit_fixedcov <- R6Class( ## PRIVATE TORCH METHODS FOR OPTIMIZATION ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% torch_elbo = function(data, params, index=torch_tensor(1:self$n)) { - S2 <- torch_square(params$S[index]) - Z <- data$O[index] + params$M[index] + torch_mm(data$X[index], params$B) - res <- sum(data$w) * torch_trace(torch_mm(private$torch_Sigma(data, params, index), private$torch_Omega(data, params))) + - sum(data$w[index,NULL] * (torch_exp(Z + .5 * S2) - data$Y[index] * Z - .5 * torch_log(S2))) + S2 <- torch_exp(params$psi[index]) + Z <- data$O[index] + params$M[index] + # 0.5 factor: KL term is (1/2)*tr(Omega * Sigma_q); Sigma here is the empirical mean cov + res <- 0.5 * sum(data$w) * torch_trace(torch_mm(private$torch_Sigma(data, params, index), private$torch_Omega(data, params))) + + sum(data$w[index,NULL] * (torch_exp(Z + .5 * S2) - data$Y[index] * Z - .5 * params$psi[index])) res }, @@ -952,8 +993,7 @@ PLNfit_fixedcov <- R6Class( O = O[-i, , drop = FALSE], w = w[-i]) args <- list(data = data, - # params = list(B = private$B, Omega = private$Omega, M = private$M[-i, ], S = private$S[-i, ]), - params = do.call(compute_PLN_starting_point, data), + params = compute_PLN_starting_point(data$Y, data$X, data$O, data$w), config = config) optim_out <- do.call(private$optimizer$main, args) optim_out[c("B", "Omega")] @@ -981,107 +1021,3 @@ PLNfit_fixedcov <- R6Class( ) ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -## CLASS PLNfit_genetprior ############################ -# ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -# -# #' An R6 Class to represent a PLNfit in a standard, general framework, with residual covariance modelling -# #' motivatived by population genetics -# #' -# #' @inherit PLNfit -# #' @rdname PLNfit_genetprior -# #' @importFrom R6 R6Class -# #' -# #' @examples -# #' \dontrun{ -# #' data(trichoptera) -# #' trichoptera <- prepare_data(trichoptera$Abundance, trichoptera$Covariate) -# #' myPLN <- PLN(Abundance ~ 1, data = trichoptera) -# #' class(myPLN) -# #' print(myPLN) -# #' } -# PLNfit_genetprior <- R6Class( -# classname = "PLNfit_genetprior", -# inherit = PLNfit, -# ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -# ## PUBLIC MEMBERS ---- -# ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -# public = list( -# #' @description Call to the NLopt or TORCH optimizer and update of the relevant fields -# optimize = function(responses, covariates, offsets, weights, control) { -# args <- list(Y = responses, -# X = covariates, -# O = offsets, -# w = weights, -# params = list(B = private$B, M = private$M, S = private$S)) -# -# if (self$vcov_model == "genetic") { -# args$params$rho = 0.25 -# args$C <- control$corr_matrix -# } -# if (self$vcov_model == "fixed") { -# args$Omega <- private$Omega -# } -# -# if (control$backend == "nlopt") -# optim_out <- do.call(nlopt_optimizexxx, c(args, list(config = control$options_nlopt))) -# else { -# ## initialize torch with nlopt -# optim_out <- self$optimize_nlopt(c(args, list(config = control$options_nlopt))) -# args$params = list(B = optim_out$B, M = optim_out$M, S = optim_out$S) -# optim_out <- self$optimize_torch(c(args, list(config = control$options_torch))) -# } -# -# private$B <- optim_out$B -# private$M <- optim_out$M -# private$S <- optim_out$S -# private$Z <- optim_out$Z -# private$A <- optim_out$A -# private$monitoring <- list(iterations = optim_out$iterations, message = status_to_message(optim_out$status)) -# self$update_Sigma(args$w) -# self$update_loglik(args$w, args$Y) -# }, -# update_Sigma = function(weights) { -# w_bar <- sum(weights) -# private$Sigma <- switch(self$vcov_model, -# "spherical" = Matrix::Diagonal(self$p, sum(crossprod(weights, private$M^2 + private$S^2)) / (self$p * w_bar)), -# "diagonal" = Matrix::Diagonal(self$p, crossprod(weights, private$M^2 + private$S^2)/ w_bar), -# "full" = (crossprod(private$M, weights * private$M) + diag(as.numeric(crossprod(weights, private$S^2)))) / w_bar, -# "fixed" = solve(private$Omega) -# ) -# private$Omega <- switch(self$vcov_model, -# "fixed" = private$Omega, solve(private$Sigma) -# # "genetic = private$Omega, solve(private$Sigma) -# ) -# -# # if (self$vcov_model == "genetic") -# # private$psi <- list(sigma2 = optim_out$sigma2, rho = optim_out$rho) -# -# }, -# -# update_loglik = function(weights, Y) { -# KY <- .5 * self$p - rowSums(.logfactorial(Y)) -# S2 <- private$S**2 -# Ji <- as.numeric( -# .5 * determinant(private$Omega, logarithm = TRUE)$modulus + KY + -# rowSums(Y * private$Z - private$A + .5 * log(private$S^2) - -# .5 * ( (private$M %*% private$Omega) * private$M + sweep(private$S^2, 2, diag(private$Omega), '*'))) -# ) -# attr(Ji, "weights") <- weights -# private$Ji <- Ji -# }, -# ), -# active = list( -# #' @field nb_param number of parameters in the current PLN model -# nb_param = function() {as.integer(self$p * self$d + 2)}, -# #' @field vcov_model character: the model used for the residual covariance -# vcov_model = function() {"genetic"}, -# #' @field gen_par a list with two parameters, sigma2 and rho, only used with the genetic covariance model -# gen_par = function() {private$psi}, -# ), -# private = list( -# psi = NA, # parameters for genetic model of covariance -# ) -# ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -# ## END OF THE CLASS PLNfit_genetprior -# ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -# ) diff --git a/R/PLNmixture.R b/R/PLNmixture.R index 7ecbe61d..a2c66208 100644 --- a/R/PLNmixture.R +++ b/R/PLNmixture.R @@ -2,9 +2,7 @@ #' #' Fit the mixture variants of the Poisson lognormal with a variational algorithm. Use the (g)lm syntax for model specification (covariates, offsets). #' -#' @param formula an object of class "formula": a symbolic description of the model to be fitted. -#' @param data an optional data frame, list or environment (or object coercible by as.data.frame to a data frame) containing the variables in the model. If not found in data, the variables are taken from environment(formula), typically the environment from which lm is called. -#' @param subset an optional vector specifying a subset of observations to be used in the fitting process. +#' @inheritParams PLN formula data subset #' @param clusters a vector of integer containing the successive number of clusters (or components) to be considered #' @param control a list-like structure for controlling the optimization, with default generated by [PLNmixture_param()]. See the associated documentation #' for details. @@ -69,27 +67,24 @@ PLNmixture <- function(formula, data, subset, clusters = 1:5, control = PLNmixt #' #' Helper to define list of parameters to control the PLNmixture fit. All arguments have defaults. #' -#' @param backend optimization back used, either "nlopt" or "torch". Default is "nlopt" +#' @param backend optimization back used, either "builtin", "nlopt" or "torch". Default is "builtin". #' @param covariance character setting the model for the covariance matrices of the mixture components. Either "full", "diagonal" or "spherical". Default is "spherical". #' @param smoothing The smoothing to apply. Either, 'none', forward', 'backward' or 'both'. Default is 'both'. #' @param init_cl The initial clustering to apply. Either, 'kmeans', CAH' or a user defined clustering given as a list of clusterings, the size of which is equal to the number of clusters considered. Default is 'kmeans'. -#' @param config_optim a list for controlling the optimizer (either "nlopt" or "torch" backend). See details -#' @param config_post a list for controlling the post-treatments (optional bootstrap, jackknife, R2, etc.). -#' @param trace a integer for verbosity. -#' @param inception Set up the parameters initialization: by default, the model is initialized with a multivariate linear model applied on -#' log-transformed data, and with the same formula as the one provided by the user. However, the user can provide a PLNfit (typically obtained from a previous fit), -#' which sometimes speeds up the inference. +#' @inheritParams PLN_param trace config_optim config_post inception #' #' @return list of parameters configuring the fit. -#' @details See [PLN_param()] for a full description of the generic optimization parameters. PLNmixture_param() also has 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 xtol multiplied by the absolute value of the parameter. Default is 1e-6 -#' * "maxit_out" outer solver stops when the number of iteration exceeds maxit_out. Default is 50 -#' * "it_smoothing" number of the iterations of the smoothing procedure. Default is 1. +#' @inherit PLN_param details +#' @section Outer-loop optimization parameters: +#' `PLNmixture_param()` adds parameters controlling the EM and smoothing outer loops: +#' * "ftol_em" outer EM solver stops when the objective changes by less than ftol_em (relative). Default is 1e-3 +#' * "maxit_em" outer EM solver stops when the number of iterations exceeds maxit_em. Default is 50 +#' * "it_smooth" number of the iterations of the smoothing procedure. Default is 1. #' #' @seealso [PLN_param()] #' @export PLNmixture_param <- function( - backend = "nlopt" , + backend = c("builtin", "nlopt", "torch"), trace = 1 , covariance = "spherical", init_cl = "kmeans" , @@ -107,20 +102,8 @@ PLNmixture_param <- function( ## optimization config backend <- match.arg(backend) - stopifnot(backend %in% c("nlopt", "torch")) - if (backend == "nlopt") { - stopifnot(config_optim$algorithm %in% available_algorithms_nlopt) - config_opt <- config_default_nlopt - } - if (backend == "torch") { - stopifnot(config_optim$algorithm %in% available_algorithms_torch) - config_opt <- config_default_torch - } - config_opt$ftol_out <- 1e-3 - config_opt$maxit_out <- 50 - config_opt$it_smooth <- 1 - config_opt[names(config_optim)] <- config_optim - config_opt$trace <- trace + config_opt <- make_config_optim(backend, config_optim, trace, + extra = list(ftol_em = 1e-3, maxit_em = 50, it_smooth = 1)) structure(list( backend = backend , diff --git a/R/PLNmixturefamily-class.R b/R/PLNmixturefamily-class.R index 598bca88..bf43dec6 100644 --- a/R/PLNmixturefamily-class.R +++ b/R/PLNmixturefamily-class.R @@ -31,7 +31,7 @@ PLNmixturefamily <- ## Control options control$trace <- FALSE config_fast <- control$config_optim - config_fast$maxit_out <- 2 + config_fast$maxit_em <- 2 ## Effective number of clusters (remove empty classes) and current clustering with clusters numbered in 1:k (with no gaps) cl <- model$memberships @@ -98,7 +98,7 @@ PLNmixturefamily <- ## Control options control$trace <- FALSE config_fast <- control$config_optim - config_fast$maxit_out <- 2 + config_fast$maxit_em <- 2 ## number of clusters if (is.null(k)) k <- length(model$components) @@ -171,7 +171,7 @@ PLNmixturefamily <- myPLN <- PLNfit$new(responses, covariates, offsets, rep(1, nrow(responses)), formula, control) myPLN$optimize(responses, covariates, offsets, rep(1, nrow(responses)), control$config_optim) Sbar <- rowSums(myPLN$var_par$S2) - D <- sqrt(as.matrix(dist(myPLN$var_par$M)^2) + outer(Sbar,rep(1,myPLN$n)) + outer(rep(1, myPLN$n), Sbar)) + D <- sqrt(as.matrix(dist(myPLN$latent_pos)^2) + outer(Sbar,rep(1,myPLN$n)) + outer(rep(1, myPLN$n), Sbar)) clusterings <-switch(control$init_cl, "kmeans" = lapply(clusters, function(k) kmeans(D, centers = k, nstart = 30)$cl), "ward.D2" = D %>% as.dist() %>% hclust(method = "ward.D2") %>% cutree(clusters) %>% as.data.frame() %>% as.list() diff --git a/R/PLNmixturefit-class.R b/R/PLNmixturefit-class.R index ca6c2149..d4b5b545 100644 --- a/R/PLNmixturefit-class.R +++ b/R/PLNmixturefit-class.R @@ -45,10 +45,7 @@ PLNmixturefit <- M <- private$comp %>% map("var_par") %>% map("M") S2 <- private$comp %>% map("var_par") %>% map("S2") - mu <- private$comp %>% map(coef) %>% map(~outer(rep(1, self$n), as.numeric(.x))) - - Ak_tilde <- list(M, S2, mu) %>% - purrr::pmap(function(M_k, S2_k, mu_k) exp(O + mu_k + M_k + .5 * S2_k)) + Ak_tilde <- map2(M, S2, function(M_k, S2_k) exp(O + M_k + .5 * S2_k)) Tk <- asplit(private$tau, 2) @@ -105,8 +102,8 @@ PLNmixturefit <- ## =========================================== ## INITIALISATION cond <- FALSE; iter <- 1 - objective <- numeric(config$maxit_out); objective[iter] <- Inf - convergence <- numeric(config$maxit_out); convergence[iter] <- NA + objective <- numeric(config$maxit_em); objective[iter] <- Inf + convergence <- numeric(config$maxit_em); convergence[iter] <- NA ## =========================================== ## OPTIMISATION while (!cond) { @@ -138,7 +135,7 @@ PLNmixturefit <- ## Assess convergence objective[iter] <- -self$loglik convergence[iter] <- abs(objective[iter-1] - objective[iter]) /abs(objective[iter]) - if ((convergence[iter] < config$ftol_out) | (iter >= config$maxit_out)) cond <- TRUE + if ((convergence[iter] < config$ftol_em) | (iter >= config$maxit_em)) cond <- TRUE } @@ -189,8 +186,8 @@ PLNmixturefit <- ## =========================================== ## INITIALISATION cond <- FALSE; iter <- 1 - objective <- numeric(control$config_optim$maxit_out); objective[iter] <- Inf - convergence <- numeric(control$config_optim$maxit_out); convergence[iter] <- NA + objective <- numeric(control$config_optim$maxit_em); objective[iter] <- Inf + convergence <- numeric(control$config_optim$maxit_em); convergence[iter] <- NA ## =========================================== ## OPTIMISATION @@ -221,7 +218,7 @@ PLNmixturefit <- rowSums(tau * J_ik) - rowSums(.xlogx(tau)) + tau %*% log(colMeans(tau)) objective[iter] <- -sum(J_ik) convergence[iter] <- abs(objective[iter-1] - objective[iter]) /abs(objective[iter]) - if ((convergence[iter] < control$config_optim$ftol_out) | (iter >= control$config_optim$maxit_out)) cond <- TRUE + if ((convergence[iter] < control$config_optim$ftol_em) | (iter >= control$config_optim$maxit_em)) cond <- TRUE } @@ -231,7 +228,7 @@ PLNmixturefit <- "position" = { latent_pos <- array(0, dim = c(nrow(args$X), self$k, self$p)) for (k in seq.int(self$k)) { - latent_pos[ , k, ] <- ve_step[[k]]$M + rep(1, nrow(args$X)) %o% self$group_means[, k] + latent_pos[ , k, ] <- ve_step[[k]]$M } res <- apply(latent_pos * tau %o% rep(1, self$p), c(1, 3), sum) rownames(res) <- rownames(newdata) @@ -250,8 +247,7 @@ PLNmixturefit <- plot_clustering_data = function(main = "Expected counts reorder by clustering", plot = TRUE, log_scale = TRUE) { M <- private$mix_up('var_par$M') S2 <- private$mix_up('var_par$S2') - mu <- self$posteriorProb %*% t(self$group_means) - A <- exp(mu + M + .5 * S2) + A <- exp(M + .5 * S2) p <- plot_matrix(A, 'samples', 'variables', self$memberships, log_scale) if (plot) print(p) invisible(p) @@ -263,7 +259,7 @@ PLNmixturefit <- #' @param main character. A title for the plot. An hopefully appropriate title will be used by default. #' @return a [`ggplot2::ggplot`] graphic plot_clustering_pca = function(main = "Clustering labels in Individual Factor Map", plot = TRUE) { - mu <- self$posteriorProb %*% t(self$group_means) + private$mix_up('var_par$M') + mu <- private$mix_up('var_par$M') svdM <- svd(scale(mu, TRUE, FALSE), nv = 2) .scores <- data.frame(t(t(svdM$u[, 1:2]) * svdM$d[1:2])) colnames(.scores) <- paste("a",1:2,sep = "") @@ -328,7 +324,7 @@ PLNmixturefit <- #' @field latent a matrix: values of the latent vector (Z in the model) latent = function() {private$mix_up('latent')}, #' @field latent_pos a matrix: values of the latent position vector (Z) without covariates effects or offset - latent_pos = function() {private$mix_up('var_par$M') + self$posteriorProb %*% t(self$group_means)}, + latent_pos = function() {private$mix_up('latent_pos')}, #' @field posteriorProb matrix ofposterior probability for cluster belonging posteriorProb = function(value) {if (missing(value)) return(private$tau) else private$tau <- value}, #' @field memberships vector for cluster index diff --git a/R/PLNnetwork.R b/R/PLNnetwork.R index 372357be..020f41dc 100644 --- a/R/PLNnetwork.R +++ b/R/PLNnetwork.R @@ -4,10 +4,7 @@ #' using a variational algorithm. Iterate over a range of logarithmically spaced sparsity parameter values. #' Use the (g)lm syntax to specify the model (including covariates and offsets). #' -#' @param formula an object of class "formula": a symbolic description of the model to be fitted. -#' @param data an optional data frame, list or environment (or object coercible by as.data.frame to a data frame) containing the variables in the model. If not found in data, the variables are taken from environment(formula), typically the environment from which lm is called. -#' @param subset an optional vector specifying a subset of observations to be used in the fitting process. -#' @param weights an optional vector of observation weights to be used in the fitting process. +#' @inheritParams PLN formula data subset weights #' @param penalties an optional vector of positive real number controlling the level of sparsity of the underlying network. if NULL (the default), will be set internally. See `PLNnetwork_param()` for additional tuning of the penalty. #' @param control a list-like structure for controlling the optimization, with default generated by [PLNnetwork_param()]. See the corresponding documentation for details; #' @@ -52,29 +49,26 @@ PLNnetwork <- function(formula, data, subset, weights, penalties = NULL, control #' #' Helper to define list of parameters to control the PLN fit. All arguments have defaults. #' -#' @param backend optimization back used, either "nlopt" or "torch". Default is "nlopt" +#' @param backend optimization back used, either "nlopt", "builtin" or "torch". Default is "nlopt". +#' Note: the "nlopt" backend converges better in PLNnetwork's outer glasso alternation than "builtin". #' @param inception_cov Covariance structure used for the inception model used to initialize the PLNfamily. Defaults to "full" and can be constrained to "diagonal" and "spherical". -#' @param config_optim a list for controlling the optimizer (either "nlopt" or "torch" backend). See details -#' @param config_post a list for controlling the post-treatment (optional bootstrap, jackknife, R2, etc). -#' @param trace a integer for verbosity. #' @param n_penalties an integer that specifies the number of values for the penalty grid when internally generated. Ignored when penalties is non `NULL` #' @param min_ratio the penalty grid ranges from the minimal value that produces a sparse to this value multiplied by `min_ratio`. Default is 0.1. #' @param penalize_diagonal boolean: should the diagonal terms be penalized in the graphical-Lasso? Default is \code{TRUE} #' @param penalty_weights either a single or a list of p x p matrix of weights (default: all weights equal to 1) to adapt the amount of shrinkage to each pairs of node. Must be symmetric with positive values. -#' @param inception Set up the parameters initialization: by default, the model is initialized with a multivariate linear model applied on -#' log-transformed data, and with the same formula as the one provided by the user. However, the user can provide a PLNfit (typically obtained from a previous fit), -#' which sometimes speeds up the inference. +#' @inheritParams PLN_param trace config_optim config_post inception #' #' @return list of parameters configuring the fit. #' @inherit PLN_param details -#' @details See [PLN_param()] for a full description of the generic optimization parameters. PLNnetwork_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 multiplied by the absolute value of the parameter. Default is 1e-6 -#' * "maxit_out" outer solver stops when the number of iteration exceeds maxit_out. Default is 50 +#' @section Outer-loop optimization parameters: +#' `PLNnetwork_param()` adds two parameters controlling the alternating GLASSO/VEM loop: +#' * "ftol_em" outer alternating solver stops when the objective changes by less than ftol_em (relative). Default is 1e-5 +#' * "maxit_em" outer alternating solver stops when the number of iterations exceeds maxit_em. Default is 20 #' #' @seealso [PLN_param()] #' @export PLNnetwork_param <- function( - backend = c("nlopt", "torch"), + backend = c("nlopt", "builtin", "torch"), inception_cov = c("full", "spherical", "diagonal"), trace = 1 , n_penalties = 30 , @@ -95,20 +89,9 @@ PLNnetwork_param <- function( ## optimization config backend <- match.arg(backend) - stopifnot(backend %in% c("nlopt", "torch")) - if (backend == "nlopt") { - stopifnot(config_optim$algorithm %in% available_algorithms_nlopt) - config_opt <- config_default_nlopt - } - if (backend == "torch") { - stopifnot(config_optim$algorithm %in% available_algorithms_torch) - config_opt <- config_default_torch - } inception_cov <- match.arg(inception_cov) - config_opt$trace <- trace - config_opt$ftol_out <- 1e-5 - config_opt$maxit_out <- 20 - config_opt[names(config_optim)] <- config_optim + config_opt <- make_config_optim(backend, config_optim, trace, + extra = list(ftol_em = 1e-5, maxit_em = 20)) structure(list( backend = backend , @@ -120,7 +103,6 @@ PLNnetwork_param <- function( penalty_weights = penalty_weights , jackknife = FALSE , bootstrap = 0 , - variance = TRUE , config_post = config_pst , config_optim = config_opt , inception = inception ), class = "PLNmodels_param") diff --git a/R/PLNnetworkfamily-class.R b/R/PLNnetworkfamily-class.R index 7c9ecca5..85ae75a9 100644 --- a/R/PLNnetworkfamily-class.R +++ b/R/PLNnetworkfamily-class.R @@ -97,9 +97,9 @@ Networkfamily <- R6Class( ## Save time by starting the optimization of model m + 1 with optimal parameters of model m if (m < length(self$penalties)) self$models[[m + 1]]$update( - B = self$models[[m]]$model_par$B, - M = self$models[[m]]$var_par$M, - S = self$models[[m]]$var_par$S + B = self$models[[m]]$model_par$B, + M = self$models[[m]]$var_par$M, + S2 = self$models[[m]]$var_par$S2 ) if (config$trace > 1) { @@ -177,7 +177,7 @@ Networkfamily <- R6Class( plot = function(criteria = c("loglik", "pen_loglik", "BIC", "EBIC"), reverse = FALSE, log.x = TRUE) { vlines <- sapply(intersect(criteria, c("BIC", "EBIC")) , function(crit) self$getBestModel(crit)$penalty) p <- super$plot(criteria, reverse) + xlab("penalty") + geom_vline(xintercept = vlines, linetype = "dashed", alpha = 0.25) - if (log.x) p <- p + ggplot2::coord_trans(x = "log10") + if (log.x) p <- p + ggplot2::coord_transform(x = "log10") p }, @@ -371,7 +371,7 @@ PLNnetworkfamily <- R6Class( inception_ <- self$getModel(self$penalties[1]) inception_$update( M = inception_$var_par$M[subsample, ], - S = inception_$var_par$S[subsample, ] + S2 = inception_$var_par$S2[subsample, ] ) ## force some control parameters @@ -507,7 +507,7 @@ ZIPLNnetworkfamily <- R6Class( inception_$update( R = inception_$var_par$R[subsample, ], M = inception_$var_par$M[subsample, ], - S = inception_$var_par$S[subsample, ] + S2 = inception_$var_par$S2[subsample, ] ) ## force some control parameters diff --git a/R/PLNnetworkfit-class.R b/R/PLNnetworkfit-class.R index 87538587..b9eb733f 100644 --- a/R/PLNnetworkfit-class.R +++ b/R/PLNnetworkfit-class.R @@ -53,14 +53,15 @@ PLNnetworkfit <- R6Class( #' @param config a list for controlling the optimization optimize = function(data, config) { cond <- FALSE; iter <- 0 - objective <- numeric(config$maxit_out) - convergence <- numeric(config$maxit_out) + objective <- numeric(config$maxit_em) + convergence <- numeric(config$maxit_em) ## start from the standard PLN at initialization objective.old <- -self$loglik args <- list(data = list(Y = data$Y, X = data$X, O = data$O, w = data$w), - params = list(B = private$B, M = private$M, S = private$S), + params = list(B = private$B, M = private$M, S2 = private$S2), config = config) - private$Sigma <- crossprod(private$M)/self$n + diag(colMeans(private$S**2), self$p, self$p) + M_res_init <- private$M - private$X %*% private$B + private$Sigma <- crossprod(M_res_init)/self$n + diag(colMeans(private$S2), self$p, self$p) while (!cond) { iter <- iter + 1 if (config$trace > 1) cat("", iter) @@ -76,10 +77,10 @@ PLNnetworkfit <- R6Class( ## Check convergence objective[iter] <- -self$loglik # + self$penalty * sum(abs(private$Omega)) convergence[iter] <- abs(objective[iter] - objective.old)/abs(objective[iter]) - if ((convergence[iter] < config$ftol_out) | (iter >= config$maxit_out)) cond <- TRUE + if ((convergence[iter] < config$ftol_em) | (iter >= config$maxit_em)) cond <- TRUE ## Prepare next iterate - args$params <- list(B = private$B, M = private$M, S = private$S) + args$params <- list(B = private$B, M = private$M, S2 = private$S2) objective.old <- objective[iter] } diff --git a/R/RcppExports.R b/R/RcppExports.R index 6213a68b..655492b7 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -1,8 +1,40 @@ # Generated by using Rcpp::compileAttributes() -> do not edit by hand # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 -cpp_test_nlopt <- function() { - .Call('_PLNmodels_cpp_test_nlopt', PACKAGE = 'PLNmodels') +builtin_optimize_full <- function(data, params, config) { + .Call('_PLNmodels_builtin_optimize_full', PACKAGE = 'PLNmodels', data, params, config) +} + +builtin_optimize_vestep_full <- function(data, params, B, Omega, config) { + .Call('_PLNmodels_builtin_optimize_vestep_full', PACKAGE = 'PLNmodels', data, params, B, Omega, config) +} + +builtin_optimize_diagonal <- function(data, params, config) { + .Call('_PLNmodels_builtin_optimize_diagonal', PACKAGE = 'PLNmodels', data, params, config) +} + +builtin_optimize_vestep_diagonal <- function(data, params, B, Omega, config) { + .Call('_PLNmodels_builtin_optimize_vestep_diagonal', PACKAGE = 'PLNmodels', data, params, B, Omega, config) +} + +builtin_optimize_spherical <- function(data, params, config) { + .Call('_PLNmodels_builtin_optimize_spherical', PACKAGE = 'PLNmodels', data, params, config) +} + +builtin_optimize_vestep_spherical <- function(data, params, B, Omega, config) { + .Call('_PLNmodels_builtin_optimize_vestep_spherical', PACKAGE = 'PLNmodels', data, params, B, Omega, config) +} + +builtin_optimize_fixed <- function(data, params, config) { + .Call('_PLNmodels_builtin_optimize_fixed', PACKAGE = 'PLNmodels', data, params, config) +} + +builtin_optimize_rank <- function(data, params, config) { + .Call('_PLNmodels_builtin_optimize_rank', PACKAGE = 'PLNmodels', data, params, config) +} + +builtin_optimize_vestep_rank <- function(data, params, B, C, config) { + .Call('_PLNmodels_builtin_optimize_vestep_rank', PACKAGE = 'PLNmodels', data, params, B, C, config) } nlopt_optimize_diagonal <- function(data, params, config) { @@ -17,16 +49,12 @@ nlopt_optimize_fixed <- function(data, params, config) { .Call('_PLNmodels_nlopt_optimize_fixed', PACKAGE = 'PLNmodels', data, params, config) } -nlopt_optimize <- function(data, params, config) { - .Call('_PLNmodels_nlopt_optimize', PACKAGE = 'PLNmodels', data, params, config) -} - -nlopt_optimize_vestep <- function(data, params, B, Omega, config) { - .Call('_PLNmodels_nlopt_optimize_vestep', PACKAGE = 'PLNmodels', data, params, B, Omega, config) +nlopt_optimize_full <- function(data, params, config) { + .Call('_PLNmodels_nlopt_optimize_full', PACKAGE = 'PLNmodels', data, params, config) } -nlopt_optimize_genetic_modeling <- function(init_parameters, Y, X, O, w, C, configuration) { - .Call('_PLNmodels_nlopt_optimize_genetic_modeling', PACKAGE = 'PLNmodels', init_parameters, Y, X, O, w, C, configuration) +nlopt_optimize_vestep_full <- function(data, params, B, Omega, config) { + .Call('_PLNmodels_nlopt_optimize_vestep_full', PACKAGE = 'PLNmodels', data, params, B, Omega, config) } nlopt_optimize_rank <- function(data, params, config) { @@ -45,20 +73,28 @@ nlopt_optimize_vestep_spherical <- function(data, params, B, Omega, config) { .Call('_PLNmodels_nlopt_optimize_vestep_spherical', PACKAGE = 'PLNmodels', data, params, B, Omega, config) } -zipln_vloglik <- function(Y, X, O, Pi, Omega, B, R, M, S) { - .Call('_PLNmodels_zipln_vloglik', PACKAGE = 'PLNmodels', Y, X, O, Pi, Omega, B, R, M, S) +cpp_test_nlopt <- function() { + .Call('_PLNmodels_cpp_test_nlopt', PACKAGE = 'PLNmodels') } -optim_zipln_Omega_full <- function(M, X, B, S) { - .Call('_PLNmodels_optim_zipln_Omega_full', PACKAGE = 'PLNmodels', M, X, B, S) +nlopt_optimize_genetic_modeling <- function(init_parameters, Y, X, O, w, C, configuration) { + .Call('_PLNmodels_nlopt_optimize_genetic_modeling', PACKAGE = 'PLNmodels', init_parameters, Y, X, O, w, C, configuration) } -optim_zipln_Omega_spherical <- function(M, X, B, S) { - .Call('_PLNmodels_optim_zipln_Omega_spherical', PACKAGE = 'PLNmodels', M, X, B, S) +zipln_vloglik <- function(Y, X, O, Pi, Omega, B, R, M, S2) { + .Call('_PLNmodels_zipln_vloglik', PACKAGE = 'PLNmodels', Y, X, O, Pi, Omega, B, R, M, S2) } -optim_zipln_Omega_diagonal <- function(M, X, B, S) { - .Call('_PLNmodels_optim_zipln_Omega_diagonal', PACKAGE = 'PLNmodels', M, X, B, S) +optim_zipln_Omega_full <- function(M, X, B, S2) { + .Call('_PLNmodels_optim_zipln_Omega_full', PACKAGE = 'PLNmodels', M, X, B, S2) +} + +optim_zipln_Omega_spherical <- function(M, X, B, S2) { + .Call('_PLNmodels_optim_zipln_Omega_spherical', PACKAGE = 'PLNmodels', M, X, B, S2) +} + +optim_zipln_Omega_diagonal <- function(M, X, B, S2) { + .Call('_PLNmodels_optim_zipln_Omega_diagonal', PACKAGE = 'PLNmodels', M, X, B, S2) } optim_zipln_B_dense <- function(M, X) { @@ -69,20 +105,28 @@ optim_zipln_zipar_covar <- function(R, init_B0, X0, configuration) { .Call('_PLNmodels_optim_zipln_zipar_covar', PACKAGE = 'PLNmodels', R, init_B0, X0, configuration) } -optim_zipln_R_var <- function(Y, X, O, M, S, Pi, B) { - .Call('_PLNmodels_optim_zipln_R_var', PACKAGE = 'PLNmodels', Y, X, O, M, S, Pi, B) +optim_zipln_R_var <- function(Y, X, O, M, S2, Pi, B) { + .Call('_PLNmodels_optim_zipln_R_var', PACKAGE = 'PLNmodels', Y, X, O, M, S2, Pi, B) +} + +optim_zipln_R_exact <- function(Y, X, O, M, S2, Pi, B) { + .Call('_PLNmodels_optim_zipln_R_exact', PACKAGE = 'PLNmodels', Y, X, O, M, S2, Pi, B) +} + +optim_zipln_M <- function(init_M, Y, X, O, R, S2, B, Omega, configuration) { + .Call('_PLNmodels_optim_zipln_M', PACKAGE = 'PLNmodels', init_M, Y, X, O, R, S2, B, Omega, configuration) } -optim_zipln_R_exact <- function(Y, X, O, M, S, Pi, B) { - .Call('_PLNmodels_optim_zipln_R_exact', PACKAGE = 'PLNmodels', Y, X, O, M, S, Pi, B) +optim_zipln_psi <- function(init_S2, O, M, R, B, diag_Omega, configuration) { + .Call('_PLNmodels_optim_zipln_psi', PACKAGE = 'PLNmodels', init_S2, O, M, R, B, diag_Omega, configuration) } -optim_zipln_M <- function(init_M, Y, X, O, R, S, B, Omega, configuration) { - .Call('_PLNmodels_optim_zipln_M', PACKAGE = 'PLNmodels', init_M, Y, X, O, R, S, B, Omega, configuration) +ve_step_zipln_nlopt <- function(init_M, init_S2, Y, X, O, Pi, B, Omega, configuration) { + .Call('_PLNmodels_ve_step_zipln_nlopt', PACKAGE = 'PLNmodels', init_M, init_S2, Y, X, O, Pi, B, Omega, configuration) } -optim_zipln_S <- function(init_S, O, M, R, B, diag_Omega, configuration) { - .Call('_PLNmodels_optim_zipln_S', PACKAGE = 'PLNmodels', init_S, O, M, R, B, diag_Omega, configuration) +ve_step_zipln_newton <- function(init_M, init_S2, Y, X, O, Pi, B, Omega, maxiter, ftol_rel) { + .Call('_PLNmodels_ve_step_zipln_newton', PACKAGE = 'PLNmodels', init_M, init_S2, Y, X, O, Pi, B, Omega, maxiter, ftol_rel) } cpp_test_packing <- function() { diff --git a/R/ZIPLN.R b/R/ZIPLN.R index 1e50b646..c2b28688 100644 --- a/R/ZIPLN.R +++ b/R/ZIPLN.R @@ -64,23 +64,23 @@ ZIPLN <- function(formula, data, subset, zi = c("single", "row", "col"), control #' Control of a ZIPLN fit #' -#' Helper to define list of parameters to control the PLN fit. All arguments have defaults. +#' Helper to define list of parameters to control the ZIPLN fit. All arguments have defaults. #' #' @inheritParams PLN_param #' @inheritParams PLNnetwork_param +#' @param backend optimization backend, either `"builtin"` (default, built-in Newton optimizer for the joint VE step) or `"nlopt"` (NLOPT-based CCSAQ). #' @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()] and [PLNnetwork_param()] for a full description of the generic optimization parameters. Like [PLNnetwork_param()], ZIPLN_param() has two parameters controlling the optimization due the inner-outer loop structure of the optimizer: +#' @details See [PLN_param()] for a description of the generic `config_optim` entries (`ftol_rel`, `xtol_rel`, etc.). Like [PLNnetwork_param()], ZIPLN_param() has two parameters controlling the outer EM loop: #' * "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-6 -#' * "maxit_out" outer solver stops when the number of iteration exceeds `maxit_out`. Default is 100 +#' * "maxit_out" outer solver stops when the number of iteration exceeds `maxit_out`. Default is 200 for "builtin", 100 for "nlopt" #' and one additional parameter controlling the form of the variational approximation of the zero inflation: -#' * "approx_ZI" either uses an exact or approximated conditional distribution for the zero inflation. Default is FALSE #' #' @export ZIPLN_param <- function( - backend = c("nlopt"), + backend = c("builtin", "nlopt"), trace = 1, covariance = c("full", "diagonal", "spherical", "fixed", "sparse"), Omega = NULL, @@ -104,15 +104,13 @@ ZIPLN_param <- function( 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$approx_ZI <- TRUE - config_opt[names(config_optim)] <- config_optim + ## optimization config — mirrors PLN_param: "builtin" = Newton, "nlopt" = CCSAQ/etc. + backend <- match.arg(backend) + config_opt <- make_config_optim(backend, config_optim, trace, + extra = list( + ftol_out = 1e-6, + maxit_out = if (backend == "builtin") 200L else 100L + )) structure(list( backend = backend , diff --git a/R/ZIPLNfit-S3methods.R b/R/ZIPLNfit-S3methods.R index d6aabb84..f7c0da78 100644 --- a/R/ZIPLNfit-S3methods.R +++ b/R/ZIPLNfit-S3methods.R @@ -95,6 +95,88 @@ sigma.ZIPLNfit <- function(object, ...) { object$model_par$Sigma } +#' Extract log-likelihood of a fitted ZIPLN model +#' +#' @name logLik.ZIPLNfit +#' @description Returns the variational lower bound of the log-likelihood as a `"logLik"` object, +#' compatible with [stats::AIC()] and [stats::BIC()]. +#' +#' @param object an R6 object with class [`ZIPLNfit`] +#' @param ... additional parameters for S3 compatibility. Not used +#' @return An object of class `"logLik"`. The numeric value is the variational ELBO. +#' Attributes `df` and `nobs` hold the number of parameters and observations. +#' +#' @importFrom stats logLik +#' @export +#' @examples +#' data(trichoptera) +#' trichoptera <- prepare_data(trichoptera$Abundance, trichoptera$Covariate) +#' model <- ZIPLN(Abundance ~ 1, data = trichoptera) +#' logLik(model) +logLik.ZIPLNfit <- function(object, ...) { + stopifnot(isZIPLNfit(object)) + structure(object$loglik, class = "logLik", df = object$nb_param, nobs = object$n) +} + +#' Akaike Information Criterion for a fitted ZIPLN model +#' +#' @name AIC.ZIPLNfit +#' @description Computes the variational AIC as `loglik - nb_param` (larger is better). +#' This follows the maximization convention used throughout PLNmodels. +#' +#' @param object an R6 object with class [`ZIPLNfit`] +#' @param k not used, present for S3 compatibility. +#' @param ... additional parameters for S3 compatibility. Not used +#' @return A scalar: the variational AIC (larger is better). +#' +#' @importFrom stats AIC +#' @export +#' @examples +#' data(trichoptera) +#' trichoptera <- prepare_data(trichoptera$Abundance, trichoptera$Covariate) +#' model <- ZIPLN(Abundance ~ 1, data = trichoptera) +#' AIC(model) +AIC.ZIPLNfit <- function(object, ..., k = 2) { + stopifnot(isZIPLNfit(object)) + object$AIC +} + +#' Bayesian Information Criterion for a fitted ZIPLN model +#' +#' @name BIC.ZIPLNfit +#' @description Computes the variational BIC as `loglik - 0.5 * log(n) * nb_param` (larger is better). +#' This follows the maximization convention used throughout PLNmodels. +#' +#' @param object an R6 object with class [`ZIPLNfit`] +#' @param ... additional parameters for S3 compatibility. Not used +#' @return A scalar: the variational BIC (larger is better). +#' +#' @importFrom stats BIC +#' @export +#' @examples +#' data(trichoptera) +#' trichoptera <- prepare_data(trichoptera$Abundance, trichoptera$Covariate) +#' model <- ZIPLN(Abundance ~ 1, data = trichoptera) +#' BIC(model) +BIC.ZIPLNfit <- function(object, ...) { + stopifnot(isZIPLNfit(object)) + object$BIC +} + +#' @rdname ICL +#' @description `ICL.ZIPLNfit`: ICL for a fitted [`ZIPLNfit`]. +#' @param object an R6 object with class [`ZIPLNfit`] +#' @export +#' @examples +#' data(trichoptera) +#' trichoptera <- prepare_data(trichoptera$Abundance, trichoptera$Covariate) +#' model <- ZIPLN(Abundance ~ 1, data = trichoptera) +#' ICL(model) +ICL.ZIPLNfit <- function(object, ...) { + stopifnot(isZIPLNfit(object)) + object$ICL +} + ## ========================================================================================= ## ## PUBLIC S3 METHODS FOR ZIPLNfit_sparse diff --git a/R/ZIPLNfit-class.R b/R/ZIPLNfit-class.R index 8b828a5f..9a87e529 100644 --- a/R/ZIPLNfit-class.R +++ b/R/ZIPLNfit-class.R @@ -44,25 +44,25 @@ ZIPLNfit <- R6Class( #' @param Omega precision matrix of the latent variables #' @param Sigma covariance matrix of the latent variables #' @param M matrix of mean vectors for the variational approximation - #' @param S matrix of standard deviation parameters for the variational approximation + #' @param S2 matrix of variance parameters for the variational approximation #' @param R matrix of probabilities for the variational approximation #' @param Ji vector of variational lower bounds of the log-likelihoods (one value per sample) #' @param Z matrix of latent vectors (includes covariates and offset effects) #' @param A matrix of fitted values #' @param monitoring a list with optimization monitoring quantities #' @return Update the current [`ZIPLNfit`] object - update = function(B=NA, B0=NA, Pi=NA, Omega=NA, Sigma=NA, M=NA, S=NA, R=NA, Ji=NA, Z=NA, A=NA, monitoring=NA) { - if (!anyNA(B)) private$B <- B - if (!anyNA(B0)) private$B0 <- B0 - if (!anyNA(Pi)) private$Pi <- Pi - if (!anyNA(Omega)) private$Omega <- Omega - if (!anyNA(Sigma)) private$Sigma <- Sigma - if (!anyNA(M)) private$M <- M - if (!anyNA(S)) private$S <- S - if (!anyNA(R)) private$R <- R - if (!anyNA(Z)) private$Z <- Z - if (!anyNA(A)) private$A <- A - if (!anyNA(Ji)) private$Ji <- Ji + update = function(B=NA, B0=NA, Pi=NA, Omega=NA, Sigma=NA, M=NA, S2=NA, R=NA, Ji=NA, Z=NA, A=NA, monitoring=NA) { + if (!anyNA(B)) private$B <- B + if (!anyNA(B0)) private$B0 <- B0 + if (!anyNA(Pi)) private$Pi <- Pi + if (!anyNA(Omega)) private$Omega <- Omega + if (!anyNA(Sigma)) private$Sigma <- Sigma + if (!anyNA(M)) private$M <- M + if (!identical(S2, NA)) private$S2 <- S2 + if (!anyNA(R)) private$R <- R + if (!anyNA(Z)) private$Z <- Z + if (!anyNA(A)) private$A <- A + if (!anyNA(Ji)) private$Ji <- Ji if (!anyNA(monitoring)) private$monitoring <- monitoring }, @@ -84,7 +84,7 @@ ZIPLNfit <- R6Class( if (isZIPLNfit(control$inception)) { private$R <- control$inception$var_par$R private$M <- control$inception$var_par$M - private$S <- control$inception$var_par$S + private$S2 <- control$inception$var_par$S2 private$B <- control$inception$model_par$B private$B0 <- control$inception$model_par$B0 } else { @@ -106,7 +106,6 @@ ZIPLNfit <- R6Class( B[,j] <- replace_na(coef(zip_out, "count"), 0) R[, j] <- replace_na(predict(zip_out, type = "zero"), sum(y == 0) / n) M[,j] <- pmin(replace_na(residuals(zip_out), 0) + data$X %*% coef(zip_out, "count"), 10) - if (max(M[,j]) > 10) browser() } else { p_out <- glm(y ~ 0 + data$X, family = 'poisson', offset = data$O[, j]) B0[,j] <- rep(-10, d0) @@ -122,7 +121,7 @@ ZIPLNfit <- R6Class( ## Initialization of the PLN component private$B <- B private$M <- M - private$S <- matrix(.1, n, p) + private$S2 <- matrix(.01, n, p) } private$Pi <- switch(control$ziparam, "single" = matrix( mean(private$R), n, p) , @@ -138,10 +137,23 @@ ZIPLNfit <- R6Class( "single" = function(R, ...) list(Pi = matrix( mean(R), nrow(R), p) , B0 = matrix(NA, d0, p)), "row" = function(R, ...) list(Pi = matrix(rowMeans(R), nrow(R), p) , B0 = matrix(NA, d0, p)), "col" = function(R, ...) list(Pi = matrix(colMeans(R), nrow(R), p, byrow = TRUE), B0 = matrix(NA, d0, p)), - "covar" = optim_zipln_zipar_covar + "covar" = function(R, init_B0, X0, config) { + # optim_zipln_zipar_covar is always nlopt-based + if (control$backend == "builtin") config <- config_default_nlopt + optim_zipln_zipar_covar(R, init_B0, X0, config) + } ) - private$optimizer$R <- ifelse(control$config_optim$approx_ZI, optim_zipln_R_var, optim_zipln_R_exact) private$optimizer$Omega <- optim_zipln_Omega_full + # Dispatch VE step on backend: "builtin" = Newton, "nlopt" = CCSAQ/etc. + private$optimizer$MS <- if (control$backend == "builtin") { + ftol <- if (!is.null(control$config_optim$ftol_in)) control$config_optim$ftol_in else 1e-8 + maxiter <- as.integer(if (!is.null(control$config_optim$maxeval)) control$config_optim$maxeval else 10000L) + function(init_M, init_S2, Y, X, O, Pi, B, Omega, configuration) + ve_step_zipln_newton(init_M, init_S2, Y, X, O, Pi, B, Omega, maxiter, ftol) + } else { + function(init_M, init_S2, Y, X, O, Pi, B, Omega, configuration) + ve_step_zipln_nlopt(init_M, init_S2, Y, X, O, Pi, B, Omega, configuration) + } }, @@ -151,7 +163,7 @@ ZIPLNfit <- R6Class( parameters <- list(Omega = NA, B0 = private$B0, B = private$B, Pi = private$Pi, - M = private$M, S = private$S, R = private$R) + M = private$M, S2 = private$S2, R = private$R) # Outer loop nb_iter <- 0 @@ -171,7 +183,7 @@ ZIPLNfit <- R6Class( ### M Step # PLN part new_Omega <- private$optimizer$Omega( - M = parameters$M, X = data$X, B = parameters$B, S = parameters$S + M = parameters$M, X = data$X, B = parameters$B, S2 = parameters$S2 ) new_B <- private$optimizer$B( M = parameters$M, X = data$X @@ -184,31 +196,25 @@ ZIPLNfit <- R6Class( new_B0 <- optim_new_zipar$B0 new_Pi <- optim_new_zipar$Pi - ### VE Step - # ZI part - new_R <- private$optimizer$R(Y = data$Y, X = data$X, O = data$O, M = parameters$M, S = parameters$S, Pi = new_Pi, B = new_B) - - # PLN part - new_M <- optim_zipln_M( - init_M = parameters$M, - Y = data$Y, X = data$X, O = data$O, R = new_R, S = parameters$S, B = new_B, Omega = new_Omega, - configuration = control - )$M - new_S <- optim_zipln_S( - init_S = parameters$S, - O = data$O, M = new_M, R = new_R, B = new_B, diag_Omega = diag(new_Omega), - configuration = control - )$S + ### VE Step — joint (M, ψ, R): both CCSAQ and NEWTON handle R internally + MS_out <- private$optimizer$MS( + init_M = parameters$M, init_S2 = parameters$S2, + Y = data$Y, X = data$X, O = data$O, + Pi = new_Pi, B = new_B, Omega = new_Omega, configuration = control + ) + new_M <- MS_out$M + new_S2 <- MS_out$S2 + new_R <- MS_out$R # Check convergence new_parameters <- list( Omega = new_Omega, B = new_B, B0 = new_B0, Pi = new_Pi, - R = new_R, M = new_M, S = new_S + R = new_R, M = new_M, S2 = new_S2 ) nb_iter <- nb_iter + 1 vloglik <- zipln_vloglik( - data$Y, data$X, data$O, new_Pi, new_Omega, new_B, new_R, new_M, new_S + data$Y, data$X, data$O, new_Pi, new_Omega, new_B, new_R, new_M, new_S2 ) criterion[nb_iter] <- new_objective <- -sum(vloglik) @@ -242,10 +248,10 @@ ZIPLNfit <- R6Class( Omega = parameters$Omega, Sigma = tryCatch(Matrix::solve(symmpart(parameters$Omega)), error = function(e) {e}), M = parameters$M, - S = parameters$S, + S2 = parameters$S2, R = parameters$R, Z = data$O + parameters$M, - A = exp(data$O + parameters$M + .5 * parameters$S^2), + A = exp(data$O + parameters$M + .5 * parameters$S2), Ji = vloglik, monitoring = list( iterations = nb_iter, @@ -262,17 +268,17 @@ ZIPLNfit <- R6Class( rownames(private$B0) <- colnames(data$X0) rownames(private$Omega) <- colnames(private$Omega) <- colnames(private$Pi) <- colnames_Y dimnames(private$Sigma) <- dimnames(private$Omega) - rownames(private$M) <- rownames(private$S) <- rownames(private$R) <- rownames(private$Pi) <- rownames(data$Y) + rownames(private$M) <- rownames(private$S2) <- rownames(private$R) <- rownames(private$Pi) <- rownames(data$Y) }, - #' @description Result of one call to the VE step of the optimization procedure: optimal variational parameters (M, S, R) and corresponding log likelihood values for fixed model parameters (Sigma, B, B0). Intended to position new data in the latent space. + #' @description Result of one call to the VE step of the optimization procedure: optimal variational parameters (M, S2, R) and corresponding log likelihood values for fixed model parameters (Sigma, B, B0). Intended to position new data in the latent space. #' @param B Optional fixed value of the regression parameters in the PLN component #' @param B0 Optional fixed value of the regression parameters in the ZI component #' @param Omega inverse variance-covariance matrix of the latent variables #' @return A list with three components: #' * the matrix `M` of variational means, - #' * the matrix `S` of variational standard deviations + #' * the matrix `S2` of variational variances #' * the matrix `R` of variational ZI probabilities #' * the vector `Ji` of (variational) log-likelihood of each new observation #' * a list `monitoring` with information about convergence status @@ -283,7 +289,7 @@ ZIPLNfit <- R6Class( control = ZIPLN_param(backend = "nlopt")$config_optim) { n <- nrow(data$Y) parameters <- - list(M = matrix(0, n, self$p), S = matrix(0.1, n, self$p), R = matrix(0, n, self$p)) + list(M = matrix(0, n, self$p), S2 = matrix(.01, n, self$p), R = matrix(0, n, self$p)) # Outer loop nb_iter <- 0 @@ -306,26 +312,21 @@ ZIPLNfit <- R6Class( R = parameters$R, init_B0 = B0, X0 = data$X0, config = config_default_nlopt )$Pi - # VE Step - new_R <- private$optimizer$R( - Y = data$Y, X = data$X, O = data$O, M = parameters$M, S = parameters$S, Pi = Pi, B = B + # VE Step — joint (M, ψ, R): R handled internally by optimizer + MS_out <- private$optimizer$MS( + init_M = parameters$M, init_S2 = parameters$S2, + Y = data$Y, X = data$X, O = data$O, + Pi = Pi, B = B, Omega = Omega, configuration = control ) - new_M <- optim_zipln_M( - init_M = parameters$M, - Y = data$Y, X = data$X, O = data$O, R = new_R, S = parameters$S, B = B, Omega = Omega, - configuration = control - )$M - new_S <- optim_zipln_S( - init_S = parameters$S, - O = data$O, M = new_M, R = new_R, B = B, diag_Omega = diag(Omega), - configuration = control - )$S + new_M <- MS_out$M + new_S2 <- MS_out$S2 + new_R <- MS_out$R # Check convergence - new_parameters <- list(R = new_R, M = new_M, S = new_S) + new_parameters <- list(R = new_R, M = new_M, S2 = new_S2) nb_iter <- nb_iter + 1 vloglik <- zipln_vloglik( - data$Y, data$X, data$O, Pi, Omega, B, new_R, new_M, new_S + data$Y, data$X, data$O, Pi, Omega, B, new_R, new_M, new_S2 ) criterion[nb_iter] <- new_objective <- -sum(vloglik) @@ -356,7 +357,8 @@ ZIPLNfit <- R6Class( list( M = parameters$M, - S = parameters$S, + S2 = parameters$S2, + S = sqrt(parameters$S2), R = parameters$R, Ji = vloglik, monitoring = list( @@ -431,7 +433,7 @@ ZIPLNfit <- R6Class( ) R <- VE$R M <- VE$M - S2 <- VE$S^2 + S2 <- VE$S2 } else { # otherwise set R to Pi, M to XB and S2 to diag(Sigma) R <- private$Pi[1:nrow(newdata), ] @@ -490,7 +492,7 @@ ZIPLNfit <- R6Class( Pi = NA, # the probability parameters for the ZI part Omega = NA, # the precision matrix Sigma = NA, # the covariance matrix - S = NA, # the variational parameters for the standard deviations + S2 = NA, # the variational parameters for the variance M = NA, # the variational parameters for the means Z = NA, # the matrix of latent variable P = NA, # the matrix of latent variable without covariates effect @@ -536,7 +538,7 @@ ZIPLNfit <- R6Class( #' @field model_par a list with the matrices of parameters found in the model (B, Sigma, plus some others depending on the variant) model_par = function() {list(B = private$B, B0 = private$B0, Pi = private$Pi, Omega = private$Omega, Sigma = private$Sigma)}, #' @field var_par a list with two matrices, M and S2, which are the estimated parameters in the variational approximation - var_par = function() {list(M = private$M, S2 = private$S^2, S = private$S, R = private$R)}, + var_par = function() {list(M = private$M, S2 = private$S2, S = sqrt(private$S2), R = private$R)}, #' @field optim_par a list with parameters useful for monitoring the optimization optim_par = function() {private$monitoring}, #' @field latent a matrix: values of the latent vector (Z in the model) @@ -562,7 +564,7 @@ ZIPLNfit <- R6Class( #' @field entropy_ZI Entropy of the variational distribution entropy_ZI = function() {-sum(.xlogx(1 - private$R)) - sum(.xlogx(private$R))}, #' @field entropy_PLN Entropy of the Gaussian variational distribution in the PLN component - entropy_PLN = function() {.5 * (self$n * self$p * log(2*pi*exp(1)) + sum(log(private$S^2)))}, + entropy_PLN = function() {.5 * (self$n * self$p * log(2*pi*exp(1)) + sum(log(private$S2)))}, #' @field ICL variational lower bound of the ICL ICL = function() {self$BIC - self$entropy}, #' @field criteria a vector with loglik, BIC, ICL and number of parameters @@ -697,7 +699,7 @@ ZIPLNfit_fixed <- R6Class( initialize = function(data, control) { super$initialize(data, control) private$Omega <- control$Omega - private$optimizer$Omega <- function(M, X, B, S) {private$Omega} + private$optimizer$Omega <- function(M, X, B, S2) {private$Omega} } ), active = list( @@ -761,8 +763,8 @@ ZIPLNfit_sparse <- R6Class( private$lambda <- control$penalty private$rho <- control$penalty_weights private$optimizer$Omega <- - function(M, X, B, S) { - glassoFast( crossprod(M - X %*% B)/self$n + diag(colMeans(S * S), self$p, self$p), + function(M, X, B, S2) { + glassoFast( crossprod(M - X %*% B)/self$n + diag(colMeans(S2), self$p, self$p), rho = private$lambda * private$rho )$wi } }, diff --git a/R/ZIPLNnetwork.R b/R/ZIPLNnetwork.R index 989550ed..c3ede542 100644 --- a/R/ZIPLNnetwork.R +++ b/R/ZIPLNnetwork.R @@ -87,7 +87,6 @@ ZIPLNnetwork_param <- function( config_opt$trace <- trace config_opt$ftol_out <- 1e-6 config_opt$maxit_out <- 50 - config_opt$approx_ZI <- TRUE config_opt[names(config_optim)] <- config_optim inception_cov <- match.arg(inception_cov) diff --git a/R/plot_utils.R b/R/plot_utils.R index f1aa1a0e..4b980291 100644 --- a/R/plot_utils.R +++ b/R/plot_utils.R @@ -82,55 +82,10 @@ circle <- function(center = c(0, 0), radius = 1, npoints = 100) { r = radius tt = seq(0, 2 * pi, length = npoints) xx = center[1] + r * cos(tt) - yy = center[1] + r * sin(tt) + yy = center[2] + r * sin(tt) return(data.frame(x = xx, y = yy)) } -#' @importFrom scales alpha -GeomCircle <- ggplot2::ggproto("GeomCircle", - ggplot2::Geom, - required_aes = c("x", "y", "radius"), - default_aes = ggplot2::aes( - colour = "grey30", fill=NA, alpha=NA, linewidth=1, linetype="solid"), - draw_key = function (data, params, size) - { - grid::circleGrob( - 0.5, 0.5, - r=0.35, - gp = grid::gpar( - col = scales::alpha(data$colour, data$alpha), - fill = scales::alpha(data$fill, data$alpha), - lty = data$linetype, - lwd = data$linewidth - ) - ) - }, - - draw_panel = function(data, panel_scales, coord, na.rm = TRUE) { - coords <- coord$transform(data, panel_scales) - grid::circleGrob( - x=coords$x, y=coords$y, - r=coords$radius, - gp = grid::gpar( - col = alpha(coords$colour, coords$alpha), - fill = alpha(coords$fill, coords$alpha), - lty = coords$linetype, - lwd = coords$linewidth - ) - ) - } -) - -geom_circle <- function(mapping = NULL, data = NULL, stat = "identity", - position = "identity", na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE, ...) { - ggplot2::layer( - geom = GeomCircle, mapping = mapping, data = data, stat = stat, - position = position, show.legend = show.legend, inherit.aes = inherit.aes, - params = list(na.rm = na.rm, ...) - ) -} - g_legend <- function(a.gplot){ tmp <- ggplot_gtable(ggplot_build(a.gplot)) leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box") diff --git a/R/utils.R b/R/utils.R index c36a44d0..20a9868b 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,4 +1,4 @@ -available_algorithms_nlopt <- c("MMA", "CCSAQ", "LBFGS", "VAR1", "VAR2") #"TNEWTON", "TNEWTON_PRECOND", "TNEWTON_PRECOND_RESTART"# +available_algorithms_nlopt <- c("CCSAQ", "MMA", "LBFGS", "VAR1", "VAR2") available_algorithms_torch <- c("RPROP", "RMSPROP", "ADAM", "ADAGRAD") config_default_nlopt <- @@ -13,6 +13,27 @@ config_default_nlopt <- maxtime = -1 ) + +config_default_builtin <- + list( + algorithm = "NEWTON", + backend = "builtin", + maxeval = 10000, + ftol_in = 1e-8, + maxit_em = 200, + ftol_em = 1e-8 + ) + + +# PLNPCA builtin backend: joint L-BFGS on [vec(B); vec(C); vec(M); vec(ψ)] with strong Wolfe +# line search (m=10 pairs). Only maxeval and ftol_in are read by the C++ optimizer. +config_default_plnpca <- + list( + backend = "builtin", + maxeval = 10000, + ftol_in = 1e-8 + ) + config_default_torch <- list( algorithm = "RPROP", @@ -32,6 +53,29 @@ config_default_torch <- device = "cpu" ) +## Build the optimizer config list from a backend name and user overrides. +## `builtin_default` lets PLNPCA pass config_default_plnpca instead of config_default_builtin. +## `extra` is a named list of additional defaults applied BEFORE user overrides (so the user can +## still override them), used for outer-loop parameters like ftol_em/maxit_em in PLNnetwork and +## PLNmixture. +make_config_optim <- function(backend, config_optim, trace, + builtin_default = config_default_builtin, + extra = list()) { + config_opt <- if (backend == "nlopt") { + stopifnot(config_optim$algorithm %in% available_algorithms_nlopt) + config_default_nlopt + } else if (backend == "torch") { + stopifnot(config_optim$algorithm %in% available_algorithms_torch) + config_default_torch + } else { + builtin_default + } + config_opt$trace <- trace + config_opt[names(extra)] <- extra + config_opt[names(config_optim)] <- config_optim + config_opt +} + config_post_default_PLN <- list( jackknife = FALSE, @@ -77,26 +121,6 @@ config_post_default_PLNmixture <- sandwich_var = FALSE ) -status_to_message <- function(status) { - message <- switch(as.character(status), - "1" = "success", - "2" = "success, stopval was reached", - "3" = "success, ftol_rel or ftol_abs was reached", - "4" = "success, xtol_rel or xtol_abs was reached", - "5" = "success, maxeval was reached", - "6" = "success, maxtime was reached", - "-1" = "failure", - "-2" = "invalid arguments", - "-3" = "out of memory.", - "-4" = "roundoff errors led to a breakdown of the optimization algorithm", - "-5" = "forced termination:", - "Return status not recognized" - ) - message -} - -trace <- function(x) sum(diag(x)) - .xlogx <- function(x) ifelse(x < .Machine$double.eps, 0, x*log(x)) .softmax <- function(x) { @@ -169,9 +193,17 @@ extract_model <- function(call, envir) { } else { stopifnot(all(w > 0) && length(w) == nrow(Y)) } - ## Save encountered levels for predict methods as attribute of the formula - attr(call$formula, "xlevels") <- .getXlevels(terms(frame), frame) - list(Y = Y, X = X, O = O, miss = is.na(Y), w = w, formula = call$formula) + ## Save encountered levels for predict methods as attribute of the formula. + ## Evaluate the formula expression to get the formula object before setting + ## attributes — avoids "cannot set an attribute on a 'symbol'" when the + ## formula was passed as a variable (e.g. PLN(my_formula, data = d)). + formula_obj <- if (!inherits(call$formula, "formula")) { + eval(call$formula, envir = envir) + } else { + call$formula + } + attr(formula_obj, "xlevels") <- .getXlevels(terms(frame), frame) + list(Y = Y, X = X, O = O, miss = is.na(Y), w = w, formula = formula_obj) } edge_to_node <- function(x, n = max(x)) { @@ -184,16 +216,6 @@ edge_to_node <- function(x, n = max(x)) { return(data.frame(node1 = i + 1, node2 = j + 1)) } -node_pair_to_egde <- function(x, y, node.set = union(x, y)) { - ## Convert node labels to integers (starting from 0) - x <- match(x, node.set) - 1 - y <- match(y, node.set) - 1 - ## For each pair (x,y) return, corresponding edge number - n <- length(node.set) - j.grid <- cumsum(0:(n - 1)) - x + j.grid[y] + 1 -} - #' @title PLN RNG #' #' @description Random generation for the PLN model with latent mean equal to mu, latent covariance matrix @@ -266,16 +288,25 @@ create_parameters <- function( #' Helper function for PLN initialization. #' #' @description -#' Barebone function to compute starting points for B, M and S when fitting a PLN. Mostly intended for internal use. +#' Barebone function to compute starting points for B, M and S2 when fitting a PLN. Mostly intended for internal use. #' #' @param Y Response count matrix #' @param X Covariate matrix. Note that initialization will fail if the model matrix is singular. #' @param O Offset matrix (in log-scale) #' @param w Weight vector (defaults to 1) -#' @param s Scale parameter for S (defaults to 0.1) -#' @return a named list of starting values for model parameter B and variational parameters M and S used in the iterative optimization algorithm of [PLN()] +#' @param method character: strategy used to initialize B. Either `"LM"` (default, fast weighted +#' log-linear regression) or `"GLM"` (p independent Poisson GLMs, more accurate for complex +#' or unbalanced designs but slower). +#' @return a named list of starting values for model parameter B and variational parameters M and S2 used in the iterative optimization algorithm of [PLN()] #' -#' @details The default strategy to estimate B and M is to fit a linear model with covariates `X` to the response count matrix (after adding a pseudocount of 1, scaling by the offset and taking the log). The regression matrix is used to initialize `B` and the residuals to initialize `M`. `S` is initialized as a constant conformable matrix with value `s`. +#' @details +#' * **B**: estimated by weighted LM (`method = "LM"`, default) or p independent Poisson GLMs +#' (`method = "GLM"`). The GLM option gives better B estimates for factorial or unbalanced +#' designs at the cost of p IRLS fits. +#' * **M**: initialized to `log((1 + Y) / exp(O))` (M_full in the X*B + M_res parameterization). +#' * **S**: initialized element-wise to `1 / sqrt(2 + Y)`, the approximate VE-step optimum at +#' Omega = I. This adapts automatically to count levels: high S for zero counts (high +#' uncertainty), low S for large counts. #' #' @rdname compute_PLN_starting_point #' @examples @@ -284,17 +315,29 @@ create_parameters <- function( #' Y <- barents$Abundance #' X <- model.matrix(Abundance ~ Latitude + Longitude + Depth + Temperature, data = barents) #' O <- log(barents$Offset) -#' w <-- rep(1, nrow(Y)) +#' w <- rep(1, nrow(Y)) #' compute_PLN_starting_point(Y, X, O, w) +#' compute_PLN_starting_point(Y, X, O, w, method = "GLM") #' } #' -#' @importFrom stats lm.fit +#' @importFrom stats lm.fit glm.fit poisson #' @export -compute_PLN_starting_point <- function(Y, X, O, w, s = 0.1) { - # Y = responses, X = covariates, O = offsets (in log scale), w = weights +compute_PLN_starting_point <- function(Y, X, O, w, method = c("LM", "GLM")) { + method <- match.arg(method) n <- nrow(Y); p <- ncol(Y); d <- ncol(X) - fits <- lm.fit(w * X, w * log((1 + Y)/exp(O)), singular.ok = FALSE) - list(B = matrix(fits$coefficients, d, p), - M = matrix(fits$residuals, n, p), - S = matrix(s, n, p)) + Y0 <- replace(Y, is.na(Y), 0) # treat missing counts as 0 for initialization only + expO <- exp(O) + if (method == "GLM") { + pois_fam <- poisson() + B <- vapply(seq_len(p), function(j) + glm.fit(X, Y0[, j], offset = O[, j], weights = w, family = pois_fam)$coefficients, + FUN.VALUE = numeric(d) + ) + } else { + B <- lm.fit(w * X, w * log((1 + Y0) / expO), singular.ok = TRUE)$coefficients + B[is.na(B)] <- 0 + } + list(B = matrix(B, d, p), + M = matrix(log((1 + Y0) / expO), n, p), + S2 = 1 / (2 + Y0)) } diff --git a/R/zzz.R b/R/zzz.R index f7bb61ea..ef7c52e9 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1,5 +1,4 @@ .onAttach <- function(libname, pkgname) { version <- read.dcf(file=system.file("DESCRIPTION", package=pkgname), fields="Version") packageStartupMessage(paste0("This is package '", pkgname,"' version ",version)) - packageStartupMessage('Use future::plan(multicore/multisession) to speed up PLNPCA/PLNmixture/stability_selection.') } diff --git a/_pkgdown.yml b/_pkgdown.yml index 7deb44d4..3b75a9fd 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -60,6 +60,9 @@ reference: - '`predict_cond.PLNfit`' - '`fitted.PLNfit`' - '`standard_error.PLNfit`' + - '`logLik.PLNfit`' + - '`AIC.PLNfit`' + - '`BIC.PLNfit`' - title: 'Zero Inflated Poisson lognormal fit' desc: > Description of the ZIPLNfit object and methods for its manipulation. @@ -71,6 +74,9 @@ reference: - '`predict.ZIPLNfit`' - '`fitted.ZIPLNfit`' - '`plot.ZIPLNfit_sparse`' + - '`logLik.ZIPLNfit`' + - '`AIC.ZIPLNfit`' + - '`BIC.ZIPLNfit`' - title: 'Linear discriminant analysis via a Poisson lognormal fit' desc: > Description of the PLNLDAfit object and methods for its manipulation. @@ -132,6 +138,7 @@ reference: - '`PLNfamily`' - '`plot.PLNfamily`' - '`rPLN`' + - '`ICL`' - '`compute_PLN_starting_point`' - title: Data sets desc: ~ @@ -142,4 +149,3 @@ reference: - '`barents`' - '`mollusk`' - '`scRNA`' - diff --git a/inst/benchmark/backend_comparison.R b/inst/benchmark/backend_comparison.R new file mode 100644 index 00000000..de4ff3a8 --- /dev/null +++ b/inst/benchmark/backend_comparison.R @@ -0,0 +1,191 @@ +## ============================================================ +## Backend comparison: builtin Newton vs nlopt/CCSAQ +## Metrics: computation time, iterations, final loglik +## Datasets: trichoptera, barents, mollusk, oaks, microcosm, scRNA +## Covariances: full, diagonal, spherical (including scRNA full) +## Output: inst/benchmark/ +## ============================================================ + +suppressPackageStartupMessages({ + devtools::load_all(".", quiet = TRUE) + library(ggplot2) + library(dplyr) + library(tidyr) +}) + +ctrl_newton <- function(cov) PLN_param(backend = "builtin", covariance = cov, trace = 0) +ctrl_nlopt <- function(cov) PLN_param(backend = "nlopt", covariance = cov, trace = 0) + +## ---- Helper: fit one model with timing, return summary row ---- +fit_timed <- function(formula, data, cov, backend_ctrl, backend_name, label) { + t0 <- proc.time() + m <- tryCatch( + PLN(formula, data = data, control = backend_ctrl(cov)), + error = function(e) NULL + ) + elapsed <- (proc.time() - t0)[["elapsed"]] + if (is.null(m)) { + return(data.frame( + label = label, backend = backend_name, covariance = cov, + time_s = elapsed, n_iter = NA_integer_, loglik = NA_real_, + converged = FALSE, stringsAsFactors = FALSE + )) + } + data.frame( + label = label, + backend = backend_name, + covariance = cov, + time_s = elapsed, + n_iter = m$optim_par$iterations, + loglik = m$loglik, + converged = (m$optim_par$status == 3), + stringsAsFactors = FALSE + ) +} + +## ---- Helper: run both backends for a given (formula, data, cov) ---- +compare_both <- function(formula, data, cov, label) { + cat(sprintf(" %s [%s]...\n", label, cov)) + rbind( + fit_timed(formula, data, cov, ctrl_newton, "newton", label), + fit_timed(formula, data, cov, ctrl_nlopt, "nlopt", label) + ) +} + +## ---- Data preparation ---- +tri <- prepare_data(trichoptera$Abundance, trichoptera$Covariate) +mol <- prepare_data(mollusk$Abundance, mollusk$Covariate) + +## ---- Run all comparisons ---- +results <- list() + +cat("=== trichoptera (n=49, p=17) ===\n") +for (cov in c("full", "diagonal", "spherical")) { + results[[length(results)+1]] <- compare_both(Abundance ~ 1, tri, cov, "tri_nocov") + results[[length(results)+1]] <- compare_both(Abundance ~ Wind + Temperature, tri, cov, "tri_cov") +} + +cat("=== barents (n=89, p=30) ===\n") +for (cov in c("full", "diagonal", "spherical")) { + results[[length(results)+1]] <- compare_both(Abundance ~ 1, barents, cov, "bar_nocov") + results[[length(results)+1]] <- compare_both(Abundance ~ Depth + Temperature, barents, cov, "bar_cov") +} + +cat("=== mollusk (n=163, p=32) ===\n") +for (cov in c("full", "diagonal", "spherical")) { + results[[length(results)+1]] <- compare_both(Abundance ~ 1, mol, cov, "mol_nocov") + results[[length(results)+1]] <- compare_both(Abundance ~ site + season, mol, cov, "mol_cov") +} + +cat("=== oaks (n=116, p=114) ===\n") +for (cov in c("full", "diagonal", "spherical")) { + results[[length(results)+1]] <- compare_both(Abundance ~ 1 + offset(log(Offset)), oaks, cov, "oak_nocov") + results[[length(results)+1]] <- compare_both(Abundance ~ tree + offset(log(Offset)), oaks, cov, "oak_cov") +} + +cat("=== microcosm (n=880, p=259) ===\n") +for (cov in c("diagonal", "spherical")) { + results[[length(results)+1]] <- compare_both(Abundance ~ 1 + offset(log(Offset)), microcosm, cov, "mic_nocov") + results[[length(results)+1]] <- compare_both(Abundance ~ site + offset(log(Offset)), microcosm, cov, "mic_cov") +} +cat(" microcosm full (slow)...\n") +for (lbl in c("mic_nocov", "mic_cov")) { + form <- if (lbl == "mic_nocov") Abundance ~ 1 + offset(log(Offset)) else Abundance ~ site + offset(log(Offset)) + results[[length(results)+1]] <- compare_both(form, microcosm, "full", lbl) +} + +cat("=== scRNA (n=3918, p=500) ===\n") +for (cov in c("diagonal", "spherical")) { + results[[length(results)+1]] <- compare_both(counts ~ 1 + offset(log(total_counts)), scRNA, cov, "scr_nocov") + results[[length(results)+1]] <- compare_both(counts ~ cell_line + offset(log(total_counts)), scRNA, cov, "scr_cov") +} +cat(" scRNA full covariance (very slow)...\n") +for (lbl in c("scr_nocov", "scr_cov")) { + form <- if (lbl == "scr_nocov") counts ~ 1 + offset(log(total_counts)) else counts ~ cell_line + offset(log(total_counts)) + results[[length(results)+1]] <- compare_both(form, scRNA, "full", lbl) +} + +cat("All fits done.\n\n") + +## ---- Combine results ---- +df <- do.call(rbind, results) +df$dataset <- sub("_.*", "", df$label) +df$covariates <- sub(".*_", "", df$label) + +## ---- Summary table (wide format) ---- +cat("========== COMPARISON SUMMARY ==========\n") +wide <- df %>% + select(label, covariance, backend, time_s, n_iter, loglik, converged) %>% + tidyr::pivot_wider( + names_from = backend, + values_from = c(time_s, n_iter, loglik, converged) + ) %>% + mutate( + loglik_diff = loglik_newton - loglik_nlopt, + speedup = time_s_nlopt / time_s_newton + ) %>% + arrange(label, covariance) + +print(wide %>% select(label, covariance, + time_newton = time_s_newton, time_nlopt = time_s_nlopt, speedup, + iter_newton = n_iter_newton, iter_nlopt = n_iter_nlopt, + ll_newton = loglik_newton, ll_nlopt = loglik_nlopt, + ll_diff = loglik_diff, + conv_newton = converged_newton, conv_nlopt = converged_nlopt + ) %>% + mutate(across(where(is.numeric), ~ signif(., 4))), + row.names = FALSE, width = 200) + +write.csv(wide, "inst/benchmark/backend_comparison.csv", row.names = FALSE) +cat("Saved: backend_comparison.csv\n") + +## ---- Plot 1: time comparison ---- +p1 <- ggplot(df, aes(x = paste(label, covariance, sep="\n"), y = time_s, fill = backend)) + + geom_col(position = "dodge", width = 0.7) + + facet_wrap(~ dataset, scales = "free", nrow = 2) + + scale_fill_manual(values = c(newton = "#E69F00", nlopt = "#56B4E9")) + + labs(title = "Computation time: Newton vs nlopt", + x = NULL, y = "Elapsed time (s)", fill = "Backend") + + theme_bw(base_size = 10) + + theme(axis.text.x = element_text(angle = 45, hjust = 1, size = 7)) + +ggsave("inst/benchmark/backend_time.pdf", p1, width = 18, height = 10) +cat("\nSaved: backend_time.pdf\n") + +## ---- Plot 2: loglik difference (newton - nlopt) ---- +df_wide <- df %>% + pivot_wider(names_from = backend, values_from = c(time_s, n_iter, loglik, converged)) %>% + mutate(ll_diff = loglik_newton - loglik_nlopt, + fit = paste(label, covariance, sep=" / ")) + +p2 <- ggplot(df_wide, aes(x = fit, y = ll_diff, + fill = ifelse(ll_diff > 0, "Newton better", "nlopt better"))) + + geom_col(width = 0.7) + + facet_wrap(~ dataset, scales = "free", nrow = 2) + + geom_hline(yintercept = 0, linetype = "dashed") + + scale_fill_manual(values = c("Newton better" = "#009E73", "nlopt better" = "#D55E00"), + name = NULL) + + labs(title = "loglik difference: Newton minus nlopt", + subtitle = "Positive = Newton finds better solution", + x = NULL, y = "loglik(Newton) - loglik(nlopt)") + + theme_bw(base_size = 10) + + theme(axis.text.x = element_text(angle = 45, hjust = 1, size = 7)) + +ggsave("inst/benchmark/backend_loglik.pdf", p2, width = 18, height = 10) +cat("Saved: backend_loglik.pdf\n") + +## ---- Plot 3: speedup (nlopt_time / newton_time) ---- +p3 <- ggplot(df_wide, aes(x = fit, y = time_s_nlopt / time_s_newton, + fill = dataset)) + + geom_col(width = 0.7) + + facet_wrap(~ dataset, scales = "free", nrow = 2) + + geom_hline(yintercept = 1, linetype = "dashed", colour = "grey40") + + labs(title = "Speedup: nlopt_time / newton_time", + subtitle = "> 1 means Newton is faster", + x = NULL, y = "Speedup ratio") + + theme_bw(base_size = 10) + + theme(axis.text.x = element_text(angle = 45, hjust = 1, size = 7), + legend.position = "none") + +ggsave("inst/benchmark/backend_speedup.pdf", p3, width = 18, height = 10) +cat("Saved: backend_speedup.pdf\n") diff --git a/inst/benchmark/backend_comparison.csv b/inst/benchmark/backend_comparison.csv new file mode 100644 index 00000000..e85f1739 --- /dev/null +++ b/inst/benchmark/backend_comparison.csv @@ -0,0 +1,37 @@ +"label","covariance","time_s_newton","time_s_nlopt","n_iter_newton","n_iter_nlopt","loglik_newton","loglik_nlopt","converged_newton","converged_nlopt","loglik_diff","speedup" +"bar_cov","diagonal",1.05,0.539000000000001,1390,610,-4652.41317806047,-4653.99348305037,TRUE,TRUE,1.58030498990229,0.513333333333334 +"bar_cov","full",1.841,1.026,1764,1680,-4402.0859350791,-4413.41174849079,TRUE,TRUE,11.325813411695,0.557305812058663 +"bar_cov","spherical",0.811,0.469999999999999,829,256,-4760.4695205047,-4761.35301027491,TRUE,TRUE,0.883489770218148,0.579531442663377 +"bar_nocov","diagonal",0.707000000000001,0.441999999999998,635,192,-5149.60159867053,-5149.63778663945,TRUE,TRUE,0.0361879689180569,0.625176803394622 +"bar_nocov","full",1.24,0.888999999999999,984,1181,-4598.24275109682,-4612.09856510894,TRUE,TRUE,13.8558140121222,0.716935483870968 +"bar_nocov","spherical",0.495999999999999,0.43,196,129,-5328.28635148151,-5328.2894020688,TRUE,TRUE,0.00305058729372831,0.86693548387097 +"mic_cov","diagonal",51.479,15.247,639,374,-240659.939958148,-240818.143459407,TRUE,TRUE,158.203501258919,0.296179024456575 +"mic_cov","full",115.783,22.978,1309,507,-214999.32158194,-244917.899601699,TRUE,FALSE,29918.5780197598,0.198457459212492 +"mic_cov","spherical",48.234,18.277,565,351,-240957.760282918,-241060.554147804,TRUE,TRUE,102.793864886713,0.37892358087656 +"mic_nocov","diagonal",20.108,19.471,210,337,-256915.919764276,-256977.808342199,TRUE,TRUE,61.888577923557,0.968321066242292 +"mic_nocov","full",105.867,22.934,1124,462,-217552.959190675,-248119.764778727,TRUE,FALSE,30566.8055880514,0.21663030028243 +"mic_nocov","spherical",15.628,16.729,190,344,-257402.932528361,-257453.434787707,TRUE,TRUE,50.502259346249,1.07045047350908 +"mol_cov","diagonal",13.834,21.611,15396,10000,-2911.2889512502,-2919.77577617919,FALSE,FALSE,8.4868249289816,1.56216567876247 +"mol_cov","full",17.49,11.069,15061,14772,-2846.76911940346,-2852.36858140965,FALSE,TRUE,5.59946200618424,0.632875929102344 +"mol_cov","spherical",10.278,3.16200000000001,11631,3618,-2953.18152203507,-2954.28459024873,FALSE,TRUE,1.1030682136643,0.307647402218331 +"mol_nocov","diagonal",3.68,0.679000000000002,3637,421,-4194.73378465473,-4194.53368225736,FALSE,TRUE,-0.200102397374394,0.184510869565218 +"mol_nocov","full",7.626,4.899,4930,6131,-3636.11380818712,-3643.5050447213,FALSE,TRUE,7.39123653418164,0.642407553107789 +"mol_nocov","spherical",1.708,0.545000000000002,1532,210,-4243.76351089611,-4243.76368505931,TRUE,TRUE,0.000174163194060384,0.319086651053865 +"oak_cov","diagonal",2.94999999999999,1.547,459,286,-35993.0942141486,-35995.6366421201,TRUE,TRUE,2.54242797150073,0.524406779661018 +"oak_cov","full",5.15700000000001,5.24799999999999,882,1672,-31386.5517453461,-31407.5336217167,TRUE,TRUE,20.9818763705771,1.01764591816947 +"oak_cov","spherical",2.09899999999999,0.792000000000002,294,137,-36731.9371369512,-36732.9568866259,TRUE,TRUE,1.01974967472052,0.37732253454026 +"oak_nocov","diagonal",1.09299999999999,0.854000000000013,121,141,-38407.6721221679,-38407.8643602946,TRUE,TRUE,0.192238126750453,0.781335773101575 +"oak_nocov","full",6.188,4.69499999999999,715,1750,-32028.4697547819,-32048.6173086626,TRUE,TRUE,20.1475538807026,0.758726567550096 +"oak_nocov","spherical",0.850999999999999,0.722000000000008,60,105,-39450.2375855111,-39450.2370236831,TRUE,TRUE,-0.000561827982892282,0.848413631022337 +"scr_cov","diagonal",231.829,132.426,420,268,-4047743.23620142,-4047750.81489767,TRUE,TRUE,7.57869625417516,0.57122275470282 +"scr_cov","full",285.188,739.741,527,1550,-3749669.06887884,-3750612.59354959,TRUE,TRUE,943.52467074804,2.59387141113932 +"scr_cov","spherical",134.827,67.923,266,143,-4123014.20792418,-4123019.79846823,TRUE,TRUE,5.59054405335337,0.503778916685827 +"scr_nocov","diagonal",69.731,88.533,124,181,-4619897.81674815,-4619906.54349095,TRUE,TRUE,8.72674279939383,1.26963617329452 +"scr_nocov","full",367.284,782.01,644,1676,-3781946.19168387,-3782813.28887135,TRUE,TRUE,867.097187487409,2.12916979775868 +"scr_nocov","spherical",30.346,42.8700000000001,52,93,-4796744.81980006,-4796751.50031606,TRUE,TRUE,6.68051600176841,1.41270678178343 +"tri_cov","diagonal",0.573,0.451000000000001,927,510,-1140.57830657624,-1140.60974804156,FALSE,TRUE,0.031441465318494,0.787085514834208 +"tri_cov","full",0.877,0.557,1052,975,-1080.76749574514,-1082.12577047728,FALSE,TRUE,1.35827473213976,0.635119726339795 +"tri_cov","spherical",0.465000000000002,0.427999999999999,405,190,-1172.0745796868,-1172.08077342394,TRUE,TRUE,0.00619373714448557,0.920430107526876 +"tri_nocov","diagonal",0.529999999999999,0.423,793,211,-1250.76584921142,-1250.72668131909,FALSE,TRUE,-0.0391678923338077,0.798113207547171 +"tri_nocov","full",0.897,0.661,816,1229,-1129.55914454164,-1130.2978158157,TRUE,TRUE,0.738671274052194,0.736900780379041 +"tri_nocov","spherical",0.437999999999999,0.395,234,98,-1286.04055118098,-1286.04064726557,TRUE,TRUE,9.60845829922619e-05,0.901826484018266 diff --git a/inst/benchmark/backend_loglik.pdf b/inst/benchmark/backend_loglik.pdf new file mode 100644 index 00000000..95cc35a3 Binary files /dev/null and b/inst/benchmark/backend_loglik.pdf differ diff --git a/inst/benchmark/backend_speedup.pdf b/inst/benchmark/backend_speedup.pdf new file mode 100644 index 00000000..4616206e Binary files /dev/null and b/inst/benchmark/backend_speedup.pdf differ diff --git a/inst/benchmark/backend_time.pdf b/inst/benchmark/backend_time.pdf new file mode 100644 index 00000000..a81790d7 Binary files /dev/null and b/inst/benchmark/backend_time.pdf differ diff --git a/inst/benchmark/bench_compare.R b/inst/benchmark/bench_compare.R new file mode 100644 index 00000000..f8ba826b --- /dev/null +++ b/inst/benchmark/bench_compare.R @@ -0,0 +1,105 @@ +#!/usr/bin/env Rscript +## Usage: Rscript bench_compare.R + +args <- commandArgs(trailingOnly = TRUE) +if (length(args) < 2) stop("Usage: bench_compare.R ") + +df_master <- readRDS(args[1]) +df_ce <- readRDS(args[2]) +df_all <- rbind(df_master, df_ce) + +branch_m <- unique(df_master$branch) +branch_ce <- unique(df_ce$branch) + +## ── Cross-branch comparison: nlopt only (compatible baseline) ───────────────── +df_m <- df_master[df_master$backend == "nlopt", ] +df_c <- df_ce[df_ce$backend == "nlopt", ] + +## Merge on model + dataset +comp <- merge(df_m, df_c, by = c("model", "dataset"), suffixes = c(".m", ".ce")) +comp$delta_loglik <- comp$loglik.ce - comp$loglik.m +comp$speedup <- comp$time_s.m / comp$time_s.ce +comp <- comp[order(comp$model, comp$dataset), ] + +## ── Print ───────────────────────────────────────────────────────────────────── +HR <- strrep("=", 115) +hr <- strrep("-", 115) + +cat("\n", HR, "\n", sep="") +cat(sprintf(" BRANCH COMPARISON: %s (ce) vs %s (master)\n", branch_ce, branch_m)) +cat(sprintf(" Backend: nlopt (comparable defaults)\n")) +cat(HR, "\n\n", sep="") + +cat(sprintf(" %-12s %-12s | %7s %7s %8s | %10s %10s %6s | %5s %5s\n", + "Model", "Dataset", "t_master", "t_ce", "speedup", "ll_master", "ll_ce", "delta", "it_m", "it_ce")) +cat(sprintf(" %s\n", strrep("-", 100))) + +prev_model <- "" +for (i in seq_len(nrow(comp))) { + r <- comp[i, ] + if (r$model != prev_model && i > 1) cat("\n") + prev_model <- r$model + + flag <- if (!is.na(r$delta_loglik) && abs(r$delta_loglik) > 5) { + if (r$delta_loglik > 0) " ▲" else " ▼" + } else "" + + cat(sprintf(" %-12s %-12s | %7.2fs %7.2fs %8.2fx | %10.1f %10.1f %+6.1f%s | %5s %5s\n", + r$model, r$dataset, + r$time_s.m, r$time_s.ce, r$speedup, + r$loglik.m, r$loglik.ce, r$delta_loglik, flag, + ifelse(is.na(r$n_iter.m), "?", as.character(r$n_iter.m)), + ifelse(is.na(r$n_iter.ce), "?", as.character(r$n_iter.ce)) + )) +} + +cat("\n Legend: delta = ll_ce - ll_master (▲ ce better, ▼ ce worse, threshold |delta|>5)\n") +cat( " speedup = t_master / t_ce (>1 ce faster, <1 ce slower)\n\n") + +## ── Extra backends (code-enhancement only) ──────────────────────────────────── +extra <- df_ce[df_ce$backend != "nlopt", ] +if (nrow(extra) > 0) { + cat(hr, "\n", sep="") + cat(" NEW BACKENDS in code-enhancement vs its own nlopt baseline\n") + cat(hr, "\n\n", sep="") + + for (be in unique(extra$backend)) { + cat(sprintf(" Backend '%s':\n", be)) + sub_e <- extra[extra$backend == be, ] + for (i in seq_len(nrow(sub_e))) { + rx <- sub_e[i, ] + rnl <- df_c[df_c$model == rx$model & df_c$dataset == rx$dataset, ] + if (nrow(rnl) == 0) next + cat(sprintf(" %-12s %-12s | t=%.2fs vs %.2fs (nlopt) speedup=%+.2fx | ll_diff=%+.1f\n", + rx$model, rx$dataset, + rx$time_s, rnl$time_s, rnl$time_s / rx$time_s, + rx$loglik - rnl$loglik + )) + } + cat("\n") + } +} + +## ── Parameter norms ─────────────────────────────────────────────────────────── +cat(hr, "\n", sep="") +cat(" PARAMETER NORMS — B and Omega (Frobenius)\n") +cat(hr, "\n\n", sep="") +cat(sprintf(" %-12s %-12s | norm_B: %8s %8s | norm_Om: %8s %8s\n", + "Model", "Dataset", "master", "ce", "master", "ce")) +cat(sprintf(" %s\n", strrep("-", 80))) + +for (i in seq_len(nrow(comp))) { + r <- comp[i, ] + cat(sprintf(" %-12s %-12s | norm_B: %8.4f %8.4f | norm_Om: %8.4f %8.4f\n", + r$model, r$dataset, + ifelse(is.na(r$norm_B.m), 0, r$norm_B.m), + ifelse(is.na(r$norm_B.ce), 0, r$norm_B.ce), + ifelse(is.na(r$norm_Om.m), 0, r$norm_Om.m), + ifelse(is.na(r$norm_Om.ce), 0, r$norm_Om.ce) + )) +} + +## ── Save CSV ────────────────────────────────────────────────────────────────── +out_csv <- file.path(dirname(args[1]), "branch_comparison.csv") +write.csv(df_all, out_csv, row.names = FALSE) +cat(sprintf("\nFull results saved to: %s\n", out_csv)) diff --git a/inst/benchmark/bench_plnpca_fixed.R b/inst/benchmark/bench_plnpca_fixed.R new file mode 100644 index 00000000..5bfc8a0b --- /dev/null +++ b/inst/benchmark/bench_plnpca_fixed.R @@ -0,0 +1,71 @@ +#!/usr/bin/env Rscript +## Usage: Rscript bench_plnpca_fixed.R +## PLNPCA at fixed ranks (3, 5, 10) — comparable across branches. + +args <- commandArgs(trailingOnly = TRUE) +if (length(args) < 3) stop("Usage: bench_plnpca_fixed.R ") +lib_path <- args[1] +branch_name <- args[2] +out_rds <- args[3] + +.libPaths(c(lib_path, .libPaths())) +suppressPackageStartupMessages(library(PLNmodels)) +cat(sprintf("Branch: %s | PLNmodels %s\n\n", branch_name, packageVersion("PLNmodels"))) + +data(trichoptera); data(oaks); data(barents) +tri <- prepare_data(trichoptera$Abundance, trichoptera$Covariate) + +RANKS <- c(3L, 5L, 10L) + +datasets <- list( + list(name = "trichoptera", expr_tmpl = function(q, ctrl) + PLNPCA(Abundance ~ 1, data = tri, ranks = q, control = ctrl)), + list(name = "barents", expr_tmpl = function(q, ctrl) + PLNPCA(Abundance ~ Depth + Temperature, data = barents, ranks = q, control = ctrl)), + list(name = "oaks", expr_tmpl = function(q, ctrl) + PLNPCA(Abundance ~ 1 + offset(log(Offset)), data = oaks, ranks = q, control = ctrl)) +) + +ctrl <- PLNPCA_param(trace = 0) +results <- list() + +for (ds in datasets) { + for (q in RANKS) { + cat(sprintf(" PLNPCA %-12s rank=%2d ... ", ds$name, q)) + t0 <- proc.time() + fit <- tryCatch(ds$expr_tmpl(q, ctrl), error = function(e) { + cat("ERROR:", conditionMessage(e), "\n"); NULL + }) + elapsed <- round((proc.time() - t0)[["elapsed"]], 3) + if (is.null(fit)) next + + ## Single-rank PLNPCA returns a PLNPCAfamily with one model + m <- if (inherits(fit, "PLNPCAfamily")) fit$models[[1]] else fit + + loglik <- round(m$loglik, 4) + n_iter <- if (!is.null(m$optim_par$iterations)) as.integer(m$optim_par$iterations) else NA_integer_ + norm_B <- round(norm(as.matrix(m$model_par$B), "F"), 4) + norm_Om <- tryCatch(round(norm(as.matrix(m$model_par$Omega), "F"), 4), error = function(e) NA_real_) + + cat(sprintf("done (%.2fs, ll=%.1f, iter=%s)\n", elapsed, loglik, + ifelse(is.na(n_iter), "?", n_iter))) + + results[[length(results)+1]] <- data.frame( + branch = branch_name, + model = "PLNPCA", + dataset = ds$name, + rank = q, + backend = "nlopt", + time_s = elapsed, + loglik = loglik, + n_iter = n_iter, + norm_B = norm_B, + norm_Om = norm_Om, + stringsAsFactors = FALSE + ) + } +} + +df <- do.call(rbind, results) +saveRDS(df, out_rds) +cat(sprintf("\n%d runs saved to %s\n", nrow(df), out_rds)) diff --git a/inst/benchmark/bench_plnpca_init.R b/inst/benchmark/bench_plnpca_init.R new file mode 100644 index 00000000..99b67221 --- /dev/null +++ b/inst/benchmark/bench_plnpca_init.R @@ -0,0 +1,138 @@ +#!/usr/bin/env Rscript +## Benchmark : PLNPCA init_method × backend +## +## Comparaisons testées : +## init_method : "LM" — nouvelle init (lm.fit sur log(Y), défaut actuel) +## "GLM" — init Poisson GLM (p fits IRLS) +## "PLN-EM" — ancienne init master (PLNfit complet comme inception) +## backend : "nlopt" — CCSAQ (défaut PLNPCA) +## "builtin" — L-BFGS joint + Wolfe fort +## +## IMPORTANT : ne jamais lancer en parallèle (BLAS multithreadé). + +suppressPackageStartupMessages({ + devtools::load_all(quiet = TRUE) +}) +cat("PLNmodels", as.character(packageVersion("PLNmodels")), "\n\n") + +data(trichoptera); data(barents); data(oaks) +tri <- prepare_data(trichoptera$Abundance, trichoptera$Covariate) + +## -------------------------------------------------------------------------- +## Configurations testées +## -------------------------------------------------------------------------- +RANKS <- list( + trichoptera = c(1L, 3L, 5L), + barents = c(3L, 5L, 10L), + oaks = c(5L, 10L, 20L) +) + +DATASETS <- list( + list(name = "trichoptera", + formula = Abundance ~ 1, + data = tri), + list(name = "barents", + formula = Abundance ~ Depth + Temperature, + data = barents), + list(name = "oaks", + formula = Abundance ~ 1 + offset(log(Offset)), + data = oaks) +) + +BACKENDS <- c("nlopt", "builtin") + +## -------------------------------------------------------------------------- +## Helpers +## -------------------------------------------------------------------------- +run_one <- function(ds, ranks, backend, init_method, pln_inception = NULL) { + ctrl <- if (identical(init_method, "PLN-EM")) { + PLNPCA_param(backend = backend, trace = 0, inception = pln_inception) + } else { + PLNPCA_param(backend = backend, trace = 0, init_method = init_method) + } + t0 <- proc.time() + fit <- tryCatch( + PLNPCA(ds$formula, data = ds$data, ranks = ranks, control = ctrl), + error = function(e) { message(" ERROR: ", conditionMessage(e)); NULL } + ) + elapsed <- round((proc.time() - t0)[["elapsed"]], 2) + list(fit = fit, elapsed = elapsed) +} + +## -------------------------------------------------------------------------- +## Main loop (tout séquentiel) +## -------------------------------------------------------------------------- +results <- list() + +for (ds in DATASETS) { + ranks <- RANKS[[ds$name]] + cat(sprintf("=== %s (ranks: %s) ===\n", ds$name, paste(ranks, collapse = ","))) + + ## Pré-calculer le PLNfit pour l'init PLN-EM (une fois par dataset) + cat(" [PLN-EM] fitting full PLN inception ...\n") + t_pln <- proc.time() + pln_inc <- PLN(ds$formula, data = ds$data, control = PLN_param(trace = 0)) + t_pln <- round((proc.time() - t_pln)[["elapsed"]], 2) + cat(sprintf(" [PLN-EM] PLN done in %.1fs\n", t_pln)) + + for (backend in BACKENDS) { + for (init_method in c("LM", "GLM", "PLN-EM")) { + label <- sprintf("%-8s init=%-7s", backend, init_method) + cat(sprintf(" %s ...", label)) + + res <- run_one(ds, ranks, backend, init_method, pln_inception = pln_inc) + elapsed <- res$elapsed + + if (is.null(res$fit)) { + cat(" FAILED\n") + next + } + + for (m in res$fit$models) { + q <- m$rank + loglik <- round(m$loglik, 2) + n_iter <- if (!is.null(m$optim_par$iterations)) m$optim_par$iterations else NA_integer_ + results[[length(results) + 1]] <- data.frame( + dataset = ds$name, + rank = q, + backend = backend, + init_method = init_method, + loglik = loglik, + n_iter = as.integer(n_iter), + time_total_s = elapsed, + stringsAsFactors = FALSE + ) + } + ll_str <- paste(sapply(res$fit$models, function(m) round(m$loglik, 1)), collapse = " | ") + cat(sprintf(" %.1fs ll: %s\n", elapsed, ll_str)) + } + } + cat("\n") +} + +## -------------------------------------------------------------------------- +## Table de résultats +## -------------------------------------------------------------------------- +df <- do.call(rbind, results) + +cat("\n=== Résultats (loglik, plus grand = meilleur) ===\n\n") + +for (ds_name in unique(df$dataset)) { + sub <- df[df$dataset == ds_name, ] + cat(sprintf("-- %s --\n", ds_name)) + cat(sprintf(" %-8s %-8s %s\n", "backend", "init", paste(sprintf("q=%-4s", unique(sub$rank)), collapse = " "))) + for (b in BACKENDS) { + for (im in c("LM", "GLM", "PLN-EM")) { + row <- sub[sub$backend == b & sub$init_method == im, ] + if (nrow(row) == 0) next + row <- row[order(row$rank), ] + vals <- sprintf("%-6.1f", row$loglik) + cat(sprintf(" %-8s %-8s %s\n", b, im, paste(vals, collapse = " "))) + } + } + cat("\n") +} + +out_rds <- "inst/benchmark/bench_plnpca_init_results.rds" +saveRDS(df, out_rds) +cat("Résultats sauvegardés dans", out_rds, "\n") diff --git a/inst/benchmark/bench_plnpca_init_results.rds b/inst/benchmark/bench_plnpca_init_results.rds new file mode 100644 index 00000000..556ab425 Binary files /dev/null and b/inst/benchmark/bench_plnpca_init_results.rds differ diff --git a/inst/benchmark/bench_run.R b/inst/benchmark/bench_run.R new file mode 100644 index 00000000..059850cf --- /dev/null +++ b/inst/benchmark/bench_run.R @@ -0,0 +1,121 @@ +#!/usr/bin/env Rscript +## Usage: Rscript bench_run.R +## Runs PLN, PLNPCA, ZIPLN, PLNnetwork on trichoptera / barents / oaks. +## Metrics: time (s), loglik (ELBO), n_iter, Frobenius norms of B and Omega. + +args <- commandArgs(trailingOnly = TRUE) +if (length(args) < 3) stop("Usage: bench_run.R ") +lib_path <- args[1] +branch_name <- args[2] +out_rds <- args[3] + +.libPaths(c(lib_path, .libPaths())) +suppressPackageStartupMessages(library(PLNmodels)) +cat(sprintf("Branch: %s | PLNmodels %s\n\n", branch_name, packageVersion("PLNmodels"))) + +## ── Detect available backends ───────────────────────────────────────────────── +pln_backends <- tryCatch(as.character(formals(PLN_param)$backend)[-1], error = function(e) "nlopt") +zipln_backends <- tryCatch(as.character(formals(ZIPLN_param)$backend)[-1], error = function(e) "nlopt") +has_homemade_pln <- "homemade" %in% pln_backends +has_homemade_zipln <- "homemade" %in% zipln_backends + +cat("PLN backends available: ", paste(pln_backends, collapse=", "), "\n") +cat("ZIPLN backends available: ", paste(zipln_backends, collapse=", "), "\n\n") + +## ── Data ───────────────────────────────────────────────────────────────────── +data(trichoptera) +data(oaks) +data(barents) +tri <- prepare_data(trichoptera$Abundance, trichoptera$Covariate) + +## ── Helpers ────────────────────────────────────────────────────────────────── +frob <- function(x) if (is.null(x)) NA_real_ else norm(as.matrix(x), "F") + +extract_fit <- function(fit) { + list( + loglik = round(fit$loglik, 4), + n_iter = if (!is.null(fit$optim_par$iterations)) as.integer(fit$optim_par$iterations) else NA_integer_, + norm_B = round(frob(fit$model_par$B), 4), + norm_Om = round(frob(fit$model_par$Omega), 4) + ) +} + +run_timed <- function(expr, model, dataset, backend) { + cat(sprintf(" %-12s %-12s [%s] ... ", model, dataset, backend)) + t0 <- proc.time() + obj <- tryCatch(eval(expr), error = function(e) { cat("ERROR:", conditionMessage(e), "\n"); NULL }) + elapsed <- round((proc.time() - t0)[["elapsed"]], 3) + if (is.null(obj)) return(NULL) + + ## For families (PLNPCA, PLNnetwork) extract best model + fit <- tryCatch( + if (inherits(obj, c("PLNPCAfamily", "PLNnetworkfamily"))) { + crit <- if (inherits(obj, "PLNPCAfamily")) "ICL" else "BIC" + obj$getBestModel(crit) + } else { + obj + }, + error = function(e) obj + ) + + m <- extract_fit(fit) + cat(sprintf("done (%.2fs, ll=%.1f)\n", elapsed, m$loglik)) + data.frame( + branch = branch_name, + model = model, + dataset = dataset, + backend = backend, + time_s = elapsed, + loglik = m$loglik, + n_iter = m$n_iter, + norm_B = m$norm_B, + norm_Om = m$norm_Om, + stringsAsFactors = FALSE + ) +} + +results <- list() +add <- function(r) if (!is.null(r)) results[[length(results)+1]] <<- r + +## ── PLN ─────────────────────────────────────────────────────────────────────── +cat("=== PLN ===\n") + +for (be in c("nlopt", if (has_homemade_pln) "homemade")) { + ctrl <- PLN_param(backend = be, trace = 0) + add(run_timed(quote(PLN(Abundance ~ 1, data = tri, control = ctrl)), "PLN", "trichoptera", be)) + add(run_timed(quote(PLN(Abundance ~ Depth + Temperature, data = barents, control = ctrl)), "PLN", "barents", be)) + add(run_timed(quote(PLN(Abundance ~ 1 + offset(log(Offset)), data = oaks, control = ctrl)), "PLN", "oaks", be)) +} + +## ── PLNPCA ──────────────────────────────────────────────────────────────────── +cat("\n=== PLNPCA ===\n") + +ctrl_pca <- PLNPCA_param(trace = 0) +for (ds in list( + list(name="trichoptera", expr=quote(PLNPCA(Abundance ~ 1, data=tri, ranks=1:5, control=ctrl_pca))), + list(name="barents", expr=quote(PLNPCA(Abundance ~ Depth + Temperature, data=barents, ranks=1:5, control=ctrl_pca))), + list(name="oaks", expr=quote(PLNPCA(Abundance ~ 1 + offset(log(Offset)), data=oaks, ranks=1:5, control=ctrl_pca))) +)) { + add(run_timed(ds$expr, "PLNPCA", ds$name, "nlopt")) +} + +## ── ZIPLN ───────────────────────────────────────────────────────────────────── +cat("\n=== ZIPLN ===\n") + +for (be in c("nlopt", if (has_homemade_zipln) "homemade")) { + ctrl <- ZIPLN_param(backend = be, trace = 0) + add(run_timed(quote(ZIPLN(Abundance ~ 1, data=tri, control=ctrl)), "ZIPLN", "trichoptera", be)) + add(run_timed(quote(ZIPLN(Abundance ~ 1 + offset(log(Offset)), data=oaks, control=ctrl)), "ZIPLN", "oaks", be)) +} + +## ── PLNnetwork ──────────────────────────────────────────────────────────────── +cat("\n=== PLNnetwork ===\n") + +ctrl_net <- PLNnetwork_param(n_penalties = 10, trace = 0) +add(run_timed(quote(PLNnetwork(Abundance ~ 1, data=tri, control=ctrl_net)), "PLNnetwork", "trichoptera", "nlopt")) +add(run_timed(quote(PLNnetwork(Abundance ~ 1 + offset(log(Offset)), data=oaks, control=ctrl_net)), "PLNnetwork", "oaks", "nlopt")) + +## ── Save ────────────────────────────────────────────────────────────────────── +df <- do.call(rbind, results) +saveRDS(df, out_rds) +cat(sprintf("\nDone. %d runs saved to %s\n", nrow(df), out_rds)) diff --git a/inst/benchmark/benchmark_backends.R b/inst/benchmark/benchmark_backends.R new file mode 100644 index 00000000..dde97032 --- /dev/null +++ b/inst/benchmark/benchmark_backends.R @@ -0,0 +1,118 @@ +## Benchmark backends (nlopt / builtin / torch) sur PLN, ZIPLN, PLNPCA +## Jeux de données : trichoptera (n=49, p=17), barents (n=89, p=30), oaks (n=116, p=114) +## IMPORTANT : séquentiel uniquement (BLAS multithreadé) + +devtools::load_all(quiet = TRUE) +library(PLNmodels) + +# ── Données ────────────────────────────────────────────────────────────────── +data(trichoptera) +data(barents) +data(oaks) + +datasets <- list( + trichoptera = list( + data = prepare_data(trichoptera$Abundance, trichoptera$Covariate), + formula = Abundance ~ 1 + offset(log(Offset)), + pca_rank = 3L + ), + barents = list( + data = barents, + formula = Abundance ~ Temperature + Depth + offset(log(Offset)), + pca_rank = 5L + ), + oaks = list( + data = prepare_data(oaks$Abundance, oaks[, c("tree", "distTOtrunk", "orientation", "pmInfection")], + offset = oaks$Offset), + formula = Abundance ~ 1 + offset(log(Offset)), + pca_rank = 5L + ) +) + +backends_pln <- c("nlopt", "builtin", "torch") +backends_zipln <- c("nlopt", "builtin") # torch non supporté pour ZIPLN +backends_pca <- c("nlopt", "builtin", "torch") +cov_types <- c("full", "diagonal", "spherical") + +# ── Helper ─────────────────────────────────────────────────────────────────── +run_one <- function(expr) { + t <- system.time(m <- tryCatch(expr, error = function(e) { message(" ERROR: ", e$message); NULL })) + if (is.null(m)) return(data.frame(loglik = NA, iterations = NA, time = NA)) + # PLNPCA : récupérer le premier (seul) modèle + if (inherits(m, "PLNPCAfamily")) m <- m$models[[1]] + data.frame( + loglik = round(m$loglik, 3), + iterations = m$optim_par$iterations, + time = round(t["elapsed"], 3) + ) +} + +# ── Benchmark ───────────────────────────────────────────────────────────────── +results <- list() + +for (dname in names(datasets)) { + ds <- datasets[[dname]] + cat("\n══════════════════════════════════════════════\n") + cat(" Dataset:", dname, "\n") + cat("══════════════════════════════════════════════\n") + + # ── PLN (full / diagonal / spherical) ────────────────────────────────────── + for (cov in cov_types) { + for (bk in backends_pln) { + tag <- sprintf("PLN-%s / %s / %s", cov, bk, dname) + cat(" ", tag, "...") + res <- run_one( + PLN(ds$formula, data = ds$data, + control = PLN_param(backend = bk, covariance = cov, trace = 0)) + ) + cat(sprintf(" loglik=%.1f iter=%s t=%.2fs\n", + res$loglik, res$iterations, res$time)) + results[[tag]] <- cbind(model = "PLN", covariance = cov, + backend = bk, dataset = dname, res) + } + } + + # ── ZIPLN ────────────────────────────────────────────────────────────────── + for (bk in backends_zipln) { + tag <- sprintf("ZIPLN / %s / %s", bk, dname) + cat(" ", tag, "...") + res <- run_one( + ZIPLN(ds$formula, data = ds$data, + control = ZIPLN_param(backend = bk, trace = 0)) + ) + cat(sprintf(" loglik=%.1f iter=%s t=%.2fs\n", + res$loglik, res$iterations, res$time)) + results[[tag]] <- cbind(model = "ZIPLN", covariance = "full", + backend = bk, dataset = dname, res) + } + + # ── PLNPCA ───────────────────────────────────────────────────────────────── + for (bk in backends_pca) { + tag <- sprintf("PLNPCA(q=%d) / %s / %s", ds$pca_rank, bk, dname) + cat(" ", tag, "...") + res <- run_one( + PLNPCA(ds$formula, data = ds$data, ranks = ds$pca_rank, + control = PLNPCA_param(backend = bk, trace = 0)) + ) + cat(sprintf(" loglik=%.1f iter=%s t=%.2fs\n", + res$loglik, res$iterations, res$time)) + results[[tag]] <- cbind(model = sprintf("PLNPCA(q=%d)", ds$pca_rank), + covariance = NA, backend = bk, dataset = dname, res) + } +} + +# ── Tableau récapitulatif ───────────────────────────────────────────────────── +cat("\n\n══════════════════════════════════════════════\n") +cat(" RÉCAPITULATIF\n") +cat("══════════════════════════════════════════════\n\n") + +df <- do.call(rbind, results) +rownames(df) <- NULL + +# Affichage par dataset +for (dname in names(datasets)) { + cat(sprintf("\n--- %s ---\n", dname)) + sub <- df[df$dataset == dname, c("model", "covariance", "backend", "loglik", "iterations", "time")] + sub$covariance[is.na(sub$covariance)] <- "-" + print(sub, row.names = FALSE) +} diff --git a/inst/benchmark/convergence_analysis.R b/inst/benchmark/convergence_analysis.R new file mode 100644 index 00000000..d109df59 --- /dev/null +++ b/inst/benchmark/convergence_analysis.R @@ -0,0 +1,232 @@ +## ============================================================ +## Convergence analysis of the builtin Newton backend +## Datasets: trichoptera (n=49, p=17), barents (n=89, p=30), +## mollusk (n=163, p=32), oaks (n=116, p=114), +## microcosm (n=880, p=259), scRNA (n=3918, p=500) +## Covariances: full, diagonal, spherical +## With / without covariates +## Note: full covariance for microcosm (~30-60s) and scRNA (very slow) included +## Output: inst/benchmark/ +## ============================================================ + +suppressPackageStartupMessages({ + devtools::load_all(".", quiet = TRUE) + library(ggplot2) + library(tidyr) +}) + +ctrl <- function(cov) PLN_param(backend = "builtin", covariance = cov, trace = 0) + +## ---- trichoptera (n=49, p=17) ---- +cat("Fitting trichoptera...\n") +tri <- prepare_data(trichoptera$Abundance, trichoptera$Covariate) +fits <- list( + tri_full_nocov = PLN(Abundance ~ 1, data = tri, control = ctrl("full")), + tri_diag_nocov = PLN(Abundance ~ 1, data = tri, control = ctrl("diagonal")), + tri_sph_nocov = PLN(Abundance ~ 1, data = tri, control = ctrl("spherical")), + tri_full_cov = PLN(Abundance ~ Wind + Temperature, data = tri, control = ctrl("full")), + tri_diag_cov = PLN(Abundance ~ Wind + Temperature, data = tri, control = ctrl("diagonal")), + tri_sph_cov = PLN(Abundance ~ Wind + Temperature, data = tri, control = ctrl("spherical")) +) + +## ---- barents (n=89, p=30) ---- +cat("Fitting barents...\n") +fits <- c(fits, list( + bar_full_nocov = PLN(Abundance ~ 1 + offset(log(Offset)), data = barents, control = ctrl("full")), + bar_diag_nocov = PLN(Abundance ~ 1 + offset(log(Offset)), data = barents, control = ctrl("diagonal")), + bar_sph_nocov = PLN(Abundance ~ 1 + offset(log(Offset)), data = barents, control = ctrl("spherical")), + bar_full_cov = PLN(Abundance ~ Depth + Temperature + offset(log(Offset)), data = barents, control = ctrl("full")), + bar_diag_cov = PLN(Abundance ~ Depth + Temperature + offset(log(Offset)), data = barents, control = ctrl("diagonal")), + bar_sph_cov = PLN(Abundance ~ Depth + Temperature + offset(log(Offset)), data = barents, control = ctrl("spherical")) +)) + +## ---- mollusk (n=163, p=32) ---- +cat("Fitting mollusk...\n") +mol <- prepare_data(mollusk$Abundance, mollusk$Covariate) +fits <- c(fits, list( + mol_full_nocov = PLN(Abundance ~ 1, data = mol, control = ctrl("full")), + mol_diag_nocov = PLN(Abundance ~ 1, data = mol, control = ctrl("diagonal")), + mol_sph_nocov = PLN(Abundance ~ 1, data = mol, control = ctrl("spherical")), + mol_full_cov = PLN(Abundance ~ site + season, data = mol, control = ctrl("full")), + mol_diag_cov = PLN(Abundance ~ site + season, data = mol, control = ctrl("diagonal")), + mol_sph_cov = PLN(Abundance ~ site + season, data = mol, control = ctrl("spherical")) +)) + +## ---- oaks (n=116, p=114) ---- +cat("Fitting oaks...\n") +fits <- c(fits, list( + oak_full_nocov = PLN(Abundance ~ 1 + offset(log(Offset)), data = oaks, control = ctrl("full")), + oak_diag_nocov = PLN(Abundance ~ 1 + offset(log(Offset)), data = oaks, control = ctrl("diagonal")), + oak_sph_nocov = PLN(Abundance ~ 1 + offset(log(Offset)), data = oaks, control = ctrl("spherical")), + oak_full_cov = PLN(Abundance ~ tree + offset(log(Offset)), data = oaks, control = ctrl("full")), + oak_diag_cov = PLN(Abundance ~ tree + offset(log(Offset)), data = oaks, control = ctrl("diagonal")), + oak_sph_cov = PLN(Abundance ~ tree + offset(log(Offset)), data = oaks, control = ctrl("spherical")) +)) + +## ---- microcosm (n=880, p=259) ---- +cat("Fitting microcosm (diagonal + spherical)...\n") +fits <- c(fits, list( + mic_diag_nocov = PLN(Abundance ~ 1 + offset(log(Offset)), data = microcosm, control = ctrl("diagonal")), + mic_sph_nocov = PLN(Abundance ~ 1 + offset(log(Offset)), data = microcosm, control = ctrl("spherical")), + mic_diag_cov = PLN(Abundance ~ site + offset(log(Offset)), data = microcosm, control = ctrl("diagonal")), + mic_sph_cov = PLN(Abundance ~ site + offset(log(Offset)), data = microcosm, control = ctrl("spherical")) +)) +cat("Fitting microcosm full covariance (slow — O(n·p²) M-step with n=880, p=259)...\n") +fits <- c(fits, list( + mic_full_nocov = PLN(Abundance ~ 1 + offset(log(Offset)), data = microcosm, control = ctrl("full")), + mic_full_cov = PLN(Abundance ~ site + offset(log(Offset)), data = microcosm, control = ctrl("full")) +)) + +## ---- scRNA (n=3918, p=500) — full covariance skipped ---- +cat("Fitting scRNA diagonal + spherical (n=3918, p=500)...\n") +fits <- c(fits, list( + scr_diag_nocov = PLN(counts ~ 1 + offset(log(total_counts)), data = scRNA, control = ctrl("diagonal")), + scr_sph_nocov = PLN(counts ~ 1 + offset(log(total_counts)), data = scRNA, control = ctrl("spherical")), + scr_diag_cov = PLN(counts ~ cell_line + offset(log(total_counts)), data = scRNA, control = ctrl("diagonal")), + scr_sph_cov = PLN(counts ~ cell_line + offset(log(total_counts)), data = scRNA, control = ctrl("spherical")) +)) +cat("Fitting scRNA full covariance (very slow — O(n·p²) M-step with n=3918, p=500)...\n") +fits <- c(fits, list( + scr_full_nocov = PLN(counts ~ 1 + offset(log(total_counts)), data = scRNA, control = ctrl("full")), + scr_full_cov = PLN(counts ~ cell_line + offset(log(total_counts)), data = scRNA, control = ctrl("full")) +)) + +cat("All fits done.\n") + +## ---- Extract monitoring ---- +mon <- lapply(names(fits), function(nm) { + m <- fits[[nm]]$optim_par + obj <- m$objective + obj_norm <- (obj - min(obj)) / (max(obj) - min(obj) + .Machine$double.eps) + rel_change <- abs(diff(obj)) / (abs(obj[-length(obj)]) + 1e-30) + tail_n <- max(5L, as.integer(0.2 * length(rel_change))) + tail_slope <- if (all(tail(rel_change, tail_n) > 0)) + mean(log10(tail(rel_change, tail_n) + 1e-30)) + else NA_real_ + parts <- strsplit(nm, "_")[[1]] + list( + name = nm, + dataset = parts[1], + covariance = parts[2], + covariates = parts[3], + n_iter = m$iterations, + status = m$status, + converged = (m$status == 3), + obj_init = obj[1], + obj_final = obj[length(obj)], + rel_drop = (obj[1] - obj[length(obj)]) / abs(obj[1]), + last_delta = rel_change[length(rel_change)], + tail_slope = tail_slope, + obj_seq = obj, + rel_seq = rel_change, + obj_norm_seq = obj_norm + ) +}) + +## ---- Summary table ---- +cat("\n========== CONVERGENCE SUMMARY ==========\n") +sumtab <- do.call(rbind, lapply(mon, function(x) { + data.frame( + fit = x$name, + n_iter = x$n_iter, + converged = x$converged, + rel_drop = signif(x$rel_drop, 3), + last_delta = signif(x$last_delta, 3), + tail_slope = signif(x$tail_slope, 3), + stringsAsFactors = FALSE + ) +})) +print(sumtab, row.names = FALSE) + +## ---- Plateau detection ---- +cat("\n========== PLATEAU DETECTION (fraction of steps with delta < 1e-6) ==========\n") +for (x in mon) { + r <- x$rel_seq + frac_flat <- mean(r < 1e-6) + cat(sprintf(" %-25s %5.1f%% flat steps | %d total\n", + x$name, 100*frac_flat, x$n_iter)) +} + +## ---- EM kink detection ---- +cat("\n========== EM KINK DETECTION (local minima in rel-change = EM M-step boundaries) ==========\n") +for (x in mon) { + r <- x$rel_seq + kinks <- which(diff(sign(diff(log(r + 1e-30)))) == 2) + cat(sprintf(" %-25s ~%d EM kinks in %d inner steps (%.1f steps/EM)\n", + x$name, length(kinks), x$n_iter, + if (length(kinks) > 0) x$n_iter / length(kinks) else NaN)) +} + +## ---- Convergence speed ---- +cat("\n========== CONVERGENCE RATE (mean log10 rel-change in last 20% of steps) ==========\n") +for (x in mon) { + cat(sprintf(" %-25s tail log10(delta) = %.2f (higher = slower)\n", + x$name, x$tail_slope)) +} + +## ---- Build tidy data frames for plots ---- +df_traj <- do.call(rbind, lapply(mon, function(x) { + data.frame(name = x$name, dataset = x$dataset, covariance = x$covariance, + covariates = x$covariates, + step = seq_along(x$obj_norm_seq), obj_norm = x$obj_norm_seq, + stringsAsFactors = FALSE) +})) + +df_rel <- do.call(rbind, lapply(mon, function(x) { + data.frame(name = x$name, dataset = x$dataset, covariance = x$covariance, + covariates = x$covariates, + step = seq_along(x$rel_seq), rel_change = pmax(x$rel_seq, 1e-16), + stringsAsFactors = FALSE) +})) + +## ---- Plot 1: normalised objective (log1p) ---- +dataset_labels <- c(tri = "trichoptera (n=49, p=17)", + bar = "barents (n=89, p=30)", + mol = "mollusk (n=163, p=32)", + oak = "oaks (n=116, p=114)", + mic = "microcosm (n=880, p=259)", + scr = "scRNA (n=3918, p=500)") + +p1 <- ggplot(df_traj, aes(step, obj_norm + 1e-6, colour = covariance, linetype = covariates)) + + geom_line(linewidth = 0.6) + + facet_wrap(~ dataset, scales = "free_x", + labeller = labeller(dataset = dataset_labels)) + + scale_y_log10() + + labs(title = "Normalised inner objective (log10 scale)", + subtitle = "(obj - obj_min) / range -- 0 = fully converged", + x = "Newton step (cumulated over EM)", y = "Normalised obj", + colour = "Covariance", linetype = "Covariates") + + theme_bw(base_size = 11) + +ggsave("inst/benchmark/convergence_trajectory.pdf", p1, width = 15, height = 8) +cat("\nSaved: convergence_trajectory.pdf\n") + +## ---- Plot 2: per-step relative change ---- +p2 <- ggplot(df_rel, aes(step, rel_change, colour = covariance, linetype = covariates)) + + geom_line(linewidth = 0.5, alpha = 0.8) + + facet_wrap(~ dataset, scales = "free", + labeller = labeller(dataset = dataset_labels)) + + scale_y_log10() + + geom_hline(yintercept = 1e-8, linetype = "dotted", colour = "grey50") + + labs(title = "Per-step relative change |dobj|/|obj| (log10)", + subtitle = "Dotted = ftol_in = 1e-8 | Bumps = EM M-step boundary", + x = "Newton step", y = "Relative change", + colour = "Covariance", linetype = "Covariates") + + theme_bw(base_size = 11) + +ggsave("inst/benchmark/convergence_rel_change.pdf", p2, width = 15, height = 8) +cat("Saved: convergence_rel_change.pdf\n") + +## ---- Plot 3: distribution of step sizes ---- +p3 <- ggplot(df_rel, aes(rel_change, fill = covariance)) + + geom_histogram(bins = 50, alpha = 0.65, position = "identity") + + facet_grid(dataset ~ covariates, scales = "free_y", + labeller = labeller(dataset = dataset_labels)) + + scale_x_log10() + + geom_vline(xintercept = 1e-8, linetype = "dotted") + + labs(title = "Distribution of per-step relative changes", + x = "Relative change (log10)", fill = "Covariance") + + theme_bw(base_size = 10) + +ggsave("inst/benchmark/convergence_step_dist.pdf", p3, width = 12, height = 14) +cat("Saved: convergence_step_dist.pdf\n") diff --git a/inst/benchmark/convergence_rel_change.pdf b/inst/benchmark/convergence_rel_change.pdf new file mode 100644 index 00000000..ce6fd6ea Binary files /dev/null and b/inst/benchmark/convergence_rel_change.pdf differ diff --git a/inst/benchmark/convergence_step_dist.pdf b/inst/benchmark/convergence_step_dist.pdf new file mode 100644 index 00000000..5fbccd59 Binary files /dev/null and b/inst/benchmark/convergence_step_dist.pdf differ diff --git a/inst/benchmark/convergence_trajectory.pdf b/inst/benchmark/convergence_trajectory.pdf new file mode 100644 index 00000000..4d5fafd0 Binary files /dev/null and b/inst/benchmark/convergence_trajectory.pdf differ diff --git a/inst/case_studies/microcosm.qmd b/inst/case_studies/microcosm.qmd index 9014e0e7..1e256508 100644 --- a/inst/case_studies/microcosm.qmd +++ b/inst/case_studies/microcosm.qmd @@ -152,7 +152,7 @@ model_selection %>% gt() %>% ), locations = cells_body( columns = c("ICL"), - rows = c(2, 8, 17) + rows = c(2, 7, 17) )) ``` diff --git a/inst/case_studies/mixture_iris.R b/inst/case_studies/mixture_iris.R index 08185e8e..1ac7f38c 100644 --- a/inst/case_studies/mixture_iris.R +++ b/inst/case_studies/mixture_iris.R @@ -4,25 +4,24 @@ library(PLNmodels) library(tidyverse) library(viridisLite) -nb_cores <- 4 - count <- iris %>% dplyr::select(-Species) %>% exp() %>% round() %>% as.matrix() covariate <- data.frame(Species = iris$Species) iris_data <- prepare_data(count, covariate) -my_mixtures <- PLNmixture(Abundance ~ 1 + offset(log(Offset)), clusters = 1:5, data = iris_data, control_main = list(core = nb_cores)) +my_mixtures <- PLNmixture(Abundance ~ 1 + offset(log(Offset)), clusters = 1:5, data = iris_data) plot(my_mixtures) myPLN <- getBestModel(my_mixtures) +myPLN <- getModel(my_mixtures, 3) plot(myPLN, type = "pca") plot(myPLN, type = "matrix") aricode::ARI(myPLN$memberships, iris$Species) -my_mixtures_covar <- PLNmixture(Abundance ~ 0 + Species + offset(log(Offset)), clusters = 1:3, data = iris_data, control_main = list(core = nb_cores)) +my_mixtures_covar <- PLNmixture(Abundance ~ 0 + Species + offset(log(Offset)), clusters = 1:3, data = iris_data) plot(my_mixtures_covar) -myPLN_covar <- getBestModel(my_mixtures_covar) +myPLN_covar <- getModel(my_mixtures_covar, 2) plot(myPLN_covar, "pca") plot(myPLN_covar, "matrix") diff --git a/inst/case_studies/mollusk.R b/inst/case_studies/mollusk.R index cb350efa..c2498602 100644 --- a/inst/case_studies/mollusk.R +++ b/inst/case_studies/mollusk.R @@ -7,8 +7,8 @@ mollusc <- prepare_data(mollusk$Abundance, mollusk$Covariate)#> Warning: Sample( ## simple PLN system.time(myPLN_M0 <- PLN(Abundance ~ 1 + offset(log(Offset)), data = mollusc)) system.time(myPLN <- PLN(Abundance ~ 0 + site + offset(log(Offset)), data = mollusc)) -system.time(myPLN_diagonal <- PLN(Abundance ~ 0 + site + offset(log(Offset)), data = mollusc, control = list(covariance = "diagonal"))) -system.time(myPLN_spherical <- PLN(Abundance ~ 0 + site + offset(log(Offset)), data = mollusc, control = list(covariance = "spherical"))) +system.time(myPLN_diagonal <- PLN(Abundance ~ 0 + site + offset(log(Offset)), data = mollusc, control = PLN_param(covariance = "diagonal"))) +system.time(myPLN_spherical <- PLN(Abundance ~ 0 + site + offset(log(Offset)), data = mollusc, control = PLN_param(covariance = "spherical"))) rbind( myPLN_M0$criteria, diff --git a/inst/case_studies/oaks_tree.R b/inst/case_studies/oaks_tree.R index e93ac50f..9008c3e1 100644 --- a/inst/case_studies/oaks_tree.R +++ b/inst/case_studies/oaks_tree.R @@ -1,11 +1,6 @@ library(PLNmodels) library(factoextra) -## setting up future for parallelism -nb_cores <- 10 -options(future.fork.enable = TRUE) -future::plan("multicore", workers = nb_cores) - ## get oaks data set data(oaks) @@ -53,8 +48,6 @@ rbind( "ZIPLN diagonal single", "ZIPLN diagonal column prob", "ZIPLN diagonal row prob", "ZIPLN diagonal covar prob")) %>% knitr::kable() - - ## Discriminant Analysis with LDA myLDA_tree <- PLNLDA(Abundance ~ 1 + offset(log(Offset)), grouping = tree, data = oaks) plot(myLDA_tree) @@ -65,7 +58,7 @@ plot(myLDA_tree_diagonal) otu.family <- factor(rep(c("fungi", "E. aphiltoides", "bacteria"), c(47, 1, 66))) plot(myLDA_tree, "variable", var_cols = otu.family) ## TODO: add color for arrows to check -myLDA_tree_spherical <- PLNLDA(Abundance ~ 1 + offset(log(Offset)), grouping = tree, data = oaks, control = PLN_param(covariance = "spherical")) +myLDA_tree_spherical <- PLNLDA(Abundance ~ 1 + offset(log(Offset)), grouping = tree, data = oaks, control = PLNLDA_param(covariance = "spherical")) plot(myLDA_tree_spherical) ## One dimensional check of plot @@ -73,7 +66,7 @@ myLDA_orientation <- PLNLDA(Abundance ~ 1 + offset(log(Offset)), grouping = orie plot(myLDA_orientation) ## Dimension reduction with PCA -system.time(myPLNPCAs <- PLNPCA(Abundance ~ 1 + offset(log(Offset)), data = oaks, ranks = 1:30)) # about 40 secs. +system.time(myPLNPCAs <- PLNPCA(Abundance ~ 1 + offset(log(Offset)), data = oaks, ranks = c(1, 5, 10, 20, 30, 35))) plot(myPLNPCAs) myPLNPCA <- getBestModel(myPLNPCAs) plot(myPLNPCA, ind_cols = oaks$tree) @@ -85,7 +78,7 @@ factoextra::fviz_pca_biplot( ) + labs(col = "distance (cm)") + scale_color_viridis_d() ## Dimension reduction with PCA -system.time(myPLNPCAs_tree <- PLNPCA(Abundance ~ 0 + tree + offset(log(Offset)), data = oaks, ranks = 1:30)) # about 40 sec. +system.time(myPLNPCAs_tree <- PLNPCA(Abundance ~ 0 + tree + offset(log(Offset)), data = oaks, ranks = c(1, 5, 10, 20, 30, 35))) plot(myPLNPCAs_tree) myPLNPCA_tree <- getBestModel(myPLNPCAs_tree) @@ -96,8 +89,7 @@ factoextra::fviz_pca_biplot( labs(col = "distance (cm)") + scale_color_viridis_c() ## Network inference with sparce covariance estimation - -system.time(myPLNnets <- PLNnetwork(Abundance ~ 0 + tree + offset(log(Offset)), data = oaks, control = PLNnetwork_param(min_ratio = 0.1))) +system.time(myPLNnets <- PLNnetwork(Abundance ~ 0 + tree + offset(log(Offset)), data = oaks, control = PLNnetwork_param(min_ratio = 0.02))) plot(myPLNnets) plot(getBestModel(myPLNnets, "EBIC")) # stability_selection(myPLNnets) @@ -135,12 +127,9 @@ system.time(my_mixtures <- PLNmixture(Abundance ~ 0 + tree + distTOground + offs plot(my_mixtures, criteria = c("loglik", "ICL", "BIC"), reverse = TRUE) -myPLN <- my_mixtures %>% getBestModel("ICL") +myPLN <- my_mixtures %>% getModel(4) myPLN$plot_clustering_pca(main = 'clustering memberships in individual factor map') p <- myPLN$plot_clustering_data() aricode::ARI(myPLN$memberships, oaks$tree) - - -future::plan("sequential") diff --git a/inst/missing_data/call_optim_PCA.R b/inst/missing_data/call_optim_PCA.R deleted file mode 100644 index 1a3993b4..00000000 --- a/inst/missing_data/call_optim_PCA.R +++ /dev/null @@ -1,26 +0,0 @@ -library(PLNmodels) -data("trichoptera") -trichoptera <- prepare_data(trichoptera$Abundance, trichoptera$Covariate) - -Y <- as.matrix(trichoptera$Abundance) -X <- model.matrix(Abundance ~ 1, data = trichoptera) -n <- nrow(Y) -p <- ncol(Y) -d <- ncol(X) # number of covariates -q <- 5 # number of PCA components -O <- matrix(0, nrow = n, ncol = p) - -data <- list(Y = Y, - X = X, - O = O, - w = rep(1,n)) - -params <- list(B = matrix(0, d, p), - C = matrix(0, p, q), - M = matrix(0, n, q), - S = matrix(0.1, n, q) - ) -config <- PLNPCA_param()$config_optim - -out <- PLNmodels:::nlopt_optimize_rank(data, params, config) - diff --git a/inst/simus_ZIPLN/essai_ZIPLN.R b/inst/simus_ZIPLN/essai_ZIPLN.R index bf494ff2..fda84cc9 100644 --- a/inst/simus_ZIPLN/essai_ZIPLN.R +++ b/inst/simus_ZIPLN/essai_ZIPLN.R @@ -2,6 +2,7 @@ library(PLNmodels) library(MASS) library(tidyverse) library(parallel) +library(viridisLite) rZIPLN <- function(n = 10, mu = rep(0, ncol(Sigma)), @@ -129,12 +130,12 @@ one_simu <- function(i) { res <- do.call(rbind, lapply(1:50, one_simu)) -p <- ggplot(res) + aes(x = factor(n), y = pred_Y, fill = factor(method)) + geom_violin() + theme_bw() + +p <- ggplot(res) + aes(x = factor(n), y = pred_Y, fill = factor(method)) + geom_violin() + scale_fill_viridis_d() + theme_bw() + scale_y_log10() + ylim(c(0,2)) p -p <- ggplot(res) + aes(x = factor(n), y = rmse_B, fill = factor(method)) + geom_violin() + theme_bw() + scale_y_log10() + ylim(c(2,5)) +p <- ggplot(res) + aes(x = factor(n), y = rmse_B, fill = factor(method)) + geom_violin() + scale_fill_viridis_d() + theme_bw() + scale_y_log10() + ylim(c(2,5)) p -p <- ggplot(res) + aes(x = factor(n), y = rmse_Omega, fill = factor(method)) + geom_violin() + theme_bw() + scale_y_log10() + ylim(c(0.1,.3)) +p <- ggplot(res) + aes(x = factor(n), y = rmse_Omega, fill = factor(method)) + geom_violin() + scale_fill_viridis_d() + theme_bw() + scale_y_log10() + ylim(c(0.1,.3)) p diff --git a/man/AIC.PLNfit.Rd b/man/AIC.PLNfit.Rd new file mode 100644 index 00000000..87978c52 --- /dev/null +++ b/man/AIC.PLNfit.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/PLNfit-S3methods.R +\name{AIC.PLNfit} +\alias{AIC.PLNfit} +\title{Akaike Information Criterion for a fitted PLN model} +\usage{ +\method{AIC}{PLNfit}(object, ..., k = 2) +} +\arguments{ +\item{object}{an R6 object with class \code{\link{PLNfit}}} + +\item{...}{additional parameters for S3 compatibility. Not used} + +\item{k}{not used, present for S3 compatibility.} +} +\value{ +A scalar: the variational AIC (larger is better). +} +\description{ +Computes the variational AIC as \code{loglik - nb_param} (larger is better). +This follows the maximization convention used throughout PLNmodels. +} +\examples{ +data(trichoptera) +trichoptera <- prepare_data(trichoptera$Abundance, trichoptera$Covariate) +model <- PLN(Abundance ~ 1, data = trichoptera) +AIC(model) +} diff --git a/man/AIC.ZIPLNfit.Rd b/man/AIC.ZIPLNfit.Rd new file mode 100644 index 00000000..62eb39ab --- /dev/null +++ b/man/AIC.ZIPLNfit.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ZIPLNfit-S3methods.R +\name{AIC.ZIPLNfit} +\alias{AIC.ZIPLNfit} +\title{Akaike Information Criterion for a fitted ZIPLN model} +\usage{ +\method{AIC}{ZIPLNfit}(object, ..., k = 2) +} +\arguments{ +\item{object}{an R6 object with class \code{\link{ZIPLNfit}}} + +\item{...}{additional parameters for S3 compatibility. Not used} + +\item{k}{not used, present for S3 compatibility.} +} +\value{ +A scalar: the variational AIC (larger is better). +} +\description{ +Computes the variational AIC as \code{loglik - nb_param} (larger is better). +This follows the maximization convention used throughout PLNmodels. +} +\examples{ +data(trichoptera) +trichoptera <- prepare_data(trichoptera$Abundance, trichoptera$Covariate) +model <- ZIPLN(Abundance ~ 1, data = trichoptera) +AIC(model) +} diff --git a/man/BIC.PLNfit.Rd b/man/BIC.PLNfit.Rd new file mode 100644 index 00000000..ef0be33c --- /dev/null +++ b/man/BIC.PLNfit.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/PLNfit-S3methods.R +\name{BIC.PLNfit} +\alias{BIC.PLNfit} +\title{Bayesian Information Criterion for a fitted PLN model} +\usage{ +\method{BIC}{PLNfit}(object, ...) +} +\arguments{ +\item{object}{an R6 object with class \code{\link{PLNfit}}} + +\item{...}{additional parameters for S3 compatibility. Not used} +} +\value{ +A scalar: the variational BIC (larger is better). +} +\description{ +Computes the variational BIC as \code{loglik - 0.5 * log(n) * nb_param} (larger is better). +This follows the maximization convention used throughout PLNmodels. +} +\examples{ +data(trichoptera) +trichoptera <- prepare_data(trichoptera$Abundance, trichoptera$Covariate) +model <- PLN(Abundance ~ 1, data = trichoptera) +BIC(model) +} diff --git a/man/BIC.ZIPLNfit.Rd b/man/BIC.ZIPLNfit.Rd new file mode 100644 index 00000000..f508dc12 --- /dev/null +++ b/man/BIC.ZIPLNfit.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ZIPLNfit-S3methods.R +\name{BIC.ZIPLNfit} +\alias{BIC.ZIPLNfit} +\title{Bayesian Information Criterion for a fitted ZIPLN model} +\usage{ +\method{BIC}{ZIPLNfit}(object, ...) +} +\arguments{ +\item{object}{an R6 object with class \code{\link{ZIPLNfit}}} + +\item{...}{additional parameters for S3 compatibility. Not used} +} +\value{ +A scalar: the variational BIC (larger is better). +} +\description{ +Computes the variational BIC as \code{loglik - 0.5 * log(n) * nb_param} (larger is better). +This follows the maximization convention used throughout PLNmodels. +} +\examples{ +data(trichoptera) +trichoptera <- prepare_data(trichoptera$Abundance, trichoptera$Covariate) +model <- ZIPLN(Abundance ~ 1, data = trichoptera) +BIC(model) +} diff --git a/man/ICL.Rd b/man/ICL.Rd new file mode 100644 index 00000000..8b5b8644 --- /dev/null +++ b/man/ICL.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/PLNfit-S3methods.R, R/ZIPLNfit-S3methods.R +\name{ICL} +\alias{ICL} +\alias{ICL.PLNfit} +\alias{ICL.ZIPLNfit} +\title{Integrated Classification Likelihood} +\usage{ +ICL(object, ...) + +\method{ICL}{PLNfit}(object, ...) + +\method{ICL}{ZIPLNfit}(object, ...) +} +\arguments{ +\item{object}{an R6 object with class \code{\link{ZIPLNfit}}} + +\item{...}{additional parameters passed to methods} +} +\value{ +A scalar: the variational ICL (larger is better). +} +\description{ +Generic function to compute the Integrated Classification Likelihood (ICL) of a fitted model. +ICL = BIC - entropy of the variational distribution (larger is better). + +\code{ICL.PLNfit}: ICL for a fitted \code{\link{PLNfit}}. + +\code{ICL.ZIPLNfit}: ICL for a fitted \code{\link{ZIPLNfit}}. +} +\examples{ +data(trichoptera) +trichoptera <- prepare_data(trichoptera$Abundance, trichoptera$Covariate) +model <- PLN(Abundance ~ 1, data = trichoptera) +ICL(model) +data(trichoptera) +trichoptera <- prepare_data(trichoptera$Abundance, trichoptera$Covariate) +model <- ZIPLN(Abundance ~ 1, data = trichoptera) +ICL(model) +} diff --git a/man/Networkfamily.Rd b/man/Networkfamily.Rd index d0eefcce..530fb5a4 100644 --- a/man/Networkfamily.Rd +++ b/man/Networkfamily.Rd @@ -16,220 +16,227 @@ See the documentation for \code{\link[=getBestModel]{getBestModel()}}, The functions \code{\link[=PLNnetwork]{PLNnetwork()}}, \code{\link[=ZIPLNnetwork]{ZIPLNnetwork()}} and the classes \code{\link{PLNnetworkfit}}, \code{\link{ZIPLNfit_sparse}} } \section{Super class}{ -\code{\link[PLNmodels:PLNfamily]{PLNmodels::PLNfamily}} -> \code{Networkfamily} +\code{\link[PLNmodels:PLNfamily]{PLNfamily}} -> \code{Networkfamily} } \section{Active bindings}{ -\if{html}{\out{
}} -\describe{ -\item{\code{penalties}}{the sparsity level of the network in the successively fitted models} + \if{html}{\out{
}} + \describe{ + \item{\code{penalties}}{the sparsity level of the network in the successively fitted models} -\item{\code{stability_path}}{the stability path of each edge as returned by the stars procedure} + \item{\code{stability_path}}{the stability path of each edge as returned by the stars procedure} -\item{\code{stability}}{mean edge stability along the penalty path} + \item{\code{stability}}{mean edge stability along the penalty path} -\item{\code{criteria}}{a data frame with the values of some criteria (variational log-likelihood, (E)BIC, ICL and R2, stability) for the collection of models / fits + \item{\code{criteria}}{a data frame with the values of some criteria (variational log-likelihood, (E)BIC, ICL and R2, stability) for the collection of models / fits BIC, ICL and EBIC are defined so that they are on the same scale as the model log-likelihood, i.e. with the form, loglik - 0.5 penalty} -} -\if{html}{\out{
}} + } + \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ -\itemize{ -\item \href{#method-Networkfamily-new}{\code{Networkfamily$new()}} -\item \href{#method-Networkfamily-optimize}{\code{Networkfamily$optimize()}} -\item \href{#method-Networkfamily-coefficient_path}{\code{Networkfamily$coefficient_path()}} -\item \href{#method-Networkfamily-getBestModel}{\code{Networkfamily$getBestModel()}} -\item \href{#method-Networkfamily-plot}{\code{Networkfamily$plot()}} -\item \href{#method-Networkfamily-plot_stars}{\code{Networkfamily$plot_stars()}} -\item \href{#method-Networkfamily-plot_objective}{\code{Networkfamily$plot_objective()}} -\item \href{#method-Networkfamily-show}{\code{Networkfamily$show()}} -\item \href{#method-Networkfamily-clone}{\code{Networkfamily$clone()}} -} -} -\if{html}{\out{ -
Inherited methods + \itemize{ + \item \href{#method-Networkfamily-initialize}{\code{Networkfamily$new()}} + \item \href{#method-Networkfamily-optimize}{\code{Networkfamily$optimize()}} + \item \href{#method-Networkfamily-coefficient_path}{\code{Networkfamily$coefficient_path()}} + \item \href{#method-Networkfamily-getBestModel}{\code{Networkfamily$getBestModel()}} + \item \href{#method-Networkfamily-plot}{\code{Networkfamily$plot()}} + \item \href{#method-Networkfamily-plot_stars}{\code{Networkfamily$plot_stars()}} + \item \href{#method-Networkfamily-plot_objective}{\code{Networkfamily$plot_objective()}} + \item \href{#method-Networkfamily-show}{\code{Networkfamily$show()}} + \item \href{#method-Networkfamily-clone}{\code{Networkfamily$clone()}} + } +} +\if{html}{\out{
Inherited methods -
-}} +
}} \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-Networkfamily-new}{}}} -\subsection{Method \code{new()}}{ -Initialize all models in the collection -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Networkfamily$new(penalties, data, control)}\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-Networkfamily-initialize}{}}} +\subsection{\code{Networkfamily$new()}}{ + Initialize all models in the collection + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{Networkfamily$new(penalties, data, control)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{penalties}}{a vector of positive real number controlling the level of sparsity of the underlying network.} + \item{\code{data}}{a named list used internally to carry the data matrices} + \item{\code{control}}{a list for controlling the optimization.} + } + \if{html}{\out{
}} + } + \subsection{Returns}{ + Update all network fits in the family with smart starting values + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{penalties}}{a vector of positive real number controlling the level of sparsity of the underlying network.} - -\item{\code{data}}{a named list used internally to carry the data matrices} - -\item{\code{control}}{a list for controlling the optimization.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -Update all network fits in the family with smart starting values -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Networkfamily-optimize}{}}} -\subsection{Method \code{optimize()}}{ -Call to the C++ optimizer on all models of the collection -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Networkfamily$optimize(data, config)}\if{html}{\out{
}} +\subsection{\code{Networkfamily$optimize()}}{ + Call to the C++ optimizer on all models of the collection + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{Networkfamily$optimize(data, config)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{data}}{a named list used internally to carry the data matrices} + \item{\code{config}}{a list for controlling the optimization.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{data}}{a named list used internally to carry the data matrices} - -\item{\code{config}}{a list for controlling the optimization.} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Networkfamily-coefficient_path}{}}} -\subsection{Method \code{coefficient_path()}}{ -Extract the regularization path of a \code{\link{Networkfamily}} -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Networkfamily$coefficient_path(precision = TRUE, corr = TRUE)}\if{html}{\out{
}} +\subsection{\code{Networkfamily$coefficient_path()}}{ + Extract the regularization path of a \code{\link{Networkfamily}} + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{Networkfamily$coefficient_path(precision = TRUE, corr = TRUE)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{precision}}{Logical. Should the regularization path be extracted from the precision matrix Omega (\code{TRUE}, default) or from the variance matrix Sigma (\code{FALSE})} + \item{\code{corr}}{Logical. Should the matrix be transformed to (partial) correlation matrix before extraction? Defaults to \code{TRUE}} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{precision}}{Logical. Should the regularization path be extracted from the precision matrix Omega (\code{TRUE}, default) or from the variance matrix Sigma (\code{FALSE})} - -\item{\code{corr}}{Logical. Should the matrix be transformed to (partial) correlation matrix before extraction? Defaults to \code{TRUE}} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Networkfamily-getBestModel}{}}} -\subsection{Method \code{getBestModel()}}{ -Extract the best network in the family according to some criteria -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Networkfamily$getBestModel(crit = c("BIC", "EBIC", "StARS"), stability = 0.9)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{crit}}{character. Criterion used to perform the selection. If "StARS" is chosen but \verb{$stability} field is empty, will compute stability path.} - -\item{\code{stability}}{Only used for "StARS" criterion. A scalar indicating the target stability (= 1 - 2 beta) at which the network is selected. Default is \code{0.9}.} -} -\if{html}{\out{
}} -} -\subsection{Details}{ -For BIC and EBIC criteria, higher is better. +\subsection{\code{Networkfamily$getBestModel()}}{ + Extract the best network in the family according to some criteria + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{Networkfamily$getBestModel(crit = c("BIC", "EBIC", "StARS"), stability = 0.9)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{crit}}{character. Criterion used to perform the selection. If "StARS" is chosen but \verb{$stability} field is empty, will compute stability path.} + \item{\code{stability}}{Only used for "StARS" criterion. A scalar indicating the target stability (= 1 - 2 beta) at which the network is selected. Default is \code{0.9}.} + } + \if{html}{\out{
}} + } + \subsection{Details}{ + For BIC and EBIC criteria, higher is better. + } } -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Networkfamily-plot}{}}} -\subsection{Method \code{plot()}}{ -Display various outputs (goodness-of-fit criteria, robustness, diagnostic) associated with a collection of network fits (a \code{\link{Networkfamily}}) -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Networkfamily$plot( +\subsection{\code{Networkfamily$plot()}}{ + Display various outputs (goodness-of-fit criteria, robustness, diagnostic) associated with a collection of network fits (a \code{\link{Networkfamily}}) + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{Networkfamily$plot( criteria = c("loglik", "pen_loglik", "BIC", "EBIC"), reverse = FALSE, log.x = TRUE -)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{criteria}}{vector of characters. The criteria to plot in \code{c("loglik", "pen_loglik", "BIC", "EBIC")}. Defaults to all of them.} - -\item{\code{reverse}}{A logical indicating whether to plot the value of the criteria in the "natural" direction +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{criteria}}{vector of characters. The criteria to plot in \code{c("loglik", "pen_loglik", "BIC", "EBIC")}. Defaults to all of them.} + \item{\code{reverse}}{A logical indicating whether to plot the value of the criteria in the "natural" direction (loglik - 0.5 penalty) or in the "reverse" direction (-2 loglik + penalty). Default to FALSE, i.e use the natural direction, on the same scale as the log-likelihood.} - -\item{\code{log.x}}{logical: should the x-axis be represented in log-scale? Default is \code{TRUE}.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -a \code{\link[ggplot2:ggplot]{ggplot2::ggplot}} graph -} + \item{\code{log.x}}{logical: should the x-axis be represented in log-scale? Default is \code{TRUE}.} + } + \if{html}{\out{
}} + } + \subsection{Returns}{ + a \code{\link[ggplot2:ggplot]{ggplot2::ggplot}} graph + } } + \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Networkfamily-plot_stars}{}}} -\subsection{Method \code{plot_stars()}}{ -Plot stability path -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Networkfamily$plot_stars(stability = 0.9, log.x = TRUE)}\if{html}{\out{
}} +\subsection{\code{Networkfamily$plot_stars()}}{ + Plot stability path + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{Networkfamily$plot_stars(stability = 0.9, log.x = TRUE)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{stability}}{scalar: the targeted level of stability using stability selection. Default is \code{0.9}.} + \item{\code{log.x}}{logical: should the x-axis be represented in log-scale? Default is \code{TRUE}.} + } + \if{html}{\out{
}} + } + \subsection{Returns}{ + a \code{\link[ggplot2:ggplot]{ggplot2::ggplot}} graph + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{stability}}{scalar: the targeted level of stability using stability selection. Default is \code{0.9}.} - -\item{\code{log.x}}{logical: should the x-axis be represented in log-scale? Default is \code{TRUE}.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -a \code{\link[ggplot2:ggplot]{ggplot2::ggplot}} graph -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Networkfamily-plot_objective}{}}} -\subsection{Method \code{plot_objective()}}{ -Plot objective value of the optimization problem along the penalty path -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Networkfamily$plot_objective()}\if{html}{\out{
}} +\subsection{\code{Networkfamily$plot_objective()}}{ + Plot objective value of the optimization problem along the penalty path + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{Networkfamily$plot_objective()} + \if{html}{\out{
}} + } + \subsection{Returns}{ + a \code{\link[ggplot2:ggplot]{ggplot2::ggplot}} graph + } } -\subsection{Returns}{ -a \code{\link[ggplot2:ggplot]{ggplot2::ggplot}} graph -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Networkfamily-show}{}}} -\subsection{Method \code{show()}}{ -User friendly print method -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Networkfamily$show()}\if{html}{\out{
}} +\subsection{\code{Networkfamily$show()}}{ + User friendly print method + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{Networkfamily$show()} + \if{html}{\out{
}} + } } -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Networkfamily-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Networkfamily$clone(deep = FALSE)}\if{html}{\out{
}} +\subsection{\code{Networkfamily$clone()}}{ + The objects of this class are cloneable with this method. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{Networkfamily$clone(deep = FALSE)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{deep}}{Whether to make a deep clone.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} } diff --git a/man/PLN.Rd b/man/PLN.Rd index c5452397..f8d18e87 100644 --- a/man/PLN.Rd +++ b/man/PLN.Rd @@ -9,7 +9,7 @@ PLN(formula, data, subset, weights, control = PLN_param()) \arguments{ \item{formula}{an object of class "formula": a symbolic description of the model to be fitted.} -\item{data}{an optional data frame, list or environment (or object coercible by as.data.frame to a data frame) containing the variables in the model. If not found in data, the variables are taken from environment(formula), typically the environment from which PLN is called.} +\item{data}{an optional data frame, list or environment (or object coercible by as.data.frame to a data frame) containing the variables in the model. If not found in data, the variables are taken from environment(formula), typically the environment from which the model is called.} \item{subset}{an optional vector specifying a subset of observations to be used in the fitting process.} diff --git a/man/PLNLDA.Rd b/man/PLNLDA.Rd index 4d42c46e..32c005da 100644 --- a/man/PLNLDA.Rd +++ b/man/PLNLDA.Rd @@ -4,12 +4,12 @@ \alias{PLNLDA} \title{Poisson lognormal model towards Linear Discriminant Analysis} \usage{ -PLNLDA(formula, data, subset, weights, grouping, control = PLN_param()) +PLNLDA(formula, data, subset, weights, grouping, control = PLNLDA_param()) } \arguments{ \item{formula}{an object of class "formula": a symbolic description of the model to be fitted.} -\item{data}{an optional data frame, list or environment (or object coercible by as.data.frame to a data frame) containing the variables in the model. If not found in data, the variables are taken from environment(formula), typically the environment from which lm is called.} +\item{data}{an optional data frame, list or environment (or object coercible by as.data.frame to a data frame) containing the variables in the model. If not found in data, the variables are taken from environment(formula), typically the environment from which the model is called.} \item{subset}{an optional vector specifying a subset of observations to be used in the fitting process.} @@ -17,7 +17,7 @@ PLNLDA(formula, data, subset, weights, grouping, control = PLN_param()) \item{grouping}{a factor specifying the class of each observation used for discriminant analysis.} -\item{control}{a list-like structure for controlling the optimization, with default generated by \code{\link[=PLN_param]{PLN_param()}}. See the associated documentation} +\item{control}{a list-like structure for controlling the optimization, with default generated by \code{\link[=PLNLDA_param]{PLNLDA_param()}}. See the associated documentation.} } \value{ an R6 object with class \code{\link[=PLNLDAfit]{PLNLDAfit()}} @@ -26,19 +26,8 @@ an R6 object with class \code{\link[=PLNLDAfit]{PLNLDAfit()}} Fit the Poisson lognormal for LDA with a variational algorithm. Use the (g)lm syntax for model specification (covariates, offsets). } \details{ -The parameter \code{control} is a list controlling the optimization with the following entries: -\itemize{ -\item "covariance" character setting the model for the covariance matrix. Either "full" or "spherical". Default is "full". -\item "trace" integer for verbosity. -\item "inception" Set up the initialization. By default, the model is initialized with a multivariate linear model applied on log-transformed data. However, the user can provide a PLNfit (typically obtained from a previous fit), which often speed up the inference. -\item "ftol_rel" stop when an optimization step changes the objective function by less than ftol multiplied by the absolute value of the parameter. Default is 1e-8 -\item "ftol_abs" stop when an optimization step changes the objective function by less than ftol multiplied by the absolute value of the parameter. Default is 0 -\item "xtol_rel" stop when an optimization step changes every parameters by less than xtol multiplied by the absolute value of the parameter. Default is 1e-6 -\item "xtol_abs" stop when an optimization step changes every parameters by less than xtol multiplied by the absolute value of the parameter. Default is 0 -\item "maxeval" stop when the number of iteration exceeds maxeval. Default is 10000 -\item "maxtime" stop when the optimization time (in seconds) exceeds maxtime. Default is -1 (no restriction) -\item "algorithm" the optimization method used by NLOPT among LD type, i.e. "CCSAQ", "MMA", "LBFGS", "VAR1", "VAR2". See NLOPT documentation for further details. Default is "CCSAQ". -} +See \code{\link[=PLNLDA_param]{PLNLDA_param()}} for a full description of the optimization parameters. +Note that unlike \code{\link[=PLN_param]{PLN_param()}}, \code{\link[=PLNLDA_param]{PLNLDA_param()}} does not expose the \code{"fixed"} covariance option or the \code{Omega} parameter, which are not meaningful in the LDA context. } \examples{ data(trichoptera) diff --git a/man/PLNLDA_param.Rd b/man/PLNLDA_param.Rd index 8ab56640..ef746a33 100644 --- a/man/PLNLDA_param.Rd +++ b/man/PLNLDA_param.Rd @@ -5,7 +5,7 @@ \title{Control of a PLNLDA fit} \usage{ PLNLDA_param( - backend = c("nlopt", "torch"), + backend = c("builtin", "nlopt", "torch"), trace = 1, covariance = c("full", "diagonal", "spherical"), config_post = list(), @@ -62,6 +62,14 @@ When "torch" backend is used (only for PLN and PLNLDA for now), the following en \item "centered" if TRUE, compute the centered RMSProp where the gradient is normalized by an estimation of its variance weight_decay (L2 penalty). Default to FALSE. Only used in RMSPROP } +When "builtin" backend is used, the following entries are relevant +\itemize{ +\item "maxeval" stop when the number of Newton steps in the inner loop exceeds maxeval. Default is 10000 +\item "ftol_in" stop the inner loop when the objective changes by less than ftol_in (relative). Default is 1e-8 +\item "maxit_em" stop the EM outer loop when the number of EM iterations exceeds maxit_em. Default is 50 +\item "ftol_em" stop the EM outer loop when the ELBO changes by less than ftol_em (relative). Default is 1e-8 +} + The list of parameters \code{config_post} controls the post-treatment processing (for most \verb{PLN*()} functions), with the following entries (defaults may vary depending on the specific function, check \verb{config_post_default_*} for defaults values): \itemize{ \item jackknife boolean indicating whether jackknife should be performed to evaluate bias and variance of the model parameters. Default is FALSE. diff --git a/man/PLNLDAfit.Rd b/man/PLNLDAfit.Rd index 586089d3..2740381b 100644 --- a/man/PLNLDAfit.Rd +++ b/man/PLNLDAfit.Rd @@ -23,59 +23,58 @@ print(myPLNLDA) The function \code{\link{PLNLDA}}. } \section{Super class}{ -\code{\link[PLNmodels:PLNfit]{PLNmodels::PLNfit}} -> \code{PLNLDAfit} +\code{\link[PLNmodels:PLNfit]{PLNfit}} -> \code{PLNLDAfit} } \section{Active bindings}{ -\if{html}{\out{
}} -\describe{ -\item{\code{rank}}{the dimension of the current model} + \if{html}{\out{
}} + \describe{ + \item{\code{rank}}{the dimension of the current model} -\item{\code{nb_param}}{number of parameters in the current PLN model} + \item{\code{nb_param}}{number of parameters in the current PLN model} -\item{\code{model_par}}{a list with the matrices associated with the estimated parameters of the PLN model: B (covariates), Sigma (latent covariance), C (latent loadings), P (latent position) and Mu (group means)} + \item{\code{model_par}}{a list with the matrices associated with the estimated parameters of the PLN model: B (covariates), Sigma (latent covariance), C (latent loadings), P (latent position) and Mu (group means)} -\item{\code{percent_var}}{the percent of variance explained by each axis} + \item{\code{percent_var}}{the percent of variance explained by each axis} -\item{\code{corr_map}}{a matrix of correlations to plot the correlation circles} + \item{\code{corr_map}}{a matrix of correlations to plot the correlation circles} -\item{\code{scores}}{a matrix of scores to plot the individual factor maps} + \item{\code{scores}}{a matrix of scores to plot the individual factor maps} -\item{\code{group_means}}{a matrix of group mean vectors in the latent space.} -} -\if{html}{\out{
}} + \item{\code{group_means}}{a matrix of group mean vectors in the latent space.} + } + \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ -\itemize{ -\item \href{#method-PLNLDAfit-new}{\code{PLNLDAfit$new()}} -\item \href{#method-PLNLDAfit-optimize}{\code{PLNLDAfit$optimize()}} -\item \href{#method-PLNLDAfit-postTreatment}{\code{PLNLDAfit$postTreatment()}} -\item \href{#method-PLNLDAfit-setVisualization}{\code{PLNLDAfit$setVisualization()}} -\item \href{#method-PLNLDAfit-plot_individual_map}{\code{PLNLDAfit$plot_individual_map()}} -\item \href{#method-PLNLDAfit-plot_correlation_map}{\code{PLNLDAfit$plot_correlation_map()}} -\item \href{#method-PLNLDAfit-plot_LDA}{\code{PLNLDAfit$plot_LDA()}} -\item \href{#method-PLNLDAfit-predict}{\code{PLNLDAfit$predict()}} -\item \href{#method-PLNLDAfit-show}{\code{PLNLDAfit$show()}} -\item \href{#method-PLNLDAfit-clone}{\code{PLNLDAfit$clone()}} -} -} -\if{html}{\out{ -
Inherited methods + \itemize{ + \item \href{#method-PLNLDAfit-initialize}{\code{PLNLDAfit$new()}} + \item \href{#method-PLNLDAfit-optimize}{\code{PLNLDAfit$optimize()}} + \item \href{#method-PLNLDAfit-postTreatment}{\code{PLNLDAfit$postTreatment()}} + \item \href{#method-PLNLDAfit-setVisualization}{\code{PLNLDAfit$setVisualization()}} + \item \href{#method-PLNLDAfit-plot_individual_map}{\code{PLNLDAfit$plot_individual_map()}} + \item \href{#method-PLNLDAfit-plot_correlation_map}{\code{PLNLDAfit$plot_correlation_map()}} + \item \href{#method-PLNLDAfit-plot_LDA}{\code{PLNLDAfit$plot_LDA()}} + \item \href{#method-PLNLDAfit-predict}{\code{PLNLDAfit$predict()}} + \item \href{#method-PLNLDAfit-show}{\code{PLNLDAfit$show()}} + \item \href{#method-PLNLDAfit-clone}{\code{PLNLDAfit$clone()}} + } +} +\if{html}{\out{
Inherited methods -
-}} +
}} \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-PLNLDAfit-new}{}}} -\subsection{Method \code{new()}}{ -Initialize a \code{\link{PLNLDAfit}} object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNLDAfit$new( +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-PLNLDAfit-initialize}{}}} +\subsection{\code{PLNLDAfit$new()}}{ + Initialize a \code{\link{PLNLDAfit}} object + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNLDAfit$new( grouping, responses, covariates, @@ -83,256 +82,248 @@ Initialize a \code{\link{PLNLDAfit}} object weights, formula, control -)}\if{html}{\out{
}} +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{grouping}}{a factor specifying the class of each observation used for discriminant analysis.} + \item{\code{responses}}{the matrix of responses (called Y in the model). Will usually be extracted from the corresponding field in PLNfamily-class} + \item{\code{covariates}}{design matrix (called X in the model). Will usually be extracted from the corresponding field in PLNfamily-class} + \item{\code{offsets}}{offset matrix (called O in the model). Will usually be extracted from the corresponding field in PLNfamily-class} + \item{\code{weights}}{an optional vector of observation weights to be used in the fitting process.} + \item{\code{formula}}{model formula used for fitting, extracted from the formula in the upper-level call} + \item{\code{control}}{list controlling the optimization and the model} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{grouping}}{a factor specifying the class of each observation used for discriminant analysis.} - -\item{\code{responses}}{the matrix of responses (called Y in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{covariates}}{design matrix (called X in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{offsets}}{offset matrix (called O in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{weights}}{an optional vector of observation weights to be used in the fitting process.} - -\item{\code{formula}}{model formula used for fitting, extracted from the formula in the upper-level call} - -\item{\code{control}}{list controlling the optimization and the model} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNLDAfit-optimize}{}}} -\subsection{Method \code{optimize()}}{ -Compute group means and axis of the LDA (noted B in the model) in the +\subsection{\code{PLNLDAfit$optimize()}}{ + Compute group means and axis of the LDA (noted B in the model) in the latent space, update corresponding fields -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNLDAfit$optimize(grouping, responses, covariates, offsets, weights, config)}\if{html}{\out{
}} + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNLDAfit$optimize(grouping, responses, covariates, offsets, weights, config)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{grouping}}{a factor specifying the class of each observation used for discriminant analysis.} + \item{\code{responses}}{the matrix of responses (called Y in the model). Will usually be extracted from the corresponding field in PLNfamily-class} + \item{\code{covariates}}{design matrix. Automatically built from the covariates and the formula from the call} + \item{\code{offsets}}{offset matrix (called O in the model). Will usually be extracted from the corresponding field in PLNfamily-class} + \item{\code{weights}}{an optional vector of observation weights to be used in the fitting process.} + \item{\code{config}}{list controlling the optimization} + \item{\code{X}}{Abundance matrix.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{grouping}}{a factor specifying the class of each observation used for discriminant analysis.} - -\item{\code{responses}}{the matrix of responses (called Y in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{covariates}}{design matrix. Automatically built from the covariates and the formula from the call} - -\item{\code{offsets}}{offset matrix (called O in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{weights}}{an optional vector of observation weights to be used in the fitting process.} - -\item{\code{config}}{list controlling the optimization} - -\item{\code{X}}{Abundance matrix.} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNLDAfit-postTreatment}{}}} -\subsection{Method \code{postTreatment()}}{ -Update R2, fisher and std_err fields and visualization -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNLDAfit$postTreatment( +\subsection{\code{PLNLDAfit$postTreatment()}}{ + Update R2, fisher and std_err fields and visualization + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNLDAfit$postTreatment( grouping, responses, covariates, offsets, + weights = rep(1, nrow(responses)), config_post, config_optim -)}\if{html}{\out{
}} +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{grouping}}{a factor with group memberships} + \item{\code{responses}}{the matrix of responses (counts)} + \item{\code{covariates}}{the matrix of covariates} + \item{\code{offsets}}{the matrix of offsets} + \item{\code{weights}}{an optional vector of observation weights. Default is uniform weights.} + \item{\code{config_post}}{a list for controlling the post-treatments (optional bootstrap, jackknife, R2, etc.).} + \item{\code{config_optim}}{list controlling the optimization parameters} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{grouping}}{a factor specifying the class of each observation used for discriminant analysis.} - -\item{\code{responses}}{the matrix of responses (called Y in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{covariates}}{design matrix (called X in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{offsets}}{offset matrix (called O in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{config_post}}{a list for controlling the post-treatments (optional bootstrap, jackknife, R2, etc.).} - -\item{\code{config_optim}}{list controlling the optimization parameters} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNLDAfit-setVisualization}{}}} -\subsection{Method \code{setVisualization()}}{ -Compute LDA scores in the latent space and update corresponding fields. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNLDAfit$setVisualization(scale.unit = FALSE)}\if{html}{\out{
}} +\subsection{\code{PLNLDAfit$setVisualization()}}{ + Compute LDA scores in the latent space and update corresponding fields. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNLDAfit$setVisualization(scale.unit = FALSE)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{scale.unit}}{Logical. Should LDA scores be rescaled to have unit variance} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{scale.unit}}{Logical. Should LDA scores be rescaled to have unit variance} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNLDAfit-plot_individual_map}{}}} -\subsection{Method \code{plot_individual_map()}}{ -Plot the factorial map of the LDA -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNLDAfit$plot_individual_map( +\subsection{\code{PLNLDAfit$plot_individual_map()}}{ + Plot the factorial map of the LDA + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNLDAfit$plot_individual_map( axes = 1:min(2, self$rank), main = "Individual Factor Map", plot = TRUE -)}\if{html}{\out{
}} +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{axes}}{numeric, the axes to use for the plot when map = "individual" or "variable". Default it c(1,min(rank))} + \item{\code{main}}{character. A title for the single plot (individual or variable factor map). If NULL (the default), an hopefully appropriate title will be used.} + \item{\code{plot}}{logical. Should the plot be displayed or sent back as ggplot object} + } + \if{html}{\out{
}} + } + \subsection{Returns}{ + a \code{\link[ggplot2:ggplot]{ggplot2::ggplot}} graphic + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{axes}}{numeric, the axes to use for the plot when map = "individual" or "variable". Default it c(1,min(rank))} - -\item{\code{main}}{character. A title for the single plot (individual or variable factor map). If NULL (the default), an hopefully appropriate title will be used.} - -\item{\code{plot}}{logical. Should the plot be displayed or sent back as ggplot object} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -a \code{\link[ggplot2:ggplot]{ggplot2::ggplot}} graphic -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNLDAfit-plot_correlation_map}{}}} -\subsection{Method \code{plot_correlation_map()}}{ -Plot the correlation circle of a specified axis for a \code{\link{PLNLDAfit}} object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNLDAfit$plot_correlation_map( +\subsection{\code{PLNLDAfit$plot_correlation_map()}}{ + Plot the correlation circle of a specified axis for a \code{\link{PLNLDAfit}} object + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNLDAfit$plot_correlation_map( axes = 1:min(2, self$rank), main = "Variable Factor Map", cols = "default", plot = TRUE -)}\if{html}{\out{
}} +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{axes}}{numeric, the axes to use for the plot when map = "individual" or "variable". Default it c(1,min(rank))} + \item{\code{main}}{character. A title for the single plot (individual or variable factor map). If NULL (the default), an hopefully appropriate title will be used.} + \item{\code{cols}}{a character, factor or numeric to define the color associated with the variables. By default, all variables receive the default color of the current palette.} + \item{\code{plot}}{logical. Should the plot be displayed or sent back as ggplot object} + } + \if{html}{\out{
}} + } + \subsection{Returns}{ + a \code{\link[ggplot2:ggplot]{ggplot2::ggplot}} graphic + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{axes}}{numeric, the axes to use for the plot when map = "individual" or "variable". Default it c(1,min(rank))} - -\item{\code{main}}{character. A title for the single plot (individual or variable factor map). If NULL (the default), an hopefully appropriate title will be used.} - -\item{\code{cols}}{a character, factor or numeric to define the color associated with the variables. By default, all variables receive the default color of the current palette.} - -\item{\code{plot}}{logical. Should the plot be displayed or sent back as ggplot object} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -a \code{\link[ggplot2:ggplot]{ggplot2::ggplot}} graphic -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNLDAfit-plot_LDA}{}}} -\subsection{Method \code{plot_LDA()}}{ -Plot a summary of the \code{\link{PLNLDAfit}} object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNLDAfit$plot_LDA( +\subsection{\code{PLNLDAfit$plot_LDA()}}{ + Plot a summary of the \code{\link{PLNLDAfit}} object + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNLDAfit$plot_LDA( nb_axes = min(3, self$rank), var_cols = "default", plot = TRUE -)}\if{html}{\out{
}} +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{nb_axes}}{scalar: the number of axes to be considered when map = "both". The default is min(3,rank).} + \item{\code{var_cols}}{a character, factor or numeric to define the color associated with the variables. By default, all variables receive the default color of the current palette.} + \item{\code{plot}}{logical. Should the plot be displayed or sent back as ggplot object} + } + \if{html}{\out{
}} + } + \subsection{Returns}{ + a \code{\link{grob}} object + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{nb_axes}}{scalar: the number of axes to be considered when map = "both". The default is min(3,rank).} - -\item{\code{var_cols}}{a character, factor or numeric to define the color associated with the variables. By default, all variables receive the default color of the current palette.} - -\item{\code{plot}}{logical. Should the plot be displayed or sent back as ggplot object} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -a \code{\link{grob}} object -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNLDAfit-predict}{}}} -\subsection{Method \code{predict()}}{ -Predict group of new samples -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNLDAfit$predict( +\subsection{\code{PLNLDAfit$predict()}}{ + Predict group of new samples + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNLDAfit$predict( newdata, type = c("posterior", "response", "scores"), scale = c("log", "prob"), prior = NULL, control = PLN_param(backend = "nlopt"), envir = parent.frame() -)}\if{html}{\out{
}} +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{newdata}}{A data frame in which to look for variables, offsets and counts with which to predict.} + \item{\code{type}}{The type of prediction required. The default are posterior probabilities for each group (in either unnormalized log-scale or natural probabilities, see "scale" for details), "response" is the group with maximal posterior probability and "scores" is the average score along each separation axis in the latent space, with weights equal to the posterior probabilities.} + \item{\code{scale}}{The scale used for the posterior probability. Either log-scale ("log", default) or natural probabilities summing up to 1 ("prob").} + \item{\code{prior}}{User-specified prior group probabilities in the new data. If NULL (default), prior probabilities are computed from the learning set.} + \item{\code{control}}{a list for controlling the optimization. See \code{\link[=PLN]{PLN()}} for details.} + \item{\code{envir}}{Environment in which the prediction is evaluated} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{newdata}}{A data frame in which to look for variables, offsets and counts with which to predict.} - -\item{\code{type}}{The type of prediction required. The default are posterior probabilities for each group (in either unnormalized log-scale or natural probabilities, see "scale" for details), "response" is the group with maximal posterior probability and "scores" is the average score along each separation axis in the latent space, with weights equal to the posterior probabilities.} - -\item{\code{scale}}{The scale used for the posterior probability. Either log-scale ("log", default) or natural probabilities summing up to 1 ("prob").} - -\item{\code{prior}}{User-specified prior group probabilities in the new data. If NULL (default), prior probabilities are computed from the learning set.} - -\item{\code{control}}{a list for controlling the optimization. See \code{\link[=PLN]{PLN()}} for details.} - -\item{\code{envir}}{Environment in which the prediction is evaluated} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNLDAfit-show}{}}} -\subsection{Method \code{show()}}{ -User friendly print method -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNLDAfit$show()}\if{html}{\out{
}} +\subsection{\code{PLNLDAfit$show()}}{ + User friendly print method + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNLDAfit$show()} + \if{html}{\out{
}} + } } -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNLDAfit-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNLDAfit$clone(deep = FALSE)}\if{html}{\out{
}} +\subsection{\code{PLNLDAfit$clone()}}{ + The objects of this class are cloneable with this method. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNLDAfit$clone(deep = FALSE)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{deep}}{Whether to make a deep clone.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} } diff --git a/man/PLNLDAfit_diagonal.Rd b/man/PLNLDAfit_diagonal.Rd index 0db19353..a9b5b101 100644 --- a/man/PLNLDAfit_diagonal.Rd +++ b/man/PLNLDAfit_diagonal.Rd @@ -20,49 +20,48 @@ print(myPLNLDA) } } \section{Super classes}{ -\code{\link[PLNmodels:PLNfit]{PLNmodels::PLNfit}} -> \code{\link[PLNmodels:PLNLDAfit]{PLNmodels::PLNLDAfit}} -> \code{PLNLDAfit_diagonal} +\code{\link[PLNmodels:PLNfit]{PLNfit}} -> \code{\link[PLNmodels:PLNLDAfit]{PLNLDAfit}} -> \code{PLNLDAfit_diagonal} } \section{Active bindings}{ -\if{html}{\out{
}} -\describe{ -\item{\code{vcov_model}}{character: the model used for the residual covariance} + \if{html}{\out{
}} + \describe{ + \item{\code{vcov_model}}{character: the model used for the residual covariance} -\item{\code{nb_param}}{number of parameters in the current PLN model} -} -\if{html}{\out{
}} + \item{\code{nb_param}}{number of parameters in the current PLN model} + } + \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ -\itemize{ -\item \href{#method-PLNLDAfit_diagonal-new}{\code{PLNLDAfit_diagonal$new()}} -\item \href{#method-PLNLDAfit_diagonal-clone}{\code{PLNLDAfit_diagonal$clone()}} -} + \itemize{ + \item \href{#method-PLNLDAfit_diagonal-initialize}{\code{PLNLDAfit_diagonal$new()}} + \item \href{#method-PLNLDAfit_diagonal-clone}{\code{PLNLDAfit_diagonal$clone()}} + } } -\if{html}{\out{ -
Inherited methods +\if{html}{\out{
Inherited methods -
-}} +
}} \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-PLNLDAfit_diagonal-new}{}}} -\subsection{Method \code{new()}}{ -Initialize a \code{\link{PLNfit}} model -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNLDAfit_diagonal$new( +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-PLNLDAfit_diagonal-initialize}{}}} +\subsection{\code{PLNLDAfit_diagonal$new()}}{ + Initialize a \code{\link{PLNfit}} model + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNLDAfit_diagonal$new( grouping, responses, covariates, @@ -70,44 +69,41 @@ Initialize a \code{\link{PLNfit}} model weights, formula, control -)}\if{html}{\out{
}} +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{grouping}}{a factor specifying the class of each observation used for discriminant analysis.} + \item{\code{responses}}{the matrix of responses (called Y in the model). Will usually be extracted from the corresponding field in PLNfamily-class} + \item{\code{covariates}}{design matrix (called X in the model). Will usually be extracted from the corresponding field in PLNfamily-class} + \item{\code{offsets}}{offset matrix (called O in the model). Will usually be extracted from the corresponding field in PLNfamily-class} + \item{\code{weights}}{an optional vector of observation weights to be used in the fitting process.} + \item{\code{formula}}{model formula used for fitting, extracted from the formula in the upper-level call} + \item{\code{control}}{a list for controlling the optimization. See details.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{grouping}}{a factor specifying the class of each observation used for discriminant analysis.} - -\item{\code{responses}}{the matrix of responses (called Y in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{covariates}}{design matrix (called X in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{offsets}}{offset matrix (called O in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{weights}}{an optional vector of observation weights to be used in the fitting process.} - -\item{\code{formula}}{model formula used for fitting, extracted from the formula in the upper-level call} - -\item{\code{control}}{a list for controlling the optimization. See details.} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNLDAfit_diagonal-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNLDAfit_diagonal$clone(deep = FALSE)}\if{html}{\out{
}} +\subsection{\code{PLNLDAfit_diagonal$clone()}}{ + The objects of this class are cloneable with this method. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNLDAfit_diagonal$clone(deep = FALSE)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{deep}}{Whether to make a deep clone.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} } diff --git a/man/PLNPCA.Rd b/man/PLNPCA.Rd index 39450ae1..558a486d 100644 --- a/man/PLNPCA.Rd +++ b/man/PLNPCA.Rd @@ -9,7 +9,7 @@ PLNPCA(formula, data, subset, weights, ranks = 1:5, control = PLNPCA_param()) \arguments{ \item{formula}{an object of class "formula": a symbolic description of the model to be fitted.} -\item{data}{an optional data frame, list or environment (or object coercible by as.data.frame to a data frame) containing the variables in the model. If not found in data, the variables are taken from environment(formula), typically the environment from which lm is called.} +\item{data}{an optional data frame, list or environment (or object coercible by as.data.frame to a data frame) containing the variables in the model. If not found in data, the variables are taken from environment(formula), typically the environment from which the model is called.} \item{subset}{an optional vector specifying a subset of observations to be used in the fitting process.} diff --git a/man/PLNPCA_param.Rd b/man/PLNPCA_param.Rd index b5c23c7d..768c5792 100644 --- a/man/PLNPCA_param.Rd +++ b/man/PLNPCA_param.Rd @@ -5,15 +5,22 @@ \title{Control of PLNPCA fit} \usage{ PLNPCA_param( - backend = c("nlopt", "torch"), + backend = c("nlopt", "builtin", "torch"), trace = 1, config_optim = list(), config_post = list(), - inception = NULL + inception = NULL, + init_method = c("LM", "GLM"), + sequential = FALSE ) } \arguments{ -\item{backend}{optimization back used, either "nlopt" or "torch". Default is "nlopt"} +\item{backend}{optimization backend, either \code{"nlopt"} (default, NLOPT/CCSAQ, recommended +for PLNPCA: conservative per-variable steps reliably find the global basin even when +the singular-value ratio d1/sqrt(n) is large), \code{"builtin"} (joint L-BFGS with strong +Wolfe line search on all parameters simultaneously — faster per iteration but may +converge to inferior local optima on ill-conditioned datasets), +or \code{"torch"} (automatic differentiation via the torch package).} \item{trace}{a integer for verbosity.} @@ -21,9 +28,25 @@ PLNPCA_param( \item{config_post}{a list for controlling the post-treatments (optional bootstrap, jackknife, R2, etc.). See details} -\item{inception}{Set up the parameters initialization: by default, the model is initialized with a multivariate linear model applied on -log-transformed data, and with the same formula as the one provided by the user. However, the user can provide a PLNfit (typically obtained from a previous fit), -which sometimes speeds up the inference.} +\item{inception}{an optional pre-fitted \code{\link{PLNfit}} object. When provided, its variational +means \code{M} and regression coefficients \code{B} are used to compute the shared SVD +\code{svd(M - X*B)} that initialises all ranks simultaneously. This replaces the default +LM-based starting point and can improve convergence for large ranks on datasets with +strong covariate effects (e.g. \code{inception = PLN(formula, data)}). When \code{NULL} (default), +a fast LM is used. \code{init_method} is ignored when \code{inception} is set.} + +\item{init_method}{character: strategy used to compute the starting point for the shared SVD. +Either \code{"LM"} (default, fast: one multivariate \code{lm.fit} on log-transformed counts) or +\code{"GLM"} (p independent Poisson GLMs, more accurate for complex or highly unbalanced +designs). Ignored when \code{inception} is provided. Benchmarks show \code{"LM"} is as good as +or better than \code{"GLM"} for PLNPCA in most cases; \code{"GLM"} is not recommended. +See \code{\link[=compute_PLN_starting_point]{compute_PLN_starting_point()}}.} + +\item{sequential}{logical. If \code{TRUE}, ranks are fitted in ascending order and each model is +warm-started from the converged solution of the previous rank: loadings C are augmented +with new columns from the inception SVD, while latent scores M and variances S2 are +padded with zeros / 0.01 respectively. Disables parallel fitting across ranks. +Default is \code{FALSE}.} } \value{ list of parameters configuring the fit. @@ -59,6 +82,14 @@ When "torch" backend is used (only for PLN and PLNLDA for now), the following en \item "centered" if TRUE, compute the centered RMSProp where the gradient is normalized by an estimation of its variance weight_decay (L2 penalty). Default to FALSE. Only used in RMSPROP } +When "builtin" backend is used, the following entries are relevant +\itemize{ +\item "maxeval" stop when the number of Newton steps in the inner loop exceeds maxeval. Default is 10000 +\item "ftol_in" stop the inner loop when the objective changes by less than ftol_in (relative). Default is 1e-8 +\item "maxit_em" stop the EM outer loop when the number of EM iterations exceeds maxit_em. Default is 50 +\item "ftol_em" stop the EM outer loop when the ELBO changes by less than ftol_em (relative). Default is 1e-8 +} + The list of parameters \code{config_post} controls the post-treatment processing (for most \verb{PLN*()} functions), with the following entries (defaults may vary depending on the specific function, check \verb{config_post_default_*} for defaults values): \itemize{ \item jackknife boolean indicating whether jackknife should be performed to evaluate bias and variance of the model parameters. Default is FALSE. diff --git a/man/PLNPCAfamily.Rd b/man/PLNPCAfamily.Rd index d93a8bb5..9317fd91 100644 --- a/man/PLNPCAfamily.Rd +++ b/man/PLNPCAfamily.Rd @@ -20,42 +20,44 @@ class(myPCAs) The function \code{\link[=PLNPCA]{PLNPCA()}}, the class \code{\link[=PLNPCAfit]{PLNPCAfit()}} } \section{Super class}{ -\code{\link[PLNmodels:PLNfamily]{PLNmodels::PLNfamily}} -> \code{PLNPCAfamily} +\code{\link[PLNmodels:PLNfamily]{PLNfamily}} -> \code{PLNPCAfamily} } \section{Active bindings}{ -\if{html}{\out{
}} -\describe{ -\item{\code{ranks}}{the dimensions of the successively fitted models} -} -\if{html}{\out{
}} + \if{html}{\out{
}} + \describe{ + \item{\code{ranks}}{the dimensions of the successively fitted models} + } + \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ -\itemize{ -\item \href{#method-PLNPCAfamily-new}{\code{PLNPCAfamily$new()}} -\item \href{#method-PLNPCAfamily-optimize}{\code{PLNPCAfamily$optimize()}} -\item \href{#method-PLNPCAfamily-getModel}{\code{PLNPCAfamily$getModel()}} -\item \href{#method-PLNPCAfamily-getBestModel}{\code{PLNPCAfamily$getBestModel()}} -\item \href{#method-PLNPCAfamily-plot}{\code{PLNPCAfamily$plot()}} -\item \href{#method-PLNPCAfamily-show}{\code{PLNPCAfamily$show()}} -\item \href{#method-PLNPCAfamily-clone}{\code{PLNPCAfamily$clone()}} -} -} -\if{html}{\out{ -
Inherited methods + \itemize{ + \item \href{#method-PLNPCAfamily-initialize}{\code{PLNPCAfamily$new()}} + \item \href{#method-PLNPCAfamily-optimize}{\code{PLNPCAfamily$optimize()}} + \item \href{#method-PLNPCAfamily-getModel}{\code{PLNPCAfamily$getModel()}} + \item \href{#method-PLNPCAfamily-getBestModel}{\code{PLNPCAfamily$getBestModel()}} + \item \href{#method-PLNPCAfamily-plot}{\code{PLNPCAfamily$plot()}} + \item \href{#method-PLNPCAfamily-show}{\code{PLNPCAfamily$show()}} + \item \href{#method-PLNPCAfamily-clone}{\code{PLNPCAfamily$clone()}} + } +} +\if{html}{\out{
Inherited methods -
-}} +
}} \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-PLNPCAfamily-new}{}}} -\subsection{Method \code{new()}}{ -Initialize all models in the collection. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNPCAfamily$new( +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-PLNPCAfamily-initialize}{}}} +\subsection{\code{PLNPCAfamily$new()}}{ + Initialize all models in the collection. +A single SVD of the residual matrix \code{M - X*B} is computed once and shared across +all ranks. \code{M} and \code{B} come from either a user-provided \code{\link{PLNfit}} inception or a +fast LM on log-transformed counts (default, controlled by \code{init_method}). + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNPCAfamily$new( ranks, responses, covariates, @@ -63,138 +65,143 @@ Initialize all models in the collection. weights, formula, control -)}\if{html}{\out{
}} +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{ranks}}{the dimensions of the successively fitted models} + \item{\code{responses}}{the matrix of responses common to every models} + \item{\code{covariates}}{the matrix of covariates common to every models} + \item{\code{offsets}}{the matrix of offsets common to every models} + \item{\code{weights}}{the vector of observation weights} + \item{\code{formula}}{model formula used for fitting, extracted from the formula in the upper-level call} + \item{\code{control}}{list controlling the optimization and the model} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{ranks}}{the dimensions of the successively fitted models} - -\item{\code{responses}}{the matrix of responses common to every models} - -\item{\code{covariates}}{the matrix of covariates common to every models} - -\item{\code{offsets}}{the matrix of offsets common to every models} - -\item{\code{weights}}{the vector of observation weights} - -\item{\code{formula}}{model formula used for fitting, extracted from the formula in the upper-level call} - -\item{\code{control}}{list controlling the optimization and the model} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNPCAfamily-optimize}{}}} -\subsection{Method \code{optimize()}}{ -Call to the C++ optimizer on all models of the collection -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNPCAfamily$optimize(config)}\if{html}{\out{
}} +\subsection{\code{PLNPCAfamily$optimize()}}{ + Call to the C++ optimizer on all models of the collection + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNPCAfamily$optimize(config)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{config}}{list controlling the optimization.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{config}}{list controlling the optimization.} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNPCAfamily-getModel}{}}} -\subsection{Method \code{getModel()}}{ -Extract model from collection and add "PCA" class for compatibility with \code{\link[factoextra:fviz]{factoextra::fviz()}} -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNPCAfamily$getModel(var, index = NULL)}\if{html}{\out{
}} +\subsection{\code{PLNPCAfamily$getModel()}}{ + Extract model from collection and add "PCA" class for compatibility with \code{\link[factoextra:fviz]{factoextra::fviz()}} + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNPCAfamily$getModel(var, index = NULL)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{var}}{value of the parameter (rank for PLNPCA, sparsity for PLNnetwork) that identifies the model to be extracted from the collection. If no exact match is found, the model with closest parameter value is returned with a warning.} + \item{\code{index}}{Integer index of the model to be returned. Only the first value is taken into account.} + } + \if{html}{\out{
}} + } + \subsection{Returns}{ + a \code{\link{PLNPCAfit}} object + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{var}}{value of the parameter (rank for PLNPCA, sparsity for PLNnetwork) that identifies the model to be extracted from the collection. If no exact match is found, the model with closest parameter value is returned with a warning.} - -\item{\code{index}}{Integer index of the model to be returned. Only the first value is taken into account.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -a \code{\link{PLNPCAfit}} object -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNPCAfamily-getBestModel}{}}} -\subsection{Method \code{getBestModel()}}{ -Extract best model in the collection -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNPCAfamily$getBestModel(crit = c("ICL", "BIC"))}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{crit}}{a character for the criterion used to performed the selection. Either +\subsection{\code{PLNPCAfamily$getBestModel()}}{ + Extract best model in the collection + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNPCAfamily$getBestModel(crit = c("ICL", "BIC"))} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{crit}}{a character for the criterion used to performed the selection. Either "ICL", "BIC". Default is \code{ICL}} + } + \if{html}{\out{
}} + } + \subsection{Returns}{ + a \code{\link{PLNPCAfit}} object + } } -\if{html}{\out{
}} -} -\subsection{Returns}{ -a \code{\link{PLNPCAfit}} object -} -} + \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNPCAfamily-plot}{}}} -\subsection{Method \code{plot()}}{ -Lineplot of selected criteria for all models in the collection -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNPCAfamily$plot(criteria = c("loglik", "BIC", "ICL"), reverse = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{criteria}}{A valid model selection criteria for the collection of models. Any of "loglik", "BIC" or "ICL" (all).} - -\item{\code{reverse}}{A logical indicating whether to plot the value of the criteria in the "natural" direction +\subsection{\code{PLNPCAfamily$plot()}}{ + Lineplot of selected criteria for all models in the collection + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNPCAfamily$plot(criteria = c("loglik", "BIC", "ICL"), reverse = FALSE)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{criteria}}{A valid model selection criteria for the collection of models. Any of "loglik", "BIC" or "ICL" (all).} + \item{\code{reverse}}{A logical indicating whether to plot the value of the criteria in the "natural" direction (loglik - penalty) or in the "reverse" direction (-2 loglik + penalty). Default to FALSE, i.e use the natural direction, on the same scale as the log-likelihood.} + } + \if{html}{\out{
}} + } + \subsection{Returns}{ + A \code{\link[ggplot2:ggplot]{ggplot2::ggplot}} object + } } -\if{html}{\out{
}} -} -\subsection{Returns}{ -A \code{\link[ggplot2:ggplot]{ggplot2::ggplot}} object -} -} + \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNPCAfamily-show}{}}} -\subsection{Method \code{show()}}{ -User friendly print method -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNPCAfamily$show()}\if{html}{\out{
}} +\subsection{\code{PLNPCAfamily$show()}}{ + User friendly print method + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNPCAfamily$show()} + \if{html}{\out{
}} + } } -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNPCAfamily-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNPCAfamily$clone(deep = FALSE)}\if{html}{\out{
}} +\subsection{\code{PLNPCAfamily$clone()}}{ + The objects of this class are cloneable with this method. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNPCAfamily$clone(deep = FALSE)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{deep}}{Whether to make a deep clone.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} } diff --git a/man/PLNPCAfit.Rd b/man/PLNPCAfit.Rd index 16dbc837..bd598915 100644 --- a/man/PLNPCAfit.Rd +++ b/man/PLNPCAfit.Rd @@ -20,293 +20,300 @@ print(myPCA) The function \code{\link{PLNPCA}}, the class \code{\link[=PLNPCAfamily]{PLNPCAfamily}} } \section{Super class}{ -\code{\link[PLNmodels:PLNfit]{PLNmodels::PLNfit}} -> \code{PLNPCAfit} +\code{\link[PLNmodels:PLNfit]{PLNfit}} -> \code{PLNPCAfit} } \section{Active bindings}{ -\if{html}{\out{
}} -\describe{ -\item{\code{rank}}{the dimension of the current model} + \if{html}{\out{
}} + \describe{ + \item{\code{var_par}}{variational parameters (M, S2) in the rank-q latent space} -\item{\code{vcov_model}}{character: the model used for the residual covariance} + \item{\code{rank}}{the dimension of the current model} -\item{\code{nb_param}}{number of parameters in the current PLN model} + \item{\code{vcov_model}}{character: the model used for the residual covariance} -\item{\code{entropy}}{entropy of the variational distribution} + \item{\code{nb_param}}{number of parameters in the current PLN model} -\item{\code{latent_pos}}{a matrix: values of the latent position vector (Z) without covariates effects or offset} + \item{\code{entropy}}{entropy of the variational distribution} -\item{\code{model_par}}{a list with the matrices associated with the estimated parameters of the pPCA model: B (covariates), Sigma (covariance), Omega (precision) and C (loadings)} + \item{\code{latent_pos}}{a matrix: values of the latent position vector (Z) without covariates effects or offset} -\item{\code{percent_var}}{the percent of variance explained by each axis} + \item{\code{model_par}}{a list with the matrices associated with the estimated parameters of the pPCA model: B (covariates), Sigma (covariance), Omega (precision) and C (loadings)} -\item{\code{corr_circle}}{a matrix of correlations to plot the correlation circles} + \item{\code{percent_var}}{the percent of variance explained by each axis} -\item{\code{scores}}{a matrix of scores to plot the individual factor maps (a.k.a. principal components)} + \item{\code{corr_circle}}{a matrix of correlations to plot the correlation circles} -\item{\code{rotation}}{a matrix of rotation of the latent space} + \item{\code{scores}}{a matrix of scores to plot the individual factor maps (a.k.a. principal components)} -\item{\code{eig}}{description of the eigenvalues, similar to percent_var but for use with external methods} + \item{\code{rotation}}{a matrix of rotation of the latent space} -\item{\code{var}}{a list of data frames with PCA results for the variables: \code{coord} (coordinates of the variables), \code{cor} (correlation between variables and dimensions), \code{cos2} (Cosine of the variables) and \code{contrib} (contributions of the variable to the axes)} + \item{\code{eig}}{description of the eigenvalues, similar to percent_var but for use with external methods} -\item{\code{ind}}{a list of data frames with PCA results for the individuals: \code{coord} (coordinates of the individuals), \code{cos2} (Cosine of the individuals), \code{contrib} (contributions of individuals to an axis inertia) and \code{dist} (distance of individuals to the origin).} + \item{\code{var}}{a list of data frames with PCA results for the variables: \code{coord} (coordinates of the variables), \code{cor} (correlation between variables and dimensions), \code{cos2} (Cosine of the variables) and \code{contrib} (contributions of the variable to the axes)} -\item{\code{call}}{Hacky binding for compatibility with factoextra functions} -} -\if{html}{\out{
}} + \item{\code{ind}}{a list of data frames with PCA results for the individuals: \code{coord} (coordinates of the individuals), \code{cos2} (Cosine of the individuals), \code{contrib} (contributions of individuals to an axis inertia) and \code{dist} (distance of individuals to the origin).} + + \item{\code{call}}{Hacky binding for compatibility with factoextra functions} + } + \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ -\itemize{ -\item \href{#method-PLNPCAfit-new}{\code{PLNPCAfit$new()}} -\item \href{#method-PLNPCAfit-update}{\code{PLNPCAfit$update()}} -\item \href{#method-PLNPCAfit-optimize}{\code{PLNPCAfit$optimize()}} -\item \href{#method-PLNPCAfit-optimize_vestep}{\code{PLNPCAfit$optimize_vestep()}} -\item \href{#method-PLNPCAfit-project}{\code{PLNPCAfit$project()}} -\item \href{#method-PLNPCAfit-setVisualization}{\code{PLNPCAfit$setVisualization()}} -\item \href{#method-PLNPCAfit-postTreatment}{\code{PLNPCAfit$postTreatment()}} -\item \href{#method-PLNPCAfit-plot_individual_map}{\code{PLNPCAfit$plot_individual_map()}} -\item \href{#method-PLNPCAfit-plot_correlation_circle}{\code{PLNPCAfit$plot_correlation_circle()}} -\item \href{#method-PLNPCAfit-plot_PCA}{\code{PLNPCAfit$plot_PCA()}} -\item \href{#method-PLNPCAfit-show}{\code{PLNPCAfit$show()}} -\item \href{#method-PLNPCAfit-clone}{\code{PLNPCAfit$clone()}} -} -} -\if{html}{\out{ -
Inherited methods + \itemize{ + \item \href{#method-PLNPCAfit-initialize}{\code{PLNPCAfit$new()}} + \item \href{#method-PLNPCAfit-warm_start_from}{\code{PLNPCAfit$warm_start_from()}} + \item \href{#method-PLNPCAfit-update}{\code{PLNPCAfit$update()}} + \item \href{#method-PLNPCAfit-optimize}{\code{PLNPCAfit$optimize()}} + \item \href{#method-PLNPCAfit-optimize_vestep}{\code{PLNPCAfit$optimize_vestep()}} + \item \href{#method-PLNPCAfit-project}{\code{PLNPCAfit$project()}} + \item \href{#method-PLNPCAfit-setVisualization}{\code{PLNPCAfit$setVisualization()}} + \item \href{#method-PLNPCAfit-postTreatment}{\code{PLNPCAfit$postTreatment()}} + \item \href{#method-PLNPCAfit-plot_individual_map}{\code{PLNPCAfit$plot_individual_map()}} + \item \href{#method-PLNPCAfit-plot_correlation_circle}{\code{PLNPCAfit$plot_correlation_circle()}} + \item \href{#method-PLNPCAfit-plot_PCA}{\code{PLNPCAfit$plot_PCA()}} + \item \href{#method-PLNPCAfit-show}{\code{PLNPCAfit$show()}} + \item \href{#method-PLNPCAfit-clone}{\code{PLNPCAfit$clone()}} + } +} +\if{html}{\out{
Inherited methods -
-}} +
}} \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-PLNPCAfit-new}{}}} -\subsection{Method \code{new()}}{ -Initialize a \code{\link{PLNPCAfit}} object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNPCAfit$new(rank, responses, covariates, offsets, weights, formula, control)}\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-PLNPCAfit-initialize}{}}} +\subsection{\code{PLNPCAfit$new()}}{ + Initialize a \code{\link{PLNPCAfit}} object. +Uses the shared SVD from \code{control$svdM} (computed once in \code{\link{PLNPCAfamily}}) to set +the starting loadings \code{C} and scores \code{M}. The regression coefficients \code{B} are +initialised by the parent \code{\link{PLNfit}} constructor (LM or user-provided inception). + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNPCAfit$new(rank, responses, covariates, offsets, weights, formula, control)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{rank}}{rank of the PCA (or equivalently, dimension of the latent space)} + \item{\code{responses}}{the matrix of responses (called Y in the model). Will usually be extracted from the corresponding field in \code{\link{PLNfamily}}} + \item{\code{covariates}}{design matrix (called X in the model). Will usually be extracted from the corresponding field in \code{\link{PLNfamily}}} + \item{\code{offsets}}{offset matrix (called O in the model). Will usually be extracted from the corresponding field in \code{\link{PLNfamily}}} + \item{\code{weights}}{an optional vector of observation weights to be used in the fitting process.} + \item{\code{formula}}{model formula used for fitting, extracted from the formula in the upper-level call} + \item{\code{control}}{a list for controlling the optimization. See details.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{rank}}{rank of the PCA (or equivalently, dimension of the latent space)} - -\item{\code{responses}}{the matrix of responses (called Y in the model). Will usually be extracted from the corresponding field in \code{\link{PLNfamily}}} - -\item{\code{covariates}}{design matrix (called X in the model). Will usually be extracted from the corresponding field in \code{\link{PLNfamily}}} - -\item{\code{offsets}}{offset matrix (called O in the model). Will usually be extracted from the corresponding field in \code{\link{PLNfamily}}} - -\item{\code{weights}}{an optional vector of observation weights to be used in the fitting process.} - -\item{\code{formula}}{model formula used for fitting, extracted from the formula in the upper-level call} - -\item{\code{control}}{a list for controlling the optimization. See details.} -} -\if{html}{\out{
}} -} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-PLNPCAfit-warm_start_from}{}}} +\subsection{\code{PLNPCAfit$warm_start_from()}}{ + Reinitialize parameters for sequential warm-starting from a lower-rank fit. +Fitted loadings C, scores M, variances S, and regression coefficients B from \code{prev_fit} +are carried over; new columns are padded using the inception SVD (C) or zeros/0.1 (M/S). + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNPCAfit$warm_start_from(prev_fit, svdM)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{prev_fit}}{a converged \code{\link{PLNPCAfit}} of rank \code{self$rank - k} (k >= 1)} + \item{\code{svdM}}{the inception SVD (from \code{PLNPCAfamily})} + } + \if{html}{\out{
}} + } } + \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNPCAfit-update}{}}} -\subsection{Method \code{update()}}{ -Update a \code{\link{PLNPCAfit}} object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNPCAfit$update( +\subsection{\code{PLNPCAfit$update()}}{ + Update a \code{\link{PLNPCAfit}} object + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNPCAfit$update( B = NA, Sigma = NA, Omega = NA, C = NA, M = NA, - S = NA, + S2 = NA, Z = NA, A = NA, Ji = NA, R2 = NA, monitoring = NA -)}\if{html}{\out{
}} +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{B}}{matrix of regression matrix} + \item{\code{Sigma}}{variance-covariance matrix of the latent variables} + \item{\code{Omega}}{precision matrix of the latent variables. Inverse of Sigma.} + \item{\code{C}}{matrix of PCA loadings (in the latent space)} + \item{\code{M}}{matrix of mean vectors for the variational approximation} + \item{\code{S2}}{matrix of variational variances (n × q)} + \item{\code{Z}}{matrix of latent vectors (includes covariates and offset effects)} + \item{\code{A}}{matrix of fitted values} + \item{\code{Ji}}{vector of variational lower bounds of the log-likelihoods (one value per sample)} + \item{\code{R2}}{approximate R^2 goodness-of-fit criterion} + \item{\code{monitoring}}{a list with optimization monitoring quantities} + } + \if{html}{\out{
}} + } + \subsection{Returns}{ + Update the current \code{\link{PLNPCAfit}} object + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{B}}{matrix of regression matrix} - -\item{\code{Sigma}}{variance-covariance matrix of the latent variables} - -\item{\code{Omega}}{precision matrix of the latent variables. Inverse of Sigma.} - -\item{\code{C}}{matrix of PCA loadings (in the latent space)} - -\item{\code{M}}{matrix of mean vectors for the variational approximation} - -\item{\code{S}}{matrix of variance vectors for the variational approximation} - -\item{\code{Z}}{matrix of latent vectors (includes covariates and offset effects)} - -\item{\code{A}}{matrix of fitted values} - -\item{\code{Ji}}{vector of variational lower bounds of the log-likelihoods (one value per sample)} - -\item{\code{R2}}{approximate R^2 goodness-of-fit criterion} - -\item{\code{monitoring}}{a list with optimization monitoring quantities} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -Update the current \code{\link{PLNPCAfit}} object -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNPCAfit-optimize}{}}} -\subsection{Method \code{optimize()}}{ -Call to the C++ optimizer and update of the relevant fields -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNPCAfit$optimize(responses, covariates, offsets, weights, config)}\if{html}{\out{
}} +\subsection{\code{PLNPCAfit$optimize()}}{ + Call to the C++ optimizer and update of the relevant fields + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNPCAfit$optimize(responses, covariates, offsets, weights, config)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{responses}}{the matrix of responses (called Y in the model). Will usually be extracted from the corresponding field in \code{\link{PLNfamily}}} + \item{\code{covariates}}{design matrix (called X in the model). Will usually be extracted from the corresponding field in \code{\link{PLNfamily}}} + \item{\code{offsets}}{offset matrix (called O in the model). Will usually be extracted from the corresponding field in \code{\link{PLNfamily}}} + \item{\code{weights}}{an optional vector of observation weights to be used in the fitting process.} + \item{\code{config}}{part of the \code{control} argument which configures the optimizer} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{responses}}{the matrix of responses (called Y in the model). Will usually be extracted from the corresponding field in \code{\link{PLNfamily}}} - -\item{\code{covariates}}{design matrix (called X in the model). Will usually be extracted from the corresponding field in \code{\link{PLNfamily}}} - -\item{\code{offsets}}{offset matrix (called O in the model). Will usually be extracted from the corresponding field in \code{\link{PLNfamily}}} - -\item{\code{weights}}{an optional vector of observation weights to be used in the fitting process.} - -\item{\code{config}}{part of the \code{control} argument which configures the optimizer} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNPCAfit-optimize_vestep}{}}} -\subsection{Method \code{optimize_vestep()}}{ -Result of one call to the VE step of the optimization procedure: optimal variational parameters (M, S) and corresponding log likelihood values for fixed model parameters (C, B). Intended to position new data in the latent space for further use with PCA. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNPCAfit$optimize_vestep( +\subsection{\code{PLNPCAfit$optimize_vestep()}}{ + Result of one call to the VE step of the optimization procedure: optimal variational parameters (M, S) and corresponding log likelihood values for fixed model parameters (C, B). Intended to position new data in the latent space for further use with PCA. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNPCAfit$optimize_vestep( covariates, offsets, responses, weights = rep(1, self$n), control = PLNPCA_param(backend = "nlopt") -)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{covariates}}{design matrix (called X in the model). Will usually be extracted from the corresponding field in \code{\link{PLNfamily}}} - -\item{\code{offsets}}{offset matrix (called O in the model). Will usually be extracted from the corresponding field in \code{\link{PLNfamily}}} - -\item{\code{responses}}{the matrix of responses (called Y in the model). Will usually be extracted from the corresponding field in \code{\link{PLNfamily}}} - -\item{\code{weights}}{an optional vector of observation weights to be used in the fitting process.} - -\item{\code{control}}{a list for controlling the optimization. See details.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -A list with three components: +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{covariates}}{design matrix (called X in the model). Will usually be extracted from the corresponding field in \code{\link{PLNfamily}}} + \item{\code{offsets}}{offset matrix (called O in the model). Will usually be extracted from the corresponding field in \code{\link{PLNfamily}}} + \item{\code{responses}}{the matrix of responses (called Y in the model). Will usually be extracted from the corresponding field in \code{\link{PLNfamily}}} + \item{\code{weights}}{an optional vector of observation weights to be used in the fitting process.} + \item{\code{control}}{a list for controlling the optimization. See details.} + } + \if{html}{\out{
}} + } + \subsection{Returns}{ + A list with three components: \itemize{ \item the matrix \code{M} of variational means, \item the matrix \code{S2} of variational variances \item the vector \code{log.lik} of (variational) log-likelihood of each new observation } + } } -} + \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNPCAfit-project}{}}} -\subsection{Method \code{project()}}{ -Project new samples into the PCA space using one VE step -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNPCAfit$project(newdata, control = PLNPCA_param(), envir = parent.frame())}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{newdata}}{A data frame in which to look for variables, offsets and counts with which to predict.} - -\item{\code{control}}{a list for controlling the optimization. See \code{\link[=PLN]{PLN()}} for details.} - -\item{\code{envir}}{Environment in which the projection is evaluated} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -\itemize{ +\subsection{\code{PLNPCAfit$project()}}{ + Project new samples into the PCA space using one VE step + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNPCAfit$project(newdata, control = PLNPCA_param(), envir = parent.frame())} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{newdata}}{A data frame in which to look for variables, offsets and counts with which to predict.} + \item{\code{control}}{a list for controlling the optimization. See \code{\link[=PLN]{PLN()}} for details.} + \item{\code{envir}}{Environment in which the projection is evaluated} + } + \if{html}{\out{
}} + } + \subsection{Returns}{ + \itemize{ \item the named matrix of scores for the newdata, expressed in the same coordinate system as \code{self$scores} } + } } -} + \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNPCAfit-setVisualization}{}}} -\subsection{Method \code{setVisualization()}}{ -Compute PCA scores in the latent space and update corresponding fields. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNPCAfit$setVisualization(scale.unit = FALSE)}\if{html}{\out{
}} +\subsection{\code{PLNPCAfit$setVisualization()}}{ + Compute PCA scores in the latent space and update corresponding fields. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNPCAfit$setVisualization(scale.unit = FALSE)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{scale.unit}}{Logical. Should PCA scores be rescaled to have unit variance} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{scale.unit}}{Logical. Should PCA scores be rescaled to have unit variance} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNPCAfit-postTreatment}{}}} -\subsection{Method \code{postTreatment()}}{ -Update R2, fisher, std_err fields and set up visualization -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNPCAfit$postTreatment( +\subsection{\code{PLNPCAfit$postTreatment()}}{ + Update R2, fisher, std_err fields and set up visualization + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNPCAfit$postTreatment( responses, covariates, offsets, - weights, + weights = rep(1, nrow(responses)), config_post, config_optim, - nullModel -)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{responses}}{the matrix of responses (called Y in the model). Will usually be extracted from the corresponding field in \code{\link{PLNfamily}}} - -\item{\code{covariates}}{design matrix (called X in the model). Will usually be extracted from the corresponding field in \code{\link{PLNfamily}}} - -\item{\code{offsets}}{offset matrix (called O in the model). Will usually be extracted from the corresponding field in \code{\link{PLNfamily}}} - -\item{\code{weights}}{an optional vector of observation weights to be used in the fitting process.} - -\item{\code{config_post}}{a list for controlling the post-treatments (optional bootstrap, jackknife, R2, etc.). See details} - -\item{\code{config_optim}}{a list for controlling the optimizer (either "nlopt" or "torch" backend). See details} - -\item{\code{nullModel}}{null model used for approximate R2 computations. Defaults to a GLM model with same design matrix but not latent variable.} -} -\if{html}{\out{
}} -} -\subsection{Details}{ -The list of parameters \code{config_post} controls the post-treatment processing, with the following entries: + nullModel = NULL +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{responses}}{the matrix of responses (called Y in the model). Will usually be extracted from the corresponding field in \code{\link{PLNfamily}}} + \item{\code{covariates}}{design matrix (called X in the model). Will usually be extracted from the corresponding field in \code{\link{PLNfamily}}} + \item{\code{offsets}}{offset matrix (called O in the model). Will usually be extracted from the corresponding field in \code{\link{PLNfamily}}} + \item{\code{weights}}{an optional vector of observation weights to be used in the fitting process.} + \item{\code{config_post}}{a list for controlling the post-treatments (optional bootstrap, jackknife, R2, etc.). See details} + \item{\code{config_optim}}{a list for controlling the optimizer (either "nlopt" or "torch" backend). See details} + \item{\code{nullModel}}{null model used for approximate R2 computations. Defaults to a GLM model with same design matrix but not latent variable.} + } + \if{html}{\out{
}} + } + \subsection{Details}{ + The list of parameters \code{config_post} controls the post-treatment processing, with the following entries: \itemize{ \item jackknife boolean indicating whether jackknife should be performed to evaluate bias and variance of the model parameters. Default is FALSE. \item bootstrap integer indicating the number of bootstrap resamples generated to evaluate the variance of the model parameters. Default is 0 (inactivated). @@ -314,127 +321,128 @@ The list of parameters \code{config_post} controls the post-treatment processing \item rsquared boolean indicating whether approximation of R2 based on deviance should be computed. Default is TRUE \item trace integer for verbosity. should be > 1 to see output in post-treatments } + } } -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNPCAfit-plot_individual_map}{}}} -\subsection{Method \code{plot_individual_map()}}{ -Plot the factorial map of the PCA -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNPCAfit$plot_individual_map( +\subsection{\code{PLNPCAfit$plot_individual_map()}}{ + Plot the factorial map of the PCA + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNPCAfit$plot_individual_map( axes = 1:min(2, self$rank), main = "Individual Factor Map", plot = TRUE, cols = "default" -)}\if{html}{\out{
}} +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{axes}}{numeric, the axes to use for the plot when map = "individual" or "variable". Default it c(1,min(rank))} + \item{\code{main}}{character. A title for the single plot (individual or variable factor map). If NULL (the default), an hopefully appropriate title will be used.} + \item{\code{plot}}{logical. Should the plot be displayed or sent back as ggplot object} + \item{\code{cols}}{a character, factor or numeric to define the color associated with the individuals. By default, all individuals receive the default color of the current palette.} + } + \if{html}{\out{
}} + } + \subsection{Returns}{ + a \code{\link[ggplot2:ggplot]{ggplot2::ggplot}} graphic + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{axes}}{numeric, the axes to use for the plot when map = "individual" or "variable". Default it c(1,min(rank))} - -\item{\code{main}}{character. A title for the single plot (individual or variable factor map). If NULL (the default), an hopefully appropriate title will be used.} - -\item{\code{plot}}{logical. Should the plot be displayed or sent back as ggplot object} - -\item{\code{cols}}{a character, factor or numeric to define the color associated with the individuals. By default, all individuals receive the default color of the current palette.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -a \code{\link[ggplot2:ggplot]{ggplot2::ggplot}} graphic -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNPCAfit-plot_correlation_circle}{}}} -\subsection{Method \code{plot_correlation_circle()}}{ -Plot the correlation circle of a specified axis for a \code{\link{PLNLDAfit}} object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNPCAfit$plot_correlation_circle( +\subsection{\code{PLNPCAfit$plot_correlation_circle()}}{ + Plot the correlation circle of a specified axis for a \code{\link{PLNLDAfit}} object + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNPCAfit$plot_correlation_circle( axes = 1:min(2, self$rank), main = "Variable Factor Map", cols = "default", plot = TRUE -)}\if{html}{\out{
}} +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{axes}}{numeric, the axes to use for the plot when map = "individual" or "variable". Default it c(1,min(rank))} + \item{\code{main}}{character. A title for the single plot (individual or variable factor map). If NULL (the default), an hopefully appropriate title will be used.} + \item{\code{cols}}{a character, factor or numeric to define the color associated with the variables. By default, all variables receive the default color of the current palette.} + \item{\code{plot}}{logical. Should the plot be displayed or sent back as ggplot object} + } + \if{html}{\out{
}} + } + \subsection{Returns}{ + a \code{\link[ggplot2:ggplot]{ggplot2::ggplot}} graphic + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{axes}}{numeric, the axes to use for the plot when map = "individual" or "variable". Default it c(1,min(rank))} - -\item{\code{main}}{character. A title for the single plot (individual or variable factor map). If NULL (the default), an hopefully appropriate title will be used.} - -\item{\code{cols}}{a character, factor or numeric to define the color associated with the variables. By default, all variables receive the default color of the current palette.} - -\item{\code{plot}}{logical. Should the plot be displayed or sent back as ggplot object} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -a \code{\link[ggplot2:ggplot]{ggplot2::ggplot}} graphic -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNPCAfit-plot_PCA}{}}} -\subsection{Method \code{plot_PCA()}}{ -Plot a summary of the \code{\link{PLNPCAfit}} object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNPCAfit$plot_PCA( +\subsection{\code{PLNPCAfit$plot_PCA()}}{ + Plot a summary of the \code{\link{PLNPCAfit}} object + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNPCAfit$plot_PCA( nb_axes = min(3, self$rank), ind_cols = "ind_cols", var_cols = "var_cols", plot = TRUE -)}\if{html}{\out{
}} +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{nb_axes}}{scalar: the number of axes to be considered when map = "both". The default is min(3,rank).} + \item{\code{ind_cols}}{a character, factor or numeric to define the color associated with the individuals. By default, all variables receive the default color of the current palette.} + \item{\code{var_cols}}{a character, factor or numeric to define the color associated with the variables. By default, all variables receive the default color of the current palette.} + \item{\code{plot}}{logical. Should the plot be displayed or sent back as ggplot object} + } + \if{html}{\out{
}} + } + \subsection{Returns}{ + a \code{\link{grob}} object + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{nb_axes}}{scalar: the number of axes to be considered when map = "both". The default is min(3,rank).} - -\item{\code{ind_cols}}{a character, factor or numeric to define the color associated with the individuals. By default, all variables receive the default color of the current palette.} - -\item{\code{var_cols}}{a character, factor or numeric to define the color associated with the variables. By default, all variables receive the default color of the current palette.} - -\item{\code{plot}}{logical. Should the plot be displayed or sent back as ggplot object} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -a \code{\link{grob}} object -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNPCAfit-show}{}}} -\subsection{Method \code{show()}}{ -User friendly print method -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNPCAfit$show()}\if{html}{\out{
}} +\subsection{\code{PLNPCAfit$show()}}{ + User friendly print method + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNPCAfit$show()} + \if{html}{\out{
}} + } } -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNPCAfit-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNPCAfit$clone(deep = FALSE)}\if{html}{\out{
}} +\subsection{\code{PLNPCAfit$clone()}}{ + The objects of this class are cloneable with this method. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNPCAfit$clone(deep = FALSE)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{deep}}{Whether to make a deep clone.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} } diff --git a/man/PLN_param.Rd b/man/PLN_param.Rd index a5142d85..9d886002 100644 --- a/man/PLN_param.Rd +++ b/man/PLN_param.Rd @@ -5,17 +5,19 @@ \title{Control of a PLN fit} \usage{ PLN_param( - backend = c("nlopt", "torch"), + backend = c("builtin", "nlopt", "torch"), trace = 1, covariance = c("full", "diagonal", "spherical", "fixed"), Omega = NULL, config_post = list(), config_optim = list(), - inception = NULL + inception = NULL, + init_method = c("LM", "GLM") ) } \arguments{ -\item{backend}{optimization back used, either "nlopt" or "torch". Default is "nlopt"} +\item{backend}{optimization back used, either "builtin" (default), "nlopt" or "torch". +"builtin" is the built-in envelope-theorem Newton optimizer (does not depend on NLOPT).} \item{trace}{a integer for verbosity.} @@ -30,6 +32,8 @@ PLN_param( \item{inception}{Set up the parameters initialization: by default, the model is initialized with a multivariate linear model applied on log-transformed data, and with the same formula as the one provided by the user. However, the user can provide a PLNfit (typically obtained from a previous fit), which sometimes speeds up the inference.} + +\item{init_method}{character: strategy for the starting-point computation (ignored when \code{inception} is a PLNfit). Either \code{"LM"} (default) or \code{"GLM"} (p independent Poisson GLMs, better for complex or unbalanced designs). See \code{\link[=compute_PLN_starting_point]{compute_PLN_starting_point()}}.} } \value{ list of parameters configuring the fit. @@ -65,6 +69,14 @@ When "torch" backend is used (only for PLN and PLNLDA for now), the following en \item "centered" if TRUE, compute the centered RMSProp where the gradient is normalized by an estimation of its variance weight_decay (L2 penalty). Default to FALSE. Only used in RMSPROP } +When "builtin" backend is used, the following entries are relevant +\itemize{ +\item "maxeval" stop when the number of Newton steps in the inner loop exceeds maxeval. Default is 10000 +\item "ftol_in" stop the inner loop when the objective changes by less than ftol_in (relative). Default is 1e-8 +\item "maxit_em" stop the EM outer loop when the number of EM iterations exceeds maxit_em. Default is 50 +\item "ftol_em" stop the EM outer loop when the ELBO changes by less than ftol_em (relative). Default is 1e-8 +} + The list of parameters \code{config_post} controls the post-treatment processing (for most \verb{PLN*()} functions), with the following entries (defaults may vary depending on the specific function, check \verb{config_post_default_*} for defaults values): \itemize{ \item jackknife boolean indicating whether jackknife should be performed to evaluate bias and variance of the model parameters. Default is FALSE. diff --git a/man/PLNfamily.Rd b/man/PLNfamily.Rd index 7450c083..50d32cc7 100644 --- a/man/PLNfamily.Rd +++ b/man/PLNfamily.Rd @@ -10,172 +10,179 @@ super class for \code{\link{PLNPCAfamily}} and \code{\link{PLNnetworkfamily}}. \code{\link[=getModel]{getModel()}} } \section{Public fields}{ -\if{html}{\out{
}} -\describe{ -\item{\code{responses}}{the matrix of responses common to every models} + \if{html}{\out{
}} + \describe{ + \item{\code{responses}}{the matrix of responses common to every models} -\item{\code{covariates}}{the matrix of covariates common to every models} + \item{\code{covariates}}{the matrix of covariates common to every models} -\item{\code{offsets}}{the matrix of offsets common to every models} + \item{\code{offsets}}{the matrix of offsets common to every models} -\item{\code{weights}}{the vector of observation weights} + \item{\code{weights}}{the vector of observation weights} -\item{\code{inception}}{a \link{PLNfit} object, obtained when no sparsifying penalty is applied.} + \item{\code{inception}}{a \link{PLNfit} object, obtained when no sparsifying penalty is applied.} -\item{\code{models}}{a list of \link{PLNfit} object, one per penalty.} -} -\if{html}{\out{
}} + \item{\code{models}}{a list of \link{PLNfit} object, one per penalty.} + } + \if{html}{\out{
}} } \section{Active bindings}{ -\if{html}{\out{
}} -\describe{ -\item{\code{criteria}}{a data frame with the values of some criteria (approximated log-likelihood, BIC, ICL, etc.) for the collection of models / fits + \if{html}{\out{
}} + \describe{ + \item{\code{criteria}}{a data frame with the values of some criteria (approximated log-likelihood, BIC, ICL, etc.) for the collection of models / fits BIC and ICL are defined so that they are on the same scale as the model log-likelihood, i.e. with the form, loglik - 0.5 penalty} -\item{\code{convergence}}{sends back a data frame with some convergence diagnostics associated with the optimization process (method, optimal value, etc)} -} -\if{html}{\out{
}} + \item{\code{convergence}}{sends back a data frame with some convergence diagnostics associated with the optimization process (method, optimal value, etc)} + } + \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ -\itemize{ -\item \href{#method-PLNfamily-new}{\code{PLNfamily$new()}} -\item \href{#method-PLNfamily-postTreatment}{\code{PLNfamily$postTreatment()}} -\item \href{#method-PLNfamily-getModel}{\code{PLNfamily$getModel()}} -\item \href{#method-PLNfamily-plot}{\code{PLNfamily$plot()}} -\item \href{#method-PLNfamily-show}{\code{PLNfamily$show()}} -\item \href{#method-PLNfamily-print}{\code{PLNfamily$print()}} -\item \href{#method-PLNfamily-clone}{\code{PLNfamily$clone()}} -} + \itemize{ + \item \href{#method-PLNfamily-initialize}{\code{PLNfamily$new()}} + \item \href{#method-PLNfamily-postTreatment}{\code{PLNfamily$postTreatment()}} + \item \href{#method-PLNfamily-getModel}{\code{PLNfamily$getModel()}} + \item \href{#method-PLNfamily-plot}{\code{PLNfamily$plot()}} + \item \href{#method-PLNfamily-show}{\code{PLNfamily$show()}} + \item \href{#method-PLNfamily-print}{\code{PLNfamily$print()}} + \item \href{#method-PLNfamily-clone}{\code{PLNfamily$clone()}} + } } \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-PLNfamily-new}{}}} -\subsection{Method \code{new()}}{ -Create a new \code{\link{PLNfamily}} object. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNfamily$new(responses, covariates, offsets, weights, control)}\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-PLNfamily-initialize}{}}} +\subsection{\code{PLNfamily$new()}}{ + Create a new \code{\link{PLNfamily}} object. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNfamily$new(responses, covariates, offsets, weights, control)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{responses}}{the matrix of responses common to every models} + \item{\code{covariates}}{the matrix of covariates common to every models} + \item{\code{offsets}}{the matrix of offsets common to every models} + \item{\code{weights}}{the vector of observation weights} + \item{\code{control}}{list controlling the optimization and the model} + } + \if{html}{\out{
}} + } + \subsection{Returns}{ + A new \code{\link{PLNfamily}} object + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{responses}}{the matrix of responses common to every models} - -\item{\code{covariates}}{the matrix of covariates common to every models} - -\item{\code{offsets}}{the matrix of offsets common to every models} - -\item{\code{weights}}{the vector of observation weights} - -\item{\code{control}}{list controlling the optimization and the model} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -A new \code{\link{PLNfamily}} object -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNfamily-postTreatment}{}}} -\subsection{Method \code{postTreatment()}}{ -Update fields after optimization -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNfamily$postTreatment(config_post, config_optim)}\if{html}{\out{
}} +\subsection{\code{PLNfamily$postTreatment()}}{ + Update fields after optimization + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNfamily$postTreatment(config_post, config_optim)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{config_post}}{a list for controlling the post-treatments (optional bootstrap, jackknife, R2, etc.).} + \item{\code{config_optim}}{a list for controlling the optimization parameters used during post_treatments} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{config_post}}{a list for controlling the post-treatments (optional bootstrap, jackknife, R2, etc.).} - -\item{\code{config_optim}}{a list for controlling the optimization parameters used during post_treatments} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNfamily-getModel}{}}} -\subsection{Method \code{getModel()}}{ -Extract a model from a collection of models -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNfamily$getModel(var, index = NULL)}\if{html}{\out{
}} +\subsection{\code{PLNfamily$getModel()}}{ + Extract a model from a collection of models + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNfamily$getModel(var, index = NULL)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{var}}{value of the parameter (\code{rank} for PLNPCA, \code{sparsity} for PLNnetwork) that identifies the model to be extracted from the collection. If no exact match is found, the model with closest parameter value is returned with a warning.} + \item{\code{index}}{Integer index of the model to be returned. Only the first value is taken into account.} + } + \if{html}{\out{
}} + } + \subsection{Returns}{ + A \code{\link{PLNfit}} object + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{var}}{value of the parameter (\code{rank} for PLNPCA, \code{sparsity} for PLNnetwork) that identifies the model to be extracted from the collection. If no exact match is found, the model with closest parameter value is returned with a warning.} - -\item{\code{index}}{Integer index of the model to be returned. Only the first value is taken into account.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -A \code{\link{PLNfit}} object -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNfamily-plot}{}}} -\subsection{Method \code{plot()}}{ -Lineplot of selected criteria for all models in the collection -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNfamily$plot(criteria, reverse)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{criteria}}{A valid model selection criteria for the collection of models. Includes loglik, BIC (all), ICL (PLNPCA) and pen_loglik, EBIC (PLNnetwork)} - -\item{\code{reverse}}{A logical indicating whether to plot the value of the criteria in the "natural" direction +\subsection{\code{PLNfamily$plot()}}{ + Lineplot of selected criteria for all models in the collection + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNfamily$plot(criteria, reverse)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{criteria}}{A valid model selection criteria for the collection of models. Includes loglik, BIC (all), ICL (PLNPCA) and pen_loglik, EBIC (PLNnetwork)} + \item{\code{reverse}}{A logical indicating whether to plot the value of the criteria in the "natural" direction (loglik - penalty) or in the "reverse" direction (-2 loglik + penalty). Default to FALSE, i.e use the natural direction, on the same scale as the log-likelihood.} + } + \if{html}{\out{
}} + } + \subsection{Returns}{ + A \code{\link[ggplot2:ggplot]{ggplot2::ggplot}} object + } } -\if{html}{\out{
}} -} -\subsection{Returns}{ -A \code{\link[ggplot2:ggplot]{ggplot2::ggplot}} object -} -} + \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNfamily-show}{}}} -\subsection{Method \code{show()}}{ -User friendly print method -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNfamily$show()}\if{html}{\out{
}} +\subsection{\code{PLNfamily$show()}}{ + User friendly print method + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNfamily$show()} + \if{html}{\out{
}} + } } -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNfamily-print}{}}} -\subsection{Method \code{print()}}{ -User friendly print method -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNfamily$print()}\if{html}{\out{
}} +\subsection{\code{PLNfamily$print()}}{ + User friendly print method + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNfamily$print()} + \if{html}{\out{
}} + } } -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNfamily-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNfamily$clone(deep = FALSE)}\if{html}{\out{
}} +\subsection{\code{PLNfamily$clone()}}{ + The objects of this class are cloneable with this method. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNfamily$clone(deep = FALSE)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{deep}}{Whether to make a deep clone.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} } diff --git a/man/PLNfit.Rd b/man/PLNfit.Rd index de3f838a..c2c1d1e4 100644 --- a/man/PLNfit.Rd +++ b/man/PLNfit.Rd @@ -22,177 +22,166 @@ print(myPLN) } } \section{Active bindings}{ -\if{html}{\out{
}} -\describe{ -\item{\code{n}}{number of samples} + \if{html}{\out{
}} + \describe{ + \item{\code{n}}{number of samples} -\item{\code{q}}{number of dimensions of the latent space} + \item{\code{q}}{number of dimensions of the latent space} -\item{\code{p}}{number of species} + \item{\code{p}}{number of species} -\item{\code{d}}{number of covariates} + \item{\code{d}}{number of covariates} -\item{\code{nb_param}}{number of parameters in the current PLN model} + \item{\code{nb_param}}{number of parameters in the current PLN model} -\item{\code{model_par}}{a list with the matrices of the model parameters: B (covariates), Sigma (covariance), Omega (precision matrix), plus some others depending on the variant)} + \item{\code{model_par}}{a list with the matrices of the model parameters: B (covariates), Sigma (covariance), Omega (precision matrix), plus some others depending on the variant)} -\item{\code{var_par}}{a list with the matrices of the variational parameters: M (means) and S2 (variances)} + \item{\code{var_par}}{a list with the matrices of the variational parameters: M (means) and S2 (variances)} -\item{\code{optim_par}}{a list with parameters useful for monitoring the optimization} + \item{\code{optim_par}}{a list with parameters useful for monitoring the optimization} -\item{\code{latent}}{a matrix: values of the latent vector (Z in the model)} + \item{\code{latent}}{a matrix: values of the latent vector (Z in the model)} -\item{\code{latent_pos}}{a matrix: values of the latent position vector (Z) without covariates effects or offset} + \item{\code{latent_pos}}{a matrix: values of the latent position vector (Z) without covariates effects or offset} -\item{\code{fitted}}{a matrix: fitted values of the observations (A in the model)} + \item{\code{fitted}}{a matrix: fitted values of the observations (A in the model)} -\item{\code{vcov_coef}}{matrix of sandwich estimator of the variance-covariance of B (need fixed -ie known- covariance at the moment)} + \item{\code{vcov_coef}}{matrix of sandwich estimator of the variance-covariance of B (need fixed -ie known- covariance at the moment)} -\item{\code{vcov_model}}{character: the model used for the residual covariance} + \item{\code{vcov_model}}{character: the model used for the residual covariance} -\item{\code{weights}}{observational weights} + \item{\code{weights}}{observational weights} -\item{\code{loglik}}{(weighted) variational lower bound of the loglikelihood} + \item{\code{loglik}}{(weighted) variational lower bound of the loglikelihood} -\item{\code{loglik_vec}}{element-wise variational lower bound of the loglikelihood} + \item{\code{loglik_vec}}{element-wise variational lower bound of the loglikelihood} -\item{\code{AIC}}{variational lower bound of the AIC} + \item{\code{AIC}}{variational lower bound of the AIC} -\item{\code{BIC}}{variational lower bound of the BIC} + \item{\code{BIC}}{variational lower bound of the BIC} -\item{\code{entropy}}{Entropy of the variational distribution} + \item{\code{entropy}}{Entropy of the variational distribution} -\item{\code{ICL}}{variational lower bound of the ICL} + \item{\code{ICL}}{variational lower bound of the ICL} -\item{\code{R_squared}}{approximated goodness-of-fit criterion} + \item{\code{R_squared}}{approximated goodness-of-fit criterion} -\item{\code{criteria}}{a vector with loglik, BIC, ICL and number of parameters} -} -\if{html}{\out{
}} + \item{\code{criteria}}{a vector with loglik, BIC, ICL and number of parameters} + } + \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ -\itemize{ -\item \href{#method-PLNfit-new}{\code{PLNfit$new()}} -\item \href{#method-PLNfit-update}{\code{PLNfit$update()}} -\item \href{#method-PLNfit-optimize}{\code{PLNfit$optimize()}} -\item \href{#method-PLNfit-optimize_vestep}{\code{PLNfit$optimize_vestep()}} -\item \href{#method-PLNfit-postTreatment}{\code{PLNfit$postTreatment()}} -\item \href{#method-PLNfit-predict}{\code{PLNfit$predict()}} -\item \href{#method-PLNfit-predict_cond}{\code{PLNfit$predict_cond()}} -\item \href{#method-PLNfit-show}{\code{PLNfit$show()}} -\item \href{#method-PLNfit-print}{\code{PLNfit$print()}} -\item \href{#method-PLNfit-clone}{\code{PLNfit$clone()}} -} + \itemize{ + \item \href{#method-PLNfit-initialize}{\code{PLNfit$new()}} + \item \href{#method-PLNfit-update}{\code{PLNfit$update()}} + \item \href{#method-PLNfit-optimize}{\code{PLNfit$optimize()}} + \item \href{#method-PLNfit-optimize_vestep}{\code{PLNfit$optimize_vestep()}} + \item \href{#method-PLNfit-postTreatment}{\code{PLNfit$postTreatment()}} + \item \href{#method-PLNfit-predict}{\code{PLNfit$predict()}} + \item \href{#method-PLNfit-predict_cond}{\code{PLNfit$predict_cond()}} + \item \href{#method-PLNfit-show}{\code{PLNfit$show()}} + \item \href{#method-PLNfit-print}{\code{PLNfit$print()}} + \item \href{#method-PLNfit-clone}{\code{PLNfit$clone()}} + } } \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-PLNfit-new}{}}} -\subsection{Method \code{new()}}{ -Initialize a \code{\link{PLNfit}} model -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNfit$new(responses, covariates, offsets, weights, formula, control)}\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-PLNfit-initialize}{}}} +\subsection{\code{PLNfit$new()}}{ + Initialize a \code{\link{PLNfit}} model + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNfit$new(responses, covariates, offsets, weights, formula, control)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{responses}}{the matrix of responses (called Y in the model). Will usually be extracted from the corresponding field in PLNfamily-class} + \item{\code{covariates}}{design matrix (called X in the model). Will usually be extracted from the corresponding field in PLNfamily-class} + \item{\code{offsets}}{offset matrix (called O in the model). Will usually be extracted from the corresponding field in PLNfamily-class} + \item{\code{weights}}{an optional vector of observation weights to be used in the fitting process.} + \item{\code{formula}}{model formula used for fitting, extracted from the formula in the upper-level call} + \item{\code{control}}{a list-like structure for controlling the fit, see \code{\link[=PLN_param]{PLN_param()}}.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{responses}}{the matrix of responses (called Y in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{covariates}}{design matrix (called X in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{offsets}}{offset matrix (called O in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{weights}}{an optional vector of observation weights to be used in the fitting process.} - -\item{\code{formula}}{model formula used for fitting, extracted from the formula in the upper-level call} - -\item{\code{control}}{a list-like structure for controlling the fit, see \code{\link[=PLN_param]{PLN_param()}}.} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNfit-update}{}}} -\subsection{Method \code{update()}}{ -Update a \code{\link{PLNfit}} object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNfit$update( +\subsection{\code{PLNfit$update()}}{ + Update a \code{\link{PLNfit}} object + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNfit$update( B = NA, Sigma = NA, Omega = NA, M = NA, - S = NA, + S2 = NA, Ji = NA, R2 = NA, Z = NA, A = NA, monitoring = NA -)}\if{html}{\out{
}} +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{B}}{matrix of regression matrix} + \item{\code{Sigma}}{variance-covariance matrix of the latent variables} + \item{\code{Omega}}{precision matrix of the latent variables. Inverse of Sigma.} + \item{\code{M}}{matrix of variational parameters for the mean} + \item{\code{S2}}{matrix of variational parameters for the variance} + \item{\code{Ji}}{vector of variational lower bounds of the log-likelihoods (one value per sample)} + \item{\code{R2}}{approximate R^2 goodness-of-fit criterion} + \item{\code{Z}}{matrix of latent vectors (includes covariates and offset effects)} + \item{\code{A}}{matrix of fitted values} + \item{\code{monitoring}}{a list with optimization monitoring quantities} + } + \if{html}{\out{
}} + } + \subsection{Returns}{ + Update the current \code{\link{PLNfit}} object + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{B}}{matrix of regression matrix} - -\item{\code{Sigma}}{variance-covariance matrix of the latent variables} - -\item{\code{Omega}}{precision matrix of the latent variables. Inverse of Sigma.} - -\item{\code{M}}{matrix of variational parameters for the mean} - -\item{\code{S}}{matrix of variational parameters for the variance} - -\item{\code{Ji}}{vector of variational lower bounds of the log-likelihoods (one value per sample)} - -\item{\code{R2}}{approximate R^2 goodness-of-fit criterion} - -\item{\code{Z}}{matrix of latent vectors (includes covariates and offset effects)} - -\item{\code{A}}{matrix of fitted values} - -\item{\code{monitoring}}{a list with optimization monitoring quantities} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -Update the current \code{\link{PLNfit}} object -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNfit-optimize}{}}} -\subsection{Method \code{optimize()}}{ -Call to the NLopt or TORCH optimizer and update of the relevant fields -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNfit$optimize(responses, covariates, offsets, weights, config)}\if{html}{\out{
}} +\subsection{\code{PLNfit$optimize()}}{ + Call to the NLopt or TORCH optimizer and update of the relevant fields + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNfit$optimize(responses, covariates, offsets, weights, config)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{responses}}{the matrix of responses (called Y in the model). Will usually be extracted from the corresponding field in PLNfamily-class} + \item{\code{covariates}}{design matrix (called X in the model). Will usually be extracted from the corresponding field in PLNfamily-class} + \item{\code{offsets}}{offset matrix (called O in the model). Will usually be extracted from the corresponding field in PLNfamily-class} + \item{\code{weights}}{an optional vector of observation weights to be used in the fitting process.} + \item{\code{config}}{part of the \code{control} argument which configures the optimizer} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{responses}}{the matrix of responses (called Y in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{covariates}}{design matrix (called X in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{offsets}}{offset matrix (called O in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{weights}}{an optional vector of observation weights to be used in the fitting process.} - -\item{\code{config}}{part of the \code{control} argument which configures the optimizer} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNfit-optimize_vestep}{}}} -\subsection{Method \code{optimize_vestep()}}{ -Result of one call to the VE step of the optimization procedure: optimal variational parameters (M, S) and corresponding log likelihood values for fixed model parameters (Sigma, B). Intended to position new data in the latent space. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNfit$optimize_vestep( +\subsection{\code{PLNfit$optimize_vestep()}}{ + Result of one call to the VE step of the optimization procedure: optimal variational parameters (M, S2) and corresponding log likelihood values for fixed model parameters (Sigma, B). Intended to position new data in the latent space. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNfit$optimize_vestep( covariates, offsets, responses, @@ -200,46 +189,41 @@ Result of one call to the VE step of the optimization procedure: optimal variati B = self$model_par$B, Omega = self$model_par$Omega, control = PLN_param(backend = "nlopt") -)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{covariates}}{design matrix (called X in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{offsets}}{offset matrix (called O in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{responses}}{the matrix of responses (called Y in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{weights}}{an optional vector of observation weights to be used in the fitting process.} - -\item{\code{B}}{Optional fixed value of the regression parameters} - -\item{\code{Omega}}{precision matrix of the latent variables. Inverse of Sigma.} - -\item{\code{control}}{a list-like structure for controlling the fit, see \code{\link[=PLN_param]{PLN_param()}}.} - -\item{\code{Sigma}}{variance-covariance matrix of the latent variables} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -A list with three components: +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{covariates}}{design matrix (called X in the model). Will usually be extracted from the corresponding field in PLNfamily-class} + \item{\code{offsets}}{offset matrix (called O in the model). Will usually be extracted from the corresponding field in PLNfamily-class} + \item{\code{responses}}{the matrix of responses (called Y in the model). Will usually be extracted from the corresponding field in PLNfamily-class} + \item{\code{weights}}{an optional vector of observation weights to be used in the fitting process.} + \item{\code{B}}{Optional fixed value of the regression parameters} + \item{\code{Omega}}{precision matrix of the latent variables. Inverse of Sigma.} + \item{\code{control}}{a list-like structure for controlling the fit, see \code{\link[=PLN_param]{PLN_param()}}.} + \item{\code{Sigma}}{variance-covariance matrix of the latent variables} + } + \if{html}{\out{
}} + } + \subsection{Returns}{ + A list with three components: \itemize{ \item the matrix \code{M} of variational means, \item the matrix \code{S2} of variational variances \item the vector \code{log.lik} of (variational) log-likelihood of each new observation } + } } -} + \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNfit-postTreatment}{}}} -\subsection{Method \code{postTreatment()}}{ -Update R2, fisher and std_err fields after optimization -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNfit$postTreatment( +\subsection{\code{PLNfit$postTreatment()}}{ + Update R2, fisher and std_err fields after optimization + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNfit$postTreatment( responses, covariates, offsets, @@ -247,30 +231,24 @@ Update R2, fisher and std_err fields after optimization config_post, config_optim, nullModel = NULL -)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{responses}}{the matrix of responses (called Y in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{covariates}}{design matrix (called X in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{offsets}}{offset matrix (called O in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{weights}}{an optional vector of observation weights to be used in the fitting process.} - -\item{\code{config_post}}{a list for controlling the post-treatments (optional bootstrap, jackknife, R2, etc.). See details} - -\item{\code{config_optim}}{a list for controlling the optimization (optional bootstrap, jackknife, R2, etc.). See details} - -\item{\code{nullModel}}{null model used for approximate R2 computations. Defaults to a GLM model with same design matrix but not latent variable.} -} -\if{html}{\out{
}} -} -\subsection{Details}{ -The list of parameters \code{config} controls the post-treatment processing, with the following entries: +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{responses}}{the matrix of responses (called Y in the model). Will usually be extracted from the corresponding field in PLNfamily-class} + \item{\code{covariates}}{design matrix (called X in the model). Will usually be extracted from the corresponding field in PLNfamily-class} + \item{\code{offsets}}{offset matrix (called O in the model). Will usually be extracted from the corresponding field in PLNfamily-class} + \item{\code{weights}}{an optional vector of observation weights to be used in the fitting process.} + \item{\code{config_post}}{a list for controlling the post-treatments (optional bootstrap, jackknife, R2, etc.). See details} + \item{\code{config_optim}}{a list for controlling the optimization (optional bootstrap, jackknife, R2, etc.). See details} + \item{\code{nullModel}}{null model used for approximate R2 computations. Defaults to a GLM model with same design matrix but not latent variable.} + } + \if{html}{\out{
}} + } + \subsection{Details}{ + The list of parameters \code{config} controls the post-treatment processing, with the following entries: \itemize{ \item jackknife boolean indicating whether jackknife should be performed to evaluate bias and variance of the model parameters. Default is FALSE. \item bootstrap integer indicating the number of bootstrap resamples generated to evaluate the variance of the model parameters. Default is 0 (inactivated). @@ -278,127 +256,128 @@ The list of parameters \code{config} controls the post-treatment processing, wit \item sandwich_var boolean indicating whether sandwich estimator should be computed to estimate the variance of the model parameters (highly underestimated). Default is FALSE. \item trace integer for verbosity. should be > 1 to see output in post-treatments } + } } -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNfit-predict}{}}} -\subsection{Method \code{predict()}}{ -Predict position, scores or observations of new data. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNfit$predict( +\subsection{\code{PLNfit$predict()}}{ + Predict position, scores or observations of new data. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNfit$predict( newdata, responses = NULL, type = c("link", "response"), level = 1, envir = parent.frame() -)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{newdata}}{A data frame in which to look for variables with which to predict. If omitted, the fitted values are used.} - -\item{\code{responses}}{Optional data frame containing the count of the observed variables (matching the names of the provided as data in the PLN function), assuming the interest is in testing the model.} - -\item{\code{type}}{Scale used for the prediction. Either \code{link} (default, predicted positions in the latent space) or \code{response} (predicted counts).} - -\item{\code{level}}{Optional integer value the level to be used in obtaining the predictions. Level zero corresponds to the population predictions (default if \code{responses} is not provided) while level one (default) corresponds to predictions after evaluating the variational parameters for the new data.} - -\item{\code{envir}}{Environment in which the prediction is evaluated} -} -\if{html}{\out{
}} -} -\subsection{Details}{ -Note that \code{level = 1} can only be used if responses are provided, +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{newdata}}{A data frame in which to look for variables with which to predict. If omitted, the fitted values are used.} + \item{\code{responses}}{Optional data frame containing the count of the observed variables (matching the names of the provided as data in the PLN function), assuming the interest is in testing the model.} + \item{\code{type}}{Scale used for the prediction. Either \code{link} (default, predicted positions in the latent space) or \code{response} (predicted counts).} + \item{\code{level}}{Optional integer value the level to be used in obtaining the predictions. Level zero corresponds to the population predictions (default if \code{responses} is not provided) while level one (default) corresponds to predictions after evaluating the variational parameters for the new data.} + \item{\code{envir}}{Environment in which the prediction is evaluated} + } + \if{html}{\out{
}} + } + \subsection{Details}{ + Note that \code{level = 1} can only be used if responses are provided, as the variational parameters can't be estimated otherwise. In the absence of responses, \code{level} is ignored and the fitted values are returned + } + \subsection{Returns}{ + A matrix with predictions scores or counts. + } } -\subsection{Returns}{ -A matrix with predictions scores or counts. -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNfit-predict_cond}{}}} -\subsection{Method \code{predict_cond()}}{ -Predict position, scores or observations of new data, conditionally on the observation of a (set of) variables -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNfit$predict_cond( +\subsection{\code{PLNfit$predict_cond()}}{ + Predict position, scores or observations of new data, conditionally on the observation of a (set of) variables + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNfit$predict_cond( newdata, cond_responses, type = c("link", "response"), var_par = FALSE, envir = parent.frame() -)}\if{html}{\out{
}} +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{newdata}}{a data frame containing the covariates of the sites where to predict} + \item{\code{cond_responses}}{a data frame containing the count of the observed variables (matching the names of the provided as data in the PLN function)} + \item{\code{type}}{Scale used for the prediction. Either \code{link} (default, predicted positions in the latent space) or \code{response} (predicted counts).} + \item{\code{var_par}}{Boolean. Should new estimations of the variational parameters of mean and variance be sent back, as attributes of the matrix of predictions. Default to \code{FALSE}.} + \item{\code{envir}}{Environment in which the prediction is evaluated} + } + \if{html}{\out{
}} + } + \subsection{Returns}{ + A matrix with predictions scores or counts. + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{newdata}}{a data frame containing the covariates of the sites where to predict} - -\item{\code{cond_responses}}{a data frame containing the count of the observed variables (matching the names of the provided as data in the PLN function)} - -\item{\code{type}}{Scale used for the prediction. Either \code{link} (default, predicted positions in the latent space) or \code{response} (predicted counts).} - -\item{\code{var_par}}{Boolean. Should new estimations of the variational parameters of mean and variance be sent back, as attributes of the matrix of predictions. Default to \code{FALSE}.} - -\item{\code{envir}}{Environment in which the prediction is evaluated} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -A matrix with predictions scores or counts. -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNfit-show}{}}} -\subsection{Method \code{show()}}{ -User friendly print method -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNfit$show( +\subsection{\code{PLNfit$show()}}{ + User friendly print method + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNfit$show( model = paste("A multivariate Poisson Lognormal fit with", self$vcov_model, "covariance model.\\n") -)}\if{html}{\out{
}} +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{model}}{First line of the print output} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{model}}{First line of the print output} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNfit-print}{}}} -\subsection{Method \code{print()}}{ -User friendly print method -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNfit$print()}\if{html}{\out{
}} +\subsection{\code{PLNfit$print()}}{ + User friendly print method + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNfit$print()} + \if{html}{\out{
}} + } } -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNfit-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNfit$clone(deep = FALSE)}\if{html}{\out{
}} +\subsection{\code{PLNfit$clone()}}{ + The objects of this class are cloneable with this method. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNfit$clone(deep = FALSE)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{deep}}{Whether to make a deep clone.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} } diff --git a/man/PLNfit_diagonal.Rd b/man/PLNfit_diagonal.Rd index a9b55c00..f1f89e07 100644 --- a/man/PLNfit_diagonal.Rd +++ b/man/PLNfit_diagonal.Rd @@ -28,127 +28,123 @@ print(myPLNLDA) } } \section{Super class}{ -\code{\link[PLNmodels:PLNfit]{PLNmodels::PLNfit}} -> \code{PLNfit_diagonal} +\code{\link[PLNmodels:PLNfit]{PLNfit}} -> \code{PLNfit_diagonal} } \section{Active bindings}{ -\if{html}{\out{
}} -\describe{ -\item{\code{nb_param}}{number of parameters in the current PLN model} + \if{html}{\out{
}} + \describe{ + \item{\code{nb_param}}{number of parameters in the current PLN model} -\item{\code{vcov_model}}{character: the model used for the residual covariance} -} -\if{html}{\out{
}} + \item{\code{vcov_model}}{character: the model used for the residual covariance} + } + \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ -\itemize{ -\item \href{#method-PLNfit_diagonal-new}{\code{PLNfit_diagonal$new()}} -\item \href{#method-PLNfit_diagonal-clone}{\code{PLNfit_diagonal$clone()}} -} + \itemize{ + \item \href{#method-PLNfit_diagonal-initialize}{\code{PLNfit_diagonal$new()}} + \item \href{#method-PLNfit_diagonal-clone}{\code{PLNfit_diagonal$clone()}} + } } -\if{html}{\out{ -
Inherited methods +\if{html}{\out{
Inherited methods -
-}} +
}} \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-PLNfit_diagonal-new}{}}} -\subsection{Method \code{new()}}{ -Initialize a \code{\link{PLNfit}} model -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNfit_diagonal$new(responses, covariates, offsets, weights, formula, control)}\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-PLNfit_diagonal-initialize}{}}} +\subsection{\code{PLNfit_diagonal$new()}}{ + Initialize a \code{\link{PLNfit}} model + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNfit_diagonal$new(responses, covariates, offsets, weights, formula, control)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{responses}}{the matrix of responses (called Y in the model). Will usually be extracted from the corresponding field in PLNfamily-class} + \item{\code{covariates}}{design matrix (called X in the model). Will usually be extracted from the corresponding field in PLNfamily-class} + \item{\code{offsets}}{offset matrix (called O in the model). Will usually be extracted from the corresponding field in PLNfamily-class} + \item{\code{weights}}{an optional vector of observation weights to be used in the fitting process.} + \item{\code{formula}}{model formula used for fitting, extracted from the formula in the upper-level call} + \item{\code{control}}{a list for controlling the optimization. See details.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{responses}}{the matrix of responses (called Y in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{covariates}}{design matrix (called X in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{offsets}}{offset matrix (called O in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{weights}}{an optional vector of observation weights to be used in the fitting process.} - -\item{\code{formula}}{model formula used for fitting, extracted from the formula in the upper-level call} - -\item{\code{control}}{a list for controlling the optimization. See details.} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNfit_diagonal-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNfit_diagonal$clone(deep = FALSE)}\if{html}{\out{
}} +\subsection{\code{PLNfit_diagonal$clone()}}{ + The objects of this class are cloneable with this method. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNfit_diagonal$clone(deep = FALSE)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{deep}}{Whether to make a deep clone.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} } \section{Super classes}{ -\code{\link[PLNmodels:PLNfit]{PLNmodels::PLNfit}} -> \code{\link[PLNmodels:PLNLDAfit]{PLNmodels::PLNLDAfit}} -> \code{PLNLDAfit_spherical} +\code{\link[PLNmodels:PLNfit]{PLNfit}} -> \code{\link[PLNmodels:PLNLDAfit]{PLNLDAfit}} -> \code{PLNLDAfit_spherical} } \section{Active bindings}{ -\if{html}{\out{
}} -\describe{ -\item{\code{vcov_model}}{character: the model used for the residual covariance} + \if{html}{\out{
}} + \describe{ + \item{\code{vcov_model}}{character: the model used for the residual covariance} -\item{\code{nb_param}}{number of parameters in the current PLN model} -} -\if{html}{\out{
}} + \item{\code{nb_param}}{number of parameters in the current PLN model} + } + \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ -\itemize{ -\item \href{#method-PLNLDAfit_spherical-new}{\code{PLNLDAfit_spherical$new()}} -\item \href{#method-PLNLDAfit_spherical-clone}{\code{PLNLDAfit_spherical$clone()}} + \itemize{ + \item \href{#method-PLNLDAfit_spherical-initialize}{\code{PLNLDAfit_spherical$new()}} + \item \href{#method-PLNLDAfit_spherical-clone}{\code{PLNLDAfit_spherical$clone()}} + } } -} -\if{html}{\out{ -
Inherited methods +\if{html}{\out{
Inherited methods -
-}} +
}} \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-PLNLDAfit_spherical-new}{}}} -\subsection{Method \code{new()}}{ -Initialize a \code{\link{PLNfit}} model -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNLDAfit_spherical$new( +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-PLNLDAfit_spherical-initialize}{}}} +\subsection{\code{PLNLDAfit_spherical$new()}}{ + Initialize a \code{\link{PLNfit}} model + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNLDAfit_spherical$new( grouping, responses, covariates, @@ -156,44 +152,41 @@ Initialize a \code{\link{PLNfit}} model weights, formula, control -)}\if{html}{\out{
}} +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{grouping}}{a factor specifying the class of each observation used for discriminant analysis.} + \item{\code{responses}}{the matrix of responses (called Y in the model). Will usually be extracted from the corresponding field in PLNfamily-class} + \item{\code{covariates}}{design matrix (called X in the model). Will usually be extracted from the corresponding field in PLNfamily-class} + \item{\code{offsets}}{offset matrix (called O in the model). Will usually be extracted from the corresponding field in PLNfamily-class} + \item{\code{weights}}{an optional vector of observation weights to be used in the fitting process.} + \item{\code{formula}}{model formula used for fitting, extracted from the formula in the upper-level call} + \item{\code{control}}{a list for controlling the optimization. See details.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{grouping}}{a factor specifying the class of each observation used for discriminant analysis.} - -\item{\code{responses}}{the matrix of responses (called Y in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{covariates}}{design matrix (called X in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{offsets}}{offset matrix (called O in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{weights}}{an optional vector of observation weights to be used in the fitting process.} - -\item{\code{formula}}{model formula used for fitting, extracted from the formula in the upper-level call} - -\item{\code{control}}{a list for controlling the optimization. See details.} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNLDAfit_spherical-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNLDAfit_spherical$clone(deep = FALSE)}\if{html}{\out{
}} +\subsection{\code{PLNLDAfit_spherical$clone()}}{ + The objects of this class are cloneable with this method. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNLDAfit_spherical$clone(deep = FALSE)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{deep}}{Whether to make a deep clone.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} } diff --git a/man/PLNfit_fixedcov.Rd b/man/PLNfit_fixedcov.Rd index d0e39325..5ffc85c7 100644 --- a/man/PLNfit_fixedcov.Rd +++ b/man/PLNfit_fixedcov.Rd @@ -4,8 +4,6 @@ \alias{PLNfit_fixedcov} \title{An R6 Class to represent a PLNfit in a standard, general framework, with fixed (inverse) residual covariance} \description{ -An R6 Class to represent a PLNfit in a standard, general framework, with fixed (inverse) residual covariance - An R6 Class to represent a PLNfit in a standard, general framework, with fixed (inverse) residual covariance } \examples{ @@ -18,107 +16,102 @@ print(myPLN) } } \section{Super class}{ -\code{\link[PLNmodels:PLNfit]{PLNmodels::PLNfit}} -> \code{PLNfit_fixedcov} +\code{\link[PLNmodels:PLNfit]{PLNfit}} -> \code{PLNfit_fixedcov} } \section{Active bindings}{ -\if{html}{\out{
}} -\describe{ -\item{\code{nb_param}}{number of parameters in the current PLN model} + \if{html}{\out{
}} + \describe{ + \item{\code{nb_param}}{number of parameters in the current PLN model} -\item{\code{vcov_model}}{character: the model used for the residual covariance} + \item{\code{vcov_model}}{character: the model used for the residual covariance} -\item{\code{vcov_coef}}{matrix of sandwich estimator of the variance-covariance of B (needs known covariance at the moment)} -} -\if{html}{\out{
}} + \item{\code{vcov_coef}}{matrix of sandwich estimator of the variance-covariance of B (needs known covariance at the moment)} + } + \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ -\itemize{ -\item \href{#method-PLNfit_fixedcov-new}{\code{PLNfit_fixedcov$new()}} -\item \href{#method-PLNfit_fixedcov-optimize}{\code{PLNfit_fixedcov$optimize()}} -\item \href{#method-PLNfit_fixedcov-clone}{\code{PLNfit_fixedcov$clone()}} + \itemize{ + \item \href{#method-PLNfit_fixedcov-initialize}{\code{PLNfit_fixedcov$new()}} + \item \href{#method-PLNfit_fixedcov-optimize}{\code{PLNfit_fixedcov$optimize()}} + \item \href{#method-PLNfit_fixedcov-clone}{\code{PLNfit_fixedcov$clone()}} + } } -} -\if{html}{\out{ -
Inherited methods +\if{html}{\out{
Inherited methods -
-}} +
}} \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-PLNfit_fixedcov-new}{}}} -\subsection{Method \code{new()}}{ -Initialize a \code{\link{PLNfit}} model -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNfit_fixedcov$new(responses, covariates, offsets, weights, formula, control)}\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-PLNfit_fixedcov-initialize}{}}} +\subsection{\code{PLNfit_fixedcov$new()}}{ + Initialize a \code{\link{PLNfit}} model + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNfit_fixedcov$new(responses, covariates, offsets, weights, formula, control)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{responses}}{the matrix of responses (called Y in the model). Will usually be extracted from the corresponding field in PLNfamily-class} + \item{\code{covariates}}{design matrix (called X in the model). Will usually be extracted from the corresponding field in PLNfamily-class} + \item{\code{offsets}}{offset matrix (called O in the model). Will usually be extracted from the corresponding field in PLNfamily-class} + \item{\code{weights}}{an optional vector of observation weights to be used in the fitting process.} + \item{\code{formula}}{model formula used for fitting, extracted from the formula in the upper-level call} + \item{\code{control}}{a list for controlling the optimization. See details.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{responses}}{the matrix of responses (called Y in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{covariates}}{design matrix (called X in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{offsets}}{offset matrix (called O in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{weights}}{an optional vector of observation weights to be used in the fitting process.} - -\item{\code{formula}}{model formula used for fitting, extracted from the formula in the upper-level call} - -\item{\code{control}}{a list for controlling the optimization. See details.} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNfit_fixedcov-optimize}{}}} -\subsection{Method \code{optimize()}}{ -Call to the NLopt or TORCH optimizer and update of the relevant fields -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNfit_fixedcov$optimize(responses, covariates, offsets, weights, config)}\if{html}{\out{
}} +\subsection{\code{PLNfit_fixedcov$optimize()}}{ + Call to the NLopt or TORCH optimizer and update of the relevant fields + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNfit_fixedcov$optimize(responses, covariates, offsets, weights, config)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{responses}}{the matrix of responses (called Y in the model). Will usually be extracted from the corresponding field in PLNfamily-class} + \item{\code{covariates}}{design matrix (called X in the model). Will usually be extracted from the corresponding field in PLNfamily-class} + \item{\code{offsets}}{offset matrix (called O in the model). Will usually be extracted from the corresponding field in PLNfamily-class} + \item{\code{weights}}{an optional vector of observation weights to be used in the fitting process.} + \item{\code{config}}{part of the \code{control} argument which configures the optimizer} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{responses}}{the matrix of responses (called Y in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{covariates}}{design matrix (called X in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{offsets}}{offset matrix (called O in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{weights}}{an optional vector of observation weights to be used in the fitting process.} - -\item{\code{config}}{part of the \code{control} argument which configures the optimizer} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNfit_fixedcov-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNfit_fixedcov$clone(deep = FALSE)}\if{html}{\out{
}} +\subsection{\code{PLNfit_fixedcov$clone()}}{ + The objects of this class are cloneable with this method. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNfit_fixedcov$clone(deep = FALSE)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{deep}}{Whether to make a deep clone.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} } diff --git a/man/PLNfit_spherical.Rd b/man/PLNfit_spherical.Rd index b43fdc47..0f126f5b 100644 --- a/man/PLNfit_spherical.Rd +++ b/man/PLNfit_spherical.Rd @@ -4,8 +4,6 @@ \alias{PLNfit_spherical} \title{An R6 Class to represent a PLNfit in a standard, general framework, with spherical residual covariance} \description{ -An R6 Class to represent a PLNfit in a standard, general framework, with spherical residual covariance - An R6 Class to represent a PLNfit in a standard, general framework, with spherical residual covariance } \examples{ @@ -18,80 +16,77 @@ print(myPLN) } } \section{Super class}{ -\code{\link[PLNmodels:PLNfit]{PLNmodels::PLNfit}} -> \code{PLNfit_spherical} +\code{\link[PLNmodels:PLNfit]{PLNfit}} -> \code{PLNfit_spherical} } \section{Active bindings}{ -\if{html}{\out{
}} -\describe{ -\item{\code{nb_param}}{number of parameters in the current PLN model} + \if{html}{\out{
}} + \describe{ + \item{\code{nb_param}}{number of parameters in the current PLN model} -\item{\code{vcov_model}}{character: the model used for the residual covariance} -} -\if{html}{\out{
}} + \item{\code{vcov_model}}{character: the model used for the residual covariance} + } + \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ -\itemize{ -\item \href{#method-PLNfit_spherical-new}{\code{PLNfit_spherical$new()}} -\item \href{#method-PLNfit_spherical-clone}{\code{PLNfit_spherical$clone()}} -} + \itemize{ + \item \href{#method-PLNfit_spherical-initialize}{\code{PLNfit_spherical$new()}} + \item \href{#method-PLNfit_spherical-clone}{\code{PLNfit_spherical$clone()}} + } } -\if{html}{\out{ -
Inherited methods +\if{html}{\out{
Inherited methods -
-}} +
}} \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-PLNfit_spherical-new}{}}} -\subsection{Method \code{new()}}{ -Initialize a \code{\link{PLNfit}} model -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNfit_spherical$new(responses, covariates, offsets, weights, formula, control)}\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-PLNfit_spherical-initialize}{}}} +\subsection{\code{PLNfit_spherical$new()}}{ + Initialize a \code{\link{PLNfit}} model + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNfit_spherical$new(responses, covariates, offsets, weights, formula, control)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{responses}}{the matrix of responses (called Y in the model). Will usually be extracted from the corresponding field in PLNfamily-class} + \item{\code{covariates}}{design matrix (called X in the model). Will usually be extracted from the corresponding field in PLNfamily-class} + \item{\code{offsets}}{offset matrix (called O in the model). Will usually be extracted from the corresponding field in PLNfamily-class} + \item{\code{weights}}{an optional vector of observation weights to be used in the fitting process.} + \item{\code{formula}}{model formula used for fitting, extracted from the formula in the upper-level call} + \item{\code{control}}{a list for controlling the optimization. See details.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{responses}}{the matrix of responses (called Y in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{covariates}}{design matrix (called X in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{offsets}}{offset matrix (called O in the model). Will usually be extracted from the corresponding field in PLNfamily-class} - -\item{\code{weights}}{an optional vector of observation weights to be used in the fitting process.} - -\item{\code{formula}}{model formula used for fitting, extracted from the formula in the upper-level call} - -\item{\code{control}}{a list for controlling the optimization. See details.} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNfit_spherical-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNfit_spherical$clone(deep = FALSE)}\if{html}{\out{
}} +\subsection{\code{PLNfit_spherical$clone()}}{ + The objects of this class are cloneable with this method. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNfit_spherical$clone(deep = FALSE)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{deep}}{Whether to make a deep clone.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} } diff --git a/man/PLNmixture.Rd b/man/PLNmixture.Rd index e96ff721..d7c60f69 100644 --- a/man/PLNmixture.Rd +++ b/man/PLNmixture.Rd @@ -9,7 +9,7 @@ PLNmixture(formula, data, subset, clusters = 1:5, control = PLNmixture_param()) \arguments{ \item{formula}{an object of class "formula": a symbolic description of the model to be fitted.} -\item{data}{an optional data frame, list or environment (or object coercible by as.data.frame to a data frame) containing the variables in the model. If not found in data, the variables are taken from environment(formula), typically the environment from which lm is called.} +\item{data}{an optional data frame, list or environment (or object coercible by as.data.frame to a data frame) containing the variables in the model. If not found in data, the variables are taken from environment(formula), typically the environment from which the model is called.} \item{subset}{an optional vector specifying a subset of observations to be used in the fitting process.} diff --git a/man/PLNmixture_param.Rd b/man/PLNmixture_param.Rd index 81ec96c7..fb559161 100644 --- a/man/PLNmixture_param.Rd +++ b/man/PLNmixture_param.Rd @@ -5,7 +5,7 @@ \title{Control of a PLNmixture fit} \usage{ PLNmixture_param( - backend = "nlopt", + backend = c("builtin", "nlopt", "torch"), trace = 1, covariance = "spherical", init_cl = "kmeans", @@ -16,7 +16,7 @@ PLNmixture_param( ) } \arguments{ -\item{backend}{optimization back used, either "nlopt" or "torch". Default is "nlopt"} +\item{backend}{optimization back used, either "builtin", "nlopt" or "torch". Default is "builtin".} \item{trace}{a integer for verbosity.} @@ -28,7 +28,7 @@ PLNmixture_param( \item{config_optim}{a list for controlling the optimizer (either "nlopt" or "torch" backend). See details} -\item{config_post}{a list for controlling the post-treatments (optional bootstrap, jackknife, R2, etc.).} +\item{config_post}{a list for controlling the post-treatments (optional bootstrap, jackknife, R2, etc.). See details} \item{inception}{Set up the parameters initialization: by default, the model is initialized with a multivariate linear model applied on log-transformed data, and with the same formula as the one provided by the user. However, the user can provide a PLNfit (typically obtained from a previous fit), @@ -41,13 +41,60 @@ list of parameters configuring the fit. Helper to define list of parameters to control the PLNmixture fit. All arguments have defaults. } \details{ -See \code{\link[=PLN_param]{PLN_param()}} for a full description of the generic optimization parameters. PLNmixture_param() also has additional parameters controlling the optimization due the inner-outer loop structure of the optimizer: +The list of parameters \code{config_optim} controls the optimizers. When "nlopt" is chosen the following entries are relevant \itemize{ -\item "ftol_out" outer solver stops when an optimization step changes the objective function by less than xtol multiplied by the absolute value of the parameter. Default is 1e-6 -\item "maxit_out" outer solver stops when the number of iteration exceeds maxit_out. Default is 50 -\item "it_smoothing" number of the iterations of the smoothing procedure. Default is 1. +\item "algorithm" the optimization method used by NLOPT among LD type, e.g. "CCSAQ", "MMA", "LBFGS". See NLOPT documentation for further details. Default is "CCSAQ". +\item "maxeval" stop when the number of iteration exceeds maxeval. Default is 10000 +\item "ftol_rel" stop when an optimization step changes the objective function by less than ftol multiplied by the absolute value of the parameter. Default is 1e-8 +\item "xtol_rel" stop when an optimization step changes every parameters by less than xtol multiplied by the absolute value of the parameter. Default is 1e-6 +\item "ftol_abs" stop when an optimization step changes the objective function by less than ftol_abs. Default is 0.0 (disabled) +\item "xtol_abs" stop when an optimization step changes every parameters by less than xtol_abs. Default is 0.0 (disabled) +\item "maxtime" stop when the optimization time (in seconds) exceeds maxtime. Default is -1 (disabled) +} + +When "torch" backend is used (only for PLN and PLNLDA for now), the following entries are relevant: +\itemize{ +\item "algorithm" the optimizer used by torch among RPROP (default), RMSPROP, ADAM and ADAGRAD +\item "maxeval" stop when the number of iteration exceeds maxeval. Default is 10 000 +\item "numepoch" stop training once this number of epochs exceeds numepoch. Set to -1 to enable infinite training. Default is 1 000 +\item "num_batch" number of batches to use during training. Defaults to 1 (use full dataset at each epoch) +\item "ftol_rel" stop when an optimization step changes the objective function by less than ftol multiplied by the absolute value of the parameter. Default is 1e-8 +\item "xtol_rel" stop when an optimization step changes every parameters by less than xtol multiplied by the absolute value of the parameter. Default is 1e-6 +\item "lr" learning rate. Default is 0.1. +\item "momentum" momentum factor. Default is 0 (no momentum). Only used in RMSPROP +\item "weight_decay" Weight decay penalty. Default is 0 (no decay). Not used in RPROP +\item "step_sizes" pair of minimal (default: 1e-6) and maximal (default: 50) allowed step sizes. Only used in RPROP +\item "etas" pair of multiplicative increase and decrease factors. Default is (0.5, 1.2). Only used in RPROP +\item "centered" if TRUE, compute the centered RMSProp where the gradient is normalized by an estimation of its variance weight_decay (L2 penalty). Default to FALSE. Only used in RMSPROP +} + +When "builtin" backend is used, the following entries are relevant +\itemize{ +\item "maxeval" stop when the number of Newton steps in the inner loop exceeds maxeval. Default is 10000 +\item "ftol_in" stop the inner loop when the objective changes by less than ftol_in (relative). Default is 1e-8 +\item "maxit_em" stop the EM outer loop when the number of EM iterations exceeds maxit_em. Default is 50 +\item "ftol_em" stop the EM outer loop when the ELBO changes by less than ftol_em (relative). Default is 1e-8 +} + +The list of parameters \code{config_post} controls the post-treatment processing (for most \verb{PLN*()} functions), with the following entries (defaults may vary depending on the specific function, check \verb{config_post_default_*} for defaults values): +\itemize{ +\item jackknife boolean indicating whether jackknife should be performed to evaluate bias and variance of the model parameters. Default is FALSE. +\item bootstrap integer indicating the number of bootstrap resamples generated to evaluate the variance of the model parameters. Default is 0 (inactivated). +\item variational_var boolean indicating whether variational Fisher information matrix should be computed to estimate the variance of the model parameters (highly underestimated). Default is FALSE. +\item sandwich_var boolean indicating whether sandwich estimation should be used to estimate the variance of the model parameters (highly underestimated). Default is FALSE. +\item rsquared boolean indicating whether approximation of R2 based on deviance should be computed. Default is TRUE } } +\section{Outer-loop optimization parameters}{ + +\code{PLNmixture_param()} adds parameters controlling the EM and smoothing outer loops: +\itemize{ +\item "ftol_em" outer EM solver stops when the objective changes by less than ftol_em (relative). Default is 1e-3 +\item "maxit_em" outer EM solver stops when the number of iterations exceeds maxit_em. Default is 50 +\item "it_smooth" number of the iterations of the smoothing procedure. Default is 1. +} +} + \seealso{ \code{\link[=PLN_param]{PLN_param()}} } diff --git a/man/PLNmixturefamily.Rd b/man/PLNmixturefamily.Rd index a511cfb4..fbebdc9c 100644 --- a/man/PLNmixturefamily.Rd +++ b/man/PLNmixturefamily.Rd @@ -13,203 +13,212 @@ See the documentation for \code{\link[=getBestModel]{getBestModel()}}, \code{\li The function \code{\link{PLNmixture}}, the class \code{\link[=PLNmixturefit]{PLNmixturefit}} } \section{Super class}{ -\code{\link[PLNmodels:PLNfamily]{PLNmodels::PLNfamily}} -> \code{PLNmixturefamily} +\code{\link[PLNmodels:PLNfamily]{PLNfamily}} -> \code{PLNmixturefamily} } \section{Active bindings}{ -\if{html}{\out{
}} -\describe{ -\item{\code{clusters}}{vector indicating the number of clusters considered is the successively fitted models} -} -\if{html}{\out{
}} + \if{html}{\out{
}} + \describe{ + \item{\code{clusters}}{vector indicating the number of clusters considered is the successively fitted models} + } + \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ -\itemize{ -\item \href{#method-PLNmixturefamily-new}{\code{PLNmixturefamily$new()}} -\item \href{#method-PLNmixturefamily-optimize}{\code{PLNmixturefamily$optimize()}} -\item \href{#method-PLNmixturefamily-smooth}{\code{PLNmixturefamily$smooth()}} -\item \href{#method-PLNmixturefamily-plot}{\code{PLNmixturefamily$plot()}} -\item \href{#method-PLNmixturefamily-plot_objective}{\code{PLNmixturefamily$plot_objective()}} -\item \href{#method-PLNmixturefamily-getBestModel}{\code{PLNmixturefamily$getBestModel()}} -\item \href{#method-PLNmixturefamily-show}{\code{PLNmixturefamily$show()}} -\item \href{#method-PLNmixturefamily-print}{\code{PLNmixturefamily$print()}} -\item \href{#method-PLNmixturefamily-clone}{\code{PLNmixturefamily$clone()}} -} -} -\if{html}{\out{ -
Inherited methods + \itemize{ + \item \href{#method-PLNmixturefamily-initialize}{\code{PLNmixturefamily$new()}} + \item \href{#method-PLNmixturefamily-optimize}{\code{PLNmixturefamily$optimize()}} + \item \href{#method-PLNmixturefamily-smooth}{\code{PLNmixturefamily$smooth()}} + \item \href{#method-PLNmixturefamily-plot}{\code{PLNmixturefamily$plot()}} + \item \href{#method-PLNmixturefamily-plot_objective}{\code{PLNmixturefamily$plot_objective()}} + \item \href{#method-PLNmixturefamily-getBestModel}{\code{PLNmixturefamily$getBestModel()}} + \item \href{#method-PLNmixturefamily-show}{\code{PLNmixturefamily$show()}} + \item \href{#method-PLNmixturefamily-print}{\code{PLNmixturefamily$print()}} + \item \href{#method-PLNmixturefamily-clone}{\code{PLNmixturefamily$clone()}} + } +} +\if{html}{\out{
Inherited methods -
-}} +
}} \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-PLNmixturefamily-new}{}}} -\subsection{Method \code{new()}}{ -helper function for forward smoothing: split a group +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-PLNmixturefamily-initialize}{}}} +\subsection{\code{PLNmixturefamily$new()}}{ + helper function for forward smoothing: split a group -Initialize all models in the collection. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNmixturefamily$new( + Initialize all models in the collection. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNmixturefamily$new( clusters, responses, covariates, offsets, formula, control -)}\if{html}{\out{
}} +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{clusters}}{the dimensions of the successively fitted models} + \item{\code{responses}}{the matrix of responses common to every models} + \item{\code{covariates}}{the matrix of covariates common to every models} + \item{\code{offsets}}{the matrix of offsets common to every models} + \item{\code{formula}}{model formula used for fitting, extracted from the formula in the upper-level call} + \item{\code{control}}{a list for controlling the optimization. See details.} + \item{\code{control}}{a list for controlling the optimization. See details.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{clusters}}{the dimensions of the successively fitted models} - -\item{\code{responses}}{the matrix of responses common to every models} - -\item{\code{covariates}}{the matrix of covariates common to every models} - -\item{\code{offsets}}{the matrix of offsets common to every models} - -\item{\code{formula}}{model formula used for fitting, extracted from the formula in the upper-level call} - -\item{\code{control}}{a list for controlling the optimization. See details.} - -\item{\code{control}}{a list for controlling the optimization. See details.} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNmixturefamily-optimize}{}}} -\subsection{Method \code{optimize()}}{ -Call to the optimizer on all models of the collection -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNmixturefamily$optimize(config)}\if{html}{\out{
}} +\subsection{\code{PLNmixturefamily$optimize()}}{ + Call to the optimizer on all models of the collection + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNmixturefamily$optimize(config)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{config}}{a list for controlling the optimization} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{config}}{a list for controlling the optimization} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNmixturefamily-smooth}{}}} -\subsection{Method \code{smooth()}}{ -function to restart clustering to avoid local minima by smoothing the loglikelihood values as a function of the number of clusters -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNmixturefamily$smooth(control)}\if{html}{\out{
}} +\subsection{\code{PLNmixturefamily$smooth()}}{ + function to restart clustering to avoid local minima by smoothing the loglikelihood values as a function of the number of clusters + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNmixturefamily$smooth(control)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{control}}{a list to control the smoothing process} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{control}}{a list to control the smoothing process} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNmixturefamily-plot}{}}} -\subsection{Method \code{plot()}}{ -Lineplot of selected criteria for all models in the collection -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNmixturefamily$plot(criteria = c("loglik", "BIC", "ICL"), reverse = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{criteria}}{A valid model selection criteria for the collection of models. Any of "loglik", "BIC" or "ICL" (all).} - -\item{\code{reverse}}{A logical indicating whether to plot the value of the criteria in the "natural" direction +\subsection{\code{PLNmixturefamily$plot()}}{ + Lineplot of selected criteria for all models in the collection + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNmixturefamily$plot(criteria = c("loglik", "BIC", "ICL"), reverse = FALSE)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{criteria}}{A valid model selection criteria for the collection of models. Any of "loglik", "BIC" or "ICL" (all).} + \item{\code{reverse}}{A logical indicating whether to plot the value of the criteria in the "natural" direction (loglik - 0.5 penalty) or in the "reverse" direction (-2 loglik + penalty). Default to FALSE, i.e use the natural direction, on the same scale as the log-likelihood..} + } + \if{html}{\out{
}} + } + \subsection{Returns}{ + A \code{\link[ggplot2:ggplot]{ggplot2::ggplot}} object + } } -\if{html}{\out{
}} -} -\subsection{Returns}{ -A \code{\link[ggplot2:ggplot]{ggplot2::ggplot}} object -} -} + \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNmixturefamily-plot_objective}{}}} -\subsection{Method \code{plot_objective()}}{ -Plot objective value of the optimization problem along the penalty path -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNmixturefamily$plot_objective()}\if{html}{\out{
}} +\subsection{\code{PLNmixturefamily$plot_objective()}}{ + Plot objective value of the optimization problem along the penalty path + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNmixturefamily$plot_objective()} + \if{html}{\out{
}} + } + \subsection{Returns}{ + a \code{\link[ggplot2:ggplot]{ggplot2::ggplot}} graph + } } -\subsection{Returns}{ -a \code{\link[ggplot2:ggplot]{ggplot2::ggplot}} graph -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNmixturefamily-getBestModel}{}}} -\subsection{Method \code{getBestModel()}}{ -Extract best model in the collection -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNmixturefamily$getBestModel(crit = c("BIC", "ICL", "loglik"))}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{crit}}{a character for the criterion used to performed the selection. Either +\subsection{\code{PLNmixturefamily$getBestModel()}}{ + Extract best model in the collection + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNmixturefamily$getBestModel(crit = c("BIC", "ICL", "loglik"))} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{crit}}{a character for the criterion used to performed the selection. Either "BIC", "ICL" or "loglik". Default is \code{ICL}} + } + \if{html}{\out{
}} + } + \subsection{Returns}{ + a \code{\link{PLNmixturefit}} object + } } -\if{html}{\out{
}} -} -\subsection{Returns}{ -a \code{\link{PLNmixturefit}} object -} -} + \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNmixturefamily-show}{}}} -\subsection{Method \code{show()}}{ -User friendly print method -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNmixturefamily$show()}\if{html}{\out{
}} +\subsection{\code{PLNmixturefamily$show()}}{ + User friendly print method + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNmixturefamily$show()} + \if{html}{\out{
}} + } } -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNmixturefamily-print}{}}} -\subsection{Method \code{print()}}{ -User friendly print method -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNmixturefamily$print()}\if{html}{\out{
}} +\subsection{\code{PLNmixturefamily$print()}}{ + User friendly print method + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNmixturefamily$print()} + \if{html}{\out{
}} + } } -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNmixturefamily-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNmixturefamily$clone(deep = FALSE)}\if{html}{\out{
}} +\subsection{\code{PLNmixturefamily$clone()}}{ + The objects of this class are cloneable with this method. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNmixturefamily$clone(deep = FALSE)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{deep}}{Whether to make a deep clone.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} } diff --git a/man/PLNmixturefit.Rd b/man/PLNmixturefit.Rd index 7108e70c..df473265 100644 --- a/man/PLNmixturefit.Rd +++ b/man/PLNmixturefit.Rd @@ -14,228 +14,224 @@ See the documentation for ... The function \code{\link{PLNmixture}}, the class \code{\link[=PLNmixturefamily]{PLNmixturefamily}} } \section{Active bindings}{ -\if{html}{\out{
}} -\describe{ -\item{\code{n}}{number of samples} + \if{html}{\out{
}} + \describe{ + \item{\code{n}}{number of samples} -\item{\code{p}}{number of dimensions of the latent space} + \item{\code{p}}{number of dimensions of the latent space} -\item{\code{k}}{number of components} + \item{\code{k}}{number of components} -\item{\code{d}}{number of covariates} + \item{\code{d}}{number of covariates} -\item{\code{components}}{components of the mixture (PLNfits)} + \item{\code{components}}{components of the mixture (PLNfits)} -\item{\code{latent}}{a matrix: values of the latent vector (Z in the model)} + \item{\code{latent}}{a matrix: values of the latent vector (Z in the model)} -\item{\code{latent_pos}}{a matrix: values of the latent position vector (Z) without covariates effects or offset} + \item{\code{latent_pos}}{a matrix: values of the latent position vector (Z) without covariates effects or offset} -\item{\code{posteriorProb}}{matrix ofposterior probability for cluster belonging} + \item{\code{posteriorProb}}{matrix ofposterior probability for cluster belonging} -\item{\code{memberships}}{vector for cluster index} + \item{\code{memberships}}{vector for cluster index} -\item{\code{mixtureParam}}{vector of cluster proportions} + \item{\code{mixtureParam}}{vector of cluster proportions} -\item{\code{optim_par}}{a list with parameters useful for monitoring the optimization} + \item{\code{optim_par}}{a list with parameters useful for monitoring the optimization} -\item{\code{nb_param}}{number of parameters in the current PLN model} + \item{\code{nb_param}}{number of parameters in the current PLN model} -\item{\code{entropy_clustering}}{Entropy of the variational distribution of the cluster (multinomial)} + \item{\code{entropy_clustering}}{Entropy of the variational distribution of the cluster (multinomial)} -\item{\code{entropy_latent}}{Entropy of the variational distribution of the latent vector (Gaussian)} + \item{\code{entropy_latent}}{Entropy of the variational distribution of the latent vector (Gaussian)} -\item{\code{entropy}}{Full entropy of the variational distribution (latent vector + clustering)} + \item{\code{entropy}}{Full entropy of the variational distribution (latent vector + clustering)} -\item{\code{loglik}}{variational lower bound of the loglikelihood} + \item{\code{loglik}}{variational lower bound of the loglikelihood} -\item{\code{loglik_vec}}{element-wise variational lower bound of the loglikelihood} + \item{\code{loglik_vec}}{element-wise variational lower bound of the loglikelihood} -\item{\code{BIC}}{variational lower bound of the BIC} + \item{\code{BIC}}{variational lower bound of the BIC} -\item{\code{ICL}}{variational lower bound of the ICL (include entropy of both the clustering and latent distributions)} + \item{\code{ICL}}{variational lower bound of the ICL (include entropy of both the clustering and latent distributions)} -\item{\code{R_squared}}{approximated goodness-of-fit criterion} + \item{\code{R_squared}}{approximated goodness-of-fit criterion} -\item{\code{criteria}}{a vector with loglik, BIC, ICL, and number of parameters} + \item{\code{criteria}}{a vector with loglik, BIC, ICL, and number of parameters} -\item{\code{model_par}}{a list with the matrices of parameters found in the model (Theta, Sigma, Mu and Pi)} + \item{\code{model_par}}{a list with the matrices of parameters found in the model (Theta, Sigma, Mu and Pi)} -\item{\code{vcov_model}}{character: the model used for the covariance (either "spherical", "diagonal" or "full")} + \item{\code{vcov_model}}{character: the model used for the covariance (either "spherical", "diagonal" or "full")} -\item{\code{fitted}}{a matrix: fitted values of the observations (A in the model)} + \item{\code{fitted}}{a matrix: fitted values of the observations (A in the model)} -\item{\code{group_means}}{a matrix of group mean vectors in the latent space.} -} -\if{html}{\out{
}} + \item{\code{group_means}}{a matrix of group mean vectors in the latent space.} + } + \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ -\itemize{ -\item \href{#method-PLNmixturefit-new}{\code{PLNmixturefit$new()}} -\item \href{#method-PLNmixturefit-optimize}{\code{PLNmixturefit$optimize()}} -\item \href{#method-PLNmixturefit-predict}{\code{PLNmixturefit$predict()}} -\item \href{#method-PLNmixturefit-plot_clustering_data}{\code{PLNmixturefit$plot_clustering_data()}} -\item \href{#method-PLNmixturefit-plot_clustering_pca}{\code{PLNmixturefit$plot_clustering_pca()}} -\item \href{#method-PLNmixturefit-postTreatment}{\code{PLNmixturefit$postTreatment()}} -\item \href{#method-PLNmixturefit-show}{\code{PLNmixturefit$show()}} -\item \href{#method-PLNmixturefit-print}{\code{PLNmixturefit$print()}} -\item \href{#method-PLNmixturefit-clone}{\code{PLNmixturefit$clone()}} -} + \itemize{ + \item \href{#method-PLNmixturefit-initialize}{\code{PLNmixturefit$new()}} + \item \href{#method-PLNmixturefit-optimize}{\code{PLNmixturefit$optimize()}} + \item \href{#method-PLNmixturefit-predict}{\code{PLNmixturefit$predict()}} + \item \href{#method-PLNmixturefit-plot_clustering_data}{\code{PLNmixturefit$plot_clustering_data()}} + \item \href{#method-PLNmixturefit-plot_clustering_pca}{\code{PLNmixturefit$plot_clustering_pca()}} + \item \href{#method-PLNmixturefit-postTreatment}{\code{PLNmixturefit$postTreatment()}} + \item \href{#method-PLNmixturefit-show}{\code{PLNmixturefit$show()}} + \item \href{#method-PLNmixturefit-print}{\code{PLNmixturefit$print()}} + \item \href{#method-PLNmixturefit-clone}{\code{PLNmixturefit$clone()}} + } } \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-PLNmixturefit-new}{}}} -\subsection{Method \code{new()}}{ -Optimize a the +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-PLNmixturefit-initialize}{}}} +\subsection{\code{PLNmixturefit$new()}}{ + Optimize a the -Initialize a \code{\link{PLNmixturefit}} model -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNmixturefit$new( + Initialize a \code{\link{PLNmixturefit}} model + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNmixturefit$new( responses, covariates, offsets, posteriorProb, formula, control -)}\if{html}{\out{
}} +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{responses}}{the matrix of responses common to every models} + \item{\code{covariates}}{the matrix of covariates common to every models} + \item{\code{offsets}}{the matrix of offsets common to every models} + \item{\code{posteriorProb}}{matrix ofposterior probability for cluster belonging} + \item{\code{formula}}{model formula used for fitting, extracted from the formula in the upper-level call} + \item{\code{control}}{a list for controlling the optimization.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{responses}}{the matrix of responses common to every models} - -\item{\code{covariates}}{the matrix of covariates common to every models} - -\item{\code{offsets}}{the matrix of offsets common to every models} - -\item{\code{posteriorProb}}{matrix ofposterior probability for cluster belonging} - -\item{\code{formula}}{model formula used for fitting, extracted from the formula in the upper-level call} - -\item{\code{control}}{a list for controlling the optimization.} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNmixturefit-optimize}{}}} -\subsection{Method \code{optimize()}}{ -Optimize a \code{\link{PLNmixturefit}} model -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNmixturefit$optimize(responses, covariates, offsets, config)}\if{html}{\out{
}} +\subsection{\code{PLNmixturefit$optimize()}}{ + Optimize a \code{\link{PLNmixturefit}} model + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNmixturefit$optimize(responses, covariates, offsets, config)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{responses}}{the matrix of responses common to every models} + \item{\code{covariates}}{the matrix of covariates common to every models} + \item{\code{offsets}}{the matrix of offsets common to every models} + \item{\code{config}}{a list for controlling the optimization} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{responses}}{the matrix of responses common to every models} - -\item{\code{covariates}}{the matrix of covariates common to every models} - -\item{\code{offsets}}{the matrix of offsets common to every models} - -\item{\code{config}}{a list for controlling the optimization} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNmixturefit-predict}{}}} -\subsection{Method \code{predict()}}{ -Predict group of new samples -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNmixturefit$predict( +\subsection{\code{PLNmixturefit$predict()}}{ + Predict group of new samples + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNmixturefit$predict( newdata, type = c("posterior", "response", "position"), prior = matrix(rep(1/self$k, self$k), nrow(newdata), self$k, byrow = TRUE), control = PLNmixture_param(), envir = parent.frame() -)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{newdata}}{A data frame in which to look for variables, offsets and counts with which to predict.} - -\item{\code{type}}{The type of prediction required. The default \code{posterior} are posterior probabilities for each group , +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{newdata}}{A data frame in which to look for variables, offsets and counts with which to predict.} + \item{\code{type}}{The type of prediction required. The default \code{posterior} are posterior probabilities for each group , \code{response} is the group with maximal posterior probability and \code{latent} is the averaged latent coordinate (without offset and nor covariate effects), with weights equal to the posterior probabilities.} - -\item{\code{prior}}{User-specified prior group probabilities in the new data. The default uses a uniform prior.} - -\item{\code{control}}{a list-like structure for controlling the fit. See \code{\link[=PLNmixture_param]{PLNmixture_param()}} for details.} - -\item{\code{envir}}{Environment in which the prediction is evaluated} -} -\if{html}{\out{
}} -} + \item{\code{prior}}{User-specified prior group probabilities in the new data. The default uses a uniform prior.} + \item{\code{control}}{a list-like structure for controlling the fit. See \code{\link[=PLNmixture_param]{PLNmixture_param()}} for details.} + \item{\code{envir}}{Environment in which the prediction is evaluated} + } + \if{html}{\out{
}} + } } + \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNmixturefit-plot_clustering_data}{}}} -\subsection{Method \code{plot_clustering_data()}}{ -Plot the matrix of expected mean counts (without offsets, without covariate effects) reordered according the inferred clustering -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNmixturefit$plot_clustering_data( +\subsection{\code{PLNmixturefit$plot_clustering_data()}}{ + Plot the matrix of expected mean counts (without offsets, without covariate effects) reordered according the inferred clustering + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNmixturefit$plot_clustering_data( main = "Expected counts reorder by clustering", plot = TRUE, log_scale = TRUE -)}\if{html}{\out{
}} +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{main}}{character. A title for the plot. An hopefully appropriate title will be used by default.} + \item{\code{plot}}{logical. Should the plot be displayed or sent back as \code{\link[ggplot2:ggplot]{ggplot2::ggplot}} object} + \item{\code{log_scale}}{logical. Should the color scale values be log-transform before plotting? Default is \code{TRUE}.} + } + \if{html}{\out{
}} + } + \subsection{Returns}{ + a \code{\link[ggplot2:ggplot]{ggplot2::ggplot}} graphic + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{main}}{character. A title for the plot. An hopefully appropriate title will be used by default.} - -\item{\code{plot}}{logical. Should the plot be displayed or sent back as \code{\link[ggplot2:ggplot]{ggplot2::ggplot}} object} - -\item{\code{log_scale}}{logical. Should the color scale values be log-transform before plotting? Default is \code{TRUE}.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -a \code{\link[ggplot2:ggplot]{ggplot2::ggplot}} graphic -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNmixturefit-plot_clustering_pca}{}}} -\subsection{Method \code{plot_clustering_pca()}}{ -Plot the individual map of a PCA performed on the latent coordinates, where individuals are colored according to the memberships -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNmixturefit$plot_clustering_pca( +\subsection{\code{PLNmixturefit$plot_clustering_pca()}}{ + Plot the individual map of a PCA performed on the latent coordinates, where individuals are colored according to the memberships + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNmixturefit$plot_clustering_pca( main = "Clustering labels in Individual Factor Map", plot = TRUE -)}\if{html}{\out{
}} +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{main}}{character. A title for the plot. An hopefully appropriate title will be used by default.} + \item{\code{plot}}{logical. Should the plot be displayed or sent back as \code{\link[ggplot2:ggplot]{ggplot2::ggplot}} object} + } + \if{html}{\out{
}} + } + \subsection{Returns}{ + a \code{\link[ggplot2:ggplot]{ggplot2::ggplot}} graphic + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{main}}{character. A title for the plot. An hopefully appropriate title will be used by default.} - -\item{\code{plot}}{logical. Should the plot be displayed or sent back as \code{\link[ggplot2:ggplot]{ggplot2::ggplot}} object} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -a \code{\link[ggplot2:ggplot]{ggplot2::ggplot}} graphic -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNmixturefit-postTreatment}{}}} -\subsection{Method \code{postTreatment()}}{ -Update fields after optimization -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNmixturefit$postTreatment( +\subsection{\code{PLNmixturefit$postTreatment()}}{ + Update fields after optimization + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNmixturefit$postTreatment( responses, covariates, offsets, @@ -243,64 +239,65 @@ Update fields after optimization config_post, config_optim, nullModel -)}\if{html}{\out{
}} +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{responses}}{the matrix of responses common to every models} + \item{\code{covariates}}{the matrix of covariates common to every models} + \item{\code{offsets}}{the matrix of offsets common to every models} + \item{\code{weights}}{an optional vector of observation weights to be used in the fitting process.} + \item{\code{config_post}}{a list for controlling the post-treatment} + \item{\code{config_optim}}{a list for controlling the optimization during the post-treatment computations} + \item{\code{nullModel}}{null model used for approximate R2 computations. Defaults to a GLM model with same design matrix but not latent variable.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{responses}}{the matrix of responses common to every models} - -\item{\code{covariates}}{the matrix of covariates common to every models} - -\item{\code{offsets}}{the matrix of offsets common to every models} - -\item{\code{weights}}{an optional vector of observation weights to be used in the fitting process.} - -\item{\code{config_post}}{a list for controlling the post-treatment} - -\item{\code{config_optim}}{a list for controlling the optimization during the post-treatment computations} - -\item{\code{nullModel}}{null model used for approximate R2 computations. Defaults to a GLM model with same design matrix but not latent variable.} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNmixturefit-show}{}}} -\subsection{Method \code{show()}}{ -User friendly print method -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNmixturefit$show()}\if{html}{\out{
}} +\subsection{\code{PLNmixturefit$show()}}{ + User friendly print method + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNmixturefit$show()} + \if{html}{\out{
}} + } } -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNmixturefit-print}{}}} -\subsection{Method \code{print()}}{ -User friendly print method -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNmixturefit$print()}\if{html}{\out{
}} +\subsection{\code{PLNmixturefit$print()}}{ + User friendly print method + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNmixturefit$print()} + \if{html}{\out{
}} + } } -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNmixturefit-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNmixturefit$clone(deep = FALSE)}\if{html}{\out{
}} +\subsection{\code{PLNmixturefit$clone()}}{ + The objects of this class are cloneable with this method. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNmixturefit$clone(deep = FALSE)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{deep}}{Whether to make a deep clone.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} } diff --git a/man/PLNmodels-package.Rd b/man/PLNmodels-package.Rd index 7bab17cd..8c628440 100644 --- a/man/PLNmodels-package.Rd +++ b/man/PLNmodels-package.Rd @@ -23,6 +23,7 @@ Useful links: Authors: \itemize{ + \item Julien Chiquet \email{julien.chiquet@inrae.fr} (\href{https://orcid.org/0000-0002-3629-3429}{ORCID}) \item Mahendra Mariadassou \email{mahendra.mariadassou@inrae.fr} (\href{https://orcid.org/0000-0003-2986-354X}{ORCID}) \item Stéphane Robin \email{stephane.robin@inrae.fr} \item François Gindraud \email{francois.gindraud@gmail.com} diff --git a/man/PLNnetwork.Rd b/man/PLNnetwork.Rd index 51589dfe..cb077714 100644 --- a/man/PLNnetwork.Rd +++ b/man/PLNnetwork.Rd @@ -16,7 +16,7 @@ PLNnetwork( \arguments{ \item{formula}{an object of class "formula": a symbolic description of the model to be fitted.} -\item{data}{an optional data frame, list or environment (or object coercible by as.data.frame to a data frame) containing the variables in the model. If not found in data, the variables are taken from environment(formula), typically the environment from which lm is called.} +\item{data}{an optional data frame, list or environment (or object coercible by as.data.frame to a data frame) containing the variables in the model. If not found in data, the variables are taken from environment(formula), typically the environment from which the model is called.} \item{subset}{an optional vector specifying a subset of observations to be used in the fitting process.} diff --git a/man/PLNnetwork_param.Rd b/man/PLNnetwork_param.Rd index c40c1350..b76da47a 100644 --- a/man/PLNnetwork_param.Rd +++ b/man/PLNnetwork_param.Rd @@ -5,7 +5,7 @@ \title{Control of PLNnetwork fit} \usage{ PLNnetwork_param( - backend = c("nlopt", "torch"), + backend = c("nlopt", "builtin", "torch"), inception_cov = c("full", "spherical", "diagonal"), trace = 1, n_penalties = 30, @@ -18,7 +18,8 @@ PLNnetwork_param( ) } \arguments{ -\item{backend}{optimization back used, either "nlopt" or "torch". Default is "nlopt"} +\item{backend}{optimization back used, either "nlopt", "builtin" or "torch". Default is "nlopt". +Note: the "nlopt" backend converges better in PLNnetwork's outer glasso alternation than "builtin".} \item{inception_cov}{Covariance structure used for the inception model used to initialize the PLNfamily. Defaults to "full" and can be constrained to "diagonal" and "spherical".} @@ -32,7 +33,7 @@ PLNnetwork_param( \item{penalty_weights}{either a single or a list of p x p matrix of weights (default: all weights equal to 1) to adapt the amount of shrinkage to each pairs of node. Must be symmetric with positive values.} -\item{config_post}{a list for controlling the post-treatment (optional bootstrap, jackknife, R2, etc).} +\item{config_post}{a list for controlling the post-treatments (optional bootstrap, jackknife, R2, etc.). See details} \item{config_optim}{a list for controlling the optimizer (either "nlopt" or "torch" backend). See details} @@ -47,12 +48,59 @@ list of parameters configuring the fit. Helper to define list of parameters to control the PLN fit. All arguments have defaults. } \details{ -See \code{\link[=PLN_param]{PLN_param()}} for a full description of the generic optimization parameters. PLNnetwork_param() also has two additional parameters controlling the optimization due the inner-outer loop structure of the optimizer: +The list of parameters \code{config_optim} controls the optimizers. When "nlopt" is chosen the following entries are relevant \itemize{ -\item "ftol_out" outer solver stops when an optimization step changes the objective function by less than ftol multiplied by the absolute value of the parameter. Default is 1e-6 -\item "maxit_out" outer solver stops when the number of iteration exceeds maxit_out. Default is 50 +\item "algorithm" the optimization method used by NLOPT among LD type, e.g. "CCSAQ", "MMA", "LBFGS". See NLOPT documentation for further details. Default is "CCSAQ". +\item "maxeval" stop when the number of iteration exceeds maxeval. Default is 10000 +\item "ftol_rel" stop when an optimization step changes the objective function by less than ftol multiplied by the absolute value of the parameter. Default is 1e-8 +\item "xtol_rel" stop when an optimization step changes every parameters by less than xtol multiplied by the absolute value of the parameter. Default is 1e-6 +\item "ftol_abs" stop when an optimization step changes the objective function by less than ftol_abs. Default is 0.0 (disabled) +\item "xtol_abs" stop when an optimization step changes every parameters by less than xtol_abs. Default is 0.0 (disabled) +\item "maxtime" stop when the optimization time (in seconds) exceeds maxtime. Default is -1 (disabled) +} + +When "torch" backend is used (only for PLN and PLNLDA for now), the following entries are relevant: +\itemize{ +\item "algorithm" the optimizer used by torch among RPROP (default), RMSPROP, ADAM and ADAGRAD +\item "maxeval" stop when the number of iteration exceeds maxeval. Default is 10 000 +\item "numepoch" stop training once this number of epochs exceeds numepoch. Set to -1 to enable infinite training. Default is 1 000 +\item "num_batch" number of batches to use during training. Defaults to 1 (use full dataset at each epoch) +\item "ftol_rel" stop when an optimization step changes the objective function by less than ftol multiplied by the absolute value of the parameter. Default is 1e-8 +\item "xtol_rel" stop when an optimization step changes every parameters by less than xtol multiplied by the absolute value of the parameter. Default is 1e-6 +\item "lr" learning rate. Default is 0.1. +\item "momentum" momentum factor. Default is 0 (no momentum). Only used in RMSPROP +\item "weight_decay" Weight decay penalty. Default is 0 (no decay). Not used in RPROP +\item "step_sizes" pair of minimal (default: 1e-6) and maximal (default: 50) allowed step sizes. Only used in RPROP +\item "etas" pair of multiplicative increase and decrease factors. Default is (0.5, 1.2). Only used in RPROP +\item "centered" if TRUE, compute the centered RMSProp where the gradient is normalized by an estimation of its variance weight_decay (L2 penalty). Default to FALSE. Only used in RMSPROP +} + +When "builtin" backend is used, the following entries are relevant +\itemize{ +\item "maxeval" stop when the number of Newton steps in the inner loop exceeds maxeval. Default is 10000 +\item "ftol_in" stop the inner loop when the objective changes by less than ftol_in (relative). Default is 1e-8 +\item "maxit_em" stop the EM outer loop when the number of EM iterations exceeds maxit_em. Default is 50 +\item "ftol_em" stop the EM outer loop when the ELBO changes by less than ftol_em (relative). Default is 1e-8 +} + +The list of parameters \code{config_post} controls the post-treatment processing (for most \verb{PLN*()} functions), with the following entries (defaults may vary depending on the specific function, check \verb{config_post_default_*} for defaults values): +\itemize{ +\item jackknife boolean indicating whether jackknife should be performed to evaluate bias and variance of the model parameters. Default is FALSE. +\item bootstrap integer indicating the number of bootstrap resamples generated to evaluate the variance of the model parameters. Default is 0 (inactivated). +\item variational_var boolean indicating whether variational Fisher information matrix should be computed to estimate the variance of the model parameters (highly underestimated). Default is FALSE. +\item sandwich_var boolean indicating whether sandwich estimation should be used to estimate the variance of the model parameters (highly underestimated). Default is FALSE. +\item rsquared boolean indicating whether approximation of R2 based on deviance should be computed. Default is TRUE } } +\section{Outer-loop optimization parameters}{ + +\code{PLNnetwork_param()} adds two parameters controlling the alternating GLASSO/VEM loop: +\itemize{ +\item "ftol_em" outer alternating solver stops when the objective changes by less than ftol_em (relative). Default is 1e-5 +\item "maxit_em" outer alternating solver stops when the number of iterations exceeds maxit_em. Default is 20 +} +} + \seealso{ \code{\link[=PLN_param]{PLN_param()}} } diff --git a/man/PLNnetworkfamily.Rd b/man/PLNnetworkfamily.Rd index 6cb3e9ab..bcff4a4f 100644 --- a/man/PLNnetworkfamily.Rd +++ b/man/PLNnetworkfamily.Rd @@ -22,93 +22,94 @@ class(fits) The function \code{\link[=PLNnetwork]{PLNnetwork()}}, the class \code{\link{PLNnetworkfit}} } \section{Super classes}{ -\code{\link[PLNmodels:PLNfamily]{PLNmodels::PLNfamily}} -> \code{\link[PLNmodels:Networkfamily]{PLNmodels::Networkfamily}} -> \code{PLNnetworkfamily} +\code{\link[PLNmodels:PLNfamily]{PLNfamily}} -> \code{\link[PLNmodels:Networkfamily]{Networkfamily}} -> \code{PLNnetworkfamily} } \section{Methods}{ \subsection{Public methods}{ -\itemize{ -\item \href{#method-PLNnetworkfamily-new}{\code{PLNnetworkfamily$new()}} -\item \href{#method-PLNnetworkfamily-stability_selection}{\code{PLNnetworkfamily$stability_selection()}} -\item \href{#method-PLNnetworkfamily-clone}{\code{PLNnetworkfamily$clone()}} + \itemize{ + \item \href{#method-PLNnetworkfamily-initialize}{\code{PLNnetworkfamily$new()}} + \item \href{#method-PLNnetworkfamily-stability_selection}{\code{PLNnetworkfamily$stability_selection()}} + \item \href{#method-PLNnetworkfamily-clone}{\code{PLNnetworkfamily$clone()}} + } } -} -\if{html}{\out{ -
Inherited methods +\if{html}{\out{
Inherited methods -
-}} +
}} \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-PLNnetworkfamily-new}{}}} -\subsection{Method \code{new()}}{ -Initialize all models in the collection -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNnetworkfamily$new(penalties, data, control)}\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-PLNnetworkfamily-initialize}{}}} +\subsection{\code{PLNnetworkfamily$new()}}{ + Initialize all models in the collection + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNnetworkfamily$new(penalties, data, control)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{penalties}}{a vector of positive real number controlling the level of sparsity of the underlying network.} + \item{\code{data}}{a named list used internally to carry the data matrices} + \item{\code{control}}{a list for controlling the optimization.} + } + \if{html}{\out{
}} + } + \subsection{Returns}{ + Update current \code{\link{PLNnetworkfit}} with smart starting values + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{penalties}}{a vector of positive real number controlling the level of sparsity of the underlying network.} - -\item{\code{data}}{a named list used internally to carry the data matrices} - -\item{\code{control}}{a list for controlling the optimization.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -Update current \code{\link{PLNnetworkfit}} with smart starting values -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNnetworkfamily-stability_selection}{}}} -\subsection{Method \code{stability_selection()}}{ -Compute the stability path by stability selection -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNnetworkfamily$stability_selection( +\subsection{\code{PLNnetworkfamily$stability_selection()}}{ + Compute the stability path by stability selection + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNnetworkfamily$stability_selection( subsamples = NULL, control = PLNnetwork_param() -)}\if{html}{\out{
}} +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{subsamples}}{a list of vectors describing the subsamples. The number of vectors (or list length) determines the number of subsamples used in the stability selection. Automatically set to 20 subsamples with size \code{10*sqrt(n)} if \code{n >= 144} and \code{0.8*n} otherwise following Liu et al. (2010) recommendations.} + \item{\code{control}}{a list controlling the main optimization process in each call to \code{\link[=PLNnetwork]{PLNnetwork()}}. See \code{\link[=PLNnetwork]{PLNnetwork()}} and \code{\link[=PLN_param]{PLN_param()}} for details.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{subsamples}}{a list of vectors describing the subsamples. The number of vectors (or list length) determines the number of subsamples used in the stability selection. Automatically set to 20 subsamples with size \code{10*sqrt(n)} if \code{n >= 144} and \code{0.8*n} otherwise following Liu et al. (2010) recommendations.} - -\item{\code{control}}{a list controlling the main optimization process in each call to \code{\link[=PLNnetwork]{PLNnetwork()}}. See \code{\link[=PLNnetwork]{PLNnetwork()}} and \code{\link[=PLN_param]{PLN_param()}} for details.} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNnetworkfamily-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNnetworkfamily$clone(deep = FALSE)}\if{html}{\out{
}} +\subsection{\code{PLNnetworkfamily$clone()}}{ + The objects of this class are cloneable with this method. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNnetworkfamily$clone(deep = FALSE)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{deep}}{Whether to make a deep clone.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} } diff --git a/man/PLNnetworkfit.Rd b/man/PLNnetworkfit.Rd index 5dad7d68..0042340a 100644 --- a/man/PLNnetworkfit.Rd +++ b/man/PLNnetworkfit.Rd @@ -22,119 +22,122 @@ print(myPLNnet) The function \code{\link[=PLNnetwork]{PLNnetwork()}}, the class \code{\link{PLNnetworkfamily}} } \section{Super classes}{ -\code{\link[PLNmodels:PLNfit]{PLNmodels::PLNfit}} -> \code{\link[PLNmodels:PLNfit_fixedcov]{PLNmodels::PLNfit_fixedcov}} -> \code{PLNnetworkfit} +\code{\link[PLNmodels:PLNfit]{PLNfit}} -> \code{\link[PLNmodels:PLNfit_fixedcov]{PLNfit_fixedcov}} -> \code{PLNnetworkfit} } \section{Active bindings}{ -\if{html}{\out{
}} -\describe{ -\item{\code{vcov_model}}{character: the model used for the residual covariance} + \if{html}{\out{
}} + \describe{ + \item{\code{vcov_model}}{character: the model used for the residual covariance} -\item{\code{penalty}}{the global level of sparsity in the current model} + \item{\code{penalty}}{the global level of sparsity in the current model} -\item{\code{penalty_weights}}{a matrix of weights controlling the amount of penalty element-wise.} + \item{\code{penalty_weights}}{a matrix of weights controlling the amount of penalty element-wise.} -\item{\code{n_edges}}{number of edges if the network (non null coefficient of the sparse precision matrix)} + \item{\code{n_edges}}{number of edges if the network (non null coefficient of the sparse precision matrix)} -\item{\code{nb_param}}{number of parameters in the current PLN model} + \item{\code{nb_param}}{number of parameters in the current PLN model} -\item{\code{pen_loglik}}{variational lower bound of the l1-penalized loglikelihood} + \item{\code{pen_loglik}}{variational lower bound of the l1-penalized loglikelihood} -\item{\code{EBIC}}{variational lower bound of the EBIC} + \item{\code{EBIC}}{variational lower bound of the EBIC} -\item{\code{density}}{proportion of non-null edges in the network} + \item{\code{density}}{proportion of non-null edges in the network} -\item{\code{criteria}}{a vector with loglik, penalized loglik, BIC, EBIC, ICL, R_squared, number of parameters, number of edges and graph density} -} -\if{html}{\out{
}} + \item{\code{criteria}}{a vector with loglik, penalized loglik, BIC, EBIC, ICL, R_squared, number of parameters, number of edges and graph density} + } + \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ -\itemize{ -\item \href{#method-PLNnetworkfit-new}{\code{PLNnetworkfit$new()}} -\item \href{#method-PLNnetworkfit-optimize}{\code{PLNnetworkfit$optimize()}} -\item \href{#method-PLNnetworkfit-latent_network}{\code{PLNnetworkfit$latent_network()}} -\item \href{#method-PLNnetworkfit-plot_network}{\code{PLNnetworkfit$plot_network()}} -\item \href{#method-PLNnetworkfit-show}{\code{PLNnetworkfit$show()}} -\item \href{#method-PLNnetworkfit-clone}{\code{PLNnetworkfit$clone()}} -} -} -\if{html}{\out{ -
Inherited methods + \itemize{ + \item \href{#method-PLNnetworkfit-initialize}{\code{PLNnetworkfit$new()}} + \item \href{#method-PLNnetworkfit-optimize}{\code{PLNnetworkfit$optimize()}} + \item \href{#method-PLNnetworkfit-latent_network}{\code{PLNnetworkfit$latent_network()}} + \item \href{#method-PLNnetworkfit-plot_network}{\code{PLNnetworkfit$plot_network()}} + \item \href{#method-PLNnetworkfit-show}{\code{PLNnetworkfit$show()}} + \item \href{#method-PLNnetworkfit-clone}{\code{PLNnetworkfit$clone()}} + } +} +\if{html}{\out{
Inherited methods -
-}} +
}} \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-PLNnetworkfit-new}{}}} -\subsection{Method \code{new()}}{ -Initialize a \code{\link{PLNnetworkfit}} object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNnetworkfit$new(data, control)}\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-PLNnetworkfit-initialize}{}}} +\subsection{\code{PLNnetworkfit$new()}}{ + Initialize a \code{\link{PLNnetworkfit}} object + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNnetworkfit$new(data, control)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{data}}{a named list used internally to carry the data matrices} + \item{\code{control}}{a list for controlling the optimization.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{data}}{a named list used internally to carry the data matrices} - -\item{\code{control}}{a list for controlling the optimization.} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNnetworkfit-optimize}{}}} -\subsection{Method \code{optimize()}}{ -Call to the C++ optimizer and update of the relevant fields -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNnetworkfit$optimize(data, config)}\if{html}{\out{
}} +\subsection{\code{PLNnetworkfit$optimize()}}{ + Call to the C++ optimizer and update of the relevant fields + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNnetworkfit$optimize(data, config)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{data}}{a named list used internally to carry the data matrices} + \item{\code{config}}{a list for controlling the optimization} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{data}}{a named list used internally to carry the data matrices} - -\item{\code{config}}{a list for controlling the optimization} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNnetworkfit-latent_network}{}}} -\subsection{Method \code{latent_network()}}{ -Extract interaction network in the latent space -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNnetworkfit$latent_network(type = c("partial_cor", "support", "precision"))}\if{html}{\out{
}} +\subsection{\code{PLNnetworkfit$latent_network()}}{ + Extract interaction network in the latent space + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNnetworkfit$latent_network(type = c("partial_cor", "support", "precision"))} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{type}}{edge value in the network. Can be "support" (binary edges), "precision" (coefficient of the precision matrix) or "partial_cor" (partial correlation between species)} + } + \if{html}{\out{
}} + } + \subsection{Returns}{ + a square matrix of size \code{PLNnetworkfit$n} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{type}}{edge value in the network. Can be "support" (binary edges), "precision" (coefficient of the precision matrix) or "partial_cor" (partial correlation between species)} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -a square matrix of size \code{PLNnetworkfit$n} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNnetworkfit-plot_network}{}}} -\subsection{Method \code{plot_network()}}{ -plot the latent network. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNnetworkfit$plot_network( +\subsection{\code{PLNnetworkfit$plot_network()}}{ + plot the latent network. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNnetworkfit$plot_network( type = c("partial_cor", "support"), output = c("igraph", "corrplot"), edge.color = c("#F8766D", "#00BFC4"), @@ -142,54 +145,53 @@ plot the latent network. node.labels = NULL, layout = layout_in_circle, plot = TRUE -)}\if{html}{\out{
}} +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{type}}{edge value in the network. Either "precision" (coefficient of the precision matrix) or "partial_cor" (partial correlation between species).} + \item{\code{output}}{Output type. Either \code{igraph} (for the network) or \code{corrplot} (for the adjacency matrix)} + \item{\code{edge.color}}{Length 2 color vector. Color for positive/negative edges. Default is \code{c("#F8766D", "#00BFC4")}. Only relevant for igraph output.} + \item{\code{remove.isolated}}{if \code{TRUE}, isolated node are remove before plotting. Only relevant for igraph output.} + \item{\code{node.labels}}{vector of character. The labels of the nodes. The default will use the column names ot the response matrix.} + \item{\code{layout}}{an optional igraph layout. Only relevant for igraph output.} + \item{\code{plot}}{logical. Should the final network be displayed or only sent back to the user. Default is \code{TRUE}.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{type}}{edge value in the network. Either "precision" (coefficient of the precision matrix) or "partial_cor" (partial correlation between species).} - -\item{\code{output}}{Output type. Either \code{igraph} (for the network) or \code{corrplot} (for the adjacency matrix)} - -\item{\code{edge.color}}{Length 2 color vector. Color for positive/negative edges. Default is \code{c("#F8766D", "#00BFC4")}. Only relevant for igraph output.} - -\item{\code{remove.isolated}}{if \code{TRUE}, isolated node are remove before plotting. Only relevant for igraph output.} - -\item{\code{node.labels}}{vector of character. The labels of the nodes. The default will use the column names ot the response matrix.} - -\item{\code{layout}}{an optional igraph layout. Only relevant for igraph output.} - -\item{\code{plot}}{logical. Should the final network be displayed or only sent back to the user. Default is \code{TRUE}.} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNnetworkfit-show}{}}} -\subsection{Method \code{show()}}{ -User friendly print method -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNnetworkfit$show()}\if{html}{\out{
}} +\subsection{\code{PLNnetworkfit$show()}}{ + User friendly print method + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNnetworkfit$show()} + \if{html}{\out{
}} + } } -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PLNnetworkfit-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PLNnetworkfit$clone(deep = FALSE)}\if{html}{\out{
}} +\subsection{\code{PLNnetworkfit$clone()}}{ + The objects of this class are cloneable with this method. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PLNnetworkfit$clone(deep = FALSE)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{deep}}{Whether to make a deep clone.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} } diff --git a/man/ZIPLN.Rd b/man/ZIPLN.Rd index b5bbe650..5bf37310 100644 --- a/man/ZIPLN.Rd +++ b/man/ZIPLN.Rd @@ -15,7 +15,7 @@ ZIPLN( \arguments{ \item{formula}{an object of class "formula": a symbolic description of the model to be fitted.} -\item{data}{an optional data frame, list or environment (or object coercible by as.data.frame to a data frame) containing the variables in the model. If not found in data, the variables are taken from environment(formula), typically the environment from which PLN is called.} +\item{data}{an optional data frame, list or environment (or object coercible by as.data.frame to a data frame) containing the variables in the model. If not found in data, the variables are taken from environment(formula), typically the environment from which the model is called.} \item{subset}{an optional vector specifying a subset of observations to be used in the fitting process.} diff --git a/man/ZIPLN_param.Rd b/man/ZIPLN_param.Rd index 5d9a624d..b36cf537 100644 --- a/man/ZIPLN_param.Rd +++ b/man/ZIPLN_param.Rd @@ -5,7 +5,7 @@ \title{Control of a ZIPLN fit} \usage{ ZIPLN_param( - backend = c("nlopt"), + backend = c("builtin", "nlopt"), trace = 1, covariance = c("full", "diagonal", "spherical", "fixed", "sparse"), Omega = NULL, @@ -18,7 +18,7 @@ ZIPLN_param( ) } \arguments{ -\item{backend}{optimization back used, either "nlopt" or "torch". Default is "nlopt"} +\item{backend}{optimization backend, either \code{"builtin"} (default, built-in Newton optimizer for the joint VE step) or \code{"nlopt"} (NLOPT-based CCSAQ).} \item{trace}{a integer for verbosity.} @@ -44,14 +44,13 @@ which sometimes speeds up the inference.} list of parameters used during the fit and post-processing steps } \description{ -Helper to define list of parameters to control the PLN fit. All arguments have defaults. +Helper to define list of parameters to control the ZIPLN fit. All arguments have defaults. } \details{ -See \code{\link[=PLN_param]{PLN_param()}} and \code{\link[=PLNnetwork_param]{PLNnetwork_param()}} for a full description of the generic optimization parameters. Like \code{\link[=PLNnetwork_param]{PLNnetwork_param()}}, ZIPLN_param() has two parameters controlling the optimization due the inner-outer loop structure of the optimizer: +See \code{\link[=PLN_param]{PLN_param()}} for a description of the generic \code{config_optim} entries (\code{ftol_rel}, \code{xtol_rel}, etc.). Like \code{\link[=PLNnetwork_param]{PLNnetwork_param()}}, ZIPLN_param() has two parameters controlling the outer EM loop: \itemize{ \item "ftol_out" outer solver stops when an optimization step changes the objective function by less than \code{ftol_out} multiplied by the absolute value of the parameter. Default is 1e-6 -\item "maxit_out" outer solver stops when the number of iteration exceeds \code{maxit_out}. Default is 100 +\item "maxit_out" outer solver stops when the number of iteration exceeds \code{maxit_out}. Default is 200 for "builtin", 100 for "nlopt" and one additional parameter controlling the form of the variational approximation of the zero inflation: -\item "approx_ZI" either uses an exact or approximated conditional distribution for the zero inflation. Default is FALSE } } diff --git a/man/ZIPLNfit.Rd b/man/ZIPLNfit.Rd index e8660c0c..dafc7b8b 100644 --- a/man/ZIPLNfit.Rd +++ b/man/ZIPLNfit.Rd @@ -28,286 +28,281 @@ print(myPLN) } \section{Active bindings}{ -\if{html}{\out{
}} -\describe{ -\item{\code{n}}{number of samples/sites} + \if{html}{\out{
}} + \describe{ + \item{\code{n}}{number of samples/sites} -\item{\code{q}}{number of dimensions of the latent space} + \item{\code{q}}{number of dimensions of the latent space} -\item{\code{p}}{number of variables/species} + \item{\code{p}}{number of variables/species} -\item{\code{d}}{number of covariates in the PLN part} + \item{\code{d}}{number of covariates in the PLN part} -\item{\code{d0}}{number of covariates in the ZI part} + \item{\code{d0}}{number of covariates in the ZI part} -\item{\code{nb_param_zi}}{number of parameters in the ZI part of the model} + \item{\code{nb_param_zi}}{number of parameters in the ZI part of the model} -\item{\code{nb_param_pln}}{number of parameters in the PLN part of the model} + \item{\code{nb_param_pln}}{number of parameters in the PLN part of the model} -\item{\code{nb_param}}{number of parameters in the ZIPLN model} + \item{\code{nb_param}}{number of parameters in the ZIPLN model} -\item{\code{model_par}}{a list with the matrices of parameters found in the model (B, Sigma, plus some others depending on the variant)} + \item{\code{model_par}}{a list with the matrices of parameters found in the model (B, Sigma, plus some others depending on the variant)} -\item{\code{var_par}}{a list with two matrices, M and S2, which are the estimated parameters in the variational approximation} + \item{\code{var_par}}{a list with two matrices, M and S2, which are the estimated parameters in the variational approximation} -\item{\code{optim_par}}{a list with parameters useful for monitoring the optimization} + \item{\code{optim_par}}{a list with parameters useful for monitoring the optimization} -\item{\code{latent}}{a matrix: values of the latent vector (Z in the model)} + \item{\code{latent}}{a matrix: values of the latent vector (Z in the model)} -\item{\code{latent_pos}}{a matrix: values of the latent position vector (Z) without covariates effects or offset} + \item{\code{latent_pos}}{a matrix: values of the latent position vector (Z) without covariates effects or offset} -\item{\code{fitted}}{a matrix: fitted values of the observations (A in the model)} + \item{\code{fitted}}{a matrix: fitted values of the observations (A in the model)} -\item{\code{vcov_model}}{character: the model used for the covariance (either "spherical", "diagonal", "full" or "sparse")} + \item{\code{vcov_model}}{character: the model used for the covariance (either "spherical", "diagonal", "full" or "sparse")} -\item{\code{zi_model}}{character: the model used for the zero inflation (either "single", "row", "col" or "covar")} + \item{\code{zi_model}}{character: the model used for the zero inflation (either "single", "row", "col" or "covar")} -\item{\code{loglik}}{(weighted) variational lower bound of the loglikelihood} + \item{\code{loglik}}{(weighted) variational lower bound of the loglikelihood} -\item{\code{loglik_vec}}{element-wise variational lower bound of the loglikelihood} + \item{\code{loglik_vec}}{element-wise variational lower bound of the loglikelihood} -\item{\code{AIC}}{variational lower bound of the AIC} + \item{\code{AIC}}{variational lower bound of the AIC} -\item{\code{BIC}}{variational lower bound of the BIC} + \item{\code{BIC}}{variational lower bound of the BIC} -\item{\code{entropy}}{Entropy of the variational distribution} + \item{\code{entropy}}{Entropy of the variational distribution} -\item{\code{entropy_ZI}}{Entropy of the variational distribution} + \item{\code{entropy_ZI}}{Entropy of the variational distribution} -\item{\code{entropy_PLN}}{Entropy of the Gaussian variational distribution in the PLN component} + \item{\code{entropy_PLN}}{Entropy of the Gaussian variational distribution in the PLN component} -\item{\code{ICL}}{variational lower bound of the ICL} + \item{\code{ICL}}{variational lower bound of the ICL} -\item{\code{criteria}}{a vector with loglik, BIC, ICL and number of parameters} -} -\if{html}{\out{
}} + \item{\code{criteria}}{a vector with loglik, BIC, ICL and number of parameters} + } + \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ -\itemize{ -\item \href{#method-ZIPLNfit-update}{\code{ZIPLNfit$update()}} -\item \href{#method-ZIPLNfit-new}{\code{ZIPLNfit$new()}} -\item \href{#method-ZIPLNfit-optimize}{\code{ZIPLNfit$optimize()}} -\item \href{#method-ZIPLNfit-optimize_vestep}{\code{ZIPLNfit$optimize_vestep()}} -\item \href{#method-ZIPLNfit-predict}{\code{ZIPLNfit$predict()}} -\item \href{#method-ZIPLNfit-show}{\code{ZIPLNfit$show()}} -\item \href{#method-ZIPLNfit-print}{\code{ZIPLNfit$print()}} -\item \href{#method-ZIPLNfit-clone}{\code{ZIPLNfit$clone()}} -} + \itemize{ + \item \href{#method-ZIPLNfit-update}{\code{ZIPLNfit$update()}} + \item \href{#method-ZIPLNfit-initialize}{\code{ZIPLNfit$new()}} + \item \href{#method-ZIPLNfit-optimize}{\code{ZIPLNfit$optimize()}} + \item \href{#method-ZIPLNfit-optimize_vestep}{\code{ZIPLNfit$optimize_vestep()}} + \item \href{#method-ZIPLNfit-predict}{\code{ZIPLNfit$predict()}} + \item \href{#method-ZIPLNfit-show}{\code{ZIPLNfit$show()}} + \item \href{#method-ZIPLNfit-print}{\code{ZIPLNfit$print()}} + \item \href{#method-ZIPLNfit-clone}{\code{ZIPLNfit$clone()}} + } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-ZIPLNfit-update}{}}} -\subsection{Method \code{update()}}{ -Update a \code{\link{ZIPLNfit}} object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{ZIPLNfit$update( +\subsection{\code{ZIPLNfit$update()}}{ + Update a \code{\link{ZIPLNfit}} object + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{ZIPLNfit$update( B = NA, B0 = NA, Pi = NA, Omega = NA, Sigma = NA, M = NA, - S = NA, + S2 = NA, R = NA, Ji = NA, Z = NA, A = NA, monitoring = NA -)}\if{html}{\out{
}} +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{B}}{matrix of regression parameters in the Poisson lognormal component} + \item{\code{B0}}{matrix of regression parameters in the zero inflated component} + \item{\code{Pi}}{Zero inflated probability parameter (either scalar, row-vector, col-vector or matrix)} + \item{\code{Omega}}{precision matrix of the latent variables} + \item{\code{Sigma}}{covariance matrix of the latent variables} + \item{\code{M}}{matrix of mean vectors for the variational approximation} + \item{\code{S2}}{matrix of variance parameters for the variational approximation} + \item{\code{R}}{matrix of probabilities for the variational approximation} + \item{\code{Ji}}{vector of variational lower bounds of the log-likelihoods (one value per sample)} + \item{\code{Z}}{matrix of latent vectors (includes covariates and offset effects)} + \item{\code{A}}{matrix of fitted values} + \item{\code{monitoring}}{a list with optimization monitoring quantities} + } + \if{html}{\out{
}} + } + \subsection{Returns}{ + Update the current \code{\link{ZIPLNfit}} object + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{B}}{matrix of regression parameters in the Poisson lognormal component} - -\item{\code{B0}}{matrix of regression parameters in the zero inflated component} - -\item{\code{Pi}}{Zero inflated probability parameter (either scalar, row-vector, col-vector or matrix)} - -\item{\code{Omega}}{precision matrix of the latent variables} - -\item{\code{Sigma}}{covariance matrix of the latent variables} - -\item{\code{M}}{matrix of mean vectors for the variational approximation} - -\item{\code{S}}{matrix of standard deviation parameters for the variational approximation} - -\item{\code{R}}{matrix of probabilities for the variational approximation} - -\item{\code{Ji}}{vector of variational lower bounds of the log-likelihoods (one value per sample)} - -\item{\code{Z}}{matrix of latent vectors (includes covariates and offset effects)} - -\item{\code{A}}{matrix of fitted values} - -\item{\code{monitoring}}{a list with optimization monitoring quantities} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -Update the current \code{\link{ZIPLNfit}} object -} -} \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-ZIPLNfit-new}{}}} -\subsection{Method \code{new()}}{ -Initialize a \code{\link{ZIPLNfit}} model -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{ZIPLNfit$new(data, control)}\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-ZIPLNfit-initialize}{}}} +\subsection{\code{ZIPLNfit$new()}}{ + Initialize a \code{\link{ZIPLNfit}} model + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{ZIPLNfit$new(data, control)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{data}}{a named list used internally to carry the data matrices} + \item{\code{control}}{a list for controlling the optimization. See details.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{data}}{a named list used internally to carry the data matrices} - -\item{\code{control}}{a list for controlling the optimization. See details.} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-ZIPLNfit-optimize}{}}} -\subsection{Method \code{optimize()}}{ -Call to the Cpp optimizer and update of the relevant fields -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{ZIPLNfit$optimize(data, control)}\if{html}{\out{
}} +\subsection{\code{ZIPLNfit$optimize()}}{ + Call to the Cpp optimizer and update of the relevant fields + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{ZIPLNfit$optimize(data, control)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{data}}{a named list used internally to carry the data matrices} + \item{\code{control}}{a list for controlling the optimization. See details.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{data}}{a named list used internally to carry the data matrices} - -\item{\code{control}}{a list for controlling the optimization. See details.} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-ZIPLNfit-optimize_vestep}{}}} -\subsection{Method \code{optimize_vestep()}}{ -Result of one call to the VE step of the optimization procedure: optimal variational parameters (M, S, R) and corresponding log likelihood values for fixed model parameters (Sigma, B, B0). Intended to position new data in the latent space. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{ZIPLNfit$optimize_vestep( +\subsection{\code{ZIPLNfit$optimize_vestep()}}{ + Result of one call to the VE step of the optimization procedure: optimal variational parameters (M, S2, R) and corresponding log likelihood values for fixed model parameters (Sigma, B, B0). Intended to position new data in the latent space. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{ZIPLNfit$optimize_vestep( data, B = self$model_par$B, B0 = self$model_par$B0, Omega = self$model_par$Omega, control = ZIPLN_param(backend = "nlopt")$config_optim -)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{data}}{a named list used internally to carry the data matrices} - -\item{\code{B}}{Optional fixed value of the regression parameters in the PLN component} - -\item{\code{B0}}{Optional fixed value of the regression parameters in the ZI component} - -\item{\code{Omega}}{inverse variance-covariance matrix of the latent variables} - -\item{\code{control}}{a list for controlling the optimization. See details.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -A list with three components: +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{data}}{a named list used internally to carry the data matrices} + \item{\code{B}}{Optional fixed value of the regression parameters in the PLN component} + \item{\code{B0}}{Optional fixed value of the regression parameters in the ZI component} + \item{\code{Omega}}{inverse variance-covariance matrix of the latent variables} + \item{\code{control}}{a list for controlling the optimization. See details.} + } + \if{html}{\out{
}} + } + \subsection{Returns}{ + A list with three components: \itemize{ \item the matrix \code{M} of variational means, -\item the matrix \code{S} of variational standard deviations +\item the matrix \code{S2} of variational variances \item the matrix \code{R} of variational ZI probabilities \item the vector \code{Ji} of (variational) log-likelihood of each new observation \item a list \code{monitoring} with information about convergence status } + } } -} + \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-ZIPLNfit-predict}{}}} -\subsection{Method \code{predict()}}{ -Predict position, scores or observations of new data. See \code{\link[=predict.ZIPLNfit]{predict.ZIPLNfit()}} for the S3 method and additional details -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{ZIPLNfit$predict( +\subsection{\code{ZIPLNfit$predict()}}{ + Predict position, scores or observations of new data. See \code{\link[=predict.ZIPLNfit]{predict.ZIPLNfit()}} for the S3 method and additional details + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{ZIPLNfit$predict( newdata, responses = NULL, type = c("link", "response", "deflated"), level = 1, envir = parent.frame() -)}\if{html}{\out{
}} +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{newdata}}{A data frame in which to look for variables with which to predict. If omitted, the fitted values are used.} + \item{\code{responses}}{Optional data frame containing the count of the observed variables (matching the names of the provided as data in the PLN function), assuming the interest in in testing the model.} + \item{\code{type}}{Scale used for the prediction. Either \code{"link"} (default, predicted positions in the latent space), \code{"response"} (predicted average counts, accounting for zero-inflation) or \code{"deflated"} (predicted average counts, not accounting for zero-inflation and using only the PLN part of the model).} + \item{\code{level}}{Optional integer value the level to be used in obtaining the predictions. Level zero corresponds to the population predictions (default if \code{responses} is not provided) while level one (default) corresponds to predictions after evaluating the variational parameters for the new data.} + \item{\code{envir}}{Environment in which the prediction is evaluated} + } + \if{html}{\out{
}} + } + \subsection{Returns}{ + A matrix with predictions scores or counts. + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{newdata}}{A data frame in which to look for variables with which to predict. If omitted, the fitted values are used.} - -\item{\code{responses}}{Optional data frame containing the count of the observed variables (matching the names of the provided as data in the PLN function), assuming the interest in in testing the model.} - -\item{\code{type}}{Scale used for the prediction. Either \code{"link"} (default, predicted positions in the latent space), \code{"response"} (predicted average counts, accounting for zero-inflation) or \code{"deflated"} (predicted average counts, not accounting for zero-inflation and using only the PLN part of the model).} - -\item{\code{level}}{Optional integer value the level to be used in obtaining the predictions. Level zero corresponds to the population predictions (default if \code{responses} is not provided) while level one (default) corresponds to predictions after evaluating the variational parameters for the new data.} - -\item{\code{envir}}{Environment in which the prediction is evaluated} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -A matrix with predictions scores or counts. -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-ZIPLNfit-show}{}}} -\subsection{Method \code{show()}}{ -User friendly print method -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{ZIPLNfit$show( +\subsection{\code{ZIPLNfit$show()}}{ + User friendly print method + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{ZIPLNfit$show( model = paste("A multivariate Zero Inflated Poisson Lognormal fit with", self$vcov_model, "covariance model.\\n") -)}\if{html}{\out{
}} +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{model}}{First line of the print output} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{model}}{First line of the print output} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-ZIPLNfit-print}{}}} -\subsection{Method \code{print()}}{ -User friendly print method -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{ZIPLNfit$print()}\if{html}{\out{
}} +\subsection{\code{ZIPLNfit$print()}}{ + User friendly print method + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{ZIPLNfit$print()} + \if{html}{\out{
}} + } } -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-ZIPLNfit-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{ZIPLNfit$clone(deep = FALSE)}\if{html}{\out{
}} +\subsection{\code{ZIPLNfit$clone()}}{ + The objects of this class are cloneable with this method. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{ZIPLNfit$clone(deep = FALSE)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{deep}}{Whether to make a deep clone.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} } diff --git a/man/ZIPLNfit_diagonal.Rd b/man/ZIPLNfit_diagonal.Rd index 8b75204f..672fee27 100644 --- a/man/ZIPLNfit_diagonal.Rd +++ b/man/ZIPLNfit_diagonal.Rd @@ -4,8 +4,6 @@ \alias{ZIPLNfit_diagonal} \title{An R6 Class to represent a ZIPLNfit in a standard, general framework, with diagonal residual covariance} \description{ -An R6 Class to represent a ZIPLNfit in a standard, general framework, with diagonal residual covariance - An R6 Class to represent a ZIPLNfit in a standard, general framework, with diagonal residual covariance } \examples{ @@ -19,70 +17,71 @@ print(myPLN) } } \section{Super class}{ -\code{\link[PLNmodels:ZIPLNfit]{PLNmodels::ZIPLNfit}} -> \code{ZIPLNfit_diagonal} +\code{\link[PLNmodels:ZIPLNfit]{ZIPLNfit}} -> \code{ZIPLNfit_diagonal} } \section{Active bindings}{ -\if{html}{\out{
}} -\describe{ -\item{\code{nb_param_pln}}{number of parameters in the PLN part of the current model} + \if{html}{\out{
}} + \describe{ + \item{\code{nb_param_pln}}{number of parameters in the PLN part of the current model} -\item{\code{vcov_model}}{character: the model used for the residual covariance} -} -\if{html}{\out{
}} + \item{\code{vcov_model}}{character: the model used for the residual covariance} + } + \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ -\itemize{ -\item \href{#method-ZIPLNfit_diagonal-new}{\code{ZIPLNfit_diagonal$new()}} -\item \href{#method-ZIPLNfit_diagonal-clone}{\code{ZIPLNfit_diagonal$clone()}} + \itemize{ + \item \href{#method-ZIPLNfit_diagonal-initialize}{\code{ZIPLNfit_diagonal$new()}} + \item \href{#method-ZIPLNfit_diagonal-clone}{\code{ZIPLNfit_diagonal$clone()}} + } } -} -\if{html}{\out{ -
Inherited methods +\if{html}{\out{
Inherited methods -
-}} +
}} \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-ZIPLNfit_diagonal-new}{}}} -\subsection{Method \code{new()}}{ -Initialize a \code{\link{ZIPLNfit_diagonal}} model -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{ZIPLNfit_diagonal$new(data, control)}\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-ZIPLNfit_diagonal-initialize}{}}} +\subsection{\code{ZIPLNfit_diagonal$new()}}{ + Initialize a \code{\link{ZIPLNfit_diagonal}} model + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{ZIPLNfit_diagonal$new(data, control)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{data}}{a named list used internally to carry the data matrices} + \item{\code{control}}{a list for controlling the optimization. See details.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{data}}{a named list used internally to carry the data matrices} - -\item{\code{control}}{a list for controlling the optimization. See details.} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-ZIPLNfit_diagonal-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{ZIPLNfit_diagonal$clone(deep = FALSE)}\if{html}{\out{
}} +\subsection{\code{ZIPLNfit_diagonal$clone()}}{ + The objects of this class are cloneable with this method. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{ZIPLNfit_diagonal$clone(deep = FALSE)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{deep}}{Whether to make a deep clone.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} } diff --git a/man/ZIPLNfit_fixed.Rd b/man/ZIPLNfit_fixed.Rd index 6f6da2fd..049adc2d 100644 --- a/man/ZIPLNfit_fixed.Rd +++ b/man/ZIPLNfit_fixed.Rd @@ -4,8 +4,6 @@ \alias{ZIPLNfit_fixed} \title{An R6 Class to represent a ZIPLNfit in a standard, general framework, with fixed (inverse) residual covariance} \description{ -An R6 Class to represent a ZIPLNfit in a standard, general framework, with fixed (inverse) residual covariance - An R6 Class to represent a ZIPLNfit in a standard, general framework, with fixed (inverse) residual covariance } \examples{ @@ -20,70 +18,71 @@ print(myPLN) } } \section{Super class}{ -\code{\link[PLNmodels:ZIPLNfit]{PLNmodels::ZIPLNfit}} -> \code{ZIPLNfit_fixed} +\code{\link[PLNmodels:ZIPLNfit]{ZIPLNfit}} -> \code{ZIPLNfit_fixed} } \section{Active bindings}{ -\if{html}{\out{
}} -\describe{ -\item{\code{nb_param_pln}}{number of parameters in the PLN part of the current model} + \if{html}{\out{
}} + \describe{ + \item{\code{nb_param_pln}}{number of parameters in the PLN part of the current model} -\item{\code{vcov_model}}{character: the model used for the residual covariance} -} -\if{html}{\out{
}} + \item{\code{vcov_model}}{character: the model used for the residual covariance} + } + \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ -\itemize{ -\item \href{#method-ZIPLNfit_fixed-new}{\code{ZIPLNfit_fixed$new()}} -\item \href{#method-ZIPLNfit_fixed-clone}{\code{ZIPLNfit_fixed$clone()}} + \itemize{ + \item \href{#method-ZIPLNfit_fixed-initialize}{\code{ZIPLNfit_fixed$new()}} + \item \href{#method-ZIPLNfit_fixed-clone}{\code{ZIPLNfit_fixed$clone()}} + } } -} -\if{html}{\out{ -
Inherited methods +\if{html}{\out{
Inherited methods -
-}} +
}} \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-ZIPLNfit_fixed-new}{}}} -\subsection{Method \code{new()}}{ -Initialize a \code{\link{ZIPLNfit_fixed}} model -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{ZIPLNfit_fixed$new(data, control)}\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-ZIPLNfit_fixed-initialize}{}}} +\subsection{\code{ZIPLNfit_fixed$new()}}{ + Initialize a \code{\link{ZIPLNfit_fixed}} model + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{ZIPLNfit_fixed$new(data, control)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{data}}{a named list used internally to carry the data matrices} + \item{\code{control}}{a list for controlling the optimization. See details.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{data}}{a named list used internally to carry the data matrices} - -\item{\code{control}}{a list for controlling the optimization. See details.} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-ZIPLNfit_fixed-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{ZIPLNfit_fixed$clone(deep = FALSE)}\if{html}{\out{
}} +\subsection{\code{ZIPLNfit_fixed$clone()}}{ + The objects of this class are cloneable with this method. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{ZIPLNfit_fixed$clone(deep = FALSE)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{deep}}{Whether to make a deep clone.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} } diff --git a/man/ZIPLNfit_sparse.Rd b/man/ZIPLNfit_sparse.Rd index f5e5387e..c22212d0 100644 --- a/man/ZIPLNfit_sparse.Rd +++ b/man/ZIPLNfit_sparse.Rd @@ -4,8 +4,6 @@ \alias{ZIPLNfit_sparse} \title{An R6 Class to represent a ZIPLNfit in a standard, general framework, with sparse inverse residual covariance} \description{ -An R6 Class to represent a ZIPLNfit in a standard, general framework, with sparse inverse residual covariance - An R6 Class to represent a ZIPLNfit in a standard, general framework, with sparse inverse residual covariance } \examples{ @@ -20,98 +18,100 @@ plot(myPLN) } } \section{Super class}{ -\code{\link[PLNmodels:ZIPLNfit]{PLNmodels::ZIPLNfit}} -> \code{ZIPLNfit_sparse} +\code{\link[PLNmodels:ZIPLNfit]{ZIPLNfit}} -> \code{ZIPLNfit_sparse} } \section{Active bindings}{ -\if{html}{\out{
}} -\describe{ -\item{\code{penalty}}{the global level of sparsity in the current model} + \if{html}{\out{
}} + \describe{ + \item{\code{penalty}}{the global level of sparsity in the current model} -\item{\code{penalty_weights}}{a matrix of weights controlling the amount of penalty element-wise.} + \item{\code{penalty_weights}}{a matrix of weights controlling the amount of penalty element-wise.} -\item{\code{n_edges}}{number of edges if the network (non null coefficient of the sparse precision matrix)} + \item{\code{n_edges}}{number of edges if the network (non null coefficient of the sparse precision matrix)} -\item{\code{nb_param_pln}}{number of parameters in the PLN part of the current model} + \item{\code{nb_param_pln}}{number of parameters in the PLN part of the current model} -\item{\code{vcov_model}}{character: the model used for the residual covariance} + \item{\code{vcov_model}}{character: the model used for the residual covariance} -\item{\code{pen_loglik}}{variational lower bound of the l1-penalized loglikelihood} + \item{\code{pen_loglik}}{variational lower bound of the l1-penalized loglikelihood} -\item{\code{EBIC}}{variational lower bound of the EBIC} + \item{\code{EBIC}}{variational lower bound of the EBIC} -\item{\code{density}}{proportion of non-null edges in the network} + \item{\code{density}}{proportion of non-null edges in the network} -\item{\code{criteria}}{a vector with loglik, penalized loglik, BIC, EBIC, ICL, R_squared, number of parameters, number of edges and graph density} -} -\if{html}{\out{
}} + \item{\code{criteria}}{a vector with loglik, penalized loglik, BIC, EBIC, ICL, R_squared, number of parameters, number of edges and graph density} + } + \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ -\itemize{ -\item \href{#method-ZIPLNfit_sparse-new}{\code{ZIPLNfit_sparse$new()}} -\item \href{#method-ZIPLNfit_sparse-latent_network}{\code{ZIPLNfit_sparse$latent_network()}} -\item \href{#method-ZIPLNfit_sparse-plot_network}{\code{ZIPLNfit_sparse$plot_network()}} -\item \href{#method-ZIPLNfit_sparse-clone}{\code{ZIPLNfit_sparse$clone()}} -} -} -\if{html}{\out{ -
Inherited methods + \itemize{ + \item \href{#method-ZIPLNfit_sparse-initialize}{\code{ZIPLNfit_sparse$new()}} + \item \href{#method-ZIPLNfit_sparse-latent_network}{\code{ZIPLNfit_sparse$latent_network()}} + \item \href{#method-ZIPLNfit_sparse-plot_network}{\code{ZIPLNfit_sparse$plot_network()}} + \item \href{#method-ZIPLNfit_sparse-clone}{\code{ZIPLNfit_sparse$clone()}} + } +} +\if{html}{\out{
Inherited methods -
-}} +
}} \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-ZIPLNfit_sparse-new}{}}} -\subsection{Method \code{new()}}{ -Initialize a \code{\link{ZIPLNfit_fixed}} model -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{ZIPLNfit_sparse$new(data, control)}\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-ZIPLNfit_sparse-initialize}{}}} +\subsection{\code{ZIPLNfit_sparse$new()}}{ + Initialize a \code{\link{ZIPLNfit_fixed}} model + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{ZIPLNfit_sparse$new(data, control)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{data}}{a named list used internally to carry the data matrices} + \item{\code{control}}{a list for controlling the optimization. See details.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{data}}{a named list used internally to carry the data matrices} - -\item{\code{control}}{a list for controlling the optimization. See details.} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-ZIPLNfit_sparse-latent_network}{}}} -\subsection{Method \code{latent_network()}}{ -Extract interaction network in the latent space -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{ZIPLNfit_sparse$latent_network(type = c("partial_cor", "support", "precision"))}\if{html}{\out{
}} +\subsection{\code{ZIPLNfit_sparse$latent_network()}}{ + Extract interaction network in the latent space + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{ZIPLNfit_sparse$latent_network(type = c("partial_cor", "support", "precision"))} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{type}}{edge value in the network. Can be "support" (binary edges), "precision" (coefficient of the precision matrix) or "partial_cor" (partial correlation between species)} + } + \if{html}{\out{
}} + } + \subsection{Returns}{ + a square matrix of size \code{ZIPLNfit_sparse$n} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{type}}{edge value in the network. Can be "support" (binary edges), "precision" (coefficient of the precision matrix) or "partial_cor" (partial correlation between species)} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -a square matrix of size \code{ZIPLNfit_sparse$n} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-ZIPLNfit_sparse-plot_network}{}}} -\subsection{Method \code{plot_network()}}{ -plot the latent network. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{ZIPLNfit_sparse$plot_network( +\subsection{\code{ZIPLNfit_sparse$plot_network()}}{ + plot the latent network. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{ZIPLNfit_sparse$plot_network( type = c("partial_cor", "support"), output = c("igraph", "corrplot"), edge.color = c("#F8766D", "#00BFC4"), @@ -119,44 +119,41 @@ plot the latent network. node.labels = NULL, layout = layout_in_circle, plot = TRUE -)}\if{html}{\out{
}} +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{type}}{edge value in the network. Either "precision" (coefficient of the precision matrix) or "partial_cor" (partial correlation between species).} + \item{\code{output}}{Output type. Either \code{igraph} (for the network) or \code{corrplot} (for the adjacency matrix)} + \item{\code{edge.color}}{Length 2 color vector. Color for positive/negative edges. Default is \code{c("#F8766D", "#00BFC4")}. Only relevant for igraph output.} + \item{\code{remove.isolated}}{if \code{TRUE}, isolated node are remove before plotting. Only relevant for igraph output.} + \item{\code{node.labels}}{vector of character. The labels of the nodes. The default will use the column names ot the response matrix.} + \item{\code{layout}}{an optional igraph layout. Only relevant for igraph output.} + \item{\code{plot}}{logical. Should the final network be displayed or only sent back to the user. Default is \code{TRUE}.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{type}}{edge value in the network. Either "precision" (coefficient of the precision matrix) or "partial_cor" (partial correlation between species).} - -\item{\code{output}}{Output type. Either \code{igraph} (for the network) or \code{corrplot} (for the adjacency matrix)} - -\item{\code{edge.color}}{Length 2 color vector. Color for positive/negative edges. Default is \code{c("#F8766D", "#00BFC4")}. Only relevant for igraph output.} - -\item{\code{remove.isolated}}{if \code{TRUE}, isolated node are remove before plotting. Only relevant for igraph output.} - -\item{\code{node.labels}}{vector of character. The labels of the nodes. The default will use the column names ot the response matrix.} - -\item{\code{layout}}{an optional igraph layout. Only relevant for igraph output.} - -\item{\code{plot}}{logical. Should the final network be displayed or only sent back to the user. Default is \code{TRUE}.} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-ZIPLNfit_sparse-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{ZIPLNfit_sparse$clone(deep = FALSE)}\if{html}{\out{
}} +\subsection{\code{ZIPLNfit_sparse$clone()}}{ + The objects of this class are cloneable with this method. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{ZIPLNfit_sparse$clone(deep = FALSE)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{deep}}{Whether to make a deep clone.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} } diff --git a/man/ZIPLNfit_spherical.Rd b/man/ZIPLNfit_spherical.Rd index 5779c2c8..ccd7b049 100644 --- a/man/ZIPLNfit_spherical.Rd +++ b/man/ZIPLNfit_spherical.Rd @@ -4,8 +4,6 @@ \alias{ZIPLNfit_spherical} \title{An R6 Class to represent a ZIPLNfit in a standard, general framework, with spherical residual covariance} \description{ -An R6 Class to represent a ZIPLNfit in a standard, general framework, with spherical residual covariance - An R6 Class to represent a ZIPLNfit in a standard, general framework, with spherical residual covariance } \examples{ @@ -19,70 +17,71 @@ print(myPLN) } } \section{Super class}{ -\code{\link[PLNmodels:ZIPLNfit]{PLNmodels::ZIPLNfit}} -> \code{ZIPLNfit_spherical} +\code{\link[PLNmodels:ZIPLNfit]{ZIPLNfit}} -> \code{ZIPLNfit_spherical} } \section{Active bindings}{ -\if{html}{\out{
}} -\describe{ -\item{\code{nb_param_pln}}{number of parameters in the PLN part of the current model} + \if{html}{\out{
}} + \describe{ + \item{\code{nb_param_pln}}{number of parameters in the PLN part of the current model} -\item{\code{vcov_model}}{character: the model used for the residual covariance} -} -\if{html}{\out{
}} + \item{\code{vcov_model}}{character: the model used for the residual covariance} + } + \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ -\itemize{ -\item \href{#method-ZIPLNfit_spherical-new}{\code{ZIPLNfit_spherical$new()}} -\item \href{#method-ZIPLNfit_spherical-clone}{\code{ZIPLNfit_spherical$clone()}} + \itemize{ + \item \href{#method-ZIPLNfit_spherical-initialize}{\code{ZIPLNfit_spherical$new()}} + \item \href{#method-ZIPLNfit_spherical-clone}{\code{ZIPLNfit_spherical$clone()}} + } } -} -\if{html}{\out{ -
Inherited methods +\if{html}{\out{
Inherited methods -
-}} +
}} \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-ZIPLNfit_spherical-new}{}}} -\subsection{Method \code{new()}}{ -Initialize a \code{\link{ZIPLNfit_spherical}} model -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{ZIPLNfit_spherical$new(data, control)}\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-ZIPLNfit_spherical-initialize}{}}} +\subsection{\code{ZIPLNfit_spherical$new()}}{ + Initialize a \code{\link{ZIPLNfit_spherical}} model + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{ZIPLNfit_spherical$new(data, control)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{data}}{a named list used internally to carry the data matrices} + \item{\code{control}}{a list for controlling the optimization. See details.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{data}}{a named list used internally to carry the data matrices} - -\item{\code{control}}{a list for controlling the optimization. See details.} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-ZIPLNfit_spherical-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{ZIPLNfit_spherical$clone(deep = FALSE)}\if{html}{\out{
}} +\subsection{\code{ZIPLNfit_spherical$clone()}}{ + The objects of this class are cloneable with this method. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{ZIPLNfit_spherical$clone(deep = FALSE)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{deep}}{Whether to make a deep clone.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} } diff --git a/man/ZIPLNnetwork.Rd b/man/ZIPLNnetwork.Rd index aef11b01..29cec29a 100644 --- a/man/ZIPLNnetwork.Rd +++ b/man/ZIPLNnetwork.Rd @@ -17,7 +17,7 @@ ZIPLNnetwork( \arguments{ \item{formula}{an object of class "formula": a symbolic description of the model to be fitted.} -\item{data}{an optional data frame, list or environment (or object coercible by as.data.frame to a data frame) containing the variables in the model. If not found in data, the variables are taken from environment(formula), typically the environment from which lm is called.} +\item{data}{an optional data frame, list or environment (or object coercible by as.data.frame to a data frame) containing the variables in the model. If not found in data, the variables are taken from environment(formula), typically the environment from which the model is called.} \item{subset}{an optional vector specifying a subset of observations to be used in the fitting process.} diff --git a/man/ZIPLNnetwork_param.Rd b/man/ZIPLNnetwork_param.Rd index fe3d4daa..cf7dcfc7 100644 --- a/man/ZIPLNnetwork_param.Rd +++ b/man/ZIPLNnetwork_param.Rd @@ -18,7 +18,8 @@ ZIPLNnetwork_param( ) } \arguments{ -\item{backend}{optimization back used, either "nlopt" or "torch". Default is "nlopt"} +\item{backend}{optimization back used, either "nlopt", "builtin" or "torch". Default is "nlopt". +Note: the "nlopt" backend converges better in PLNnetwork's outer glasso alternation than "builtin".} \item{inception_cov}{Covariance structure used for the inception model used to initialize the PLNfamily. Defaults to "full" and can be constrained to "diagonal" and "spherical".} @@ -32,7 +33,7 @@ ZIPLNnetwork_param( \item{penalty_weights}{either a single or a list of p x p matrix of weights (default: all weights equal to 1) to adapt the amount of shrinkage to each pairs of node. Must be symmetric with positive values.} -\item{config_post}{a list for controlling the post-treatment (optional bootstrap, jackknife, R2, etc).} +\item{config_post}{a list for controlling the post-treatments (optional bootstrap, jackknife, R2, etc.). See details} \item{config_optim}{a list for controlling the optimizer (either "nlopt" or "torch" backend). See details} diff --git a/man/ZIPLNnetworkfamily.Rd b/man/ZIPLNnetworkfamily.Rd index 0bf90623..dde5b687 100644 --- a/man/ZIPLNnetworkfamily.Rd +++ b/man/ZIPLNnetworkfamily.Rd @@ -20,100 +20,101 @@ class(fits) The function \code{\link[=ZIPLNnetwork]{ZIPLNnetwork()}}, the class \code{\link{ZIPLNfit_sparse}} } \section{Super classes}{ -\code{\link[PLNmodels:PLNfamily]{PLNmodels::PLNfamily}} -> \code{\link[PLNmodels:Networkfamily]{PLNmodels::Networkfamily}} -> \code{ZIPLNnetworkfamily} +\code{\link[PLNmodels:PLNfamily]{PLNfamily}} -> \code{\link[PLNmodels:Networkfamily]{Networkfamily}} -> \code{ZIPLNnetworkfamily} } \section{Public fields}{ -\if{html}{\out{
}} -\describe{ -\item{\code{covariates0}}{the matrix of covariates included in the ZI component} -} -\if{html}{\out{
}} + \if{html}{\out{
}} + \describe{ + \item{\code{covariates0}}{the matrix of covariates included in the ZI component} + } + \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ -\itemize{ -\item \href{#method-ZIPLNnetworkfamily-new}{\code{ZIPLNnetworkfamily$new()}} -\item \href{#method-ZIPLNnetworkfamily-stability_selection}{\code{ZIPLNnetworkfamily$stability_selection()}} -\item \href{#method-ZIPLNnetworkfamily-clone}{\code{ZIPLNnetworkfamily$clone()}} -} + \itemize{ + \item \href{#method-ZIPLNnetworkfamily-initialize}{\code{ZIPLNnetworkfamily$new()}} + \item \href{#method-ZIPLNnetworkfamily-stability_selection}{\code{ZIPLNnetworkfamily$stability_selection()}} + \item \href{#method-ZIPLNnetworkfamily-clone}{\code{ZIPLNnetworkfamily$clone()}} + } } -\if{html}{\out{ -
Inherited methods +\if{html}{\out{
Inherited methods -
-}} +
}} \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-ZIPLNnetworkfamily-new}{}}} -\subsection{Method \code{new()}}{ -Initialize all models in the collection -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{ZIPLNnetworkfamily$new(penalties, data, control)}\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-ZIPLNnetworkfamily-initialize}{}}} +\subsection{\code{ZIPLNnetworkfamily$new()}}{ + Initialize all models in the collection + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{ZIPLNnetworkfamily$new(penalties, data, control)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{penalties}}{a vector of positive real number controlling the level of sparsity of the underlying network.} + \item{\code{data}}{a named list used internally to carry the data matrices} + \item{\code{control}}{a list for controlling the optimization.} + } + \if{html}{\out{
}} + } + \subsection{Returns}{ + Update current \code{\link{PLNnetworkfit}} with smart starting values + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{penalties}}{a vector of positive real number controlling the level of sparsity of the underlying network.} - -\item{\code{data}}{a named list used internally to carry the data matrices} - -\item{\code{control}}{a list for controlling the optimization.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -Update current \code{\link{PLNnetworkfit}} with smart starting values -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-ZIPLNnetworkfamily-stability_selection}{}}} -\subsection{Method \code{stability_selection()}}{ -Compute the stability path by stability selection -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{ZIPLNnetworkfamily$stability_selection( +\subsection{\code{ZIPLNnetworkfamily$stability_selection()}}{ + Compute the stability path by stability selection + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{ZIPLNnetworkfamily$stability_selection( subsamples = NULL, control = ZIPLNnetwork_param() -)}\if{html}{\out{
}} +)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{subsamples}}{a list of vectors describing the subsamples. The number of vectors (or list length) determines the number of subsamples used in the stability selection. Automatically set to 20 subsamples with size \code{10*sqrt(n)} if \code{n >= 144} and \code{0.8*n} otherwise following Liu et al. (2010) recommendations.} + \item{\code{control}}{a list controlling the main optimization process in each call to \code{\link[=PLNnetwork]{PLNnetwork()}}. See \code{\link[=ZIPLNnetwork]{ZIPLNnetwork()}} and \code{\link[=ZIPLN_param]{ZIPLN_param()}} for details.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{subsamples}}{a list of vectors describing the subsamples. The number of vectors (or list length) determines the number of subsamples used in the stability selection. Automatically set to 20 subsamples with size \code{10*sqrt(n)} if \code{n >= 144} and \code{0.8*n} otherwise following Liu et al. (2010) recommendations.} - -\item{\code{control}}{a list controlling the main optimization process in each call to \code{\link[=PLNnetwork]{PLNnetwork()}}. See \code{\link[=ZIPLNnetwork]{ZIPLNnetwork()}} and \code{\link[=ZIPLN_param]{ZIPLN_param()}} for details.} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-ZIPLNnetworkfamily-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{ZIPLNnetworkfamily$clone(deep = FALSE)}\if{html}{\out{
}} +\subsection{\code{ZIPLNnetworkfamily$clone()}}{ + The objects of this class are cloneable with this method. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{ZIPLNnetworkfamily$clone(deep = FALSE)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{deep}}{Whether to make a deep clone.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} } diff --git a/man/compute_PLN_starting_point.Rd b/man/compute_PLN_starting_point.Rd index 0390059b..1b047a7e 100644 --- a/man/compute_PLN_starting_point.Rd +++ b/man/compute_PLN_starting_point.Rd @@ -4,7 +4,7 @@ \alias{compute_PLN_starting_point} \title{Helper function for PLN initialization.} \usage{ -compute_PLN_starting_point(Y, X, O, w, s = 0.1) +compute_PLN_starting_point(Y, X, O, w, method = c("LM", "GLM")) } \arguments{ \item{Y}{Response count matrix} @@ -15,16 +15,26 @@ compute_PLN_starting_point(Y, X, O, w, s = 0.1) \item{w}{Weight vector (defaults to 1)} -\item{s}{Scale parameter for S (defaults to 0.1)} +\item{method}{character: strategy used to initialize B. Either \code{"LM"} (default, fast weighted +log-linear regression) or \code{"GLM"} (p independent Poisson GLMs, more accurate for complex +or unbalanced designs but slower).} } \value{ -a named list of starting values for model parameter B and variational parameters M and S used in the iterative optimization algorithm of \code{\link[=PLN]{PLN()}} +a named list of starting values for model parameter B and variational parameters M and S2 used in the iterative optimization algorithm of \code{\link[=PLN]{PLN()}} } \description{ -Barebone function to compute starting points for B, M and S when fitting a PLN. Mostly intended for internal use. +Barebone function to compute starting points for B, M and S2 when fitting a PLN. Mostly intended for internal use. } \details{ -The default strategy to estimate B and M is to fit a linear model with covariates \code{X} to the response count matrix (after adding a pseudocount of 1, scaling by the offset and taking the log). The regression matrix is used to initialize \code{B} and the residuals to initialize \code{M}. \code{S} is initialized as a constant conformable matrix with value \code{s}. +\itemize{ +\item \strong{B}: estimated by weighted LM (\code{method = "LM"}, default) or p independent Poisson GLMs +(\code{method = "GLM"}). The GLM option gives better B estimates for factorial or unbalanced +designs at the cost of p IRLS fits. +\item \strong{M}: initialized to \code{log((1 + Y) / exp(O))} (M_full in the X*B + M_res parameterization). +\item \strong{S}: initialized element-wise to \code{1 / sqrt(2 + Y)}, the approximate VE-step optimum at +Omega = I. This adapts automatically to count levels: high S for zero counts (high +uncertainty), low S for large counts. +} } \examples{ \dontrun{ @@ -32,8 +42,9 @@ data(barents) Y <- barents$Abundance X <- model.matrix(Abundance ~ Latitude + Longitude + Depth + Temperature, data = barents) O <- log(barents$Offset) -w <-- rep(1, nrow(Y)) +w <- rep(1, nrow(Y)) compute_PLN_starting_point(Y, X, O, w) +compute_PLN_starting_point(Y, X, O, w, method = "GLM") } } diff --git a/man/logLik.PLNfit.Rd b/man/logLik.PLNfit.Rd new file mode 100644 index 00000000..2de424eb --- /dev/null +++ b/man/logLik.PLNfit.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/PLNfit-S3methods.R +\name{logLik.PLNfit} +\alias{logLik.PLNfit} +\title{Extract log-likelihood of a fitted PLN model} +\usage{ +\method{logLik}{PLNfit}(object, ...) +} +\arguments{ +\item{object}{an R6 object with class \code{\link{PLNfit}}} + +\item{...}{additional parameters for S3 compatibility. Not used} +} +\value{ +An object of class \code{"logLik"}. The numeric value is the variational ELBO. +Attributes \code{df} and \code{nobs} hold the number of parameters and observations. +} +\description{ +Returns the variational lower bound of the log-likelihood as a \code{"logLik"} object, +compatible with \code{\link[stats:AIC]{stats::AIC()}} and \code{\link[stats:BIC]{stats::BIC()}}. +} +\examples{ +data(trichoptera) +trichoptera <- prepare_data(trichoptera$Abundance, trichoptera$Covariate) +model <- PLN(Abundance ~ 1, data = trichoptera) +logLik(model) +} diff --git a/man/logLik.ZIPLNfit.Rd b/man/logLik.ZIPLNfit.Rd new file mode 100644 index 00000000..ffbbe6d3 --- /dev/null +++ b/man/logLik.ZIPLNfit.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ZIPLNfit-S3methods.R +\name{logLik.ZIPLNfit} +\alias{logLik.ZIPLNfit} +\title{Extract log-likelihood of a fitted ZIPLN model} +\usage{ +\method{logLik}{ZIPLNfit}(object, ...) +} +\arguments{ +\item{object}{an R6 object with class \code{\link{ZIPLNfit}}} + +\item{...}{additional parameters for S3 compatibility. Not used} +} +\value{ +An object of class \code{"logLik"}. The numeric value is the variational ELBO. +Attributes \code{df} and \code{nobs} hold the number of parameters and observations. +} +\description{ +Returns the variational lower bound of the log-likelihood as a \code{"logLik"} object, +compatible with \code{\link[stats:AIC]{stats::AIC()}} and \code{\link[stats:BIC]{stats::BIC()}}. +} +\examples{ +data(trichoptera) +trichoptera <- prepare_data(trichoptera$Abundance, trichoptera$Covariate) +model <- ZIPLN(Abundance ~ 1, data = trichoptera) +logLik(model) +} diff --git a/memory/feedback_cpp_audit.md b/memory/feedback_cpp_audit.md new file mode 100644 index 00000000..f741b820 --- /dev/null +++ b/memory/feedback_cpp_audit.md @@ -0,0 +1,30 @@ +--- +name: feedback-cpp-audit +description: Corrections C++ appliquées sur la branche code-enhancement en juin 2026 — 8 fixes, compilation propre, 72 tests passent +metadata: + type: feedback +--- + +8 améliorations C++ appliquées intégralement le 10/06/2026. Toutes les corrections sont sur la branche `code-enhancement`. + +**Fixes appliqués :** + +1. **Guard P_X (d=0)** — 4 fichiers `nlopt_*.cpp` : `(X.n_cols > 0) ? arma::solve(...) : arma::mat(0, Y.n_rows)` évite le crash quand la formule est `~ 0`. + +2. **O(p³)→O(np) dans `nlopt_fixed_cov.cpp`** : `trace(Omega * (...))` remplacé par `full_cov_obj_grad_impl` (accu elementwise). + +3. **`DenseOmegaImpl` base struct** dans `CovarianceTraits.h` : `FullCovTraits` et `FixedCovTraits` héritent désormais de `DenseOmegaImpl` qui contient les 6 méthodes statiques identiques (`cov_diag`, `grad_hess_M`, `times_Omega`, `penalty_M`, `objective_cov`, `final_loglik`). + +4. **`NewtonConfig` struct** dans `utils.h` : centralise les 4 `containsElementNamed` parsings. + +5. **Adoption `NewtonConfig`** : `newton_{full,diag,spherical,fixed}_cov.cpp` + `nlopt_full_cov.cpp`. + +6. **`nlopt_impl.h`** : nouveau header partagé avec les 3 helpers `inline` ; copies `static` supprimées des `.cpp`. + +7. **Méthode `update()`** dans chaque `State` de `CovarianceTraits.h` : constructeur et `mstep` délèguent vers `s.update(M, S2, w, w_bar)`. + +8. **Style `SphericalCovTraits::output_cov`** : `.fill(s.sigma2)` à la place de `= arma::ones(p) * s.sigma2`. + +**Why:** factorisation, efficacité (O(p³)→O(np)), et robustesse (guard d=0). + +**How to apply:** avant toute modification C++ future, relire `CovarianceTraits.h` pour comprendre la hiérarchie `DenseOmegaImpl → FullCovTraits/FixedCovTraits` et vérifier que les nouvelles méthodes communes sont ajoutées à la base, pas dupliquées. diff --git a/src/Makevars b/src/Makevars index 22ebc632..3a7f8ac9 100644 --- a/src/Makevars +++ b/src/Makevars @@ -1 +1,2 @@ -PKG_LIBS = $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) +PKG_CXXFLAGS = $(SHLIB_OPENMP_CXXFLAGS) +PKG_LIBS = $(SHLIB_OPENMP_CXXFLAGS) $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index 07502dfa..8fbedb77 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -11,13 +11,128 @@ Rcpp::Rostream& Rcpp::Rcout = Rcpp::Rcpp_cout_get(); Rcpp::Rostream& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get(); #endif -// cpp_test_nlopt -bool cpp_test_nlopt(); -RcppExport SEXP _PLNmodels_cpp_test_nlopt() { +// builtin_optimize_full +Rcpp::List builtin_optimize_full(const Rcpp::List& data, const Rcpp::List& params, const Rcpp::List& config); +RcppExport SEXP _PLNmodels_builtin_optimize_full(SEXP dataSEXP, SEXP paramsSEXP, SEXP configSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; - rcpp_result_gen = Rcpp::wrap(cpp_test_nlopt()); + Rcpp::traits::input_parameter< const Rcpp::List& >::type data(dataSEXP); + Rcpp::traits::input_parameter< const Rcpp::List& >::type params(paramsSEXP); + Rcpp::traits::input_parameter< const Rcpp::List& >::type config(configSEXP); + rcpp_result_gen = Rcpp::wrap(builtin_optimize_full(data, params, config)); + return rcpp_result_gen; +END_RCPP +} +// builtin_optimize_vestep_full +Rcpp::List builtin_optimize_vestep_full(const Rcpp::List& data, const Rcpp::List& params, const arma::mat& B, const arma::mat& Omega, const Rcpp::List& config); +RcppExport SEXP _PLNmodels_builtin_optimize_vestep_full(SEXP dataSEXP, SEXP paramsSEXP, SEXP BSEXP, SEXP OmegaSEXP, SEXP configSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< const Rcpp::List& >::type data(dataSEXP); + Rcpp::traits::input_parameter< const Rcpp::List& >::type params(paramsSEXP); + Rcpp::traits::input_parameter< const arma::mat& >::type B(BSEXP); + Rcpp::traits::input_parameter< const arma::mat& >::type Omega(OmegaSEXP); + Rcpp::traits::input_parameter< const Rcpp::List& >::type config(configSEXP); + rcpp_result_gen = Rcpp::wrap(builtin_optimize_vestep_full(data, params, B, Omega, config)); + return rcpp_result_gen; +END_RCPP +} +// builtin_optimize_diagonal +Rcpp::List builtin_optimize_diagonal(const Rcpp::List& data, const Rcpp::List& params, const Rcpp::List& config); +RcppExport SEXP _PLNmodels_builtin_optimize_diagonal(SEXP dataSEXP, SEXP paramsSEXP, SEXP configSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< const Rcpp::List& >::type data(dataSEXP); + Rcpp::traits::input_parameter< const Rcpp::List& >::type params(paramsSEXP); + Rcpp::traits::input_parameter< const Rcpp::List& >::type config(configSEXP); + rcpp_result_gen = Rcpp::wrap(builtin_optimize_diagonal(data, params, config)); + return rcpp_result_gen; +END_RCPP +} +// builtin_optimize_vestep_diagonal +Rcpp::List builtin_optimize_vestep_diagonal(const Rcpp::List& data, const Rcpp::List& params, const arma::mat& B, const arma::mat& Omega, const Rcpp::List& config); +RcppExport SEXP _PLNmodels_builtin_optimize_vestep_diagonal(SEXP dataSEXP, SEXP paramsSEXP, SEXP BSEXP, SEXP OmegaSEXP, SEXP configSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< const Rcpp::List& >::type data(dataSEXP); + Rcpp::traits::input_parameter< const Rcpp::List& >::type params(paramsSEXP); + Rcpp::traits::input_parameter< const arma::mat& >::type B(BSEXP); + Rcpp::traits::input_parameter< const arma::mat& >::type Omega(OmegaSEXP); + Rcpp::traits::input_parameter< const Rcpp::List& >::type config(configSEXP); + rcpp_result_gen = Rcpp::wrap(builtin_optimize_vestep_diagonal(data, params, B, Omega, config)); + return rcpp_result_gen; +END_RCPP +} +// builtin_optimize_spherical +Rcpp::List builtin_optimize_spherical(const Rcpp::List& data, const Rcpp::List& params, const Rcpp::List& config); +RcppExport SEXP _PLNmodels_builtin_optimize_spherical(SEXP dataSEXP, SEXP paramsSEXP, SEXP configSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< const Rcpp::List& >::type data(dataSEXP); + Rcpp::traits::input_parameter< const Rcpp::List& >::type params(paramsSEXP); + Rcpp::traits::input_parameter< const Rcpp::List& >::type config(configSEXP); + rcpp_result_gen = Rcpp::wrap(builtin_optimize_spherical(data, params, config)); + return rcpp_result_gen; +END_RCPP +} +// builtin_optimize_vestep_spherical +Rcpp::List builtin_optimize_vestep_spherical(const Rcpp::List& data, const Rcpp::List& params, const arma::mat& B, const arma::mat& Omega, const Rcpp::List& config); +RcppExport SEXP _PLNmodels_builtin_optimize_vestep_spherical(SEXP dataSEXP, SEXP paramsSEXP, SEXP BSEXP, SEXP OmegaSEXP, SEXP configSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< const Rcpp::List& >::type data(dataSEXP); + Rcpp::traits::input_parameter< const Rcpp::List& >::type params(paramsSEXP); + Rcpp::traits::input_parameter< const arma::mat& >::type B(BSEXP); + Rcpp::traits::input_parameter< const arma::mat& >::type Omega(OmegaSEXP); + Rcpp::traits::input_parameter< const Rcpp::List& >::type config(configSEXP); + rcpp_result_gen = Rcpp::wrap(builtin_optimize_vestep_spherical(data, params, B, Omega, config)); + return rcpp_result_gen; +END_RCPP +} +// builtin_optimize_fixed +Rcpp::List builtin_optimize_fixed(const Rcpp::List& data, const Rcpp::List& params, const Rcpp::List& config); +RcppExport SEXP _PLNmodels_builtin_optimize_fixed(SEXP dataSEXP, SEXP paramsSEXP, SEXP configSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< const Rcpp::List& >::type data(dataSEXP); + Rcpp::traits::input_parameter< const Rcpp::List& >::type params(paramsSEXP); + Rcpp::traits::input_parameter< const Rcpp::List& >::type config(configSEXP); + rcpp_result_gen = Rcpp::wrap(builtin_optimize_fixed(data, params, config)); + return rcpp_result_gen; +END_RCPP +} +// builtin_optimize_rank +Rcpp::List builtin_optimize_rank(const Rcpp::List& data, const Rcpp::List& params, const Rcpp::List& config); +RcppExport SEXP _PLNmodels_builtin_optimize_rank(SEXP dataSEXP, SEXP paramsSEXP, SEXP configSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< const Rcpp::List& >::type data(dataSEXP); + Rcpp::traits::input_parameter< const Rcpp::List& >::type params(paramsSEXP); + Rcpp::traits::input_parameter< const Rcpp::List& >::type config(configSEXP); + rcpp_result_gen = Rcpp::wrap(builtin_optimize_rank(data, params, config)); + return rcpp_result_gen; +END_RCPP +} +// builtin_optimize_vestep_rank +Rcpp::List builtin_optimize_vestep_rank(const Rcpp::List& data, const Rcpp::List& params, const arma::mat& B, const arma::mat& C, const Rcpp::List& config); +RcppExport SEXP _PLNmodels_builtin_optimize_vestep_rank(SEXP dataSEXP, SEXP paramsSEXP, SEXP BSEXP, SEXP CSEXP, SEXP configSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< const Rcpp::List& >::type data(dataSEXP); + Rcpp::traits::input_parameter< const Rcpp::List& >::type params(paramsSEXP); + Rcpp::traits::input_parameter< const arma::mat& >::type B(BSEXP); + Rcpp::traits::input_parameter< const arma::mat& >::type C(CSEXP); + Rcpp::traits::input_parameter< const Rcpp::List& >::type config(configSEXP); + rcpp_result_gen = Rcpp::wrap(builtin_optimize_vestep_rank(data, params, B, C, config)); return rcpp_result_gen; END_RCPP } @@ -62,22 +177,22 @@ BEGIN_RCPP return rcpp_result_gen; END_RCPP } -// nlopt_optimize -Rcpp::List nlopt_optimize(const Rcpp::List& data, const Rcpp::List& params, const Rcpp::List& config); -RcppExport SEXP _PLNmodels_nlopt_optimize(SEXP dataSEXP, SEXP paramsSEXP, SEXP configSEXP) { +// nlopt_optimize_full +Rcpp::List nlopt_optimize_full(const Rcpp::List& data, const Rcpp::List& params, const Rcpp::List& config); +RcppExport SEXP _PLNmodels_nlopt_optimize_full(SEXP dataSEXP, SEXP paramsSEXP, SEXP configSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const Rcpp::List& >::type data(dataSEXP); Rcpp::traits::input_parameter< const Rcpp::List& >::type params(paramsSEXP); Rcpp::traits::input_parameter< const Rcpp::List& >::type config(configSEXP); - rcpp_result_gen = Rcpp::wrap(nlopt_optimize(data, params, config)); + rcpp_result_gen = Rcpp::wrap(nlopt_optimize_full(data, params, config)); return rcpp_result_gen; END_RCPP } -// nlopt_optimize_vestep -Rcpp::List nlopt_optimize_vestep(const Rcpp::List& data, const Rcpp::List& params, const arma::mat& B, const arma::mat& Omega, const Rcpp::List& config); -RcppExport SEXP _PLNmodels_nlopt_optimize_vestep(SEXP dataSEXP, SEXP paramsSEXP, SEXP BSEXP, SEXP OmegaSEXP, SEXP configSEXP) { +// nlopt_optimize_vestep_full +Rcpp::List nlopt_optimize_vestep_full(const Rcpp::List& data, const Rcpp::List& params, const arma::mat& B, const arma::mat& Omega, const Rcpp::List& config); +RcppExport SEXP _PLNmodels_nlopt_optimize_vestep_full(SEXP dataSEXP, SEXP paramsSEXP, SEXP BSEXP, SEXP OmegaSEXP, SEXP configSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; @@ -86,24 +201,7 @@ BEGIN_RCPP Rcpp::traits::input_parameter< const arma::mat& >::type B(BSEXP); Rcpp::traits::input_parameter< const arma::mat& >::type Omega(OmegaSEXP); Rcpp::traits::input_parameter< const Rcpp::List& >::type config(configSEXP); - rcpp_result_gen = Rcpp::wrap(nlopt_optimize_vestep(data, params, B, Omega, config)); - return rcpp_result_gen; -END_RCPP -} -// nlopt_optimize_genetic_modeling -Rcpp::List nlopt_optimize_genetic_modeling(const Rcpp::List& init_parameters, const arma::mat& Y, const arma::mat& X, const arma::mat& O, const arma::vec& w, const arma::mat& C, const Rcpp::List& configuration); -RcppExport SEXP _PLNmodels_nlopt_optimize_genetic_modeling(SEXP init_parametersSEXP, SEXP YSEXP, SEXP XSEXP, SEXP OSEXP, SEXP wSEXP, SEXP CSEXP, SEXP configurationSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< const Rcpp::List& >::type init_parameters(init_parametersSEXP); - Rcpp::traits::input_parameter< const arma::mat& >::type Y(YSEXP); - Rcpp::traits::input_parameter< const arma::mat& >::type X(XSEXP); - Rcpp::traits::input_parameter< const arma::mat& >::type O(OSEXP); - Rcpp::traits::input_parameter< const arma::vec& >::type w(wSEXP); - Rcpp::traits::input_parameter< const arma::mat& >::type C(CSEXP); - Rcpp::traits::input_parameter< const Rcpp::List& >::type configuration(configurationSEXP); - rcpp_result_gen = Rcpp::wrap(nlopt_optimize_genetic_modeling(init_parameters, Y, X, O, w, C, configuration)); + rcpp_result_gen = Rcpp::wrap(nlopt_optimize_vestep_full(data, params, B, Omega, config)); return rcpp_result_gen; END_RCPP } @@ -163,9 +261,36 @@ BEGIN_RCPP return rcpp_result_gen; END_RCPP } +// cpp_test_nlopt +bool cpp_test_nlopt(); +RcppExport SEXP _PLNmodels_cpp_test_nlopt() { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + rcpp_result_gen = Rcpp::wrap(cpp_test_nlopt()); + return rcpp_result_gen; +END_RCPP +} +// nlopt_optimize_genetic_modeling +Rcpp::List nlopt_optimize_genetic_modeling(const Rcpp::List& init_parameters, const arma::mat& Y, const arma::mat& X, const arma::mat& O, const arma::vec& w, const arma::mat& C, const Rcpp::List& configuration); +RcppExport SEXP _PLNmodels_nlopt_optimize_genetic_modeling(SEXP init_parametersSEXP, SEXP YSEXP, SEXP XSEXP, SEXP OSEXP, SEXP wSEXP, SEXP CSEXP, SEXP configurationSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< const Rcpp::List& >::type init_parameters(init_parametersSEXP); + Rcpp::traits::input_parameter< const arma::mat& >::type Y(YSEXP); + Rcpp::traits::input_parameter< const arma::mat& >::type X(XSEXP); + Rcpp::traits::input_parameter< const arma::mat& >::type O(OSEXP); + Rcpp::traits::input_parameter< const arma::vec& >::type w(wSEXP); + Rcpp::traits::input_parameter< const arma::mat& >::type C(CSEXP); + Rcpp::traits::input_parameter< const Rcpp::List& >::type configuration(configurationSEXP); + rcpp_result_gen = Rcpp::wrap(nlopt_optimize_genetic_modeling(init_parameters, Y, X, O, w, C, configuration)); + return rcpp_result_gen; +END_RCPP +} // zipln_vloglik -arma::vec zipln_vloglik(const arma::mat& Y, const arma::mat& X, const arma::mat& O, const arma::mat& Pi, const arma::mat& Omega, const arma::mat& B, const arma::mat& R, const arma::mat& M, const arma::mat& S); -RcppExport SEXP _PLNmodels_zipln_vloglik(SEXP YSEXP, SEXP XSEXP, SEXP OSEXP, SEXP PiSEXP, SEXP OmegaSEXP, SEXP BSEXP, SEXP RSEXP, SEXP MSEXP, SEXP SSEXP) { +arma::vec zipln_vloglik(const arma::mat& Y, const arma::mat& X, const arma::mat& O, const arma::mat& Pi, const arma::mat& Omega, const arma::mat& B, const arma::mat& R, const arma::mat& M, const arma::mat& S2); +RcppExport SEXP _PLNmodels_zipln_vloglik(SEXP YSEXP, SEXP XSEXP, SEXP OSEXP, SEXP PiSEXP, SEXP OmegaSEXP, SEXP BSEXP, SEXP RSEXP, SEXP MSEXP, SEXP S2SEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; @@ -177,50 +302,50 @@ BEGIN_RCPP Rcpp::traits::input_parameter< const arma::mat& >::type B(BSEXP); Rcpp::traits::input_parameter< const arma::mat& >::type R(RSEXP); Rcpp::traits::input_parameter< const arma::mat& >::type M(MSEXP); - Rcpp::traits::input_parameter< const arma::mat& >::type S(SSEXP); - rcpp_result_gen = Rcpp::wrap(zipln_vloglik(Y, X, O, Pi, Omega, B, R, M, S)); + Rcpp::traits::input_parameter< const arma::mat& >::type S2(S2SEXP); + rcpp_result_gen = Rcpp::wrap(zipln_vloglik(Y, X, O, Pi, Omega, B, R, M, S2)); return rcpp_result_gen; END_RCPP } // optim_zipln_Omega_full -arma::mat optim_zipln_Omega_full(const arma::mat& M, const arma::mat& X, const arma::mat& B, const arma::mat& S); -RcppExport SEXP _PLNmodels_optim_zipln_Omega_full(SEXP MSEXP, SEXP XSEXP, SEXP BSEXP, SEXP SSEXP) { +arma::mat optim_zipln_Omega_full(const arma::mat& M, const arma::mat& X, const arma::mat& B, const arma::mat& S2); +RcppExport SEXP _PLNmodels_optim_zipln_Omega_full(SEXP MSEXP, SEXP XSEXP, SEXP BSEXP, SEXP S2SEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const arma::mat& >::type M(MSEXP); Rcpp::traits::input_parameter< const arma::mat& >::type X(XSEXP); Rcpp::traits::input_parameter< const arma::mat& >::type B(BSEXP); - Rcpp::traits::input_parameter< const arma::mat& >::type S(SSEXP); - rcpp_result_gen = Rcpp::wrap(optim_zipln_Omega_full(M, X, B, S)); + Rcpp::traits::input_parameter< const arma::mat& >::type S2(S2SEXP); + rcpp_result_gen = Rcpp::wrap(optim_zipln_Omega_full(M, X, B, S2)); return rcpp_result_gen; END_RCPP } // optim_zipln_Omega_spherical -arma::mat optim_zipln_Omega_spherical(const arma::mat& M, const arma::mat& X, const arma::mat& B, const arma::mat& S); -RcppExport SEXP _PLNmodels_optim_zipln_Omega_spherical(SEXP MSEXP, SEXP XSEXP, SEXP BSEXP, SEXP SSEXP) { +arma::mat optim_zipln_Omega_spherical(const arma::mat& M, const arma::mat& X, const arma::mat& B, const arma::mat& S2); +RcppExport SEXP _PLNmodels_optim_zipln_Omega_spherical(SEXP MSEXP, SEXP XSEXP, SEXP BSEXP, SEXP S2SEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const arma::mat& >::type M(MSEXP); Rcpp::traits::input_parameter< const arma::mat& >::type X(XSEXP); Rcpp::traits::input_parameter< const arma::mat& >::type B(BSEXP); - Rcpp::traits::input_parameter< const arma::mat& >::type S(SSEXP); - rcpp_result_gen = Rcpp::wrap(optim_zipln_Omega_spherical(M, X, B, S)); + Rcpp::traits::input_parameter< const arma::mat& >::type S2(S2SEXP); + rcpp_result_gen = Rcpp::wrap(optim_zipln_Omega_spherical(M, X, B, S2)); return rcpp_result_gen; END_RCPP } // optim_zipln_Omega_diagonal -arma::mat optim_zipln_Omega_diagonal(const arma::mat& M, const arma::mat& X, const arma::mat& B, const arma::mat& S); -RcppExport SEXP _PLNmodels_optim_zipln_Omega_diagonal(SEXP MSEXP, SEXP XSEXP, SEXP BSEXP, SEXP SSEXP) { +arma::mat optim_zipln_Omega_diagonal(const arma::mat& M, const arma::mat& X, const arma::mat& B, const arma::mat& S2); +RcppExport SEXP _PLNmodels_optim_zipln_Omega_diagonal(SEXP MSEXP, SEXP XSEXP, SEXP BSEXP, SEXP S2SEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const arma::mat& >::type M(MSEXP); Rcpp::traits::input_parameter< const arma::mat& >::type X(XSEXP); Rcpp::traits::input_parameter< const arma::mat& >::type B(BSEXP); - Rcpp::traits::input_parameter< const arma::mat& >::type S(SSEXP); - rcpp_result_gen = Rcpp::wrap(optim_zipln_Omega_diagonal(M, X, B, S)); + Rcpp::traits::input_parameter< const arma::mat& >::type S2(S2SEXP); + rcpp_result_gen = Rcpp::wrap(optim_zipln_Omega_diagonal(M, X, B, S2)); return rcpp_result_gen; END_RCPP } @@ -251,8 +376,8 @@ BEGIN_RCPP END_RCPP } // optim_zipln_R_var -arma::mat optim_zipln_R_var(const arma::mat& Y, const arma::mat& X, const arma::mat& O, const arma::mat& M, const arma::mat& S, const arma::mat& Pi, const arma::mat& B); -RcppExport SEXP _PLNmodels_optim_zipln_R_var(SEXP YSEXP, SEXP XSEXP, SEXP OSEXP, SEXP MSEXP, SEXP SSEXP, SEXP PiSEXP, SEXP BSEXP) { +arma::mat optim_zipln_R_var(const arma::mat& Y, const arma::mat& X, const arma::mat& O, const arma::mat& M, const arma::mat& S2, const arma::mat& Pi, const arma::mat& B); +RcppExport SEXP _PLNmodels_optim_zipln_R_var(SEXP YSEXP, SEXP XSEXP, SEXP OSEXP, SEXP MSEXP, SEXP S2SEXP, SEXP PiSEXP, SEXP BSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; @@ -260,16 +385,16 @@ BEGIN_RCPP Rcpp::traits::input_parameter< const arma::mat& >::type X(XSEXP); Rcpp::traits::input_parameter< const arma::mat& >::type O(OSEXP); Rcpp::traits::input_parameter< const arma::mat& >::type M(MSEXP); - Rcpp::traits::input_parameter< const arma::mat& >::type S(SSEXP); + Rcpp::traits::input_parameter< const arma::mat& >::type S2(S2SEXP); Rcpp::traits::input_parameter< const arma::mat& >::type Pi(PiSEXP); Rcpp::traits::input_parameter< const arma::mat& >::type B(BSEXP); - rcpp_result_gen = Rcpp::wrap(optim_zipln_R_var(Y, X, O, M, S, Pi, B)); + rcpp_result_gen = Rcpp::wrap(optim_zipln_R_var(Y, X, O, M, S2, Pi, B)); return rcpp_result_gen; END_RCPP } // optim_zipln_R_exact -arma::mat optim_zipln_R_exact(const arma::mat& Y, const arma::mat& X, const arma::mat& O, const arma::mat& M, const arma::mat& S, const arma::mat& Pi, const arma::mat& B); -RcppExport SEXP _PLNmodels_optim_zipln_R_exact(SEXP YSEXP, SEXP XSEXP, SEXP OSEXP, SEXP MSEXP, SEXP SSEXP, SEXP PiSEXP, SEXP BSEXP) { +arma::mat optim_zipln_R_exact(const arma::mat& Y, const arma::mat& X, const arma::mat& O, const arma::mat& M, const arma::mat& S2, const arma::mat& Pi, const arma::mat& B); +RcppExport SEXP _PLNmodels_optim_zipln_R_exact(SEXP YSEXP, SEXP XSEXP, SEXP OSEXP, SEXP MSEXP, SEXP S2SEXP, SEXP PiSEXP, SEXP BSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; @@ -277,16 +402,16 @@ BEGIN_RCPP Rcpp::traits::input_parameter< const arma::mat& >::type X(XSEXP); Rcpp::traits::input_parameter< const arma::mat& >::type O(OSEXP); Rcpp::traits::input_parameter< const arma::mat& >::type M(MSEXP); - Rcpp::traits::input_parameter< const arma::mat& >::type S(SSEXP); + Rcpp::traits::input_parameter< const arma::mat& >::type S2(S2SEXP); Rcpp::traits::input_parameter< const arma::mat& >::type Pi(PiSEXP); Rcpp::traits::input_parameter< const arma::mat& >::type B(BSEXP); - rcpp_result_gen = Rcpp::wrap(optim_zipln_R_exact(Y, X, O, M, S, Pi, B)); + rcpp_result_gen = Rcpp::wrap(optim_zipln_R_exact(Y, X, O, M, S2, Pi, B)); return rcpp_result_gen; END_RCPP } // optim_zipln_M -Rcpp::List optim_zipln_M(const arma::mat& init_M, const arma::mat& Y, const arma::mat& X, const arma::mat& O, const arma::mat& R, const arma::mat& S, const arma::mat& B, const arma::mat& Omega, const Rcpp::List& configuration); -RcppExport SEXP _PLNmodels_optim_zipln_M(SEXP init_MSEXP, SEXP YSEXP, SEXP XSEXP, SEXP OSEXP, SEXP RSEXP, SEXP SSEXP, SEXP BSEXP, SEXP OmegaSEXP, SEXP configurationSEXP) { +Rcpp::List optim_zipln_M(const arma::mat& init_M, const arma::mat& Y, const arma::mat& X, const arma::mat& O, const arma::mat& R, const arma::mat& S2, const arma::mat& B, const arma::mat& Omega, const Rcpp::List& configuration); +RcppExport SEXP _PLNmodels_optim_zipln_M(SEXP init_MSEXP, SEXP YSEXP, SEXP XSEXP, SEXP OSEXP, SEXP RSEXP, SEXP S2SEXP, SEXP BSEXP, SEXP OmegaSEXP, SEXP configurationSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; @@ -295,28 +420,67 @@ BEGIN_RCPP Rcpp::traits::input_parameter< const arma::mat& >::type X(XSEXP); Rcpp::traits::input_parameter< const arma::mat& >::type O(OSEXP); Rcpp::traits::input_parameter< const arma::mat& >::type R(RSEXP); - Rcpp::traits::input_parameter< const arma::mat& >::type S(SSEXP); + Rcpp::traits::input_parameter< const arma::mat& >::type S2(S2SEXP); Rcpp::traits::input_parameter< const arma::mat& >::type B(BSEXP); Rcpp::traits::input_parameter< const arma::mat& >::type Omega(OmegaSEXP); Rcpp::traits::input_parameter< const Rcpp::List& >::type configuration(configurationSEXP); - rcpp_result_gen = Rcpp::wrap(optim_zipln_M(init_M, Y, X, O, R, S, B, Omega, configuration)); + rcpp_result_gen = Rcpp::wrap(optim_zipln_M(init_M, Y, X, O, R, S2, B, Omega, configuration)); return rcpp_result_gen; END_RCPP } -// optim_zipln_S -Rcpp::List optim_zipln_S(const arma::mat& init_S, const arma::mat& O, const arma::mat& M, const arma::mat& R, const arma::mat& B, const arma::vec& diag_Omega, const Rcpp::List& configuration); -RcppExport SEXP _PLNmodels_optim_zipln_S(SEXP init_SSEXP, SEXP OSEXP, SEXP MSEXP, SEXP RSEXP, SEXP BSEXP, SEXP diag_OmegaSEXP, SEXP configurationSEXP) { +// optim_zipln_psi +Rcpp::List optim_zipln_psi(const arma::mat& init_S2, const arma::mat& O, const arma::mat& M, const arma::mat& R, const arma::mat& B, const arma::vec& diag_Omega, const Rcpp::List& configuration); +RcppExport SEXP _PLNmodels_optim_zipln_psi(SEXP init_S2SEXP, SEXP OSEXP, SEXP MSEXP, SEXP RSEXP, SEXP BSEXP, SEXP diag_OmegaSEXP, SEXP configurationSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< const arma::mat& >::type init_S(init_SSEXP); + Rcpp::traits::input_parameter< const arma::mat& >::type init_S2(init_S2SEXP); Rcpp::traits::input_parameter< const arma::mat& >::type O(OSEXP); Rcpp::traits::input_parameter< const arma::mat& >::type M(MSEXP); Rcpp::traits::input_parameter< const arma::mat& >::type R(RSEXP); Rcpp::traits::input_parameter< const arma::mat& >::type B(BSEXP); Rcpp::traits::input_parameter< const arma::vec& >::type diag_Omega(diag_OmegaSEXP); Rcpp::traits::input_parameter< const Rcpp::List& >::type configuration(configurationSEXP); - rcpp_result_gen = Rcpp::wrap(optim_zipln_S(init_S, O, M, R, B, diag_Omega, configuration)); + rcpp_result_gen = Rcpp::wrap(optim_zipln_psi(init_S2, O, M, R, B, diag_Omega, configuration)); + return rcpp_result_gen; +END_RCPP +} +// ve_step_zipln_nlopt +Rcpp::List ve_step_zipln_nlopt(const arma::mat& init_M, const arma::mat& init_S2, const arma::mat& Y, const arma::mat& X, const arma::mat& O, const arma::mat& Pi, const arma::mat& B, const arma::mat& Omega, const Rcpp::List& configuration); +RcppExport SEXP _PLNmodels_ve_step_zipln_nlopt(SEXP init_MSEXP, SEXP init_S2SEXP, SEXP YSEXP, SEXP XSEXP, SEXP OSEXP, SEXP PiSEXP, SEXP BSEXP, SEXP OmegaSEXP, SEXP configurationSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< const arma::mat& >::type init_M(init_MSEXP); + Rcpp::traits::input_parameter< const arma::mat& >::type init_S2(init_S2SEXP); + Rcpp::traits::input_parameter< const arma::mat& >::type Y(YSEXP); + Rcpp::traits::input_parameter< const arma::mat& >::type X(XSEXP); + Rcpp::traits::input_parameter< const arma::mat& >::type O(OSEXP); + Rcpp::traits::input_parameter< const arma::mat& >::type Pi(PiSEXP); + Rcpp::traits::input_parameter< const arma::mat& >::type B(BSEXP); + Rcpp::traits::input_parameter< const arma::mat& >::type Omega(OmegaSEXP); + Rcpp::traits::input_parameter< const Rcpp::List& >::type configuration(configurationSEXP); + rcpp_result_gen = Rcpp::wrap(ve_step_zipln_nlopt(init_M, init_S2, Y, X, O, Pi, B, Omega, configuration)); + return rcpp_result_gen; +END_RCPP +} +// ve_step_zipln_newton +Rcpp::List ve_step_zipln_newton(const arma::mat& init_M, const arma::mat& init_S2, const arma::mat& Y, const arma::mat& X, const arma::mat& O, const arma::mat& Pi, const arma::mat& B, const arma::mat& Omega, const int maxiter, const double ftol_rel); +RcppExport SEXP _PLNmodels_ve_step_zipln_newton(SEXP init_MSEXP, SEXP init_S2SEXP, SEXP YSEXP, SEXP XSEXP, SEXP OSEXP, SEXP PiSEXP, SEXP BSEXP, SEXP OmegaSEXP, SEXP maxiterSEXP, SEXP ftol_relSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< const arma::mat& >::type init_M(init_MSEXP); + Rcpp::traits::input_parameter< const arma::mat& >::type init_S2(init_S2SEXP); + Rcpp::traits::input_parameter< const arma::mat& >::type Y(YSEXP); + Rcpp::traits::input_parameter< const arma::mat& >::type X(XSEXP); + Rcpp::traits::input_parameter< const arma::mat& >::type O(OSEXP); + Rcpp::traits::input_parameter< const arma::mat& >::type Pi(PiSEXP); + Rcpp::traits::input_parameter< const arma::mat& >::type B(BSEXP); + Rcpp::traits::input_parameter< const arma::mat& >::type Omega(OmegaSEXP); + Rcpp::traits::input_parameter< const int >::type maxiter(maxiterSEXP); + Rcpp::traits::input_parameter< const double >::type ftol_rel(ftol_relSEXP); + rcpp_result_gen = Rcpp::wrap(ve_step_zipln_newton(init_M, init_S2, Y, X, O, Pi, B, Omega, maxiter, ftol_rel)); return rcpp_result_gen; END_RCPP } @@ -348,17 +512,26 @@ END_RCPP } static const R_CallMethodDef CallEntries[] = { - {"_PLNmodels_cpp_test_nlopt", (DL_FUNC) &_PLNmodels_cpp_test_nlopt, 0}, + {"_PLNmodels_builtin_optimize_full", (DL_FUNC) &_PLNmodels_builtin_optimize_full, 3}, + {"_PLNmodels_builtin_optimize_vestep_full", (DL_FUNC) &_PLNmodels_builtin_optimize_vestep_full, 5}, + {"_PLNmodels_builtin_optimize_diagonal", (DL_FUNC) &_PLNmodels_builtin_optimize_diagonal, 3}, + {"_PLNmodels_builtin_optimize_vestep_diagonal", (DL_FUNC) &_PLNmodels_builtin_optimize_vestep_diagonal, 5}, + {"_PLNmodels_builtin_optimize_spherical", (DL_FUNC) &_PLNmodels_builtin_optimize_spherical, 3}, + {"_PLNmodels_builtin_optimize_vestep_spherical", (DL_FUNC) &_PLNmodels_builtin_optimize_vestep_spherical, 5}, + {"_PLNmodels_builtin_optimize_fixed", (DL_FUNC) &_PLNmodels_builtin_optimize_fixed, 3}, + {"_PLNmodels_builtin_optimize_rank", (DL_FUNC) &_PLNmodels_builtin_optimize_rank, 3}, + {"_PLNmodels_builtin_optimize_vestep_rank", (DL_FUNC) &_PLNmodels_builtin_optimize_vestep_rank, 5}, {"_PLNmodels_nlopt_optimize_diagonal", (DL_FUNC) &_PLNmodels_nlopt_optimize_diagonal, 3}, {"_PLNmodels_nlopt_optimize_vestep_diagonal", (DL_FUNC) &_PLNmodels_nlopt_optimize_vestep_diagonal, 5}, {"_PLNmodels_nlopt_optimize_fixed", (DL_FUNC) &_PLNmodels_nlopt_optimize_fixed, 3}, - {"_PLNmodels_nlopt_optimize", (DL_FUNC) &_PLNmodels_nlopt_optimize, 3}, - {"_PLNmodels_nlopt_optimize_vestep", (DL_FUNC) &_PLNmodels_nlopt_optimize_vestep, 5}, - {"_PLNmodels_nlopt_optimize_genetic_modeling", (DL_FUNC) &_PLNmodels_nlopt_optimize_genetic_modeling, 7}, + {"_PLNmodels_nlopt_optimize_full", (DL_FUNC) &_PLNmodels_nlopt_optimize_full, 3}, + {"_PLNmodels_nlopt_optimize_vestep_full", (DL_FUNC) &_PLNmodels_nlopt_optimize_vestep_full, 5}, {"_PLNmodels_nlopt_optimize_rank", (DL_FUNC) &_PLNmodels_nlopt_optimize_rank, 3}, {"_PLNmodels_nlopt_optimize_vestep_rank", (DL_FUNC) &_PLNmodels_nlopt_optimize_vestep_rank, 5}, {"_PLNmodels_nlopt_optimize_spherical", (DL_FUNC) &_PLNmodels_nlopt_optimize_spherical, 3}, {"_PLNmodels_nlopt_optimize_vestep_spherical", (DL_FUNC) &_PLNmodels_nlopt_optimize_vestep_spherical, 5}, + {"_PLNmodels_cpp_test_nlopt", (DL_FUNC) &_PLNmodels_cpp_test_nlopt, 0}, + {"_PLNmodels_nlopt_optimize_genetic_modeling", (DL_FUNC) &_PLNmodels_nlopt_optimize_genetic_modeling, 7}, {"_PLNmodels_zipln_vloglik", (DL_FUNC) &_PLNmodels_zipln_vloglik, 9}, {"_PLNmodels_optim_zipln_Omega_full", (DL_FUNC) &_PLNmodels_optim_zipln_Omega_full, 4}, {"_PLNmodels_optim_zipln_Omega_spherical", (DL_FUNC) &_PLNmodels_optim_zipln_Omega_spherical, 4}, @@ -368,7 +541,9 @@ static const R_CallMethodDef CallEntries[] = { {"_PLNmodels_optim_zipln_R_var", (DL_FUNC) &_PLNmodels_optim_zipln_R_var, 7}, {"_PLNmodels_optim_zipln_R_exact", (DL_FUNC) &_PLNmodels_optim_zipln_R_exact, 7}, {"_PLNmodels_optim_zipln_M", (DL_FUNC) &_PLNmodels_optim_zipln_M, 9}, - {"_PLNmodels_optim_zipln_S", (DL_FUNC) &_PLNmodels_optim_zipln_S, 7}, + {"_PLNmodels_optim_zipln_psi", (DL_FUNC) &_PLNmodels_optim_zipln_psi, 7}, + {"_PLNmodels_ve_step_zipln_nlopt", (DL_FUNC) &_PLNmodels_ve_step_zipln_nlopt, 9}, + {"_PLNmodels_ve_step_zipln_newton", (DL_FUNC) &_PLNmodels_ve_step_zipln_newton, 10}, {"_PLNmodels_cpp_test_packing", (DL_FUNC) &_PLNmodels_cpp_test_packing, 0}, {"_PLNmodels_get_sandwich_variance_B", (DL_FUNC) &_PLNmodels_get_sandwich_variance_B, 6}, {NULL, NULL, 0} diff --git a/src/builtin_covariance_pln.h b/src/builtin_covariance_pln.h new file mode 100644 index 00000000..00209b99 --- /dev/null +++ b/src/builtin_covariance_pln.h @@ -0,0 +1,292 @@ +#pragma once +#include +#include "utils.h" + +// ───────────────────────────────────────────────────────────────────────────── +// Shared base for dense (full p×p) Omega variants (FullCovTraits and FixedCovTraits). +// Contains the static methods that are identical in both. Derived traits use +// struct inheritance to expose these methods without repetition. +// ───────────────────────────────────────────────────────────────────────────── +struct DenseOmegaImpl { + struct State { + arma::mat Omega; + arma::vec diag_Omega; + }; + + static arma::mat times_Omega(const arma::mat & M, const State & s) { return M * s.Omega; } + + static double penalty_M(const arma::mat & MO, const arma::mat & M, const arma::vec & w) { + return 0.5 * arma::as_scalar(w.t() * arma::sum(MO % M, 1)); + } + + static double penalty_S(const arma::mat & S2, const State & s, const arma::vec & w) { + return 0.5 * arma::dot(s.diag_Omega, (w.t() * S2).t()); + } + + // Joint Newton step for (M, ψ) where ψ = log(S²): diagonal 2×2 per (i,j). + // MO (output) = M * Omega — returned so the caller can reuse it for penalty/Armijo + // without an extra O(n p²) matrix product. + static void compute_joint_step_MS( + const arma::mat & M, const State & s, + const arma::mat & A, const arma::mat & S2, + const arma::mat & Y, const arma::vec & w, const arma::mat & ones_row, + arma::mat & grad_M, arma::mat & step_M, + arma::mat & grad_psi, arma::mat & step_psi, + arma::mat & MO) + { + MO = M * s.Omega; + const arma::mat omega_d = ones_row * s.diag_Omega.t(); + const arma::mat AS2 = A % S2; + + grad_M = MO + A - Y; grad_M.each_col() %= w; + grad_psi = 0.5 * (AS2 + omega_d % S2 - 1.0); grad_psi.each_col() %= w; + + arma::mat h_pp = 0.5 * (S2 % (A % (1.0 + 0.5*S2) + omega_d)); h_pp.each_col() %= w; + arma::mat h_mp = 0.5 * AS2; h_mp.each_col() %= w; + arma::mat h_mm = A + omega_d; h_mm.each_col() %= w; + + arma::mat det = h_mm % h_pp - h_mp % h_mp; + det.clamp(1e-20, arma::datum::inf); + step_M = (h_pp % grad_M - h_mp % grad_psi) / det; + step_psi = (h_mm % grad_psi - h_mp % grad_M ) / det; + } + + static arma::vec final_loglik(const arma::mat & Y, const arma::mat & Z, const arma::mat & A, + const arma::mat & M, const arma::mat & psi, const State & s) { + const arma::mat S2 = arma::exp(psi); + return arma::sum(Y % Z - A + 0.5 * psi + - 0.5 * ((M * s.Omega) % M + S2 * arma::diagmat(s.Omega)), 1) + + 0.5 * std::real(arma::log_det(s.Omega)) + ki(Y); + } +}; + +// ───────────────────────────────────────────────────────────────────────────── +// Full (dense p×p) covariance +// ───────────────────────────────────────────────────────────────────────────── +struct FullCovTraits : DenseOmegaImpl { + struct State : DenseOmegaImpl::State { + arma::mat Sigma; + + State(const arma::mat & M, const arma::mat & S2, const arma::vec & w, double w_bar) { + update(M, S2, w, w_bar); + } + explicit State(const arma::mat & omega) { + Omega = omega; + diag_Omega = arma::diagvec(omega); + } + void update(const arma::mat & M, const arma::mat & S2, const arma::vec & w, double w_bar) { + Sigma = (1./w_bar) * (M.t() * (M.each_col() % w) + arma::diagmat(w.t() * S2)); + Omega = arma::inv_sympd(Sigma); + diag_Omega = arma::diagvec(Omega); + } + }; + + static void mstep(State & s, const arma::mat & M, const arma::mat & S2, + const arma::vec & w, double w_bar, arma::uword /*p*/) { + s.update(M, S2, w, w_bar); + } + + static double elbo_cov(const State & s, double w_bar, arma::uword /*p*/) { + return -0.5 * w_bar * std::real(arma::log_det(s.Sigma)); + } + + static Rcpp::List output_cov(const arma::mat & /*M*/, const arma::mat & /*S2*/, + const arma::vec & /*w*/, double /*w_bar*/, const State & s) { + return Rcpp::List::create(Rcpp::Named("Sigma", s.Sigma), Rcpp::Named("Omega", s.Omega)); + } + + static constexpr bool has_em = true; +}; + +// ───────────────────────────────────────────────────────────────────────────── +// Diagonal covariance +// ───────────────────────────────────────────────────────────────────────────── +struct DiagonalCovTraits { + struct State { + arma::rowvec omega2; + arma::rowvec sigma2; + + State(const arma::mat & M, const arma::mat & S2, const arma::vec & w, double w_bar) { + update(M, S2, w, w_bar); + } + explicit State(const arma::mat & omega_mat) { + omega2 = arma::diagvec(omega_mat).t(); + sigma2 = arma::pow(omega2, -1); + } + void update(const arma::mat & M, const arma::mat & S2, const arma::vec & w, double w_bar) { + sigma2 = (w.t() * (M % M + S2)) / w_bar; + omega2 = arma::pow(sigma2, -1); + } + }; + + static arma::mat times_Omega(const arma::mat & M, const State & s) { return M.each_row() % s.omega2; } + + static double penalty_M(const arma::mat & MO, const arma::mat & M, const arma::vec & w) { + return 0.5 * arma::as_scalar(w.t() * arma::sum(MO % M, 1)); + } + + static double penalty_S(const arma::mat & S2, const State & s, const arma::vec & w) { + return 0.5 * arma::as_scalar((w.t() * S2) * s.omega2.t()); + } + + // MO (output) = M.each_row() % omega2 — returned for caller reuse. + static void compute_joint_step_MS( + const arma::mat & M, const State & s, + const arma::mat & A, const arma::mat & S2, + const arma::mat & Y, const arma::vec & w, const arma::mat & ones_row, + arma::mat & grad_M, arma::mat & step_M, + arma::mat & grad_psi, arma::mat & step_psi, + arma::mat & MO) + { + const arma::mat omega_d = ones_row * s.omega2; + const arma::mat AS2 = A % S2; + MO = M.each_row() % s.omega2; + grad_M = MO + A - Y; grad_M.each_col() %= w; + grad_psi = 0.5 * (AS2 + omega_d % S2 - 1.0); grad_psi.each_col() %= w; + + arma::mat h_pp = 0.5 * (S2 % (A % (1.0 + 0.5*S2) + omega_d)); h_pp.each_col() %= w; + arma::mat h_mp = 0.5 * AS2; h_mp.each_col() %= w; + arma::mat h_mm = A + omega_d; h_mm.each_col() %= w; + + arma::mat det = h_mm % h_pp - h_mp % h_mp; + det.clamp(1e-20, arma::datum::inf); + step_M = (h_pp % grad_M - h_mp % grad_psi) / det; + step_psi = (h_mm % grad_psi - h_mp % grad_M ) / det; + } + + static void mstep(State & s, const arma::mat & M, const arma::mat & S2, + const arma::vec & w, double w_bar, arma::uword /*p*/) { + s.update(M, S2, w, w_bar); + } + + static double elbo_cov(const State & s, double w_bar, arma::uword /*p*/) { + return -0.5 * w_bar * arma::accu(arma::log(s.sigma2)); + } + + static arma::vec final_loglik(const arma::mat & Y, const arma::mat & Z, const arma::mat & A, + const arma::mat & M, const arma::mat & psi, const State & s) { + const arma::mat S2 = arma::exp(psi); + const arma::vec omega2_v = s.omega2.t(); + return arma::sum(Y % Z - A + 0.5 * psi, 1) + - 0.5 * (M % M + S2) * omega2_v + + 0.5 * arma::accu(arma::log(omega2_v)) + ki(Y); + } + + static Rcpp::List output_cov(const arma::mat & /*M*/, const arma::mat & /*S2*/, + const arma::vec & /*w*/, double /*w_bar*/, const State & s) { + arma::uword p = s.omega2.n_elem; + arma::sp_mat Sigma_out(p, p); Sigma_out.diag() = s.sigma2.t(); + arma::sp_mat Omega_out(p, p); Omega_out.diag() = s.omega2.t(); + return Rcpp::List::create(Rcpp::Named("Sigma", Sigma_out), Rcpp::Named("Omega", Omega_out)); + } + + static constexpr bool has_em = true; +}; + +// ───────────────────────────────────────────────────────────────────────────── +// Spherical covariance (scalar sigma²) +// ───────────────────────────────────────────────────────────────────────────── +struct SphericalCovTraits { + struct State { + double omega2; + double sigma2; + + State(const arma::mat & M, const arma::mat & S2, const arma::vec & w, double w_bar) { + update(M, S2, w, w_bar); + } + explicit State(const arma::mat & omega_mat) + : omega2(omega_mat(0, 0)), sigma2(1.0 / omega_mat(0, 0)) {} + void update(const arma::mat & M, const arma::mat & S2, const arma::vec & w, double w_bar) { + arma::uword p = M.n_cols; + sigma2 = arma::accu(arma::diagmat(w) * (M % M + S2)) / (double(p) * w_bar); + omega2 = 1.0 / sigma2; + } + }; + + static arma::mat times_Omega(const arma::mat & M, const State & s) { return s.omega2 * M; } + + static double penalty_S(const arma::mat & S2, const State & s, const arma::vec & w) { + return 0.5 * s.omega2 * arma::dot(w, arma::sum(S2, 1)); + } + + // MO (output) = omega2 * M — returned for caller reuse. + static void compute_joint_step_MS( + const arma::mat & M, const State & s, + const arma::mat & A, const arma::mat & S2, + const arma::mat & Y, const arma::vec & w, const arma::mat & /*ones_row*/, + arma::mat & grad_M, arma::mat & step_M, + arma::mat & grad_psi, arma::mat & step_psi, + arma::mat & MO) + { + const arma::mat AS2 = A % S2; + MO = s.omega2 * M; + grad_M = MO + A - Y; grad_M.each_col() %= w; + grad_psi = 0.5 * (AS2 + s.omega2 * S2 - 1.0); grad_psi.each_col() %= w; + + arma::mat h_pp = 0.5 * (S2 % (A % (1.0 + 0.5*S2) + s.omega2)); h_pp.each_col() %= w; + arma::mat h_mp = 0.5 * AS2; h_mp.each_col() %= w; + arma::mat h_mm = A + s.omega2; h_mm.each_col() %= w; + + arma::mat det = h_mm % h_pp - h_mp % h_mp; + det.clamp(1e-20, arma::datum::inf); + step_M = (h_pp % grad_M - h_mp % grad_psi) / det; + step_psi = (h_mm % grad_psi - h_mp % grad_M ) / det; + } + + static double penalty_M(const arma::mat & MO, const arma::mat & M, const arma::vec & w) { + return 0.5 * arma::as_scalar(w.t() * arma::sum(MO % M, 1)); + } + + static void mstep(State & s, const arma::mat & M, const arma::mat & S2, + const arma::vec & w, double w_bar, arma::uword /*p*/) { + s.update(M, S2, w, w_bar); + } + + static double elbo_cov(const State & s, double w_bar, arma::uword p) { + return -0.5 * w_bar * double(p) * std::log(s.sigma2); + } + + static arma::vec final_loglik(const arma::mat & Y, const arma::mat & Z, const arma::mat & A, + const arma::mat & M, const arma::mat & psi, const State & s) { + const arma::mat S2 = arma::exp(psi); + return arma::sum(Y % Z - A - 0.5 * (M % M + S2) / s.sigma2 + 0.5 * (psi - std::log(s.sigma2)), 1) + + ki(Y); + } + + static Rcpp::List output_cov(const arma::mat & M, const arma::mat & /*S2*/, + const arma::vec & /*w*/, double /*w_bar*/, const State & s) { + arma::uword p = M.n_cols; + arma::sp_mat Sigma_out(p, p); Sigma_out.diag().fill(s.sigma2); + arma::sp_mat Omega_out(p, p); Omega_out.diag().fill(s.omega2); + return Rcpp::List::create(Rcpp::Named("Sigma", Sigma_out), Rcpp::Named("Omega", Omega_out)); + } + + static constexpr bool has_em = true; +}; + +// ───────────────────────────────────────────────────────────────────────────── +// Fixed covariance (Omega provided externally, not estimated) +// ───────────────────────────────────────────────────────────────────────────── +struct FixedCovTraits : DenseOmegaImpl { + struct State : DenseOmegaImpl::State { + explicit State(const arma::mat & omega) { + Omega = omega; + diag_Omega = arma::diagvec(omega); + } + }; + + static void mstep(State & /*s*/, const arma::mat & /*M*/, const arma::mat & /*S2*/, + const arma::vec & /*w*/, double /*w_bar*/, arma::uword /*p*/) {} + + static double elbo_cov(const State & /*s*/, double /*w_bar*/, arma::uword /*p*/) { + return 0.0; + } + + static Rcpp::List output_cov(const arma::mat & M, const arma::mat & S2, + const arma::vec & w, double w_bar, const State & s) { + arma::mat Sigma = (M.t() * (M.each_col() % w) + arma::diagmat(w.t() * S2)) / w_bar; + return Rcpp::List::create(Rcpp::Named("Sigma", Sigma), Rcpp::Named("Omega", s.Omega)); + } + + static constexpr bool has_em = false; +}; diff --git a/src/builtin_newton_pln.h b/src/builtin_newton_pln.h new file mode 100644 index 00000000..d1ca201e --- /dev/null +++ b/src/builtin_newton_pln.h @@ -0,0 +1,215 @@ +#pragma once +#include +#include "utils.h" +#include "builtin_covariance_pln.h" + +// M_full parameterization: M is the full variational mean of Z_i (= X_i*B + M_res), +// consistent with the ZIPLN convention. M_res = M - X*B is computed locally for KL. +// +// B is profiled at every Newton step via the envelope theorem: +// B = P_X * M = (X'WX)^{-1} X'W M (closed-form optimum for current M) +// M_res = M - X*B (projection orthogonal to col(X)) +// The gradient of J_profiled w.r.t. M equals the gradient w.r.t. M_res (envelope theorem). +// +// Input/output: M is in M_full format throughout. + +// Mirror of nlopt_full_cov structure: outer EM loop (max_em) over an inner VE-step that +// optimizes (M, ψ) jointly for fixed Omega until convergence (ftol), then one Omega M-step. +// Joint Newton step per inner iteration: diagonal 2×2 per (i,j) with cross-term H_Mψ. +template +Rcpp::List builtin_optimize_pln_impl( + const arma::mat & Y, const arma::mat & X, const arma::mat & O, const arma::vec & w, + arma::mat B, arma::mat M, arma::mat S2, + typename Traits::State state, + int maxiter, double ftol, int max_em, double em_tol +) { + const int n = Y.n_rows; + const arma::uword p = Y.n_cols; + const double w_bar = arma::accu(w); + const double c1 = 1e-4; + const arma::mat ones_row = arma::ones(n, 1); + + const arma::mat Xw = X.each_col() % w; + const arma::mat XtWX = X.t() * Xw; + const arma::mat P_X = (X.n_cols > 0) ? arma::solve(XtWX, Xw.t()) : arma::mat(0, n); + + arma::mat psi = arma::log(S2); + + std::vector objective_vec; + double elbo_prev = -arma::datum::inf; + int last_status = 5; + + B = P_X * M; + arma::mat Z = O + M; + arma::mat A = arma::exp(Z + 0.5 * S2); + + for (int em_iter = 0; em_iter < std::max(1, max_em); em_iter++) { + // ── Inner VE-step: optimize (M, ψ) to convergence for the current Omega/state ── + double inner_prev = arma::datum::inf; + for (int it = 0; it < maxiter; it++) { + const arma::mat XB = X * B; + const arma::mat M_res = M - XB; + + // Joint Newton step: compute_joint_step_MS also returns MO = M_res * Omega + // so we reuse it for the Armijo penalty — avoids a redundant O(n p²) product. + arma::mat grad_M, step_M, grad_psi, step_psi, MresO; + Traits::compute_joint_step_MS(M_res, state, A, S2, Y, w, ones_row, + grad_M, step_M, grad_psi, step_psi, MresO); + const arma::mat Q_step = step_M - X * (P_X * step_M); + const arma::mat QstepO = Traits::times_Omega(Q_step, state); + double f0 = arma::accu(w.t() * (A - Y % Z - 0.5 * psi)) + + Traits::penalty_M(MresO, M_res, w) + Traits::penalty_S(S2, state, w); + double slope = -arma::accu(grad_M % Q_step) - arma::accu(grad_psi % step_psi); + if (slope >= 0) slope = -arma::accu(grad_M % step_M) - arma::accu(grad_psi % step_psi); + double alpha = 1.0; + for (int ls = 0; ls < 20; ls++) { + const arma::mat MresT = M_res - alpha * Q_step; + const arma::mat MresOt = MresO - alpha * QstepO; + const arma::mat psit = psi - alpha * step_psi; + const arma::mat S2t = arma::exp(psit); + const arma::mat Zt = Z - alpha * step_M; + const arma::mat At = arma::exp(Zt + 0.5 * S2t); + if (arma::accu(w.t() * (At - Y % Zt - 0.5 * psit)) + + Traits::penalty_M(MresOt, MresT, w) + Traits::penalty_S(S2t, state, w) + <= f0 + c1 * alpha * slope) break; + alpha *= 0.5; + } + M -= alpha * step_M; + psi -= alpha * step_psi; + S2 = arma::exp(psi); + B = P_X * M; + Z = O + M; + A = arma::exp(Z + 0.5 * S2); + + objective_vec.push_back(f0); + if (it > 0 && converged(f0, inner_prev, ftol)) break; + inner_prev = f0; + } + + // ── VM-step: update Omega/Sigma (skipped for fixed covariance) ── + const arma::mat M_res_cur = M - X * B; + if (Traits::has_em) { + Traits::mstep(state, M_res_cur, S2, w, w_bar, p); + } else { + last_status = 3; break; // fixed covariance: inner loop already converged + } + + // ── Outer ELBO for convergence ── + double elbo = arma::accu(w.t() * (Y % Z - A + 0.5 * psi)) + + Traits::elbo_cov(state, w_bar, p); + if (em_iter > 0 && converged(elbo, elbo_prev, em_tol)) { last_status = 3; break; } + elbo_prev = elbo; + } + + S2 = arma::exp(psi); + arma::mat M_res = M - X * B; + Z = O + M; + A = arma::exp(Z + 0.5 * S2); + + arma::vec loglik = Traits::final_loglik(Y, Z, A, M_res, psi, state); + Rcpp::NumericVector Ji = Rcpp::as(Rcpp::wrap(loglik)); + Ji.attr("weights") = w; + Rcpp::List cov_out = Traits::output_cov(M_res, S2, w, w_bar, state); + return Rcpp::List::create( + Rcpp::Named("B", B ), + Rcpp::Named("M", M ), + Rcpp::Named("S2", S2 ), + Rcpp::Named("Z", Z ), + Rcpp::Named("A", A ), + Rcpp::Named("Sigma", cov_out["Sigma"]), + Rcpp::Named("Omega", cov_out["Omega"]), + Rcpp::Named("Ji", Ji ), + Rcpp::Named("monitoring", Rcpp::List::create( + Rcpp::Named("status", last_status ), + Rcpp::Named("backend", "newton" ), + Rcpp::Named("objective", objective_vec ), + Rcpp::Named("iterations", (int)objective_vec.size() ) + )) + ); +} + +// ───────────────────────────────────────────────────────────────────────────── +// Generic VE-step Newton optimizer (B and Omega fixed, only M and S updated). +// State must be initialized from a fixed Omega via the explicit constructor. +template +Rcpp::List builtin_vestep_pln_impl( + const arma::mat & Y, const arma::mat & X, const arma::mat & O, const arma::vec & w, + arma::mat M, arma::mat S2, + const arma::mat & B, const typename Traits::State & state, + int maxiter, double ftol +) { + const int n = Y.n_rows; + const double c1 = 1e-4; + const arma::mat ones_row = arma::ones(n, 1); + const arma::mat XB = X * B; + + arma::mat psi = arma::log(S2); + + std::vector objective_vec; + double obj_prev = arma::datum::inf; + int total_iter = 0; + + arma::mat Z = O + M; + arma::mat A = arma::exp(Z + 0.5 * S2); + + for (int it = 0; it < maxiter; it++) { + arma::mat M_res = M - XB; + + // Joint Newton step: MO = M_res * Omega returned to avoid recomputing it + // for the Armijo penalty evaluation. + arma::mat grad_M, step_M, grad_psi, step_psi, MO; + Traits::compute_joint_step_MS(M_res, state, A, S2, Y, w, ones_row, + grad_M, step_M, grad_psi, step_psi, MO); + const arma::mat dMO = Traits::times_Omega(step_M, state); + double f0 = arma::accu(w.t() * (A - Y % Z - 0.5 * psi)) + + Traits::penalty_M(MO, M_res, w) + Traits::penalty_S(S2, state, w); + double slope = -arma::accu(grad_M % step_M) - arma::accu(grad_psi % step_psi); + double alpha = 1.0; + for (int ls = 0; ls < 20; ls++) { + const arma::mat MresT = M_res - alpha * step_M; + const arma::mat MOt = MO - alpha * dMO; + const arma::mat psit = psi - alpha * step_psi; + const arma::mat S2t = arma::exp(psit); + const arma::mat Zt = Z - alpha * step_M; + const arma::mat At = arma::exp(Zt + 0.5 * S2t); + if (arma::accu(w.t() * (At - Y % Zt - 0.5 * psit)) + + Traits::penalty_M(MOt, MresT, w) + Traits::penalty_S(S2t, state, w) + <= f0 + c1 * alpha * slope) break; + alpha *= 0.5; + } + M -= alpha * step_M; + psi -= alpha * step_psi; + S2 = arma::exp(psi); + Z = O + M; + A = arma::exp(Z + 0.5 * S2); + + // Post-update objective: reuse MO_new = MO - alpha*dMO = M_res_new * Omega + // (exact incremental update, avoids an extra O(n p²) product for full cov). + const arma::mat MO_new = MO - alpha * dMO; + const arma::mat M_res_new = M - XB; + double obj = arma::accu(w.t() * (A - Y % Z - 0.5 * psi)) + + Traits::penalty_M(MO_new, M_res_new, w) + Traits::penalty_S(S2, state, w); + objective_vec.push_back(obj); + total_iter++; + + if (it > 0 && converged(obj, obj_prev, ftol)) break; + obj_prev = obj; + } + + const arma::mat M_res = M - XB; + arma::vec loglik = Traits::final_loglik(Y, Z, A, M_res, psi, state); + + Rcpp::NumericVector Ji = Rcpp::as(Rcpp::wrap(loglik)); + Ji.attr("weights") = w; + return Rcpp::List::create( + Rcpp::Named("M") = M, + Rcpp::Named("S2") = S2, + Rcpp::Named("Ji") = Ji, + Rcpp::Named("monitoring", Rcpp::List::create( + Rcpp::Named("status", 3 ), + Rcpp::Named("backend", "newton" ), + Rcpp::Named("objective", objective_vec), + Rcpp::Named("iterations", total_iter ) + )) + ); +} diff --git a/src/builtin_optim_pln.cpp b/src/builtin_optim_pln.cpp new file mode 100644 index 00000000..14d202e0 --- /dev/null +++ b/src/builtin_optim_pln.cpp @@ -0,0 +1,152 @@ +#include "RcppArmadillo.h" + +// [[Rcpp::depends(RcppArmadillo)]] + +#include "utils.h" +#include "builtin_newton_pln.h" + +// --------------------------------------------------------------------------------------- +// Builtin Newton optimizer for PLN — all covariance structures. +// Each exported function is a thin wrapper that builds the appropriate Traits::State +// and delegates to the generic builtin_optimize_pln_impl / builtin_vestep_pln_impl templates. + +// ===== FULL COVARIANCE ===== + +// [[Rcpp::export]] +Rcpp::List builtin_optimize_full( + const Rcpp::List & data , + const Rcpp::List & params, + const Rcpp::List & config +) { + const arma::mat & Y = Rcpp::as(data["Y"]); + const arma::mat & X = Rcpp::as(data["X"]); + const arma::mat & O = Rcpp::as(data["O"]); + const arma::vec & w = Rcpp::as(data["w"]); + arma::mat B = Rcpp::as(params["B"]); + arma::mat M = Rcpp::as(params["M"]); + arma::mat S2 = Rcpp::as(params["S2"]); + const NewtonConfig cfg(config); + const double w_bar = arma::accu(w); + FullCovTraits::State state(M - X * B, S2, w, w_bar); + return builtin_optimize_pln_impl(Y, X, O, w, B, M, S2, state, cfg.maxiter, cfg.ftol, cfg.max_em, cfg.em_tol); +} + +// [[Rcpp::export]] +Rcpp::List builtin_optimize_vestep_full( + const Rcpp::List & data , + const Rcpp::List & params, + const arma::mat & B, + const arma::mat & Omega, + const Rcpp::List & config +) { + const arma::mat & Y = Rcpp::as(data["Y"]); + const arma::mat & X = Rcpp::as(data["X"]); + const arma::mat & O = Rcpp::as(data["O"]); + const arma::vec & w = Rcpp::as(data["w"]); + arma::mat M = Rcpp::as(params["M"]); + arma::mat S2 = Rcpp::as(params["S2"]); + const NewtonConfig cfg(config); + FullCovTraits::State state(Omega); + return builtin_vestep_pln_impl(Y, X, O, w, M, S2, B, state, cfg.maxiter, cfg.ftol); +} + +// ===== DIAGONAL COVARIANCE ===== + +// [[Rcpp::export]] +Rcpp::List builtin_optimize_diagonal( + const Rcpp::List & data , + const Rcpp::List & params, + const Rcpp::List & config +) { + const arma::mat & Y = Rcpp::as(data["Y"]); + const arma::mat & X = Rcpp::as(data["X"]); + const arma::mat & O = Rcpp::as(data["O"]); + const arma::vec & w = Rcpp::as(data["w"]); + arma::mat B = Rcpp::as(params["B"]); + arma::mat M = Rcpp::as(params["M"]); + arma::mat S2 = Rcpp::as(params["S2"]); + const NewtonConfig cfg(config); + const double w_bar = arma::accu(w); + DiagonalCovTraits::State state(M - X * B, S2, w, w_bar); + return builtin_optimize_pln_impl(Y, X, O, w, B, M, S2, state, cfg.maxiter, cfg.ftol, cfg.max_em, cfg.em_tol); +} + +// [[Rcpp::export]] +Rcpp::List builtin_optimize_vestep_diagonal( + const Rcpp::List & data , + const Rcpp::List & params, + const arma::mat & B, + const arma::mat & Omega, + const Rcpp::List & config +) { + const arma::mat & Y = Rcpp::as(data["Y"]); + const arma::mat & X = Rcpp::as(data["X"]); + const arma::mat & O = Rcpp::as(data["O"]); + const arma::vec & w = Rcpp::as(data["w"]); + arma::mat M = Rcpp::as(params["M"]); + arma::mat S2 = Rcpp::as(params["S2"]); + const NewtonConfig cfg(config); + DiagonalCovTraits::State state(Omega); + return builtin_vestep_pln_impl(Y, X, O, w, M, S2, B, state, cfg.maxiter, cfg.ftol); +} + +// ===== SPHERICAL COVARIANCE ===== + +// [[Rcpp::export]] +Rcpp::List builtin_optimize_spherical( + const Rcpp::List & data , + const Rcpp::List & params, + const Rcpp::List & config +) { + const arma::mat & Y = Rcpp::as(data["Y"]); + const arma::mat & X = Rcpp::as(data["X"]); + const arma::mat & O = Rcpp::as(data["O"]); + const arma::vec & w = Rcpp::as(data["w"]); + arma::mat B = Rcpp::as(params["B"]); + arma::mat M = Rcpp::as(params["M"]); + arma::mat S2 = Rcpp::as(params["S2"]); + const NewtonConfig cfg(config); + const double w_bar = arma::accu(w); + SphericalCovTraits::State state(M - X * B, S2, w, w_bar); + return builtin_optimize_pln_impl(Y, X, O, w, B, M, S2, state, cfg.maxiter, cfg.ftol, cfg.max_em, cfg.em_tol); +} + +// [[Rcpp::export]] +Rcpp::List builtin_optimize_vestep_spherical( + const Rcpp::List & data , + const Rcpp::List & params, + const arma::mat & B, + const arma::mat & Omega, + const Rcpp::List & config +) { + const arma::mat & Y = Rcpp::as(data["Y"]); + const arma::mat & X = Rcpp::as(data["X"]); + const arma::mat & O = Rcpp::as(data["O"]); + const arma::vec & w = Rcpp::as(data["w"]); + arma::mat M = Rcpp::as(params["M"]); + arma::mat S2 = Rcpp::as(params["S2"]); + const NewtonConfig cfg(config); + SphericalCovTraits::State state(Omega); + return builtin_vestep_pln_impl(Y, X, O, w, M, S2, B, state, cfg.maxiter, cfg.ftol); +} + +// ===== FIXED COVARIANCE (Omega provided externally, no VE step exported) ===== + +// [[Rcpp::export]] +Rcpp::List builtin_optimize_fixed( + const Rcpp::List & data , + const Rcpp::List & params, + const Rcpp::List & config +) { + const arma::mat & Y = Rcpp::as(data["Y"]); + const arma::mat & X = Rcpp::as(data["X"]); + const arma::mat & O = Rcpp::as(data["O"]); + const arma::vec & w = Rcpp::as(data["w"]); + arma::mat B = Rcpp::as(params["B"]); + arma::mat M = Rcpp::as(params["M"]); + arma::mat S2 = Rcpp::as(params["S2"]); + arma::mat Omega = Rcpp::as(params["Omega"]); + const NewtonConfig cfg(config); + FixedCovTraits::State state(Omega); + return builtin_optimize_pln_impl(Y, X, O, w, B, M, S2, state, cfg.maxiter, cfg.ftol, cfg.max_em, cfg.em_tol); +} diff --git a/src/builtin_optim_plnpca.cpp b/src/builtin_optim_plnpca.cpp new file mode 100644 index 00000000..23d3a171 --- /dev/null +++ b/src/builtin_optim_plnpca.cpp @@ -0,0 +1,369 @@ +#include "RcppArmadillo.h" + +// [[Rcpp::depends(RcppArmadillo)]] + +#include "utils.h" + +// --------------------------------------------------------------------------------------- +// Rank-constrained PLN — Joint L-BFGS with strong Wolfe line search +// +// All parameters [vec(B); vec(C); vec(M); vec(ψ)] are optimised simultaneously. +// Strong Wolfe line search guarantees s^T y > 0 at every accepted step, so the +// L-BFGS history always accumulates valid curvature pairs including the bilinear +// M·Cᵀ cross-curvature that block-coordinate methods miss. +// +// Note: for datasets with large d[1]/sqrt(n) (e.g. barents), joint L-BFGS may +// converge to a local optimum inferior to nlopt-CCSAQ. The nlopt backend is +// recommended when solution quality is the priority. + +// --------------------------------------------------------------------------------------- +// L-BFGS two-loop recursion: returns search direction p = -H_k · g + +static arma::vec lbfgs_direction( + const arma::vec & g, + const std::deque & sv, + const std::deque & yv +) { + const int m = (int)sv.size(); + arma::vec q = g, alpha(m, arma::fill::zeros); + for (int i = m-1; i >= 0; i--) { + double rho = 1.0 / arma::dot(yv[i], sv[i]); + alpha(i) = rho * arma::dot(sv[i], q); + q -= alpha(i) * yv[i]; + } + arma::vec r = q; + if (m > 0) { + double sy = arma::dot(sv.back(), yv.back()); + double yy = arma::dot(yv.back(), yv.back()); + if (sy > 0 && yy > 1e-20) r *= (sy / yy); + } + for (int i = 0; i < m; i++) { + double rho = 1.0 / arma::dot(yv[i], sv[i]); + double beta = rho * arma::dot(yv[i], r); + r += sv[i] * (alpha(i) - beta); + } + return -r; +} + +// --------------------------------------------------------------------------------------- +// Strong Wolfe line search (Nocedal & Wright, Algorithm 3.5/3.6). +// Guarantees s^T y > 0 when slope0 < 0 and a descent direction is given. + +struct WolfeStep { double scale; double f; arma::vec g; }; + +template +static WolfeStep wolfe_ls( + const arma::vec & x0, const arma::vec & d, + double f0, double slope0, FG && fg, + const double c1 = 1e-4, const double c2 = 0.9 +) { + auto zoom = [&](double alo, double ahi, double flo) -> WolfeStep { + for (int j = 0; j < 20; j++) { + double a = 0.5 * (alo + ahi); + auto res = fg(x0 + a * d); + double fa = res.first; arma::vec ga = res.second; + if (fa > f0 + c1*a*slope0 || fa >= flo) { ahi = a; } + else { + double da = arma::dot(ga, d); + if (std::abs(da) <= -c2 * slope0) return {a, fa, ga}; + if (da * (ahi - alo) >= 0) ahi = alo; + alo = a; flo = fa; + } + } + double a = 0.5 * (alo + ahi); + auto res = fg(x0 + a * d); + return {a, res.first, res.second}; + }; + double a = 1.0, ap = 0, fp = f0; + for (int i = 0; i < 20; i++) { + auto res = fg(x0 + a * d); + double fa = res.first; arma::vec ga = res.second; + if (fa > f0 + c1*a*slope0 || (i > 0 && fa >= fp)) return zoom(ap, a, fp); + double da = arma::dot(ga, d); + if (std::abs(da) <= -c2 * slope0) return {a, fa, ga}; + if (da >= 0) return zoom(a, ap, fa); + ap = a; fp = fa; + a = std::min(2.0 * a, 1e6); + } + auto res = fg(x0 + a * d); + return {a, res.first, res.second}; +} + +// --------------------------------------------------------------------------------------- +// [[Rcpp::export]] +Rcpp::List builtin_optimize_rank( + const Rcpp::List & data , + const Rcpp::List & params, + const Rcpp::List & config +) { + const arma::mat & Y = Rcpp::as(data["Y"]); + const arma::mat & X = Rcpp::as(data["X"]); + const arma::mat & O = Rcpp::as(data["O"]); + const arma::vec & w = Rcpp::as(data["w"]); + arma::mat B = Rcpp::as(params["B"]); + arma::mat C = Rcpp::as(params["C"]); + arma::mat M = Rcpp::as(params["M"]); + arma::mat S2 = Rcpp::as(params["S2"]); + + const int maxiter = config.containsElementNamed("maxeval") ? Rcpp::as (config["maxeval"]) : 10000; + const double ftol = config.containsElementNamed("ftol_in") ? Rcpp::as(config["ftol_in"]) : 1e-9; + const int m_hist = 10; + + const arma::uword n = Y.n_rows, p = Y.n_cols, q = M.n_cols, d = B.n_rows; + + // Packed-parameter offsets: x = [vec(B); vec(C); vec(M); vec(ψ)] + const arma::uword oB = 0, oC = d*p, oM = d*p + p*q, oPsi = d*p + p*q + n*q; + const arma::uword N = d*p + p*q + 2*n*q; + + // Warm-start ψ with one fixed-point step + arma::mat C2 = C % C; + arma::mat psi = arma::log(S2); + arma::mat Z = O + X * B + M * C.t(); + arma::mat A = arma::exp(Z + 0.5 * S2 * C2.t()); + psi = arma::clamp(-arma::log(1. + A * C2), -40., 40.); + S2 = arma::exp(psi); + A = arma::exp(Z + 0.5 * S2 * C2.t()); + + const arma::mat Xw = X.each_col() % w; + + // Joint fg evaluator for all parameters + auto fg = [&](const arma::vec & x) -> std::pair { + arma::mat B_ = arma::reshape(x.subvec(oB, oC-1 ), d, p); + arma::mat C_ = arma::reshape(x.subvec(oC, oM-1 ), p, q); + arma::mat M_ = arma::reshape(x.subvec(oM, oPsi-1 ), n, q); + arma::mat psi_ = arma::reshape(x.subvec(oPsi, N-1 ), n, q); + arma::mat S2_ = arma::exp(psi_); + arma::mat C2_ = C_ % C_; + arma::mat Z_ = O + X * B_ + M_ * C_.t(); + arma::mat A_ = arma::exp(Z_ + 0.5 * S2_ * C2_.t()); + double f = arma::accu(w.t() * (A_ - Y % Z_)) + + 0.5 * arma::accu(w.t() * (M_ % M_ + S2_ - psi_ - 1.)); + arma::mat AmY = A_ - Y; + arma::mat AmYw = AmY; AmYw.each_col() %= w; + arma::mat gB_ = Xw.t() * AmY; + arma::mat gC_ = AmYw.t() * M_ + (A_.t() * (S2_.each_col() % w)) % C_; + arma::mat gM_ = AmY * C_ + M_; gM_.each_col() %= w; + arma::mat gPs_ = arma::diagmat(w) * (0.5 * (S2_ % (1. + A_ * C2_) - 1.)); + arma::vec g = arma::join_cols( + arma::join_cols(arma::vectorise(gB_), arma::vectorise(gC_)), + arma::join_cols(arma::vectorise(gM_), arma::vectorise(gPs_))); + return {f, g}; + }; + + // Initial packed state + arma::vec x = arma::join_cols( + arma::join_cols(arma::vectorise(B), arma::vectorise(C)), + arma::join_cols(arma::vectorise(M), arma::vectorise(psi))); + + auto res0 = fg(x); double f_cur = res0.first; arma::vec g_cur = res0.second; + + std::deque sv, yv; + std::vector objective_vec; + double obj_prev = arma::datum::inf; + int total_iter = 0, last_status = 5; + const int win = 100; + + for (int it = 0; it < maxiter; it++) { + objective_vec.push_back(f_cur); + total_iter++; + + if (it > 0 && converged(f_cur, obj_prev, ftol)) { last_status = 3; break; } + obj_prev = f_cur; + if (it > 0 && it % win == 0 && (int)objective_vec.size() >= 2*win) { + double m1 = *std::min_element(objective_vec.end()-win, objective_vec.end()); + double m2 = *std::min_element(objective_vec.end()-2*win, objective_vec.end()-win); + if (converged(m1, m2, ftol)) { last_status = 3; break; } + } + + // L-BFGS direction + arma::vec d_lbfgs; + if (sv.empty()) { + double gn = arma::norm(g_cur); + d_lbfgs = (gn > 1e-20) ? arma::vec(-g_cur / gn) + : arma::vec(N, arma::fill::zeros); + } else { + d_lbfgs = lbfgs_direction(g_cur, sv, yv); + if (arma::dot(d_lbfgs, g_cur) >= 0) { + sv.clear(); yv.clear(); + d_lbfgs = -g_cur / (arma::norm(g_cur) + 1e-20); + } + } + + double slope = arma::dot(d_lbfgs, g_cur); + if (std::abs(slope) < 1e-20) { last_status = 4; break; } + + WolfeStep ws = wolfe_ls(x, d_lbfgs, f_cur, slope, fg); + + arma::vec s_new = ws.scale * d_lbfgs; + arma::vec y_new = ws.g - g_cur; + double sy = arma::dot(s_new, y_new), ss = arma::dot(s_new, s_new); + if (sy > 1e-10 * ss && ss > 1e-20) { + sv.push_back(s_new); yv.push_back(y_new); + if ((int)sv.size() > m_hist) { sv.pop_front(); yv.pop_front(); } + } + + x = x + ws.scale * d_lbfgs; + f_cur = ws.f; + g_cur = std::move(ws.g); + } + + // Unpack final parameters + B = arma::reshape(x.subvec(oB, oC-1 ), d, p); + C = arma::reshape(x.subvec(oC, oM-1 ), p, q); + M = arma::reshape(x.subvec(oM, oPsi-1), n, q); + psi = arma::reshape(x.subvec(oPsi, N-1 ), n, q); + S2 = arma::exp(psi); + C2 = C % C; + Z = O + X * B + M * C.t(); + A = arma::exp(Z + 0.5 * S2 * C2.t()); + + const double w_bar = arma::accu(w); + arma::mat nSig = M.t() * (M.each_col() % w) + arma::diagmat(arma::sum(S2.each_col() % w, 0)); + arma::mat Sigma = C * nSig * C.t() / w_bar; + arma::mat Omega = C * arma::inv_sympd(nSig / w_bar) * C.t(); + arma::vec loglik = arma::sum(Y % Z - A, 1) + - 0.5 * arma::sum(M % M + S2 - psi - 1., 1) + ki(Y); + + Rcpp::NumericVector Ji = Rcpp::as(Rcpp::wrap(loglik)); + Ji.attr("weights") = w; + return Rcpp::List::create( + Rcpp::Named("B", B ), + Rcpp::Named("C", C ), + Rcpp::Named("M", M ), + Rcpp::Named("S2", S2 ), + Rcpp::Named("Z", Z ), + Rcpp::Named("A", A ), + Rcpp::Named("Sigma", Sigma), + Rcpp::Named("Omega", Omega), + Rcpp::Named("Ji", Ji ), + Rcpp::Named("monitoring", Rcpp::List::create( + Rcpp::Named("status", last_status ), + Rcpp::Named("backend", "lbfgs" ), + Rcpp::Named("objective", objective_vec), + Rcpp::Named("iterations", total_iter ) + )) + ); +} + +// --------------------------------------------------------------------------------------- +// VE step only (project): B and C fixed, update (M, ψ). + +// [[Rcpp::export]] +Rcpp::List builtin_optimize_vestep_rank( + const Rcpp::List & data , + const Rcpp::List & params, + const arma::mat & B, + const arma::mat & C, + const Rcpp::List & config +) { + const arma::mat & Y = Rcpp::as(data["Y"]); + const arma::mat & X = Rcpp::as(data["X"]); + const arma::mat & O = Rcpp::as(data["O"]); + const arma::vec & w = Rcpp::as(data["w"]); + arma::mat M = Rcpp::as(params["M"]); + arma::mat S2 = Rcpp::as(params["S2"]); + + const int maxiter = config.containsElementNamed("maxeval") ? Rcpp::as (config["maxeval"]) : 10000; + const double ftol = config.containsElementNamed("ftol_in") ? Rcpp::as(config["ftol_in"]) : 1e-9; + const int m_hist = 10; + + const arma::uword n = Y.n_rows, q = M.n_cols; + const arma::uword oM = 0, oPsi = n*q, N = 2*n*q; + const arma::mat C2 = C % C; + const arma::mat XB = X * B; + + // Warm-start ψ + arma::mat psi = arma::log(S2); + arma::mat Z = O + XB + M * C.t(); + arma::mat A = arma::exp(Z + 0.5 * S2 * C2.t()); + psi = arma::clamp(-arma::log(1. + A * C2), -40., 40.); + S2 = arma::exp(psi); + A = arma::exp(Z + 0.5 * S2 * C2.t()); + + auto fg = [&](const arma::vec & x) -> std::pair { + arma::mat M_ = arma::reshape(x.subvec(oM, oPsi-1), n, q); + arma::mat psi_ = arma::reshape(x.subvec(oPsi, N-1 ), n, q); + arma::mat S2_ = arma::exp(psi_); + arma::mat Z_ = O + XB + M_ * C.t(); + arma::mat A_ = arma::exp(Z_ + 0.5 * S2_ * C2.t()); + double f = arma::accu(w.t() * (A_ - Y % Z_)) + + 0.5 * arma::accu(w.t() * (M_ % M_ + S2_ - psi_ - 1.)); + arma::mat gM_ = (A_ - Y) * C + M_; gM_.each_col() %= w; + arma::mat gPs_ = arma::diagmat(w) * (0.5 * (S2_ % (1. + A_ * C2) - 1.)); + return {f, arma::join_cols(arma::vectorise(gM_), arma::vectorise(gPs_))}; + }; + + arma::vec x = arma::join_cols(arma::vectorise(M), arma::vectorise(psi)); + auto res0 = fg(x); double f_cur = res0.first; arma::vec g_cur = res0.second; + + std::deque sv, yv; + std::vector objective_vec; + double obj_prev = arma::datum::inf; + int total_iter = 0; + const int win = 100; + + for (int it = 0; it < maxiter; it++) { + objective_vec.push_back(f_cur); + total_iter++; + if (it > 0 && converged(f_cur, obj_prev, ftol)) break; + obj_prev = f_cur; + if (it > 0 && it % win == 0 && (int)objective_vec.size() >= 2*win) { + double m1 = *std::min_element(objective_vec.end()-win, objective_vec.end()); + double m2 = *std::min_element(objective_vec.end()-2*win, objective_vec.end()-win); + if (converged(m1, m2, ftol)) break; + } + + arma::vec d; + if (sv.empty()) { + double gn = arma::norm(g_cur); + d = (gn > 1e-20) ? arma::vec(-g_cur / gn) + : arma::vec(N, arma::fill::zeros); + } else { + d = lbfgs_direction(g_cur, sv, yv); + if (arma::dot(d, g_cur) >= 0) { + sv.clear(); yv.clear(); + d = -g_cur / (arma::norm(g_cur) + 1e-20); + } + } + + double slope = arma::dot(d, g_cur); + if (std::abs(slope) < 1e-20) break; + + WolfeStep ws = wolfe_ls(x, d, f_cur, slope, fg); + + arma::vec s_new = ws.scale * d; + arma::vec y_new = ws.g - g_cur; + double sy = arma::dot(s_new, y_new), ss = arma::dot(s_new, s_new); + if (sy > 1e-10 * ss && ss > 1e-20) { + sv.push_back(s_new); yv.push_back(y_new); + if ((int)sv.size() > m_hist) { sv.pop_front(); yv.pop_front(); } + } + + x = x + ws.scale * d; + f_cur = ws.f; + g_cur = std::move(ws.g); + } + + M = arma::reshape(x.subvec(oM, oPsi-1), n, q); + psi = arma::reshape(x.subvec(oPsi, N-1 ), n, q); + S2 = arma::exp(psi); + Z = O + XB + M * C.t(); + A = arma::exp(Z + 0.5 * S2 * C2.t()); + + arma::vec loglik = arma::sum(Y % Z - A, 1) + - 0.5 * arma::sum(M % M + S2 - psi - 1., 1) + ki(Y); + + Rcpp::NumericVector Ji = Rcpp::as(Rcpp::wrap(loglik)); + Ji.attr("weights") = w; + return Rcpp::List::create( + Rcpp::Named("M") = M, + Rcpp::Named("S2") = S2, + Rcpp::Named("Ji") = Ji, + Rcpp::Named("monitoring", Rcpp::List::create( + Rcpp::Named("status", 3 ), + Rcpp::Named("backend", "lbfgs" ), + Rcpp::Named("objective", objective_vec), + Rcpp::Named("iterations", total_iter ) + )) + ); +} diff --git a/src/lambertW.h b/src/lambertW.h index 6b56a484..c7ad1416 100644 --- a/src/lambertW.h +++ b/src/lambertW.h @@ -1,3 +1,5 @@ +#pragma once + #include #define _USE_MATH_DEFINES diff --git a/src/nlopt_diag_cov.cpp b/src/nlopt_diag_cov.cpp new file mode 100644 index 00000000..db17ff07 --- /dev/null +++ b/src/nlopt_diag_cov.cpp @@ -0,0 +1,170 @@ +#include "RcppArmadillo.h" + +// [[Rcpp::depends(RcppArmadillo)]] +// [[Rcpp::depends(nloptr)]] + +#include "nlopt_wrapper.h" +#include "packing.h" +#include "utils.h" +#include "nlopt_impl.h" + +// --------------------------------------------------------------------------------------- +// Diagonal covariance PLN — nlopt/CCSAQ optimizer: B profiled via closed form, reduced parameter vector + +// [[Rcpp::export]] +Rcpp::List nlopt_optimize_diagonal( + const Rcpp::List & data , + const Rcpp::List & params, + const Rcpp::List & config +) { + const arma::mat & Y = Rcpp::as(data["Y"]); + const arma::mat & X = Rcpp::as(data["X"]); + const arma::mat & O = Rcpp::as(data["O"]); + const arma::vec & w = Rcpp::as(data["w"]); + const auto init_B = Rcpp::as(params["B"]); + const auto init_M = Rcpp::as(params["M"]); + const auto init_S2 = Rcpp::as(params["S2"]); + + const auto metadata = tuple_metadata(init_M, init_S2); + enum { M_ID, S_ID }; + + auto parameters = std::vector(metadata.packed_size); + metadata.map(parameters.data()) = init_M; + metadata.map(parameters.data()) = arma::log(init_S2); + + auto optimizer = new_nlopt_optimizer(config, parameters.size()); + std::vector objective_vec; + objective_vec.reserve(nlopt_get_maxeval(optimizer.get())); + const double w_bar = accu(w); + + const arma::mat Xw = X.each_col() % w; + const arma::mat P_X = (X.n_cols > 0) ? arma::solve(X.t() * Xw, Xw.t()) : arma::mat(0, Y.n_rows); + + // E-step: M_full is the NLOPT parameter; B and diag_sigma profiled at each eval + auto objective_and_grad = [&](const double * par, double * grad) -> double { + const arma::mat M_full = metadata.map(par); + const arma::mat logS2 = metadata.map(par); + const arma::mat S2 = arma::exp(logS2); + const arma::mat B = P_X * M_full; + const arma::mat M_res = M_full - X * B; + const arma::rowvec diag_sigma = w.t() * (M_res % M_res + S2) / w_bar; + const arma::rowvec inv_sigma2 = arma::pow(diag_sigma, -1); + arma::mat gM, gS; + const double obj = diag_cov_obj_grad_impl(M_res, O + M_full, S2, logS2, + inv_sigma2, 0.5 * w_bar * accu(arma::log(diag_sigma)), + Y, w, gM, gS); + metadata.map(grad) = gM; + metadata.map(grad) = gS; + objective_vec.push_back(obj); + return obj; + }; + OptimizerResult result = minimize_objective_on_parameters(optimizer.get(), objective_and_grad, parameters); + + arma::mat M = metadata.copy(parameters.data()); // M_full + arma::mat logS2 = metadata.copy(parameters.data()); + arma::mat S2 = arma::exp(logS2); + arma::mat B = P_X * M; + arma::mat M_res = M - X * B; + arma::rowvec sigma2 = w.t() * (M_res % M_res + S2) / w_bar; + arma::vec omega2 = pow(sigma2.t(), -1); + arma::sp_mat Sigma(Y.n_cols, Y.n_cols); Sigma.diag() = sigma2.t(); + arma::sp_mat Omega(Y.n_cols, Y.n_cols); Omega.diag() = omega2; + arma::mat Z = O + M; + arma::mat A = exp(Z + 0.5 * S2); + arma::mat loglik = sum(Y % Z - A + 0.5 * logS2, 1) - 0.5 * (pow(M_res, 2) + S2) * omega2 + + 0.5 * sum(log(omega2)) + ki(Y); + + Rcpp::NumericVector Ji = Rcpp::as(Rcpp::wrap(loglik)); + Ji.attr("weights") = w; + return Rcpp::List::create( + Rcpp::Named("B", B), + Rcpp::Named("M", M), // M_full + Rcpp::Named("S2", S2), + Rcpp::Named("Z", Z), + Rcpp::Named("A", A), + Rcpp::Named("Sigma", Sigma), + Rcpp::Named("Omega", Omega), + Rcpp::Named("Ji", Ji), + Rcpp::Named("monitoring", Rcpp::List::create( + Rcpp::Named("status", static_cast(result.status)), + Rcpp::Named("backend", "nlopt"), + Rcpp::Named("objective", objective_vec), + Rcpp::Named("iterations", result.nb_iterations) + )) + ); +} + +// --------------------------------------------------------------------------------------- +// VE diagonal — nlopt/CCSAQ (M and S only, B and Omega fixed) + +// [[Rcpp::export]] +Rcpp::List nlopt_optimize_vestep_diagonal( + const Rcpp::List & data , // List(Y, X, O, w) + const Rcpp::List & params, // List(M, S) + const arma::mat & B, // (d,p) + const arma::mat & Omega, // (p,p) + const Rcpp::List & config // List of config values +) { + const arma::mat & Y = Rcpp::as(data["Y"]); // responses (n,p) + const arma::mat & X = Rcpp::as(data["X"]); // covariates (n,d) + const arma::mat & O = Rcpp::as(data["O"]); // offsets (n,p) + const arma::vec & w = Rcpp::as(data["w"]); // weights (n) + const auto init_M = Rcpp::as(params["M"]); // (n,p) + const auto init_S2 = Rcpp::as(params["S2"]); // (n,p) + + const auto metadata = tuple_metadata(init_M, init_S2); + enum { M_ID, S_ID }; // Names for metadata indexes + + auto parameters = std::vector(metadata.packed_size); + metadata.map(parameters.data()) = init_M; + metadata.map(parameters.data()) = arma::log(init_S2); // pack logS2 + + auto optimizer = new_nlopt_optimizer(config, parameters.size()); + std::vector objective_vec ; + objective_vec.reserve(nlopt_get_maxeval(optimizer.get())); + + const arma::mat XB = X * B; // B is fixed; precompute XB for M_res = M - XB + const arma::rowvec omega2_v = arma::diagvec(Omega).t(); // fixed precision, as row vector + + // Vestep: M_full is the NLOPT parameter; B and Omega fixed by the caller + auto objective_and_grad = [&](const double * params, double * grad) -> double { + const arma::mat M = metadata.map(params); + const arma::mat logS2 = metadata.map(params); + const arma::mat S2 = arma::exp(logS2); + const arma::mat M_res = M - XB; + const double penalty = 0.5 * as_scalar(w.t() * (arma::pow(M_res, 2) + S2) * omega2_v.t()); + arma::mat gM, gS; + const double obj = diag_cov_obj_grad_impl(M_res, O + M, S2, logS2, omega2_v, penalty, Y, w, gM, gS); + metadata.map(grad) = gM; + metadata.map(grad) = gS; + objective_vec.push_back(obj); + return obj; + }; + OptimizerResult result = minimize_objective_on_parameters(optimizer.get(), objective_and_grad, parameters); + + // Model and variational parameters + arma::mat M = metadata.copy(parameters.data()); // M_full + arma::mat logS2 = metadata.copy(parameters.data()); + arma::mat S2 = arma::exp(logS2); + arma::mat M_res = M - XB; + // Element-wise log-likelihood + arma::mat Z = O + M; + arma::mat A = exp(Z + 0.5 * S2); + arma::vec omega2 = Omega.diag(); + arma::mat loglik = + sum(Y % Z - A + 0.5 * logS2, 1) - 0.5 * (pow(M_res, 2) + S2) * omega2 + 0.5 * sum(log(omega2)) + ki(Y); + + Rcpp::NumericVector Ji = Rcpp::as(Rcpp::wrap(loglik)); + Ji.attr("weights") = w; + return Rcpp::List::create( + Rcpp::Named("M") = M, + Rcpp::Named("S2") = S2, + Rcpp::Named("Ji") = Ji, + Rcpp::Named("monitoring", Rcpp::List::create( + Rcpp::Named("status", static_cast(result.status)), + Rcpp::Named("backend", "nlopt"), + Rcpp::Named("objective", objective_vec), + Rcpp::Named("iterations", result.nb_iterations) + )) + ); +} diff --git a/src/nlopt_fixed_cov.cpp b/src/nlopt_fixed_cov.cpp new file mode 100644 index 00000000..baa8a144 --- /dev/null +++ b/src/nlopt_fixed_cov.cpp @@ -0,0 +1,86 @@ +#include "RcppArmadillo.h" + +// [[Rcpp::depends(RcppArmadillo)]] +// [[Rcpp::depends(nloptr)]] + +#include "nlopt_wrapper.h" +#include "packing.h" +#include "utils.h" +#include "nlopt_impl.h" + +// --------------------------------------------------------------------------------------- +// Fixed covariance PLN — nlopt/CCSAQ optimizer: B profiled via closed form, reduced parameter vector + +// [[Rcpp::export]] +Rcpp::List nlopt_optimize_fixed( + const Rcpp::List & data , + const Rcpp::List & params, + const Rcpp::List & config +) { + const arma::mat & Y = Rcpp::as(data["Y"]); + const arma::mat & X = Rcpp::as(data["X"]); + const arma::mat & O = Rcpp::as(data["O"]); + const arma::vec & w = Rcpp::as(data["w"]); + const auto init_B = Rcpp::as(params["B"]); + const auto init_M = Rcpp::as(params["M"]); + const auto Omega = Rcpp::as(params["Omega"]); + const auto init_S2 = Rcpp::as(params["S2"]); + + const auto metadata = tuple_metadata(init_M, init_S2); + enum { M_ID, S_ID }; + + auto parameters = std::vector(metadata.packed_size); + metadata.map(parameters.data()) = init_M; + metadata.map(parameters.data()) = arma::log(init_S2); + + auto optimizer = new_nlopt_optimizer(config, parameters.size()); + std::vector objective_vec; + + const arma::mat Xw = X.each_col() % w; + const arma::mat P_X = (X.n_cols > 0) ? arma::solve(X.t() * Xw, Xw.t()) : arma::mat(0, Y.n_rows); + const arma::vec Omega_diag = diagvec(Omega); + + auto objective_and_grad = [&](const double * par, double * grad) -> double { + const arma::mat M_full = metadata.map(par); + const arma::mat logS2 = metadata.map(par); + const arma::mat B = P_X * M_full; + const arma::mat M_res = M_full - X * B; + arma::mat gM, gS; + const double obj = full_cov_obj_grad_impl(M_res, O + M_full, logS2, Omega, Omega_diag, Y, w, gM, gS); + metadata.map(grad) = gM; + metadata.map(grad) = gS; + objective_vec.push_back(obj); + return obj; + }; + OptimizerResult result = minimize_objective_on_parameters(optimizer.get(), objective_and_grad, parameters); + + arma::mat M = metadata.copy(parameters.data()); // M_full + arma::mat logS2 = metadata.copy(parameters.data()); + arma::mat S2 = arma::exp(logS2); + arma::mat B = P_X * M; + arma::mat M_res = M - X * B; + arma::mat Sigma = (M_res.t() * (M_res.each_col() % w) + diagmat(w.t() * S2)) / accu(w); + arma::mat Z = O + M; + arma::mat A = exp(Z + 0.5 * S2); + arma::mat loglik = sum(Y % Z - A - 0.5 * ((M_res * Omega) % M_res - logS2 + S2 * diagmat(Omega)), 1) + + 0.5 * real(log_det(Omega)) + ki(Y); + + Rcpp::NumericVector Ji = Rcpp::as(Rcpp::wrap(loglik)); + Ji.attr("weights") = w; + return Rcpp::List::create( + Rcpp::Named("B", B), + Rcpp::Named("M", M), + Rcpp::Named("S2", S2), + Rcpp::Named("Z", Z), + Rcpp::Named("A", A), + Rcpp::Named("Sigma", Sigma), + Rcpp::Named("Omega", Omega), + Rcpp::Named("Ji", Ji), + Rcpp::Named("monitoring", Rcpp::List::create( + Rcpp::Named("status", static_cast(result.status)), + Rcpp::Named("backend", "nlopt"), + Rcpp::Named("objective", objective_vec), + Rcpp::Named("iterations", result.nb_iterations) + )) + ); +} diff --git a/src/nlopt_full_cov.cpp b/src/nlopt_full_cov.cpp new file mode 100644 index 00000000..0ab28b7d --- /dev/null +++ b/src/nlopt_full_cov.cpp @@ -0,0 +1,197 @@ +#include "RcppArmadillo.h" + +// [[Rcpp::depends(RcppArmadillo)]] +// [[Rcpp::depends(nloptr)]] + +#include "nlopt_wrapper.h" +#include "packing.h" +#include "utils.h" +#include "nlopt_impl.h" + +// --------------------------------------------------------------------------------------- +// Full covariance PLN — nlopt/CCSAQ optimizer: B profiled via closed form, reduced parameter vector + +// [[Rcpp::export]] +Rcpp::List nlopt_optimize_full( + const Rcpp::List & data , // List(Y, X, O, w) + const Rcpp::List & params, // List(B, M, S) + const Rcpp::List & config // List of config values +) { + const arma::mat & Y = Rcpp::as(data["Y"]); + const arma::mat & X = Rcpp::as(data["X"]); + const arma::mat & O = Rcpp::as(data["O"]); + const arma::vec & w = Rcpp::as(data["w"]); + const auto init_B = Rcpp::as(params["B"]); + const auto init_M = Rcpp::as(params["M"]); + const auto init_S2 = Rcpp::as(params["S2"]); + + // Parameters: (M_full, logS2) — B is profiled out via closed form + const auto metadata = tuple_metadata(init_M, init_S2); + enum { M_ID, S_ID }; + + auto parameters = std::vector(metadata.packed_size); + metadata.map(parameters.data()) = init_M; + metadata.map(parameters.data()) = arma::log(init_S2); + + const double w_bar = accu(w); + const NewtonConfig cfg(config); + + // P_X = (X'WX)^{-1} X'W : d×n, precomputed once; B = P_X * M_full at each eval + const arma::mat Xw = X.each_col() % w; + const arma::mat P_X = (X.n_cols > 0) ? arma::solve(X.t() * Xw, Xw.t()) : arma::mat(0, Y.n_rows); + + // Initial Omega: M_res = M_full - X*B + arma::mat Omega; + { + const arma::mat M_res_init = init_M - X * init_B; + arma::mat Sigma_init = (1./w_bar) * (M_res_init.t() * (M_res_init.each_col() % w) + diagmat(w.t() * init_S2)); + Omega = inv_sympd(Sigma_init); + } + + std::vector objective_vec; + double elbo_prev = -arma::datum::inf; + int total_iterations = 0; + int last_status = 0; + + for (int em_iter = 0; em_iter < std::max(1, cfg.max_em); em_iter++) { + auto optimizer = new_nlopt_optimizer(config, parameters.size()); + objective_vec.reserve(objective_vec.size() + nlopt_get_maxeval(optimizer.get())); + const arma::vec Omega_diag = diagvec(Omega); + + // E-step: M_full is the NLOPT parameter; B profiled at each eval (envelope theorem) + auto objective_and_grad = [&](const double * par, double * grad) -> double { + const arma::mat M_full = metadata.map(par); + const arma::mat logS2 = metadata.map(par); + const arma::mat B = P_X * M_full; + const arma::mat M_res = M_full - X * B; + arma::mat gM, gS; + const double obj = full_cov_obj_grad_impl(M_res, O + M_full, logS2, Omega, Omega_diag, Y, w, gM, gS); + metadata.map(grad) = gM; + metadata.map(grad) = gS; + objective_vec.push_back(obj); + return obj; + }; + + OptimizerResult result = minimize_objective_on_parameters(optimizer.get(), objective_and_grad, parameters); + total_iterations += result.nb_iterations; + last_status = static_cast(result.status); + + arma::mat M_full = metadata.copy(parameters.data()); + arma::mat logS2 = metadata.copy(parameters.data()); + arma::mat S2 = arma::exp(logS2); + arma::mat B = P_X * M_full; + arma::mat M_res = M_full - X * B; + arma::mat Sigma = (1./w_bar) * (M_res.t() * (M_res.each_col() % w) + diagmat(w.t() * S2)); + Omega = inv_sympd(Sigma); + + arma::mat Z = O + M_full; + arma::mat A = exp(Z + 0.5 * S2); + double elbo = accu(w.t() * (Y % Z - A + 0.5 * logS2)) + - 0.5 * w_bar * real(log_det(Sigma)); + if (em_iter > 0 && converged(elbo, elbo_prev, cfg.em_tol)) break; + elbo_prev = elbo; + } + + arma::mat M = metadata.copy(parameters.data()); // M_full + arma::mat logS2 = metadata.copy(parameters.data()); + arma::mat S2 = arma::exp(logS2); + arma::mat B = P_X * M; + arma::mat M_res = M - X * B; + arma::mat Sigma = (1./w_bar) * (M_res.t() * (M_res.each_col() % w) + diagmat(w.t() * S2)); + arma::mat Z = O + M; + arma::mat A = exp(Z + 0.5 * S2); + arma::vec loglik = sum(Y % Z - A + 0.5 * logS2 - 0.5 * ((M_res * Omega) % M_res + S2 * diagmat(Omega)), 1) + + 0.5 * real(log_det(Omega)) + ki(Y); + + Rcpp::NumericVector Ji = Rcpp::as(Rcpp::wrap(loglik)); + Ji.attr("weights") = w; + return Rcpp::List::create( + Rcpp::Named("B", B), + Rcpp::Named("M", M), + Rcpp::Named("S2", S2), + Rcpp::Named("Z", Z), + Rcpp::Named("A", A), + Rcpp::Named("Sigma", Sigma), + Rcpp::Named("Omega", Omega), + Rcpp::Named("Ji", Ji), + Rcpp::Named("monitoring", Rcpp::List::create( + Rcpp::Named("status", last_status), + Rcpp::Named("backend", "nlopt"), + Rcpp::Named("objective", objective_vec), + Rcpp::Named("iterations", total_iterations) + )) + ); +} + +// --------------------------------------------------------------------------------------- +// VE full covariance — nlopt/CCSAQ (M and S only, B and Omega fixed) + +// [[Rcpp::export]] +Rcpp::List nlopt_optimize_vestep_full( + const Rcpp::List & data , // List(Y, X, O, w) + const Rcpp::List & params, // List(M, S) + const arma::mat & B, // (d,p) + const arma::mat & Omega, // (p,p) + const Rcpp::List & config // List of config values +) { + // Conversion from R, prepare optimization + const arma::mat & Y = Rcpp::as(data["Y"]); // responses (n,p) + const arma::mat & X = Rcpp::as(data["X"]); // covariates (n,d) + const arma::mat & O = Rcpp::as(data["O"]); // offsets (n,p) + const arma::vec & w = Rcpp::as(data["w"]); // weights (n) + const auto init_M = Rcpp::as(params["M"]); // (n,p) + const auto init_S2 = Rcpp::as(params["S2"]); // (n,p) + + const auto metadata = tuple_metadata(init_M, init_S2); + enum { M_ID, S_ID }; // Names for metadata indexes + + auto parameters = std::vector(metadata.packed_size); + metadata.map(parameters.data()) = init_M; + metadata.map(parameters.data()) = arma::log(init_S2); // pack logS2 + + // Optimize + auto optimizer = new_nlopt_optimizer(config, parameters.size()); + std::vector objective_vec ; + objective_vec.reserve(nlopt_get_maxeval(optimizer.get())); + + const arma::mat XB = X * B; // B is fixed; precompute XB for M_res = M - XB + const arma::vec Omega_diag = diagvec(Omega); + + // Vestep: M_full is the NLOPT parameter; B and Omega fixed by the caller + auto objective_and_grad = [&](const double * params, double * grad) -> double { + const arma::mat M = metadata.map(params); + const arma::mat logS2 = metadata.map(params); + arma::mat gM, gS; + const double obj = full_cov_obj_grad_impl(M - XB, O + M, logS2, Omega, Omega_diag, Y, w, gM, gS); + metadata.map(grad) = gM; + metadata.map(grad) = gS; + objective_vec.push_back(obj); + return obj; + }; + OptimizerResult result = minimize_objective_on_parameters(optimizer.get(), objective_and_grad, parameters); + + // Model and variational parameters + arma::mat M = metadata.copy(parameters.data()); // M_full + arma::mat logS2 = metadata.copy(parameters.data()); + arma::mat S2 = arma::exp(logS2); + arma::mat M_res = M - XB; + // Element-wise log-likelihood + arma::mat Z = O + M; + arma::mat A = exp(Z + 0.5 * S2); + arma::vec loglik = sum(Y % Z - A + 0.5 * logS2 - 0.5 * ((M_res * Omega) % M_res + S2 * diagmat(Omega)), 1) + + 0.5 * real(log_det(Omega)) + ki(Y); + + Rcpp::NumericVector Ji = Rcpp::as(Rcpp::wrap(loglik)); + Ji.attr("weights") = w; + return Rcpp::List::create( + Rcpp::Named("M") = M, + Rcpp::Named("S2") = S2, + Rcpp::Named("Ji") = Ji, + Rcpp::Named("monitoring", Rcpp::List::create( + Rcpp::Named("status", static_cast(result.status)), + Rcpp::Named("backend", "nlopt"), + Rcpp::Named("objective", objective_vec), + Rcpp::Named("iterations", result.nb_iterations) + )) + ); +} diff --git a/src/nlopt_impl.h b/src/nlopt_impl.h new file mode 100644 index 00000000..9477fe5b --- /dev/null +++ b/src/nlopt_impl.h @@ -0,0 +1,54 @@ +#pragma once +#include + +// Shared objective/gradient implementations for the three NLOPT covariance variants. +// Defined inline here so nlopt_full_cov.cpp, nlopt_diag_cov.cpp, nlopt_spherical.cpp and +// nlopt_fixed_cov.cpp can all include this header instead of each defining a private static copy. +// +// All three functions optimize over (M_full, ψ=log(S²)) and return grad_psi = d/dψ. + +// Full covariance: Z = O + M_full supplied by caller. +// Returns the ELBO objective (negated); fills grad_M and grad_psi. +inline double full_cov_obj_grad_impl( + const arma::mat & M_res, const arma::mat & Z, const arma::mat & logS2, + const arma::mat & Omega, const arma::vec & Omega_diag, + const arma::mat & Y, const arma::vec & w, + arma::mat & grad_M, arma::mat & grad_psi +) { + const arma::mat S2 = arma::exp(logS2); + const arma::mat A = arma::exp(Z + 0.5 * S2); + const arma::mat MO = M_res * Omega; + grad_M = MO + A - Y; grad_M.each_col() %= w; + grad_psi = 0.5 * (S2.each_row() % Omega_diag.t() + S2 % A - 1.0); grad_psi.each_col() %= w; + return accu(w.t() * (A - Y % Z - 0.5 * logS2)) + + 0.5 * (accu(MO % (M_res.each_col() % w)) + dot(Omega_diag, (w.t() * S2).t())); +} + +// Diagonal covariance: inv_sigma2 = row vector of precisions (profiled or fixed); +// penalty = KL covariance term pre-computed by the caller (differs between E-step and vestep). +inline double diag_cov_obj_grad_impl( + const arma::mat & M_res, const arma::mat & Z, + const arma::mat & S2, const arma::mat & logS2, + const arma::rowvec & inv_sigma2, double penalty, + const arma::mat & Y, const arma::vec & w, + arma::mat & grad_M, arma::mat & grad_psi +) { + const arma::mat A = arma::exp(Z + 0.5 * S2); + grad_M = M_res.each_row() % inv_sigma2 + A - Y; grad_M.each_col() %= w; + grad_psi = 0.5 * (S2.each_row() % inv_sigma2 + S2 % A - 1.0); grad_psi.each_col() %= w; + return accu(w.t() * (A - Y % Z - 0.5 * logS2)) + penalty; +} + +// Spherical covariance: inv_sigma2 = scalar precision; penalty pre-computed by caller. +inline double spherical_cov_obj_grad_impl( + const arma::mat & M_res, const arma::mat & Z, + const arma::mat & S2, const arma::mat & logS2, + double inv_sigma2, double penalty, + const arma::mat & Y, const arma::vec & w, + arma::mat & grad_M, arma::mat & grad_psi +) { + const arma::mat A = arma::exp(Z + 0.5 * S2); + grad_M = M_res * inv_sigma2 + A - Y; grad_M.each_col() %= w; + grad_psi = 0.5 * (S2 * inv_sigma2 + S2 % A - 1.0); grad_psi.each_col() %= w; + return accu(w.t() * (A - Y % Z - 0.5 * logS2)) + penalty; +} diff --git a/src/nlopt_rank_cov.cpp b/src/nlopt_rank_cov.cpp new file mode 100644 index 00000000..20da8c1f --- /dev/null +++ b/src/nlopt_rank_cov.cpp @@ -0,0 +1,182 @@ +#include "RcppArmadillo.h" + +// [[Rcpp::depends(RcppArmadillo)]] +// [[Rcpp::depends(nloptr)]] + +#include "nlopt_wrapper.h" +#include "packing.h" +#include "utils.h" + +// --------------------------------------------------------------------------------------- +// Rank-constrained covariance +// +// Variational parameter: ψ = log(S²) (unconstrained) instead of S (bounded > 0). +// Interface: takes S2 (variance), converts to ψ = log(S²) before optimizing, returns S2. +// Gradient w.r.t. ψ: ½ · w ⊙ (S² ⊙ (1 + A·C²) − 1) [no 1/S singularity] + +// Rank (q) is already determined by param dimensions ; not passed anywhere + +// [[Rcpp::export]] +Rcpp::List nlopt_optimize_rank( + const Rcpp::List & data , // List(Y, X, O, w) + const Rcpp::List & params, // List(B, C, M, S2) + const Rcpp::List & config // List of config values +) { + // Conversion from R, prepare optimization + const arma::mat & Y = Rcpp::as(data["Y"]); // responses (n,p) + const arma::mat & X = Rcpp::as(data["X"]); // covariates (n,d) + const arma::mat & O = Rcpp::as(data["O"]); // offsets (n,p) + const arma::vec & w = Rcpp::as(data["w"]); // weights (n) + const auto init_B = Rcpp::as(params["B"]); // (d,p) + const auto init_C = Rcpp::as(params["C"]); // (p,q) + const auto init_M = Rcpp::as(params["M"]); // (n,q) + const arma::mat init_S2 = Rcpp::as(params["S2"]); // (n,q) variance + const arma::mat init_psi = arma::log(init_S2); // ψ = log(S²) + + const auto metadata = tuple_metadata(init_B, init_C, init_M, init_psi); + enum { B_ID, C_ID, M_ID, PSI_ID }; + + auto parameters = std::vector(metadata.packed_size); + metadata.map (parameters.data()) = init_B; + metadata.map (parameters.data()) = init_C; + metadata.map (parameters.data()) = init_M; + metadata.map(parameters.data()) = init_psi; + + // Optimize + auto optimizer = new_nlopt_optimizer(config, parameters.size()); + std::vector objective_vec; + objective_vec.reserve(nlopt_get_maxeval(optimizer.get())); + + const arma::mat Xw = X.each_col() % w; // precomputed once + + auto objective_and_grad = [&metadata, &O, &X, &Xw, &Y, &w, &objective_vec](const double * params, double * grad) -> double { + const arma::mat B = metadata.map (params); + const arma::mat C = metadata.map (params); + const arma::mat M = metadata.map (params); + const arma::mat psi = metadata.map(params); + + const arma::mat C2 = C % C; + const arma::mat S2 = arma::exp(psi); // S² = exp(ψ) + arma::mat Z = O + X * B + M * C.t(); + arma::mat A = arma::exp(Z + 0.5 * S2 * C2.t()); + double objective = accu(diagmat(w) * (A - Y % Z)) + + 0.5 * accu(diagmat(w) * (M % M + S2 - psi - 1.)); + + metadata.map (grad) = Xw.t() * (A - Y); + metadata.map (grad) = (diagmat(w) * (A - Y)).t() * M + (A.t() * (S2.each_col() % w)) % C; + metadata.map (grad) = diagmat(w) * ((A - Y) * C + M); + metadata.map(grad) = diagmat(w) * (0.5 * (S2 % (1. + A * C2) - 1.)); + + objective_vec.push_back(objective); + return objective; + }; + OptimizerResult result = minimize_objective_on_parameters(optimizer.get(), objective_and_grad, parameters); + + // Model and variational parameters + arma::mat B = metadata.copy (parameters.data()); + arma::mat C = metadata.copy (parameters.data()); + arma::mat M = metadata.copy (parameters.data()); + arma::mat psi = metadata.copy(parameters.data()); + arma::mat S2 = arma::exp(psi); + arma::mat Sigma = C * (M.t() * (M.each_col() % w) + arma::diagmat(arma::sum(S2.each_col() % w, 0))) * C.t() / accu(w); + arma::mat Omega = C * inv_sympd((M.t() * (M.each_col() % w) + arma::diagmat(arma::sum(S2.each_col() % w, 0))) / accu(w)) * C.t(); + arma::mat Z = O + X * B + M * C.t(); + arma::mat A = arma::exp(Z + 0.5 * S2 * (C % C).t()); + arma::mat loglik = arma::sum(Y % Z - A, 1) - 0.5 * arma::sum(M % M + S2 - psi - 1., 1) + ki(Y); + + Rcpp::NumericVector Ji = Rcpp::as(Rcpp::wrap(loglik)); + Ji.attr("weights") = w; + return Rcpp::List::create( + Rcpp::Named("B", B), + Rcpp::Named("C", C), + Rcpp::Named("M", M), + Rcpp::Named("S2", S2), + Rcpp::Named("Z", Z), + Rcpp::Named("A", A), + Rcpp::Named("Sigma", Sigma), + Rcpp::Named("Omega", Omega), + Rcpp::Named("Ji", Ji), + Rcpp::Named("monitoring", Rcpp::List::create( + Rcpp::Named("status", static_cast(result.status)), + Rcpp::Named("backend", "nlopt"), + Rcpp::Named("objective", objective_vec), + Rcpp::Named("iterations", result.nb_iterations) + )) + ); +} + +// --------------------------------------------------------------------------------------- +// VE rank +// Rank-constrained covariance (for prediction in the PCA space) + +// [[Rcpp::export]] +Rcpp::List nlopt_optimize_vestep_rank( + const Rcpp::List & data , // List(Y, X, O, w) + const Rcpp::List & params, // List(M, S2) + const arma::mat & B, // (d,p) + const arma::mat & C, // (p,q) + const Rcpp::List & config // List of config values +) { + // Conversion from R, prepare optimization + const arma::mat & Y = Rcpp::as(data["Y"]); // responses (n,p) + const arma::mat & X = Rcpp::as(data["X"]); // covariates (n,d) + const arma::mat & O = Rcpp::as(data["O"]); // offsets (n,p) + const arma::vec & w = Rcpp::as(data["w"]); // weights (n) + const auto init_M = Rcpp::as(params["M"]); // (n,q) + const arma::mat init_S2 = Rcpp::as(params["S2"]); // (n,q) variance + const arma::mat init_psi = arma::log(init_S2); // ψ = log(S²) + + const auto metadata = tuple_metadata(init_M, init_psi); + enum { M_ID, PSI_ID }; + + auto parameters = std::vector(metadata.packed_size); + metadata.map (parameters.data()) = init_M; + metadata.map(parameters.data()) = init_psi; + + // Optimize + auto optimizer = new_nlopt_optimizer(config, parameters.size()); + std::vector objective_vec; + objective_vec.reserve(nlopt_get_maxeval(optimizer.get())); + const arma::mat C2 = C % C; + const arma::mat XB = X * B; + + auto objective_and_grad = [&metadata, &O, &XB, &Y, &w, &C, &C2, &objective_vec](const double * params, double * grad) -> double { + const arma::mat M = metadata.map (params); + const arma::mat psi = metadata.map(params); + + arma::mat S2 = arma::exp(psi); + arma::mat Z = O + XB + M * C.t(); + arma::mat A = arma::exp(Z + 0.5 * S2 * C2.t()); + double objective = accu(diagmat(w) * (A - Y % Z)) + + 0.5 * accu(diagmat(w) * (M % M + S2 - psi - 1.)); + + metadata.map (grad) = diagmat(w) * ((A - Y) * C + M); + metadata.map(grad) = diagmat(w) * (0.5 * (S2 % (1. + A * C2) - 1.)); + + objective_vec.push_back(objective); + return objective; + }; + OptimizerResult result = minimize_objective_on_parameters(optimizer.get(), objective_and_grad, parameters); + + // Model and variational parameters + arma::mat M = metadata.copy (parameters.data()); + arma::mat psi = metadata.copy(parameters.data()); + arma::mat S2 = arma::exp(psi); + arma::mat Z = O + X * B + M * C.t(); + arma::mat A = arma::exp(Z + 0.5 * S2 * C2.t()); + arma::mat loglik = arma::sum(Y % Z - A, 1) - 0.5 * arma::sum(M % M + S2 - psi - 1., 1) + ki(Y); + + Rcpp::NumericVector Ji = Rcpp::as(Rcpp::wrap(loglik)); + Ji.attr("weights") = w; + return Rcpp::List::create( + Rcpp::Named("M") = M, + Rcpp::Named("S2") = S2, + Rcpp::Named("Ji") = Ji, + Rcpp::Named("monitoring", Rcpp::List::create( + Rcpp::Named("status", static_cast(result.status)), + Rcpp::Named("backend", "nlopt"), + Rcpp::Named("objective", objective_vec), + Rcpp::Named("iterations", result.nb_iterations) + )) + ); +} diff --git a/src/nlopt_spherical.cpp b/src/nlopt_spherical.cpp new file mode 100644 index 00000000..60a82e76 --- /dev/null +++ b/src/nlopt_spherical.cpp @@ -0,0 +1,169 @@ +#include "RcppArmadillo.h" + +// [[Rcpp::depends(RcppArmadillo)]] +// [[Rcpp::depends(nloptr)]] + +#include "nlopt_wrapper.h" +#include "packing.h" +#include "utils.h" +#include "nlopt_impl.h" + +// --------------------------------------------------------------------------------------- +// Spherical covariance PLN — nlopt/CCSAQ optimizer: B profiled via closed form, reduced parameter vector + +// [[Rcpp::export]] +Rcpp::List nlopt_optimize_spherical( + const Rcpp::List & data , + const Rcpp::List & params, + const Rcpp::List & config +) { + const arma::mat & Y = Rcpp::as(data["Y"]); + const arma::mat & X = Rcpp::as(data["X"]); + const arma::mat & O = Rcpp::as(data["O"]); + const arma::vec & w = Rcpp::as(data["w"]); + const auto init_B = Rcpp::as(params["B"]); + const auto init_M = Rcpp::as(params["M"]); + const auto init_S2 = Rcpp::as(params["S2"]); + + const auto metadata = tuple_metadata(init_M, init_S2); + enum { M_ID, S_ID }; + + auto parameters = std::vector(metadata.packed_size); + metadata.map(parameters.data()) = init_M; + metadata.map(parameters.data()) = arma::log(init_S2); + + auto optimizer = new_nlopt_optimizer(config, parameters.size()); + const double w_bar = accu(w); + const arma::uword p = Y.n_cols; + std::vector objective_vec; + objective_vec.reserve(nlopt_get_maxeval(optimizer.get())); + + const arma::mat Xw = X.each_col() % w; + const arma::mat P_X = (X.n_cols > 0) ? arma::solve(X.t() * Xw, Xw.t()) : arma::mat(0, Y.n_rows); + + // E-step: M_full is the NLOPT parameter; B and sigma2 profiled at each eval + auto objective_and_grad = [&](const double * par, double * grad) -> double { + const arma::mat M_full = metadata.map(par); + const arma::mat logS2 = metadata.map(par); + const arma::mat S2 = arma::exp(logS2); + const arma::mat B = P_X * M_full; + const arma::mat M_res = M_full - X * B; + const double sigma2 = accu(arma::diagmat(w) * (arma::pow(M_res, 2) + S2)) / (double(p) * w_bar); + arma::mat gM, gS; + const double obj = spherical_cov_obj_grad_impl(M_res, O + M_full, S2, logS2, + 1./sigma2, 0.5 * double(p) * w_bar * std::log(sigma2), + Y, w, gM, gS); + metadata.map(grad) = gM; + metadata.map(grad) = gS; + objective_vec.push_back(obj); + return obj; + }; + OptimizerResult result = minimize_objective_on_parameters(optimizer.get(), objective_and_grad, parameters); + + arma::mat M = metadata.copy(parameters.data()); // M_full + arma::mat logS2 = metadata.copy(parameters.data()); + arma::mat S2 = arma::exp(logS2); + arma::mat B = P_X * M; + arma::mat M_res = M - X * B; + const double sigma2 = accu(diagmat(w) * (pow(M_res, 2) + S2)) / (double(p) * w_bar); + arma::sp_mat Sigma(p, p); Sigma.diag() = arma::ones(p) * sigma2; + arma::sp_mat Omega(p, p); Omega.diag() = arma::ones(p) * pow(sigma2, -1); + arma::mat Z = O + M; + arma::mat A = exp(Z + 0.5 * S2); + arma::mat loglik = sum(Y % Z - A - 0.5 * (pow(M_res, 2) + S2) / sigma2 + 0.5 * (logS2 - log(sigma2)), 1) + ki(Y); + + Rcpp::NumericVector Ji = Rcpp::as(Rcpp::wrap(loglik)); + Ji.attr("weights") = w; + return Rcpp::List::create( + Rcpp::Named("B", B), + Rcpp::Named("M", M), + Rcpp::Named("S2", S2), + Rcpp::Named("Z", Z), + Rcpp::Named("A", A), + Rcpp::Named("Sigma", Sigma), + Rcpp::Named("Omega", Omega), + Rcpp::Named("Ji", Ji), + Rcpp::Named("monitoring", Rcpp::List::create( + Rcpp::Named("status", static_cast(result.status)), + Rcpp::Named("backend", "nlopt"), + Rcpp::Named("objective", objective_vec), + Rcpp::Named("iterations", result.nb_iterations) + )) + ); +} + +// --------------------------------------------------------------------------------------- +// VE spherical — nlopt/CCSAQ (M and S only, B and Omega fixed) + +// [[Rcpp::export]] +Rcpp::List nlopt_optimize_vestep_spherical( + const Rcpp::List & data , // List(Y, X, O, w) + const Rcpp::List & params, // List(M, S) + const arma::mat & B, // (d,p) + const arma::mat & Omega, // (p,p) + const Rcpp::List & config // List of config values +) { + // Conversion from R, prepare optimization + const arma::mat & Y = Rcpp::as(data["Y"]); // responses (n,p) + const arma::mat & X = Rcpp::as(data["X"]); // covariates (n,d) + const arma::mat & O = Rcpp::as(data["O"]); // offsets (n,p) + const arma::vec & w = Rcpp::as(data["w"]); // weights (n) + const auto init_M = Rcpp::as(params["M"]); // (n,p) + const auto init_S2 = Rcpp::as(params["S2"]); // (n,p) + + const auto metadata = tuple_metadata(init_M, init_S2); + enum { M_ID, S_ID }; // Names for metadata indexes + + auto parameters = std::vector(metadata.packed_size); + metadata.map(parameters.data()) = init_M; + metadata.map(parameters.data()) = arma::log(init_S2); // pack logS2 + + // Optimize + auto optimizer = new_nlopt_optimizer(config, parameters.size()); + std::vector objective_vec ; + objective_vec.reserve(nlopt_get_maxeval(optimizer.get())); + + const arma::mat XB = X * B; // B is fixed; precompute XB for M_res = M - XB + const double omega2 = Omega(0, 0); // fixed precision = 1/sigma2 + + // Vestep: M_full is the NLOPT parameter; B and Omega fixed by the caller + auto objective_and_grad = [&](const double * params, double * grad) -> double { + const arma::mat M = metadata.map(params); + const arma::mat logS2 = metadata.map(params); + const arma::mat S2 = arma::exp(logS2); + const arma::mat M_res = M - XB; + const double penalty = 0.5 * omega2 * accu(arma::diagmat(w) * (arma::pow(M_res, 2) + S2)); + arma::mat gM, gS; + const double obj = spherical_cov_obj_grad_impl(M_res, O + M, S2, logS2, + omega2, penalty, Y, w, gM, gS); + metadata.map(grad) = gM; + metadata.map(grad) = gS; + objective_vec.push_back(obj); + return obj; + }; + OptimizerResult result = minimize_objective_on_parameters(optimizer.get(), objective_and_grad, parameters); + + // Model and variational parameters + arma::mat M = metadata.copy(parameters.data()); // M_full + arma::mat logS2 = metadata.copy(parameters.data()); + arma::mat S2 = arma::exp(logS2); + arma::mat M_res = M - XB; + // Element-wise log-likelihood + arma::mat Z = O + M; + arma::mat A = exp(Z + 0.5 * S2); + arma::mat loglik = sum(Y % Z - A - 0.5 * (pow(M_res, 2) + S2) * omega2 + 0.5 * (logS2 + log(omega2)), 1) + ki(Y); + + Rcpp::NumericVector Ji = Rcpp::as(Rcpp::wrap(loglik)); + Ji.attr("weights") = w; + return Rcpp::List::create( + Rcpp::Named("M") = M, + Rcpp::Named("S2") = S2, + Rcpp::Named("Ji") = Ji, + Rcpp::Named("monitoring", Rcpp::List::create( + Rcpp::Named("status", static_cast(result.status)), + Rcpp::Named("backend", "nlopt"), + Rcpp::Named("objective", objective_vec), + Rcpp::Named("iterations", result.nb_iterations) + )) + ); +} diff --git a/src/nlopt_wrapper.cpp b/src/nlopt_wrapper.cpp index 85c3bd5a..6b680a8b 100644 --- a/src/nlopt_wrapper.cpp +++ b/src/nlopt_wrapper.cpp @@ -85,35 +85,6 @@ std::unique_ptr new_nlopt_optimizer(const Rcpp::List return opt; } -// void set_uniform_x_weights(NloptStruct * opt, double value) { -// if(nlopt_set_x_weights1(opt, value) != NLOPT_SUCCESS) { -// throw Rcpp::exception("nlopt_set_x_weights1"); -// } -// } -// -// void set_per_value_x_weights(NloptStruct * opt, const std::vector & x_weights) { -// if(x_weights.size() != nlopt_get_dimension(opt)) { -// throw Rcpp::exception("set_per_value_xtol_weights: parameter size mismatch"); -// } -// if(nlopt_set_x_weights(opt, x_weights.data()) != NLOPT_SUCCESS) { -// throw Rcpp::exception("nlopt_set_x_weights"); -// } -// } -// -// void set_uniform_xtol_abs(NloptStruct * opt, double value) { -// if(nlopt_set_xtol_abs1(opt, value) != NLOPT_SUCCESS) { -// throw Rcpp::exception("nlopt_set_xtol_abs1"); -// } -// } -// void set_per_value_xtol_abs(NloptStruct * opt, const std::vector & xtol_abs) { -// if(xtol_abs.size() != nlopt_get_dimension(opt)) { -// throw Rcpp::exception("set_per_value_xtol_abs: parameter size mismatch"); -// } -// if(nlopt_set_xtol_abs(opt, xtol_abs.data()) != NLOPT_SUCCESS) { -// throw Rcpp::exception("nlopt_set_xtol_abs"); -// } -// } - // --------------------------------------------------------------------------------------- // sanity test and example @@ -143,18 +114,12 @@ bool cpp_test_nlopt() { auto optimizer = new_nlopt_optimizer(config, x.size()); - // set_uniform_xtol_abs(optimizer.get(), 0); - // set_uniform_x_weights(optimizer.get(), 1.); - check(nlopt_get_algorithm(optimizer.get()) == NLOPT_LD_LBFGS, "optim algorithm"); check(nlopt_get_ftol_abs(optimizer.get()) == 0.0, "optim ftol_abs"); check(nlopt_get_ftol_rel(optimizer.get()) == 0.0, "optim ftol_rel"); check(nlopt_get_xtol_rel(optimizer.get()) == 1e-12, "optim xtol_rel"); auto f_and_grad = [check](const double * x, double * grad) -> double { - // double v = x[0]; - // grad[0] = 2. * v; - // return v * v; double x1sq = x[0] * x[0] ; double obj = 100*std::pow(x[1] - x1sq,2) + std::pow(1-x[0],2); @@ -169,7 +134,6 @@ bool cpp_test_nlopt() { check(r.status != NLOPT_FAILURE, "optim status"); x = std::vector{1.5, -2}; - // set_uniform_x_weights(optimizer.get(), 1.0); r = minimize_objective_on_parameters(optimizer.get(), f_and_grad, x); return success; diff --git a/src/nlopt_wrapper.h b/src/nlopt_wrapper.h index 857e6529..e97e43cd 100644 --- a/src/nlopt_wrapper.h +++ b/src/nlopt_wrapper.h @@ -23,16 +23,6 @@ struct NloptDeleter { // xtol_rel, ftol_abs, ftol_rel, maxeval, maxtime. std::unique_ptr new_nlopt_optimizer(const Rcpp::List & config, std::size_t size); -// Helpers to set xtol_abs (uniform or per-parameter packed array). -// This is not done by new_nlopt_optimizer as it may require packing values, which must be user specified. -// void set_uniform_xtol_abs(NloptStruct * opt, double value); -// void set_per_value_xtol_abs(NloptStruct * opt, const std::vector & xtol_abs); - -// Helpers to set x_weights (uniform or per-parameter packed array). -// This is not done by new_nlopt_optimizer as it may require packing values, which must be user specified. -// void set_uniform_x_weights(NloptStruct * opt, double value); -// void set_per_value_x_weights(NloptStruct * opt, const std::vector & x_weigths); - struct OptimizerResult { nlopt_result status; double objective; diff --git a/src/optim_diag_cov.cpp b/src/optim_diag_cov.cpp deleted file mode 100644 index 01d9558c..00000000 --- a/src/optim_diag_cov.cpp +++ /dev/null @@ -1,176 +0,0 @@ -#include "RcppArmadillo.h" - -// [[Rcpp::depends(RcppArmadillo)]] -// [[Rcpp::depends(nloptr)]] - -#include "nlopt_wrapper.h" -#include "packing.h" -#include "utils.h" - -// --------------------------------------------------------------------------------------- -// Diagonal covariance - -// [[Rcpp::export]] -Rcpp::List nlopt_optimize_diagonal( - const Rcpp::List & data , // List(Y, X, O, w) - const Rcpp::List & params, // List(B, M, S) - const Rcpp::List & config // List of config values -) { - // Conversion from R, prepare optimization - const arma::mat & Y = Rcpp::as(data["Y"]); // responses (n,p) - const arma::mat & X = Rcpp::as(data["X"]); // covariates (n,d) - const arma::mat & O = Rcpp::as(data["O"]); // offsets (n,p) - const arma::vec & w = Rcpp::as(data["w"]); // weights (n) - const auto init_B = Rcpp::as(params["B"]); // (d,p) - const auto init_M = Rcpp::as(params["M"]); // (n,p) - const auto init_S = Rcpp::as(params["S"]); // (n,p) - - const auto metadata = tuple_metadata(init_B, init_M, init_S); - enum { B_ID, M_ID, S_ID }; // Names for metadata indexes - - auto parameters = std::vector(metadata.packed_size); - metadata.map(parameters.data()) = init_B; - metadata.map(parameters.data()) = init_M; - metadata.map(parameters.data()) = init_S; - - auto optimizer = new_nlopt_optimizer(config, parameters.size()); - std::vector objective_vec ; - const double w_bar = accu(w); - - // Optimize - auto objective_and_grad = [&metadata, &O, &X, &Y, &w, &w_bar, &objective_vec](const double * params, double * grad) -> double { - const arma::mat B = metadata.map(params); - const arma::mat M = metadata.map(params); - const arma::mat S = metadata.map(params); - - arma::mat S2 = S % S; - arma::mat Z = O + X * B + M; - arma::mat A = exp(Z + 0.5 * S2); - arma::rowvec diag_sigma = w.t() * (M % M + S2) / w_bar; - double objective = accu(diagmat(w) * (A - Y % Z - 0.5 * log(S2))) + 0.5 * w_bar * accu(log(diag_sigma)); - - metadata.map(grad) = (X.each_col() % w).t() * (A - Y); - metadata.map(grad) = diagmat(w) * ((M.each_row() / diag_sigma) + A - Y); - metadata.map(grad) = diagmat(w) * (S.each_row() % pow(diag_sigma, -1) + S % A - pow(S, -1)) ; - - objective_vec.push_back(objective) ; - - return objective; - }; - OptimizerResult result = minimize_objective_on_parameters(optimizer.get(), objective_and_grad, parameters); - - // Variational parameters - arma::mat M = metadata.copy(parameters.data()); - arma::mat S = metadata.copy(parameters.data()); - arma::mat S2 = S % S; - // Regression parameters - arma::mat B = metadata.copy(parameters.data()); - // Variance parameters - arma::rowvec sigma2 = w.t() * (M % M + S2) / w_bar; - arma::vec omega2 = pow(sigma2.t(), -1); - arma::sp_mat Sigma(Y.n_cols, Y.n_cols); - Sigma.diag() = sigma2; - arma::sp_mat Omega(Y.n_cols, Y.n_cols); - Omega.diag() = omega2; - // Element-wise log-likelihood - arma::mat Z = O + X * B + M; - arma::mat A = exp(Z + 0.5 * S2); - arma::mat loglik = - sum(Y % Z - A + 0.5 * log(S2), 1) - 0.5 * (pow(M, 2) + S2) * omega2 + 0.5 * sum(log(omega2)) + ki(Y); - - Rcpp::NumericVector Ji = Rcpp::as(Rcpp::wrap(loglik)); - Ji.attr("weights") = w; - return Rcpp::List::create( - Rcpp::Named("B", B), - Rcpp::Named("Sigma", Sigma), - Rcpp::Named("Omega", Omega), - Rcpp::Named("M", M), - Rcpp::Named("S", S), - Rcpp::Named("Z", Z), - Rcpp::Named("A", A), - Rcpp::Named("Ji", Ji), - Rcpp::Named("monitoring", Rcpp::List::create( - Rcpp::Named("status", static_cast(result.status)), - Rcpp::Named("backend", "nlopt"), - Rcpp::Named("objective", objective_vec), - Rcpp::Named("iterations", result.nb_iterations) - )) - ); -} - -// --------------------------------------------------------------------------------------- -// VE diagonal - -// [[Rcpp::export]] -Rcpp::List nlopt_optimize_vestep_diagonal( - const Rcpp::List & data , // List(Y, X, O, w) - const Rcpp::List & params, // List(M, S) - const arma::mat & B, // (d,p) - const arma::mat & Omega, // (p,p) - const Rcpp::List & config // List of config values -) { - // Conversion from R, prepare optimization - // Conversion from R, prepare optimization - const arma::mat & Y = Rcpp::as(data["Y"]); // responses (n,p) - const arma::mat & X = Rcpp::as(data["X"]); // covariates (n,d) - const arma::mat & O = Rcpp::as(data["O"]); // offsets (n,p) - const arma::vec & w = Rcpp::as(data["w"]); // weights (n) - const auto init_M = Rcpp::as(params["M"]); // (n,p) - const auto init_S = Rcpp::as(params["S"]); // (n,p) - - const auto metadata = tuple_metadata(init_M, init_S); - enum { M_ID, S_ID }; // Names for metadata indexes - - auto parameters = std::vector(metadata.packed_size); - metadata.map(parameters.data()) = init_M; - metadata.map(parameters.data()) = init_S; - - auto optimizer = new_nlopt_optimizer(config, parameters.size()); - std::vector objective_vec ; - - // Optimize - auto objective_and_grad = [&metadata, &O, &X, &Y, &w, &B, &Omega, &objective_vec](const double * params, double * grad) -> double { - const arma::mat M = metadata.map(params); - const arma::mat S = metadata.map(params); - - arma::mat S2 = S % S; - arma::mat Z = O + X * B + M; - arma::mat A = exp(Z + 0.5 * S2); - arma::vec omega2 = arma::diagvec(Omega); - double objective = - accu(w.t() * (A - Y % Z - 0.5 * log(S2))) + 0.5 * as_scalar(w.t() * (pow(M, 2) + S2) * omega2) ; - - metadata.map(grad) = diagmat(w) * (M * arma::diagmat(omega2) + A - Y); - metadata.map(grad) = diagmat(w) * (S.each_row() % omega2.t() + S % A - pow(S, -1)); - - objective_vec.push_back(objective) ; - - return objective; - }; - OptimizerResult result = minimize_objective_on_parameters(optimizer.get(), objective_and_grad, parameters); - - // Model and variational parameters - arma::mat M = metadata.copy(parameters.data()); - arma::mat S = metadata.copy(parameters.data()); - arma::mat S2 = S % S; - arma::vec omega2 = Omega.diag(); - // Element-wise log-likelihood - arma::mat Z = O + X * B + M; - arma::mat A = exp(Z + 0.5 * S2); - arma::mat loglik = - sum(Y % Z - A + 0.5 * log(S2), 1) - 0.5 * (pow(M, 2) + S2) * omega2 + 0.5 * sum(log(omega2)) + ki(Y); - - Rcpp::NumericVector Ji = Rcpp::as(Rcpp::wrap(loglik)); - Ji.attr("weights") = w; - return Rcpp::List::create( - Rcpp::Named("M") = M, - Rcpp::Named("S") = S, - Rcpp::Named("Ji") = Ji, - Rcpp::Named("monitoring", Rcpp::List::create( - Rcpp::Named("status", static_cast(result.status)), - Rcpp::Named("backend", "nlopt"), - Rcpp::Named("objective", objective_vec), - Rcpp::Named("iterations", result.nb_iterations) - )) - ); -} diff --git a/src/optim_fixed_cov.cpp b/src/optim_fixed_cov.cpp deleted file mode 100644 index 5ef92808..00000000 --- a/src/optim_fixed_cov.cpp +++ /dev/null @@ -1,93 +0,0 @@ -#include "RcppArmadillo.h" - -// [[Rcpp::depends(RcppArmadillo)]] -// [[Rcpp::depends(nloptr)]] - -#include "nlopt_wrapper.h" -#include "packing.h" -#include "utils.h" - -// --------------------------------------------------------------------------------------- -// Fixed inverse covariance (Omega) - -// [[Rcpp::export]] -Rcpp::List nlopt_optimize_fixed( - const Rcpp::List & data , // List(Y, X, O, w) - const Rcpp::List & params, // List(B, M, S) - const Rcpp::List & config // List of config values -) { - // Conversion from R, prepare optimization - const arma::mat & Y = Rcpp::as(data["Y"]); // responses (n,p) - const arma::mat & X = Rcpp::as(data["X"]); // covariates (n,d) - const arma::mat & O = Rcpp::as(data["O"]); // offsets (n,p) - const arma::vec & w = Rcpp::as(data["w"]); // weights (n) - const auto init_B = Rcpp::as(params["B"]); // (d,p) - const auto init_M = Rcpp::as(params["M"]); // (n,p) - const auto init_S = Rcpp::as(params["S"]); // (n,p) - const auto Omega = Rcpp::as(params["Omega"]); // covinv (p,p) - - const auto metadata = tuple_metadata(init_B, init_M, init_S); - enum { B_ID, M_ID, S_ID }; // Names for metadata indexes - - auto parameters = std::vector(metadata.packed_size); - metadata.map(parameters.data()) = init_B; - metadata.map(parameters.data()) = init_M; - metadata.map(parameters.data()) = init_S; - - // Optimize - auto optimizer = new_nlopt_optimizer(config, parameters.size()); - std::vector objective_vec ; - - auto objective_and_grad = [&metadata, &O, &X, &Y, &w, &Omega, &objective_vec](const double * params, double * grad) -> double { - const arma::mat B = metadata.map(params); - const arma::mat M = metadata.map(params); - const arma::mat S = metadata.map(params); - - arma::mat S2 = S % S; - arma::mat Z = O + X * B + M; - arma::mat A = exp(Z + 0.5 * S2); - arma::mat nSigma = M.t() * (M.each_col() % w) + diagmat(w.t() * S2); - double objective = accu(w.t() * (A - Y % Z - 0.5 * log(S2))) + 0.5 * trace(Omega * nSigma); - - metadata.map(grad) = (X.each_col() % w).t() * (A - Y); - metadata.map(grad) = diagmat(w) * (M * Omega + A - Y); - metadata.map(grad) = diagmat(w) * (S.each_row() % diagvec(Omega).t() + S % A - pow(S, -1)) ; - - objective_vec.push_back(objective) ; - - return objective; - }; - OptimizerResult result = minimize_objective_on_parameters(optimizer.get(), objective_and_grad, parameters); - - // Model and variational parameters - arma::mat B = metadata.copy(parameters.data()); - arma::mat M = metadata.copy(parameters.data()); - arma::mat S = metadata.copy(parameters.data()); - arma::mat S2 = S % S; - arma::mat Sigma = (M.t() * (M.each_col() % w) + diagmat(w.t() * S2)) / accu(w); - // Element-wise log-likelihood - arma::mat Z = O + X * B + M; - arma::mat A = exp(Z + 0.5 * S2); - arma::mat loglik = sum(Y % Z - A - 0.5 * ((M * Omega) % M - log(S2) + S2 * diagmat(Omega)), 1) + - 0.5 * real(log_det(Omega)) + ki(Y); - - Rcpp::NumericVector Ji = Rcpp::as(Rcpp::wrap(loglik)); - Ji.attr("weights") = w; - return Rcpp::List::create( - Rcpp::Named("B", B), - Rcpp::Named("M", M), - Rcpp::Named("S", S), - Rcpp::Named("Z", Z), - Rcpp::Named("A", A), - Rcpp::Named("Sigma", Sigma), - Rcpp::Named("Omega", Omega), - Rcpp::Named("Ji", Ji), - Rcpp::Named("monitoring", Rcpp::List::create( - Rcpp::Named("status", static_cast(result.status)), - Rcpp::Named("backend", "nlopt"), - Rcpp::Named("objective", objective_vec), - Rcpp::Named("iterations", result.nb_iterations) - )) - ); -} - diff --git a/src/optim_full_cov.cpp b/src/optim_full_cov.cpp deleted file mode 100644 index 0e43698a..00000000 --- a/src/optim_full_cov.cpp +++ /dev/null @@ -1,170 +0,0 @@ -#include "RcppArmadillo.h" - -// [[Rcpp::depends(RcppArmadillo)]] -// [[Rcpp::depends(nloptr)]] - -#include "nlopt_wrapper.h" -#include "packing.h" -#include "utils.h" - -// --------------------------------------------------------------------------------------- -// Fully parametrized covariance - -// [[Rcpp::export]] -Rcpp::List nlopt_optimize( - const Rcpp::List & data , // List(Y, X, O, w) - const Rcpp::List & params, // List(B, M, S) - const Rcpp::List & config // List of config values -) { - // Conversion from R, prepare optimization - const arma::mat & Y = Rcpp::as(data["Y"]); // responses (n,p) - const arma::mat & X = Rcpp::as(data["X"]); // covariates (n,d) - const arma::mat & O = Rcpp::as(data["O"]); // offsets (n,p) - const arma::vec & w = Rcpp::as(data["w"]); // weights (n) - const auto init_B = Rcpp::as(params["B"]); // (d,p) - const auto init_M = Rcpp::as(params["M"]); // (n,p) - const auto init_S = Rcpp::as(params["S"]); // (n,p) - - const auto metadata = tuple_metadata(init_B, init_M, init_S); - enum { B_ID, M_ID, S_ID }; // Names for metadata indexes - - auto parameters = std::vector(metadata.packed_size); - metadata.map(parameters.data()) = init_B; - metadata.map(parameters.data()) = init_M; - metadata.map(parameters.data()) = init_S; - - // Optimize - auto optimizer = new_nlopt_optimizer(config, parameters.size()); - std::vector objective_vec ; - const double w_bar = accu(w); - - auto objective_and_grad = [&metadata, &Y, &X, &O, &w, &w_bar, &objective_vec](const double * params, double * grad) -> double { - const arma::mat B = metadata.map(params); - const arma::mat M = metadata.map(params); - const arma::mat S = metadata.map(params); - const double w_bar = accu(w); - - arma::mat S2 = S % S ; - arma::mat Z = O + X * B + M ; - arma::mat A = exp(Z + 0.5 * S2); - arma::mat Omega = w_bar * inv_sympd(M.t() * (M.each_col() % w) + diagmat(w.t() * S2)); - double objective = accu(w.t() * (A - Y % Z - 0.5 * trunc_log(S2))) - 0.5 * w_bar * real(log_det(Omega)); - - metadata.map(grad) = (X.each_col() % w).t() * (A - Y) ; - metadata.map(grad) = diagmat(w) * (M * Omega + A - Y) ; - metadata.map(grad) = diagmat(w) * (S.each_row() % diagvec(Omega).t() + S % A - pow(S, -1)) ; - - objective_vec.push_back(objective) ; - - return objective; - }; - OptimizerResult result = minimize_objective_on_parameters(optimizer.get(), objective_and_grad, parameters); - - // Variational parameters - arma::mat M = metadata.copy(parameters.data()); - arma::mat S = metadata.copy(parameters.data()); - arma::mat S2 = S % S; - // Regression parameters - arma::mat B = metadata.copy(parameters.data()); - // Variance parameters - arma::mat Sigma = (1. / w_bar) * (M.t() * (M.each_col() % w) + diagmat(w.t() * S2)); - arma::mat Omega = inv_sympd(Sigma); - // Element-wise log-likehood - arma::mat Z = O + X * B + M; - arma::mat A = exp(Z + 0.5 * S2); - arma::vec loglik = sum(Y % Z - A + 0.5 * log(S2) - 0.5 * ((M * Omega) % M + S2 * diagmat(Omega)), 1) + - 0.5 * real(log_det(Omega)) + ki(Y); - - Rcpp::NumericVector Ji = Rcpp::as(Rcpp::wrap(loglik)); - Ji.attr("weights") = w; - return Rcpp::List::create( - Rcpp::Named("B", B), - Rcpp::Named("M", M), - Rcpp::Named("S", S), - Rcpp::Named("Z", Z), - Rcpp::Named("A", A), - Rcpp::Named("Sigma", Sigma), - Rcpp::Named("Omega", Omega), - Rcpp::Named("Ji", Ji), - Rcpp::Named("monitoring", Rcpp::List::create( - Rcpp::Named("status", static_cast(result.status)), - Rcpp::Named("backend", "nlopt"), - Rcpp::Named("objective", objective_vec), - Rcpp::Named("iterations", result.nb_iterations) - )) - ); -} - -// --------------------------------------------------------------------------------------- -// VE full - -// [[Rcpp::export]] -Rcpp::List nlopt_optimize_vestep( - const Rcpp::List & data , // List(Y, X, O, w) - const Rcpp::List & params, // List(M, S) - const arma::mat & B, // (d,p) - const arma::mat & Omega, // (p,p) - const Rcpp::List & config // List of config values -) { - // Conversion from R, prepare optimization - const arma::mat & Y = Rcpp::as(data["Y"]); // responses (n,p) - const arma::mat & X = Rcpp::as(data["X"]); // covariates (n,d) - const arma::mat & O = Rcpp::as(data["O"]); // offsets (n,p) - const arma::vec & w = Rcpp::as(data["w"]); // weights (n) - const auto init_M = Rcpp::as(params["M"]); // (n,p) - const auto init_S = Rcpp::as(params["S"]); // (n,p) - - const auto metadata = tuple_metadata(init_M, init_S); - enum { M_ID, S_ID }; // Names for metadata indexes - - auto parameters = std::vector(metadata.packed_size); - metadata.map(parameters.data()) = init_M; - metadata.map(parameters.data()) = init_S; - - // Optimize - auto optimizer = new_nlopt_optimizer(config, parameters.size()); - std::vector objective_vec ; - - auto objective_and_grad = [&metadata, &O, &X, &Y, &w, &B, &Omega, &objective_vec](const double * params, double * grad) -> double { - const arma::mat M = metadata.map(params); - const arma::mat S = metadata.map(params); - - arma::mat S2 = S % S; - arma::mat Z = O + X * B + M; - arma::mat A = exp(Z + 0.5 * S2); - arma::mat nSigma = M.t() * (M.each_col() % w) + diagmat(w.t() * S2) ; - double objective = accu(w.t() * (A - Y % Z - 0.5 * log(S2))) + 0.5 * trace(Omega * nSigma) ; - - metadata.map(grad) = diagmat(w) * (M * Omega + A - Y); - metadata.map(grad) = diagmat(w) * (S.each_row() % diagvec(Omega).t() + S % A - pow(S, -1)); - - objective_vec.push_back(objective) ; - - return objective; - }; - OptimizerResult result = minimize_objective_on_parameters(optimizer.get(), objective_and_grad, parameters); - - // Model and variational parameters - arma::mat M = metadata.copy(parameters.data()); - arma::mat S = metadata.copy(parameters.data()); - arma::mat S2 = S % S; - // Element-wise log-likelihood - arma::mat Z = O + X * B + M; - arma::mat A = exp(Z + 0.5 * S2); - arma::vec loglik = sum(Y % Z - A + 0.5 * log(S2) - 0.5 * ((M * Omega) % M + S2 * diagmat(Omega)), 1) + - 0.5 * real(log_det(Omega)) + ki(Y); - - Rcpp::NumericVector Ji = Rcpp::as(Rcpp::wrap(loglik)); - Ji.attr("weights") = w; - return Rcpp::List::create( - Rcpp::Named("M") = M, - Rcpp::Named("S") = S, - Rcpp::Named("Ji") = Ji, - Rcpp::Named("monitoring", Rcpp::List::create( - Rcpp::Named("status", static_cast(result.status)), - Rcpp::Named("backend", "nlopt"), - Rcpp::Named("objective", objective_vec), - Rcpp::Named("iterations", result.nb_iterations) - )) - ); -} diff --git a/src/optim_genet_cov.cpp b/src/optim_genet_cov.cpp index 356cfbb1..45be120d 100644 --- a/src/optim_genet_cov.cpp +++ b/src/optim_genet_cov.cpp @@ -44,8 +44,10 @@ Rcpp::List nlopt_optimize_genetic_modeling( arma::mat V; arma::eig_sym(Lambda, V, C); + const arma::mat Xw = X.each_col() % w; // fixed: precomputed once + // Optimize - auto objective_and_grad = [&metadata, &Y, &X, &O, &V, &Lambda, &w, &w_bar](const double * params, double * grad) -> double { + auto objective_and_grad = [&metadata, &Y, &X, &Xw, &O, &V, &Lambda, &w, &w_bar](const double * params, double * grad) -> double { const arma::mat Theta = metadata.map(params); const arma::mat M = metadata.map(params); const arma::mat S = metadata.map(params); @@ -64,7 +66,7 @@ Rcpp::List nlopt_optimize_genetic_modeling( 0.5 * trace(Omega * (M.t() * (M.each_col() % w) + diagmat(w.t() * S2))) + 0.5 * w_bar * accu(log(u * sigma2)); - metadata.map(grad) = (A - Y).t() * (X.each_col() % w); + metadata.map(grad) = (A - Y).t() * Xw; metadata.map(grad) = diagmat(w) * (M * Omega + A - Y); metadata.map(grad) = diagmat(w) * (S.each_row() % diagvec(Omega).t() + S % A - pow(S, -1)); metadata.map(grad) = accu(0.5 * w_bar * (Lambda - 1) / u - (0.5/sigma2) * diagvec(R) % (Lambda - 1) / pow(u, 2) ); diff --git a/src/optim_rank_cov.cpp b/src/optim_rank_cov.cpp deleted file mode 100644 index 0f09f052..00000000 --- a/src/optim_rank_cov.cpp +++ /dev/null @@ -1,172 +0,0 @@ -#include "RcppArmadillo.h" - -// [[Rcpp::depends(RcppArmadillo)]] -// [[Rcpp::depends(nloptr)]] - -#include "nlopt_wrapper.h" -#include "packing.h" -#include "utils.h" - -// --------------------------------------------------------------------------------------- -// Rank-constrained covariance - -// Rank (q) is already determined by param dimensions ; not passed anywhere - -// [[Rcpp::export]] -Rcpp::List nlopt_optimize_rank( - const Rcpp::List & data , // List(Y, X, O, w) - const Rcpp::List & params, // List(B, C, M, S) - const Rcpp::List & config // List of config values -) { - // Conversion from R, prepare optimization - const arma::mat & Y = Rcpp::as(data["Y"]); // responses (n,p) - const arma::mat & X = Rcpp::as(data["X"]); // covariates (n,d) - const arma::mat & O = Rcpp::as(data["O"]); // offsets (n,p) - const arma::vec & w = Rcpp::as(data["w"]); // weights (n) - const auto init_B = Rcpp::as(params["B"]); // (d,p) - const auto init_C = Rcpp::as(params["C"]); // (p,q) - const auto init_M = Rcpp::as(params["M"]); // (n,q) - const auto init_S = Rcpp::as(params["S"]); // (n,q) - - const auto metadata = tuple_metadata(init_B, init_C, init_M, init_S); - enum { B_ID, C_ID, M_ID, S_ID }; // Names for metadata indexes - - auto parameters = std::vector(metadata.packed_size); - metadata.map(parameters.data()) = init_B; - metadata.map(parameters.data()) = init_C; - metadata.map(parameters.data()) = init_M; - metadata.map(parameters.data()) = init_S; - - // Optimize - auto optimizer = new_nlopt_optimizer(config, parameters.size()); - std::vector objective_vec ; - - auto objective_and_grad = [&metadata, &O, &X, &Y, &w, &objective_vec](const double * params, double * grad) -> double { - const arma::mat B = metadata.map(params); - const arma::mat C = metadata.map(params); - const arma::mat M = metadata.map(params); - const arma::mat S = metadata.map(params); - - arma::mat S2 = S % S; - arma::mat Z = O + X * B + M * C.t(); - arma::mat A = exp(Z + 0.5 * S2 * (C % C).t()); - double objective = accu(diagmat(w) * (A - Y % Z)) + 0.5 * accu(diagmat(w) * (M % M + S2 - log(S2) - 1.)); - - metadata.map(grad) = (X.each_col() % w).t() * (A - Y); - metadata.map(grad) = (diagmat(w) * (A - Y)).t() * M + (A.t() * (S2.each_col() % w)) % C; - metadata.map(grad) = diagmat(w) * ((A - Y) * C + M); - metadata.map(grad) = diagmat(w) * (S - 1. / S + A * (C % C) % S) ; - - objective_vec.push_back(objective) ; - - return objective; - }; - OptimizerResult result = minimize_objective_on_parameters(optimizer.get(), objective_and_grad, parameters); - - // Model and variational parameters - arma::mat B = metadata.copy(parameters.data()); - arma::mat C = metadata.copy(parameters.data()); - arma::mat M = metadata.copy(parameters.data()); - arma::mat S = metadata.copy(parameters.data()); - arma::mat S2 = S % S; - arma::mat Sigma = C * (M.t() * (M.each_col() % w) + diagmat(sum(S2.each_col() % w, 0))) * C.t() / accu(w); - arma::mat Omega = C * inv_sympd((M.t() * (M.each_col() % w) + diagmat(sum(S2.each_col() % w, 0)))/accu(w)) * C.t() ; - // Element-wise log-likelihood - arma::mat Z = O + X * B + M * C.t(); - arma::mat A = exp(Z + 0.5 * S2 * (C % C).t()); - arma::mat loglik = arma::sum(Y % Z - A, 1) - 0.5 * sum(M % M + S2 - log(S2) - 1., 1) + ki(Y); - - Rcpp::NumericVector Ji = Rcpp::as(Rcpp::wrap(loglik)); - Ji.attr("weights") = w; - return Rcpp::List::create( - Rcpp::Named("B", B), - Rcpp::Named("C", C), - Rcpp::Named("M", M), - Rcpp::Named("S", S), - Rcpp::Named("Z", Z), - Rcpp::Named("A", A), - Rcpp::Named("Sigma", Sigma), - Rcpp::Named("Omega", Omega), - Rcpp::Named("Ji", Ji), - Rcpp::Named("monitoring", Rcpp::List::create( - Rcpp::Named("status", static_cast(result.status)), - Rcpp::Named("backend", "nlopt"), - Rcpp::Named("objective", objective_vec), - Rcpp::Named("iterations", result.nb_iterations) - )) - ); -} - -// --------------------------------------------------------------------------------------- -// VE rank -// Rank-constrained covariance (for prediction in the PCA space) - -// [[Rcpp::export]] -Rcpp::List nlopt_optimize_vestep_rank( - const Rcpp::List & data , // List(Y, X, O, w) - const Rcpp::List & params, // List(M, S) - const arma::mat & B, // (d,p) - const arma::mat & C, // (p,q) - const Rcpp::List & config // List of config values -) { - // Conversion from R, prepare optimization - const arma::mat & Y = Rcpp::as(data["Y"]); // responses (n,p) - const arma::mat & X = Rcpp::as(data["X"]); // covariates (n,d) - const arma::mat & O = Rcpp::as(data["O"]); // offsets (n,p) - const arma::vec & w = Rcpp::as(data["w"]); // weights (n) - const auto init_M = Rcpp::as(params["M"]); // (n,q) - const auto init_S = Rcpp::as(params["S"]); // (n,q) - - const auto metadata = tuple_metadata(init_M, init_S); - enum { M_ID, S_ID }; // Names for metadata indexes - - auto parameters = std::vector(metadata.packed_size); - metadata.map(parameters.data()) = init_M; - metadata.map(parameters.data()) = init_S; - - // Optimize - auto optimizer = new_nlopt_optimizer(config, parameters.size()); - std::vector objective_vec ; - - auto objective_and_grad = [&metadata, &O, &X, &Y, &w, &B, &C, &objective_vec](const double * params, double * grad) -> double { - const arma::mat M = metadata.map(params); - const arma::mat S = metadata.map(params); - - arma::mat S2 = S % S; - arma::mat Z = O + X * B + M * C.t(); - arma::mat A = exp(Z + 0.5 * S2 * (C % C).t()); - arma::mat nSigma = M.t() * (M.each_col() % w) + diagmat(w.t() * S2) ; - double objective = accu(diagmat(w) * (A - Y % Z)) + 0.5 * accu(diagmat(w) * (M % M + S2 - log(S2) - 1.)); - - metadata.map(grad) = diagmat(w) * ((A - Y) * C + M); - metadata.map(grad) = diagmat(w) * (S - 1. / S + A * (C % C) % S); - - objective_vec.push_back(objective) ; - - return objective; - }; - OptimizerResult result = minimize_objective_on_parameters(optimizer.get(), objective_and_grad, parameters); - - // Model and variational parameters - arma::mat M = metadata.copy(parameters.data()); - arma::mat S = metadata.copy(parameters.data()); - arma::mat S2 = S % S; - // Element-wise log-likelihood - arma::mat Z = O + X * B + M * C.t(); - arma::mat A = exp(Z + 0.5 * S2 * (C % C).t()); - arma::mat loglik = arma::sum(Y % Z - A, 1) - 0.5 * sum(M % M + S2 - log(S2) - 1., 1) + ki(Y); - - Rcpp::NumericVector Ji = Rcpp::as(Rcpp::wrap(loglik)); - Ji.attr("weights") = w; - return Rcpp::List::create( - Rcpp::Named("M") = M, - Rcpp::Named("S") = S, - Rcpp::Named("Ji") = Ji, - Rcpp::Named("monitoring", Rcpp::List::create( - Rcpp::Named("status", static_cast(result.status)), - Rcpp::Named("backend", "nlopt"), - Rcpp::Named("objective", objective_vec), - Rcpp::Named("iterations", result.nb_iterations) - )) - ); -} diff --git a/src/optim_spherical.cpp b/src/optim_spherical.cpp deleted file mode 100644 index 784099a9..00000000 --- a/src/optim_spherical.cpp +++ /dev/null @@ -1,173 +0,0 @@ -#include "RcppArmadillo.h" - -// [[Rcpp::depends(RcppArmadillo)]] -// [[Rcpp::depends(nloptr)]] - -#include "nlopt_wrapper.h" -#include "packing.h" -#include "utils.h" - -// --------------------------------------------------------------------------------------- -// Spherical covariance - -// [[Rcpp::export]] -Rcpp::List nlopt_optimize_spherical( - const Rcpp::List & data , // List(Y, X, O, w) - const Rcpp::List & params, // List(B, M, S) - const Rcpp::List & config // List of config values -) { - // Conversion from R, prepare optimization - const arma::mat & Y = Rcpp::as(data["Y"]); // responses (n,p) - const arma::mat & X = Rcpp::as(data["X"]); // covariates (n,d) - const arma::mat & O = Rcpp::as(data["O"]); // offsets (n,p) - const arma::vec & w = Rcpp::as(data["w"]); // weights (n) - const auto init_B = Rcpp::as(params["B"]); // (d,p) - const auto init_M = Rcpp::as(params["M"]); // (n,p) - const auto init_S = Rcpp::as(params["S"]); // (n,p) - - const auto metadata = tuple_metadata(init_B, init_M, init_S); - enum { B_ID, M_ID, S_ID }; // Names for metadata indexes - - auto parameters = std::vector(metadata.packed_size); - metadata.map(parameters.data()) = init_B; - metadata.map(parameters.data()) = init_M; - metadata.map(parameters.data()) = init_S; - - // Optimize - auto optimizer = new_nlopt_optimizer(config, parameters.size()); - const double w_bar = accu(w); - std::vector objective_vec ; - - auto objective_and_grad = [&metadata, &O, &X, &Y, &w, &w_bar, &objective_vec](const double * params, double * grad) -> double { - const arma::mat B = metadata.map(params); - const arma::mat M = metadata.map(params); - const arma::mat S = metadata.map(params); - - arma::mat S2 = S % S; - const arma::uword p = Y.n_cols; - arma::mat Z = O + X * B + M; - arma::mat A = exp(Z + 0.5 * S2); - double sigma2 = accu(diagmat(w) * (pow(M, 2) + S2)) / (double(p) * w_bar) ; - double objective = accu(w.t() * (A - Y % Z - 0.5 * log(S2))) + 0.5 * (double(p) * w_bar) * log(sigma2) ; - - metadata.map(grad) = (X.each_col() % w).t() * (A - Y); - metadata.map(grad) = diagmat(w) * (M / sigma2 + A - Y); - metadata.map(grad) = diagmat(w) * (S / sigma2 + S % A - pow(S, -1)) ; - - objective_vec.push_back(objective) ; - - return objective; - }; - OptimizerResult result = minimize_objective_on_parameters(optimizer.get(), objective_and_grad, parameters); - - // Variational parameters - arma::mat M = metadata.copy(parameters.data()); - arma::mat S = metadata.copy(parameters.data()); - arma::mat S2 = S % S; - // Regression parameters - arma::mat B = metadata.copy(parameters.data()); - // Variance parameters - const arma::uword p = Y.n_cols; - const double sigma2 = accu(diagmat(w) * (pow(M, 2) + S2)) / (double(p) * w_bar) ; - arma::sp_mat Sigma(p,p); Sigma.diag() = arma::ones(p) * sigma2; - arma::sp_mat Omega(p,p); Omega.diag() = arma::ones(p) * pow(sigma2, -1); - // Element-wise log-likelihood - arma::mat Z = O + X * B + M; - arma::mat A = exp(Z + 0.5 * S2); - arma::mat loglik = sum(Y % Z - A - 0.5 * (pow(M, 2) + S2 ) / sigma2 + 0.5 * log(S2 / sigma2), 1) + ki(Y); - - Rcpp::NumericVector Ji = Rcpp::as(Rcpp::wrap(loglik)); - Ji.attr("weights") = w; - return Rcpp::List::create( - Rcpp::Named("B", B), - Rcpp::Named("Sigma", Sigma), - Rcpp::Named("Omega", Omega), - Rcpp::Named("M", M), - Rcpp::Named("S", S), - Rcpp::Named("Z", Z), - Rcpp::Named("A", A), - Rcpp::Named("Ji", Ji), - Rcpp::Named("monitoring", Rcpp::List::create( - Rcpp::Named("status", static_cast(result.status)), - Rcpp::Named("backend", "nlopt"), - Rcpp::Named("objective", objective_vec), - Rcpp::Named("iterations", result.nb_iterations) - )) - ); -} - -// --------------------------------------------------------------------------------------- -// VE spherical - -// [[Rcpp::export]] -Rcpp::List nlopt_optimize_vestep_spherical( - const Rcpp::List & data , // List(Y, X, O, w) - const Rcpp::List & params, // List(M, S) - const arma::mat & B, // (d,p) - const arma::mat & Omega, // (p,p) - const Rcpp::List & config // List of config values -) { - // Conversion from R, prepare optimization - const arma::mat & Y = Rcpp::as(data["Y"]); // responses (n,p) - const arma::mat & X = Rcpp::as(data["X"]); // covariates (n,d) - const arma::mat & O = Rcpp::as(data["O"]); // offsets (n,p) - const arma::vec & w = Rcpp::as(data["w"]); // weights (n) - const auto init_M = Rcpp::as(params["M"]); // (n,p) - const auto init_S = Rcpp::as(params["S"]); // (n) - - const auto metadata = tuple_metadata(init_M, init_S); - enum { M_ID, S_ID }; // Names for metadata indexes - - auto parameters = std::vector(metadata.packed_size); - metadata.map(parameters.data()) = init_M; - metadata.map(parameters.data()) = init_S; - - - // Optimize - auto optimizer = new_nlopt_optimizer(config, parameters.size()); - std::vector objective_vec ; - - auto objective_and_grad = [&metadata, &O, &X, &Y, &w, &B, &Omega, &objective_vec](const double * params, double * grad) -> double { - const arma::mat M = metadata.map(params); - const arma::mat S = metadata.map(params); - - arma::mat S2 = S % S; - arma::mat Z = O + X * B + M; - arma::mat A = exp(Z + 0.5 * S2); - double n_sigma2 = accu(diagmat(w) * (pow(M, 2) + S2)) ; - double omega2 = Omega(0, 0); - double objective = accu(w.t() * (A - Y % Z - 0.5 * log(S2))) + 0.5 * n_sigma2 * omega2; - - metadata.map(grad) = diagmat(w) * (M / omega2 + A - Y); - metadata.map(grad) = diagmat(w) * (S / omega2 + S % A - pow(S, -1)); - - objective_vec.push_back(objective) ; - - return objective; - }; - OptimizerResult result = minimize_objective_on_parameters(optimizer.get(), objective_and_grad, parameters); - - // Model and variational parameters - arma::mat M = metadata.copy(parameters.data()); - arma::mat S = metadata.copy(parameters.data()); - arma::mat S2 = S % S; - double omega2 = Omega(0, 0); - // Element-wise log-likelihood - arma::mat Z = O + X * B + M; - arma::mat A = exp(Z + 0.5 * S2); - arma::mat loglik = sum(Y % Z - A - 0.5 * (pow(M, 2) + S2 ) * omega2 + 0.5 * log(S2 * omega2), 1) + ki(Y); - - Rcpp::NumericVector Ji = Rcpp::as(Rcpp::wrap(loglik)); - Ji.attr("weights") = w; - return Rcpp::List::create( - Rcpp::Named("M") = M, - Rcpp::Named("S") = S, - Rcpp::Named("Ji") = Ji, - Rcpp::Named("monitoring", Rcpp::List::create( - Rcpp::Named("status", static_cast(result.status)), - Rcpp::Named("backend", "nlopt"), - Rcpp::Named("objective", objective_vec), - Rcpp::Named("iterations", result.nb_iterations) - )) - ); -} diff --git a/src/optim_zi-pln.cpp b/src/optim_zi-pln.cpp index 54ce748f..fb01c277 100644 --- a/src/optim_zi-pln.cpp +++ b/src/optim_zi-pln.cpp @@ -1,4 +1,7 @@ #include +#ifdef _OPENMP +#include +#endif // [[Rcpp::depends(RcppArmadillo)]] // [[Rcpp::depends(nloptr)]] @@ -8,6 +11,9 @@ #include "utils.h" #include "lambertW.h" +// All optimizers use the reparameterization ψ = log(S²) so the variance S² is +// always positive. The R/C++ interface passes S2 (variance) rather than S (std dev). + // [[Rcpp::export]] arma::vec zipln_vloglik( const arma::mat & Y, // responses (n,p) @@ -18,12 +24,11 @@ arma::vec zipln_vloglik( const arma::mat & B, // (d,p) const arma::mat & R, // (n,p) const arma::mat & M, // (n,p) - const arma::mat & S // (n,p) + const arma::mat & S2 // (n,p) variational variance ) { const arma::uword p = Y.n_cols; - const arma::mat S2 = S % S ; - const arma::mat A = trunc_exp(O + M + .5 * S2) ; + const arma::mat A = trunc_exp(O + M + .5 * S2) ; const arma::mat M_mu = M - X * B ; const arma::mat mu0 = logit(Pi) ; return ( @@ -31,45 +36,45 @@ arma::vec zipln_vloglik( + sum( (1 - R) % ( Y % (O + M) - A - logfact_mat(Y) ) + R % mu0 - trunc_log( 1 + exp(mu0) ) - + 0.5 * trunc_log(S2) - 0.5 * ((M_mu * Omega) % M_mu + S2 * diagmat(Omega)) + + 0.5 * trunc_log(S2) - 0.5 * ((M_mu * Omega) % M_mu + S2.each_row() % diagvec(Omega).t()) - R % trunc_log(R) - (1 - R) % trunc_log(1-R), 1) ) ; } // [[Rcpp::export]] arma::mat optim_zipln_Omega_full( - const arma::mat & M, // (n,p) - const arma::mat & X, // (n,d) - const arma::mat & B, // (d,p) - const arma::mat & S // (n,p) + const arma::mat & M, // (n,p) + const arma::mat & X, // (n,d) + const arma::mat & B, // (d,p) + const arma::mat & S2 // (n,p) variational variance ) { const arma::uword n = M.n_rows; arma::mat M_mu = M - X * B; - return (double(n) * inv_sympd(M_mu.t() * M_mu + diagmat(sum(S % S, 0)))); + return (double(n) * inv_sympd(M_mu.t() * M_mu + diagmat(sum(S2, 0)))); } // [[Rcpp::export]] arma::mat optim_zipln_Omega_spherical( - const arma::mat & M, // (n,p) - const arma::mat & X, // (n,d) - const arma::mat & B, // (d,p) - const arma::mat & S // (n,p) + const arma::mat & M, // (n,p) + const arma::mat & X, // (n,d) + const arma::mat & B, // (d,p) + const arma::mat & S2 // (n,p) variational variance ) { const arma::uword n = M.n_rows; const arma::uword p = M.n_cols; - double sigma2 = accu( pow(M - X * B, 2) + S % S ) / double(n * p) ; + double sigma2 = accu( arma::square(M - X * B) + S2 ) / double(n * p) ; return arma::diagmat(arma::ones(p)/sigma2) ; } // [[Rcpp::export]] arma::mat optim_zipln_Omega_diagonal( - const arma::mat & M, // (n,p) - const arma::mat & X, // (n,d) - const arma::mat & B, // (d,p) - const arma::mat & S // (n,p) + const arma::mat & M, // (n,p) + const arma::mat & X, // (n,d) + const arma::mat & B, // (d,p) + const arma::mat & S2 // (n,p) variational variance ) { const arma::uword n = M.n_rows; - return arma::diagmat(double(n) / sum( pow(M - X * B, 2) + S % S, 0)) ; + return arma::diagmat(double(n) / sum( arma::square(M - X * B) + S2, 0)) ; } // [[Rcpp::export]] @@ -97,14 +102,15 @@ Rcpp::List optim_zipln_zipar_covar( auto optimizer = new_nlopt_optimizer(configuration, parameters.size()); const arma::mat Xt_R = X0.t() * R; + const arma::mat X0t = X0.t(); // Optimize - auto objective_and_grad = [&metadata, &X0, &R, &Xt_R](const double * params, double * grad) -> double { + auto objective_and_grad = [&metadata, &X0, &X0t, &Xt_R](const double * params, double * grad) -> double { const arma::mat B0 = metadata.map(params); arma::mat e_mu0 = exp(X0 * B0); - double objective = -trace(Xt_R.t() * B0) + accu(log(1. + e_mu0)); - metadata.map(grad) = -Xt_R + X0.t() * (e_mu0 % pow(1. + e_mu0, -1)) ; + double objective = -accu(Xt_R % B0) + accu(log(1. + e_mu0)); + metadata.map(grad) = -Xt_R + X0t * (e_mu0 / (1. + e_mu0)) ; return objective; }; OptimizerResult result = minimize_objective_on_parameters(optimizer.get(), objective_and_grad, parameters); @@ -119,29 +125,17 @@ Rcpp::List optim_zipln_zipar_covar( // [[Rcpp::export]] arma::mat optim_zipln_R_var( - const arma::mat & Y, // responses (n,p) - const arma::mat & X, // covariates (n,d) - const arma::mat & O, // offsets (n,p) - const arma::mat & M, // (n,p) - const arma::mat & S, // (n,p) + const arma::mat & Y, // responses (n,p) + const arma::mat & X, // covariates (n,d) + const arma::mat & O, // offsets (n,p) + const arma::mat & M, // (n,p) + const arma::mat & S2, // (n,p) variational variance const arma::mat & Pi, // (d,p) - const arma::mat & B // covariates (n,d) + const arma::mat & B // covariates (n,d) ) { - arma::mat A = exp(O + M + 0.5 * S % S); - arma::mat R = pow(1. + exp(- (A + logit(Pi))), -1); - // Zero R_{i,j} if Y_{i,j} > 0 - // multiplication with f(sign(Y)) could work to zero stuff as there should not be any +inf - // using a loop as it is more explicit and should have ok performance in C++ - arma::uword n = Y.n_rows; - arma::uword p = Y.n_cols; - for(arma::uword i = 0; i < n; i += 1) { - for(arma::uword j = 0; j < p; j += 1) { - // Add fuzzy comparison ? - if(Y(i, j) > 0.) { - R(i, j) = 0.; - } - } - } + arma::mat A = exp(O + M + 0.5 * S2); + arma::mat R = 1. / (1. + exp(-(A + logit(Pi)))); + R %= arma::conv_to::from(Y < 0.5); return R; } @@ -152,26 +146,30 @@ double phi (double mu, double sigma2) { // [[Rcpp::export]] arma::mat optim_zipln_R_exact ( - const arma::mat & Y, // covariates (n,d) - const arma::mat & X, // covariates (n,d) - const arma::mat & O, // offsets (n,p) - const arma::mat & M, // (n,p) - const arma::mat & S, // (n,p) + const arma::mat & Y, // covariates (n,d) + const arma::mat & X, // covariates (n,d) + const arma::mat & O, // offsets (n,p) + const arma::mat & M, // (n,p) + const arma::mat & S2, // (n,p) variational variance const arma::mat & Pi, // (n,p) - const arma::mat & B // covariates (n,d) + const arma::mat & B // covariates (n,d) ) { arma::mat XB = X * B; arma::mat M_mu = M - XB; - arma::uword n = M.n_rows; - arma::uword p = M.n_cols; - arma::vec diag_Sigma = arma::diagvec((1./n) * (M_mu.t() * M_mu + diagmat(sum(S % S, 0)))) ; - arma::mat R = arma::zeros(n,p); - for(arma::uword i = 0; i < n; i += 1) { - for(arma::uword j = 0; j < p; j += 1) { + const int n = (int)M.n_rows; + const int p = (int)M.n_cols; + arma::vec diag_Sigma = (sum(M_mu % M_mu, 0) + sum(S2, 0)).t() / double(n); + arma::mat R = arma::zeros(n, p); + // lambertW0_CS is pure (no global state) — safe to parallelize +#ifdef _OPENMP +#pragma omp parallel for collapse(2) schedule(static) +#endif + for(int i = 0; i < n; i++) { + for(int j = 0; j < p; j++) { if(Y(i, j) < 0.5) { - double Phi = phi(O(i,j) + XB(i,j), diag_Sigma(j)) ; - R(i,j) = Pi(i,j) / (Phi * (1 - Pi(i,j)) + Pi(i,j)) ; + double Phi = phi(O(i,j) + XB(i,j), diag_Sigma(j)); + R(i,j) = Pi(i,j) / (Phi * (1 - Pi(i,j)) + Pi(i,j)); } } } @@ -185,7 +183,7 @@ Rcpp::List optim_zipln_M( const arma::mat & X, // covariates (n,d) const arma::mat & O, // offsets (n, p) const arma::mat & R, // (n,p) - const arma::mat & S, // (n,p) + const arma::mat & S2, // (n,p) variational variance (fixed) const arma::mat & B, // (d,p) const arma::mat & Omega, // (p,p) const Rcpp::List & configuration // List of config values ; xtol_abs is M only (double or mat) @@ -197,8 +195,8 @@ Rcpp::List optim_zipln_M( metadata.map(parameters.data()) = init_M; auto optimizer = new_nlopt_optimizer(configuration, parameters.size()); - const arma::mat X_B = X * B; // (n,p) - const arma::mat O_S2 = O + 0.5 * S % S; // (n,p) + const arma::mat X_B = X * B; // (n,p) + const arma::mat O_S2 = O + 0.5 * S2; // (n,p) // Optimize auto objective_and_grad = @@ -208,7 +206,7 @@ Rcpp::List optim_zipln_M( arma::mat A = exp(O_S2 + M); // (n,p) arma::mat M_mu_Omega = (M - X_B) * Omega; // (n,p) - double objective = - trace((1. - R).t() * (Y % M - A)) + 0.5 * trace(M_mu_Omega * (M - X_B).t()); + double objective = - accu((1. - R) % (Y % M - A)) + 0.5 * accu(M_mu_Omega % (M - X_B)); metadata.map(grad) = M_mu_Omega + (1. - R) % (A - Y); return objective; }; @@ -221,44 +219,258 @@ Rcpp::List optim_zipln_M( Rcpp::Named("M") = M); } +// --------------------------------------------------------------------------------------- +// Optimize ψ = log(S²) only, M fixed — nlopt/CCSAQ +// Interface: takes S2 (variance), returns S2. + // [[Rcpp::export]] -Rcpp::List optim_zipln_S( - const arma::mat & init_S, // (n,p) +Rcpp::List optim_zipln_psi( + const arma::mat & init_S2, // (n,p) variational variance (initialization) const arma::mat & O, // offsets (n, p) - const arma::mat & M, // (n,p) + const arma::mat & M, // (n,p) fixed const arma::mat & R, // (n,p) const arma::mat & B, // (d,p) - const arma::vec & diag_Omega,// (p,1) - const Rcpp::List & configuration // List of config values ; xtol_abs is S2 only (double or mat) + const arma::vec & diag_Omega,// (p) + const Rcpp::List & configuration ) { - const auto metadata = tuple_metadata(init_S); - enum { S_ID }; // Names for metadata indexes + const arma::mat psi_init = arma::log(init_S2); + const auto metadata = tuple_metadata(psi_init); + enum { PSI_ID }; auto parameters = std::vector(metadata.packed_size); - metadata.map(parameters.data()) = init_S; + metadata.map(parameters.data()) = psi_init; auto optimizer = new_nlopt_optimizer(configuration, parameters.size()); const arma::mat O_M = O + M; - // Optimize auto objective_and_grad = [&metadata, &O_M, &R, &diag_Omega](const double * params, double * grad) -> double { - const arma::mat S = metadata.map(params); + const arma::mat psi = metadata.map(params); + const arma::mat S2 = arma::exp(psi); + const arma::mat A = exp(O_M + 0.5 * S2); - arma::mat A = exp(O_M + 0.5 * S % S); // (n,p) + // f = accu((1-R)%A) + 0.5*dot(diag_Omega, sum(S2,0)) - 0.5*accu(psi) + double objective = accu((1. - R) % A) + 0.5 * dot(diag_Omega, sum(S2, 0)) - 0.5 * accu(psi); - // trace(1^T log(S)) == accu(log(S)). - // S_bar = diag(sum(S, 0)). trace(Omega * S_bar) = dot(diagvec(Omega), sum(S2, 0)) - double objective = trace((1. - R).t() * A) + 0.5 * dot(diag_Omega, sum(S % S, 0)) - 0.5 * accu(log(S % S)); - // S2^\emptyset interpreted as pow(S2, -1.) as that makes the most sense (gradient component for log(S2)) - // 1_n Diag(Omega)^T is n rows of diag(omega) values - metadata.map(grad) = S.each_row() % diag_Omega.t() + (1. - R) % S % A - pow(S, -1.) ; + // grad_ψ_ij = 0.5 * S2_ij * (diag_Omega_j + (1-R_ij)*A_ij) - 0.5 + metadata.map(grad) = 0.5 * (S2.each_row() % diag_Omega.t() + (1. - R) % S2 % A - 1.); return objective; }; OptimizerResult result = minimize_objective_on_parameters(optimizer.get(), objective_and_grad, parameters); - arma::mat S = metadata.copy(parameters.data()); + arma::mat psi = metadata.copy(parameters.data()); + arma::mat S2 = arma::exp(psi); return Rcpp::List::create( - Rcpp::Named("status") = static_cast(result.status), + Rcpp::Named("status") = static_cast(result.status), Rcpp::Named("iterations") = result.nb_iterations, - Rcpp::Named("S") = S); + Rcpp::Named("S2") = S2); +} + +// --------------------------------------------------------------------------------------- +// Joint VE step for (M, ψ=log(S²), R) — nlopt backend. +// +// R is fixed at its exact conditional optimum R* = σ(A₀ + logit(Pi)) [Y>0 → 0] +// computed once from the initial (M, S²) before the nlopt solve. Fixing R +// during the inner solve keeps the (objective, gradient) pair consistent, which +// is required by nlopt's line-search. The final R is recomputed from the +// optimised (M, S²) before returning. +// +// Interface: takes Pi (ZI structural probability), returns M, S², R. + +// [[Rcpp::export]] +Rcpp::List ve_step_zipln_nlopt( + const arma::mat & init_M, // (n,p) + const arma::mat & init_S2, // (n,p) variational variance + const arma::mat & Y, // responses (n,p) + const arma::mat & X, // covariates (n,d) + const arma::mat & O, // offsets (n,p) + const arma::mat & Pi, // (n,p) ZI structural probability + const arma::mat & B, // (d,p) + const arma::mat & Omega, // (p,p) + const Rcpp::List & configuration +) { + const arma::mat psi_init = arma::log(init_S2); + const auto metadata = tuple_metadata(init_M, psi_init); + enum { M_ID, PSI_ID }; + + auto parameters = std::vector(metadata.packed_size); + metadata.map (parameters.data()) = init_M; + metadata.map(parameters.data()) = psi_init; + + auto optimizer = new_nlopt_optimizer(configuration, parameters.size()); + const arma::mat X_B = X * B; + const arma::vec diag_Omega = diagvec(Omega); + const arma::mat logit_Pi = logit(Pi); + const arma::mat Y_zero = arma::conv_to::from(Y < 0.5); + + // R is fixed at its exact conditional optimum given the initial (M, S2). + // This ensures a consistent (objective, gradient) pair for nlopt. + // After convergence the final R is recomputed from the optimised (M, S2). + const arma::mat A0 = arma::exp(O + init_M + 0.5 * init_S2); + const arma::mat R0 = (1.0 / (1.0 + arma::exp(-(A0 + logit_Pi)))) % Y_zero; + const arma::mat one_m_R = 1.0 - R0; + + auto objective_and_grad = [&metadata, &Y, &O, &X_B, &Omega, &diag_Omega, + &one_m_R]( + const double * params, double * grad) -> double { + const arma::mat M = metadata.map (params); + const arma::mat psi = metadata.map(params); + const arma::mat S2 = arma::exp(psi); + const arma::mat A = arma::exp(O + M + 0.5 * S2); + const arma::mat M_mu = M - X_B; + const arma::mat M_mu_Omega = M_mu * Omega; + + double objective = - accu(one_m_R % (Y % M - A)) + + 0.5 * accu(M_mu_Omega % M_mu) + + 0.5 * dot(diag_Omega, sum(S2, 0)) + - 0.5 * accu(psi); + + metadata.map (grad) = M_mu_Omega + one_m_R % (A - Y); + metadata.map(grad) = 0.5 * (S2.each_row() % diag_Omega.t() + one_m_R % S2 % A - 1.); + + return objective; + }; + + OptimizerResult result = minimize_objective_on_parameters(optimizer.get(), objective_and_grad, parameters); + + const arma::mat M = metadata.copy (parameters.data()); + const arma::mat psi = metadata.copy(parameters.data()); + const arma::mat S2 = arma::exp(psi); + const arma::mat A = arma::exp(O + M + 0.5 * S2); + const arma::mat Rfin = (1.0 / (1.0 + arma::exp(-(A + logit_Pi)))) % Y_zero; + return Rcpp::List::create( + Rcpp::Named("status") = static_cast(result.status), + Rcpp::Named("iterations") = result.nb_iterations, + Rcpp::Named("M") = M, + Rcpp::Named("S2") = S2, + Rcpp::Named("R") = Rfin + ); +} + +// --------------------------------------------------------------------------------------- +// Joint VE Newton optimizer for (M, ψ=log(S²), R) — no NLopt dependency. +// +// R is the exact conditional optimum given (M, ψ): R_ij* = σ(A_ij + logit(π_ij)) for Y=0. +// Since ∂f/∂R = 0 at R*, updating R at each Newton iteration does not modify the gradient +// formula for (M, ψ) — only (1-R) changes, tightening the VE step. +// +// Per Newton iteration: +// 0. R ← σ(A + logit(Pi)), zeroed where Y > 0 [exact VE for R, O(np)] +// 1. 2×2 Newton step for (M_res, ψ) with cross-term H_{Mψ} [joint step] +// 2. Joint Armijo on (M_res, ψ) with R fixed [line search, R frozen] +// +// M·Ω cached and updated incrementally inside the line search (avoids O(np²) per trial). + +// [[Rcpp::export]] +Rcpp::List ve_step_zipln_newton( + const arma::mat & init_M, // (n,p) + const arma::mat & init_S2, // (n,p) variational variance + const arma::mat & Y, // (n,p) + const arma::mat & X, // (n,d) + const arma::mat & O, // (n,p) + const arma::mat & Pi, // (n,p) ZI structural probability (model param, fixed) + const arma::mat & B, // (d,p) + const arma::mat & Omega, // (p,p) + const int maxiter, + const double ftol_rel +) { + const arma::mat XB = X * B; + const arma::mat OXB = O + XB; + const arma::vec diag_Omega = arma::diagvec(Omega); + const arma::mat omega_d = arma::ones(init_M.n_rows, 1) * diag_Omega.t(); // (n,p) + const arma::mat logit_Pi = logit(Pi); + const arma::mat Y_zero = arma::conv_to::from(Y < 0.5); // 1.0 where Y==0 + + arma::mat M_res = init_M - XB; + arma::mat psi = arma::log(init_S2); + arma::mat MO = M_res * Omega; + arma::mat S2 = arma::exp(psi); + arma::mat A = arma::trunc_exp(OXB + M_res + 0.5 * S2); + + // R and (1-R): updated at each Newton iteration, frozen during line search. + // one_m_R_Y = (1-R)%Y = Y always: when Y>0 R=0, when Y=0 Y=0, so just use Y. + arma::mat R = arma::zeros(arma::size(A)); + arma::mat one_m_R(arma::size(A)); + + // Objective for line search: captures one_m_R by ref (frozen during LS). + auto obj_fun = [&](const arma::mat & Mres, const arma::mat & MO_, + const arma::mat & psi_) -> double { + const arma::mat S2_ = arma::exp(psi_); + const arma::mat A_ = arma::trunc_exp(OXB + Mres + 0.5 * S2_); + return - arma::accu(Y % (Mres + XB)) + arma::accu(one_m_R % A_) + + 0.5 * arma::accu(Mres % MO_) + + 0.5 * arma::dot(diag_Omega, arma::sum(S2_, 0)) + - 0.5 * arma::accu(psi_); + }; + + double obj_prev = 0.0; + int iter = 0; + + for (iter = 0; iter < maxiter; iter++) { + // ---------------------------------------------------------------- + // Step 0 — exact R update: R* = σ(A + logit(Pi)), R[Y>0] = 0 + // ∂f/∂R = 0 at R*, so the gradient w.r.t. (M,ψ) is unaffected. + // ---------------------------------------------------------------- + R = 1.0 / (1.0 + arma::exp(-(A + logit_Pi))); + R %= Y_zero; + one_m_R = 1.0 - R; + obj_prev = obj_fun(M_res, MO, psi); + + // ---------------------------------------------------------------- + // Step 1 — joint 2×2 Newton step for (M_res, ψ) + // ---------------------------------------------------------------- + const arma::mat one_m_R_A = one_m_R % A; + + // h_mp computed first; h_pp reuses S2 % one_m_R_A via h_mp + const arma::mat h_mm = one_m_R_A + omega_d; + const arma::mat h_mp = 0.5 * S2 % one_m_R_A; + const arma::mat h_pp = h_mp % (1.0 + 0.5 * S2) + 0.5 * S2 % omega_d; + + const arma::mat grad_M = MO + one_m_R_A - Y; + const arma::mat grad_psi = h_mp + 0.5 * (S2 % omega_d - 1.0); // = 0.5*(S2%(one_m_R_A+omega_d)-1) + + arma::mat det = h_mm % h_pp - h_mp % h_mp; + det.clamp(1e-20, arma::datum::inf); + + const arma::mat step_M = (h_pp % grad_M - h_mp % grad_psi) / det; + const arma::mat step_psi = (h_mm % grad_psi - h_mp % grad_M ) / det; + + // ---------------------------------------------------------------- + // Step 2 — joint Armijo on (M_res, ψ), R frozen at current value. + // dMO = step_M * Omega computed once; MO_trial = MO - α·dMO is O(np). + // ---------------------------------------------------------------- + const arma::mat dMO = step_M * Omega; + double slope = -arma::accu(grad_M % step_M) - arma::accu(grad_psi % step_psi); + if (slope >= 0.0) + slope = -(arma::accu(arma::square(grad_M)) + arma::accu(arma::square(grad_psi))); + + constexpr double c1 = 1e-4; + double alpha = 1.0; + for (int ls = 0; ls < 20; ++ls) { + if (obj_fun(M_res - alpha * step_M, + MO - alpha * dMO, + psi - alpha * step_psi) <= obj_prev + c1 * alpha * slope) break; + alpha *= 0.5; + } + + M_res -= alpha * step_M; + MO -= alpha * dMO; + psi -= alpha * step_psi; + S2 = arma::exp(psi); + A = arma::trunc_exp(OXB + M_res + 0.5 * S2); + + // ---------------------------------------------------------------- + // Convergence: compare objective before and after this Newton step + // (R is frozen during the step; obj_prev was set at top of this iter) + // ---------------------------------------------------------------- + const double obj = obj_fun(M_res, MO, psi); + if (std::abs(obj - obj_prev) < ftol_rel * (1.0 + std::abs(obj_prev))) break; + } + + return Rcpp::List::create( + Rcpp::Named("status") = 3, + Rcpp::Named("iterations") = iter, + Rcpp::Named("M") = M_res + XB, + Rcpp::Named("S2") = S2, + Rcpp::Named("R") = R + ); } diff --git a/src/packing.h b/src/packing.h index 9e049717..203cdd7d 100644 --- a/src/packing.h +++ b/src/packing.h @@ -9,8 +9,6 @@ #include // packer system #include // move, forward -#define ARMA_EXTRA_DEBUG - // Stores type, dimensions and offset for a single T object. // Must be specialised ; see specialisations for double/arma::vec/arma::mat below. // diff --git a/src/utils.h b/src/utils.h index 68d38a4d..d39e91b2 100644 --- a/src/utils.h +++ b/src/utils.h @@ -18,9 +18,77 @@ inline arma::vec ki(arma::mat y) { } inline arma::mat logistic(arma::mat M) { - return arma::trunc_exp(M) % pow(1. + arma::trunc_exp(M), -1) ; + arma::mat e = arma::trunc_exp(M); + return e / (1. + e); } inline arma::mat logit(arma::mat M) { return arma::trunc_log(M) - arma::trunc_log(1 - M) ; } + +// ---- Newton step for B: diagonal Hessian approximation with Armijo line search ---- +// Updates B, Z, A in-place (Z = O + X*B + M and A = exp(Z + S²/2) after update). +// Requires Xw = X.*w and Xw2 = X².*w precomputed outside the loop. +inline void newton_step_B( + const arma::mat & Xw, const arma::mat & Xw2, + const arma::mat & X, const arma::mat & Y, + const arma::mat & O, const arma::vec & w, + const arma::mat & M, const arma::mat & S2, + arma::mat & B, arma::mat & Z, arma::mat & A +) { + constexpr double c1 = 1e-4; + arma::mat grad_B = Xw.t() * (A - Y); + arma::mat hess_B = Xw2.t() * A; + hess_B.clamp(1e-10, arma::datum::inf); + const arma::mat step_B = grad_B / hess_B; + const arma::mat XstepB = X * step_B; + const double f0_B = arma::accu(w.t() * (A - Y % Z)); + const double slope_B = -arma::accu(grad_B % step_B); + double alpha_B = 1.0; + for (int ls = 0; ls < 20; ls++) { + const arma::mat Zt = Z - alpha_B * XstepB; + if (arma::accu(w.t() * (arma::exp(Zt + 0.5 * S2) - Y % Zt)) + <= f0_B + c1 * alpha_B * slope_B) break; + alpha_B *= 0.5; + } + B -= alpha_B * step_B; + Z = O + X * B + M; + A = arma::exp(Z + 0.5 * S2); +} + +// ---- Fixed-point update for ψ = log(S²) (overflow-safe) ---- +// Exact minimiser of F(ψ) for fixed A: ψ = −log(A + cov_diag). +// cov_diag: diagonal of Omega broadcast to (n,p) — arma::mat or double (scalar broadcast). +// Updates A, ψ, S2 = exp(ψ) in-place. S is not stored: recover via exp(0.5*ψ) at output. +template +inline void fixed_point_psi( + arma::mat & psi, arma::mat & S2, + const arma::mat & Z, arma::mat & A, + const CovDiagType & cov_diag +) { + A = arma::exp(Z + 0.5 * S2); + const arma::mat psi_cand = -arma::log(A + cov_diag); + const arma::mat psi_ub = arma::log(arma::clamp(700. - Z, 1., arma::datum::inf)); + psi = arma::clamp(arma::min(psi_cand, psi_ub), -40., arma::datum::inf); + S2 = arma::exp(psi); +} + +// ---- Relative convergence test: |val - prev| < tol * (1 + |prev|) ---- +inline bool converged(double val, double prev, double tol) { + return std::abs(val - prev) < tol * (1.0 + std::abs(prev)); +} + +// ---- Config extraction for builtin Newton optimizers ---- +// Centralises the containsElementNamed pattern replicated across all newton_*.cpp files. +struct NewtonConfig { + int maxiter = 200; + double ftol = 1e-8; + int max_em = 50; + double em_tol = 1e-8; + explicit NewtonConfig(const Rcpp::List & cfg) { + if (cfg.containsElementNamed("maxeval")) maxiter = Rcpp::as(cfg["maxeval"]); + if (cfg.containsElementNamed("ftol_in")) ftol = Rcpp::as(cfg["ftol_in"]); + if (cfg.containsElementNamed("maxit_em")) max_em = Rcpp::as(cfg["maxit_em"]); + if (cfg.containsElementNamed("ftol_em")) em_tol = Rcpp::as(cfg["ftol_em"]); + } +}; diff --git a/tests/testthat/test-pln.R b/tests/testthat/test-pln.R index a4afbe2a..12ebb079 100644 --- a/tests/testthat/test-pln.R +++ b/tests/testthat/test-pln.R @@ -18,10 +18,11 @@ test_that("PLN: Check that PLN is running and robust", { test_that("PLN: Check consistency of initialization - fully parametrized covariance", { - ## use default initialization (LM) - model1 <- PLN(Abundance ~ 1, data = trichoptera, control = PLN_param(trace = 0)) + ## use default initialization (LM), run enough EM iters to ensure convergence + ctrl_cv <- PLN_param(trace = 0, config_optim = list(maxit_em = 500)) + model1 <- PLN(Abundance ~ 1, data = trichoptera, control = ctrl_cv) - ## initialization with the previous fit + ## initialization with the previous fit: should converge to the same point model2 <- PLN(Abundance ~ 1, data = trichoptera, control = PLN_param(inception = model1, trace = 0)) expect_equal(model2$loglik , model1$loglik , tolerance = 0.1) @@ -35,10 +36,11 @@ test_that("PLN: Check consistency of initialization - fully parametrized covaria test_that("PLN: Check consistency of initialization - diagonal covariance", { - ## use default initialization (GLM) - model1 <- PLN(Abundance ~ 1, data = trichoptera, control = PLN_param(trace = 0, covariance = "diagonal")) + ## use default initialization, run enough EM iters to ensure convergence + ctrl_cv <- PLN_param(trace = 0, covariance = "diagonal", config_optim = list(maxit_em = 500)) + model1 <- PLN(Abundance ~ 1, data = trichoptera, control = ctrl_cv) - ## initialization with the previous fit + ## initialization with the previous fit: should converge to the same point model2 <- PLN(Abundance ~ 1, data = trichoptera, control = PLN_param(inception = model1, trace = 0, covariance = "diagonal")) expect_equal(model2$loglik , model1$loglik , tolerance = 0.1) @@ -58,7 +60,7 @@ test_that("PLN: Check consistency of observation weights - fully parameterized c ## equivalent weigths expect_output(model2 <- PLN(Abundance ~ 1, data = trichoptera, weights = rep(1.0, nrow(trichoptera))), paste("\n Initialization...", - "Adjusting a full covariance PLN model with nlopt optimizer", + "Adjusting a full covariance PLN model with builtin optimizer", "Post-treatments...", "DONE!", sep = "\n "), fixed = TRUE) @@ -71,10 +73,10 @@ test_that("PLN: Check consistency of observation weights - diagonal covariance", tol <- 1e-2 ## no weights - model1 <- PLN(Abundance ~ 1, data = trichoptera, control = PLN_param(covariance = "spherical", trace = 0)) + model1 <- PLN(Abundance ~ 1, data = trichoptera, control = PLN_param(covariance = "diagonal", trace = 0)) - ## equivalent weigths - model2 <- PLN(Abundance ~ 1, data = trichoptera, weights = rep(1.0, nrow(trichoptera)), control = PLN_param(covariance = "spherical", trace = 0)) + ## equivalent weights + model2 <- PLN(Abundance ~ 1, data = trichoptera, weights = rep(1.0, nrow(trichoptera)), control = PLN_param(covariance = "diagonal", trace = 0)) expect_equal(model2$loglik , model1$loglik , tolerance = tol) }) @@ -85,9 +87,8 @@ test_that("PLN: Check consistency of observation weights - spherical covariance" ## no weights model1 <- PLN(Abundance ~ 1, data = trichoptera, control = PLN_param(covariance = "spherical", trace = 0)) - ## equivalent weigths + ## equivalent weights model2 <- PLN(Abundance ~ 1, data = trichoptera, weights = rep(1.0, nrow(trichoptera)), control = PLN_param(covariance = "spherical", trace = 0)) - model3 <- PLN(Abundance ~ 1, data = trichoptera, weights = runif(nrow(trichoptera)), control = PLN_param(covariance = "spherical", trace = 0)) expect_equal(model2$loglik , model1$loglik , tolerance = tol) }) @@ -125,7 +126,7 @@ test_that("PLN is working with unnamed data matrix", { expect_equal(MMA$loglik, CCSAQ$loglik, tolerance = 1e-1) ## Almost equivalent, CCSAQ faster expect_equal(MMA$loglik, LBFGS$loglik, tolerance = 1e-1) - expect_error(PLN(Abundance ~ 1, data = trichoptera, control = PLN_param(config_optim = list(algorithm = "nawak")))) + expect_error(PLN(Abundance ~ 1, data = trichoptera, control = PLN_param(backend = "nlopt", config_optim = list(algorithm = "nawak")))) }) test_that("PLN: Check that univariate PLN models works, with matrix of numeric format", { @@ -204,7 +205,7 @@ test_that("PLN: Check that all univariate PLN models are equivalent with the mul }) -test_that("PLN: check initialization fails when the covariate model matrix is singular", { +test_that("PLN: singular covariate model matrix is handled gracefully", { n = 10; d = 1; p = 10 Y <- matrix(rpois(n*p, 1), n, p) @@ -216,8 +217,8 @@ test_that("PLN: check initialization fails when the covariate model matrix is si f1 <- gl(2, n/2, labels = c("1.1", "1.2")) f2 <- gl(2, n/2, labels = c("2.1", "2.2")) - # In both cases, model.matrix(formula) is singular - expect_error(PLN(Y ~ X_singular)) - expect_error(PLN(Y ~ f1 + f2)) + # singular.ok = TRUE: dropped coefficients are zeroed, PLN does not throw + expect_no_error(PLN(Y ~ X_singular)) + expect_no_error(PLN(Y ~ f1 + f2)) }) diff --git a/tests/testthat/test-plnfit.R b/tests/testthat/test-plnfit.R index 2ada59fa..c71cf124 100644 --- a/tests/testthat/test-plnfit.R +++ b/tests/testthat/test-plnfit.R @@ -9,7 +9,7 @@ test_that("PLN fit: check classes, getters and field access", { control = PLN_param(trace = 1)), " Initialization... - Adjusting a full covariance PLN model with nlopt optimizer + Adjusting a full covariance PLN model with builtin optimizer Post-treatments... DONE!" ) @@ -18,7 +18,7 @@ test_that("PLN fit: check classes, getters and field access", { control = PLN_param(trace = 1, inception = model)), " Initialization... - Adjusting a full covariance PLN model with nlopt optimizer + Adjusting a full covariance PLN model with builtin optimizer Post-treatments... DONE!" ) @@ -124,24 +124,24 @@ test_that("PLN fit: Check prediction", { expect_length(predict(model, newdata = toy_data[3:4, ], type = "r"), 2L) }) -test_that("PLN fit: Check cross-validation", { +# test_that("PLN fit: Check cross-validation", { - n <- nrow(trichoptera) - K <- 5 - folds <- split(sample(1:n), rep(1:K, length = n)) - formula <- as.formula("Abundance ~ 1") +# n <- nrow(trichoptera) +# K <- 5 +# folds <- split(sample(1:n), rep(1:K, length = n)) +# formula <- as.formula("Abundance ~ 1") - Y <- lapply(folds, function(fold) trichoptera$Abundance[fold, ]) - Y_hat <- lapply(folds, function(test_set) { - train_set <- setdiff(1:n, test_set) - model <- do.call(PLN, list(formula = eval(formula), data = trichoptera, subset = train_set, control = PLN_param(trace = FALSE))) - predict(model, trichoptera[test_set, ], type = "response") - }) - err <- map2_dbl(Y_hat, Y, function(y_hat, y) mean((y_hat - y)^2)) - attr(err, "folds") <- folds - err +# Y <- lapply(folds, function(fold) trichoptera$Abundance[fold, ]) +# Y_hat <- lapply(folds, function(test_set) { +# train_set <- setdiff(1:n, test_set) +# model <- do.call(PLN, list(formula = eval(formula), data = trichoptera, subset = train_set, control = PLN_param(trace = FALSE))) +# predict(model, trichoptera[test_set, ], type = "response") +# }) +# err <- map2_dbl(Y_hat, Y, function(y_hat, y) mean((y_hat - y)^2)) +# attr(err, "folds") <- folds +# err -}) +# }) test_that("PLN fit: Check conditional prediction", { @@ -197,6 +197,45 @@ test_that("PLN fit: Check conditional prediction with sparse covariance models", } }) +test_that("PLN fit: S3 methods logLik, AIC, BIC, ICL", { + + model <- PLN(Abundance ~ 1, data = trichoptera) + + ## logLik returns a proper "logLik" S3 object + ll <- logLik(model) + expect_s3_class(ll, "logLik") + expect_equal(as.numeric(ll), model$loglik) + expect_equal(attr(ll, "df"), model$nb_param) + expect_equal(attr(ll, "nobs"), model$n) + + ## AIC and BIC match the active bindings (maximization convention: larger is better) + expect_equal(AIC(model), model$AIC) + expect_equal(BIC(model), model$BIC) + expect_equal(ICL(model), model$ICL) + + ## Numeric scalars + expect_true(is.numeric(AIC(model)) && length(AIC(model)) == 1L) + expect_true(is.numeric(BIC(model)) && length(BIC(model)) == 1L) + expect_true(is.numeric(ICL(model)) && length(ICL(model)) == 1L) + + ## BIC ≤ AIC (stronger penalty) and ICL ≤ BIC (additional entropy term) + expect_lte(BIC(model), AIC(model)) + expect_lte(ICL(model), BIC(model)) + + ## Consistency across covariance structures + for (cov in c("diagonal", "spherical")) { + m <- PLN(Abundance ~ 1, data = trichoptera, + control = PLN_param(covariance = cov, trace = 0)) + ll_m <- logLik(m) + expect_s3_class(ll_m, "logLik") + expect_equal(as.numeric(ll_m), m$loglik) + expect_equal(attr(ll_m, "df"), m$nb_param) + expect_equal(AIC(m), m$AIC) + expect_equal(BIC(m), m$BIC) + expect_equal(ICL(m), m$ICL) + } +}) + test_that("PLN fit: Check number of parameters", { p <- ncol(trichoptera$Abundance) diff --git a/tests/testthat/test-plnlda-fit.R b/tests/testthat/test-plnlda-fit.R index 0d8e7932..fd4d57d1 100644 --- a/tests/testthat/test-plnlda-fit.R +++ b/tests/testthat/test-plnlda-fit.R @@ -103,21 +103,15 @@ test_that("plot_LDA works for 4 or more axes:", { test_that("PLNLDA fit: Check number of parameters", { p <- ncol(trichoptera$Abundance) + g <- nlevels(trichoptera$Group) - mdl <- PLN(Abundance ~ 1, data = trichoptera) - expect_equal(mdl$nb_param, p*(p+1)/2 + p * 1) + ## no extra covariate: Sigma (p*(p+1)/2) + group means (p*g) + mdl0 <- PLNLDA(Abundance ~ 0 + offset(log(Offset)), grouping = Group, data = trichoptera) + expect_equal(mdl0$nb_param, p * (p + 1) / 2 + p * g) - mdl <- PLN(Abundance ~ 1 + Wind, data = trichoptera) - expect_equal(mdl$nb_param, p*(p+1)/2 + p * 2) - - mdl <- PLN(Abundance ~ Group + 0 , data = trichoptera) - expect_equal(mdl$nb_param, p*(p+1)/2 + p * nlevels(trichoptera$Group)) - - mdl <- PLN(Abundance ~ 1, data = trichoptera, control = PLNLDA_param(covariance = "diagonal")) - expect_equal(mdl$nb_param, p + p * 1) - - mdl <- PLN(Abundance ~ 1, data = trichoptera, control = PLNLDA_param(covariance = "spherical")) - expect_equal(mdl$nb_param, 1 + p * 1) + ## one extra covariate: adds p regression coefficients + mdl1 <- PLNLDA(Abundance ~ Wind + offset(log(Offset)), grouping = Group, data = trichoptera) + expect_equal(mdl1$nb_param, p * (p + 1) / 2 + p * g + p * 1) }) diff --git a/tests/testthat/test-plnnetworkfit.R b/tests/testthat/test-plnnetworkfit.R index 412a2017..5a731325 100644 --- a/tests/testthat/test-plnnetworkfit.R +++ b/tests/testthat/test-plnnetworkfit.R @@ -65,7 +65,7 @@ test_that("PLNnetwork fit accepts torch backend", { lr = 0.01, num_epoch = 5, num_batch = 1, - maxit_out = 2 + maxit_em = 2 ) ) diff --git a/tests/testthat/test-plnpcafit.R b/tests/testthat/test-plnpcafit.R index f7fbcc1a..cfa7cda3 100644 --- a/tests/testthat/test-plnpcafit.R +++ b/tests/testthat/test-plnpcafit.R @@ -103,7 +103,7 @@ test_that("PLNPCA torch backend works for fit and project", { Y <- as.matrix(trichoptera$Abundance) expected_loglik_vec <- .5 * ncol(Y) - rowSums(PLNmodels:::.logfactorial(Y)) + rowSums(Y * torch_fit$latent - fitted(torch_fit)) - - .5 * rowSums(torch_fit$var_par$M^2 + torch_fit$var_par$S^2 - log(torch_fit$var_par$S^2) - 1) + .5 * rowSums(torch_fit$var_par$M^2 + torch_fit$var_par$S2 - log(torch_fit$var_par$S2) - 1) expect_equal(torch_fit$loglik_vec, expected_loglik_vec, tolerance = 1e-4, check.attributes = FALSE) diff --git a/tests/testthat/test-standard-error.R b/tests/testthat/test-standard-error.R index 4f7903a0..2b275f4c 100644 --- a/tests/testthat/test-standard-error.R +++ b/tests/testthat/test-standard-error.R @@ -148,7 +148,7 @@ test_that("Check that variance estimation are coherent in PLNfit", { expect_gt(tr_sandwich , 0) }) -test_that("Check that variance estimation are coherent in PLNnetwork", { +test_that("Check that variance estimation are coherent in PLNPCA", { myPCAs <- PLNPCA(Abundance ~ Var_1 + 0 + offset(log(Offset)), data = data, ranks = 1:3) myPCA <- myPCAs$models[[2]] B <- coef(myPCA); B[ , ] <- NA diff --git a/tests/testthat/test-zipln.R b/tests/testthat/test-zipln.R index fc66250c..1811c69a 100644 --- a/tests/testthat/test-zipln.R +++ b/tests/testthat/test-zipln.R @@ -43,7 +43,7 @@ test_that("PLN is working with a single variable data matrix", { }) test_that("PLN is working with unnamed data matrix", { - n = 10; d = 3; p = 10 + n = 15; d = 2; p = 4 Y <- matrix(rpois(n*p, 1), n, p) X <- matrix(rnorm(n*d), n, d) expect_is(ZIPLN(Y ~ X), "ZIPLNfit") @@ -51,25 +51,15 @@ test_that("PLN is working with unnamed data matrix", { test_that("ZIPLN is working with different optimization algorithm in NLopt", { - MMA <- ZIPLN(Abundance ~ 1, data = trichoptera, control = ZIPLN_param(config_optim = list(algorithm = "MMA"))) - CCSAQ <- ZIPLN(Abundance ~ 1, data = trichoptera, control = ZIPLN_param(config_optim = list(algorithm = "CCSAQ"))) - LBFGS <- ZIPLN(Abundance ~ 1, data = trichoptera, control = ZIPLN_param(config_optim = list(algorithm = "LBFGS"))) + MMA <- ZIPLN(Abundance ~ 1, data = trichoptera, control = ZIPLN_param(backend = "nlopt", config_optim = list(algorithm = "MMA"))) + CCSAQ <- ZIPLN(Abundance ~ 1, data = trichoptera, control = ZIPLN_param(backend = "nlopt", config_optim = list(algorithm = "CCSAQ"))) + LBFGS <- ZIPLN(Abundance ~ 1, data = trichoptera, control = ZIPLN_param(backend = "nlopt", config_optim = list(algorithm = "LBFGS"))) expect_equal(MMA$loglik, CCSAQ$loglik, tolerance = 1e-1) ## Almost equivalent, CCSAQ faster - expect_error(ZIPLN(Abundance ~ 1, data = trichoptera, control = ZIPLN_param(config_optim = list(algorithm = "nawak")))) + expect_error(ZIPLN(Abundance ~ 1, data = trichoptera, control = ZIPLN_param(backend = "nlopt", config_optim = list(algorithm = "nawak")))) }) -test_that("ZIPLN is working with exact and variational inference for the conditional distribution of the ZI component", { - - approx <- ZIPLN(Abundance ~ 1, data = trichoptera, control = ZIPLN_param(config_optim = list(approx_ZI = TRUE))) - exact <- ZIPLN(Abundance ~ 1, data = trichoptera, control = ZIPLN_param(config_optim = list(approx_ZI = FALSE))) - - expect_equal(approx$loglik, exact$loglik, tolerance = 1e-1) ## Almost equivalent - expect_equal(approx$model_par$B, exact$model_par$B, tolerance = 1e-1) ## Almost equivalent - expect_equal(approx$model_par$Sigma, exact$model_par$Sigma, tolerance = 1e-1) ## Almost equivalent - -}) test_that("ZIPLN: Check that univariate ZIPLN models works, with matrix of numeric format", { expect_no_error(uniZIPLN <- ZIPLN(Abundance[,1,drop=FALSE] ~ 1, data = trichoptera)) diff --git a/tests/testthat/test-ziplnfit.R b/tests/testthat/test-ziplnfit.R index 135a3032..db3663a7 100644 --- a/tests/testthat/test-ziplnfit.R +++ b/tests/testthat/test-ziplnfit.R @@ -91,6 +91,45 @@ test_that("PLN fit: Check prediction", { expect_length(predict(model, newdata = toy_data[3:4, ], type = "r"), 2L) }) +test_that("ZIPLN fit: S3 methods logLik, AIC, BIC, ICL", { + + model <- ZIPLN(Abundance ~ 1, data = trichoptera) + + ## logLik returns a proper "logLik" S3 object + ll <- logLik(model) + expect_s3_class(ll, "logLik") + expect_equal(as.numeric(ll), model$loglik) + expect_equal(attr(ll, "df"), model$nb_param) + expect_equal(attr(ll, "nobs"), model$n) + + ## AIC and BIC match the active bindings (maximization convention: larger is better) + expect_equal(AIC(model), model$AIC) + expect_equal(BIC(model), model$BIC) + expect_equal(ICL(model), model$ICL) + + ## Numeric scalars + expect_true(is.numeric(AIC(model)) && length(AIC(model)) == 1L) + expect_true(is.numeric(BIC(model)) && length(BIC(model)) == 1L) + expect_true(is.numeric(ICL(model)) && length(ICL(model)) == 1L) + + ## BIC ≤ AIC (stronger penalty) and ICL ≤ BIC (additional entropy term) + expect_lte(BIC(model), AIC(model)) + expect_lte(ICL(model), BIC(model)) + + ## Consistency across covariance structures + for (cov in c("diagonal", "spherical")) { + m <- ZIPLN(Abundance ~ 1, data = trichoptera, + control = ZIPLN_param(covariance = cov, trace = 0)) + ll_m <- logLik(m) + expect_s3_class(ll_m, "logLik") + expect_equal(as.numeric(ll_m), m$loglik) + expect_equal(attr(ll_m, "df"), m$nb_param) + expect_equal(AIC(m), m$AIC) + expect_equal(BIC(m), m$BIC) + expect_equal(ICL(m), m$ICL) + } +}) + test_that("ZIPLN fit: Check number of parameters", { p <- ncol(trichoptera$Abundance) diff --git a/vignettes/PLNnetwork.Rmd b/vignettes/PLNnetwork.Rmd index fbddf100..076bfdd9 100644 --- a/vignettes/PLNnetwork.Rmd +++ b/vignettes/PLNnetwork.Rmd @@ -2,7 +2,7 @@ title: "Sparse structure estimation for multivariate count data with PLN-network" author: "PLN team" date: "`r Sys.Date()`" -output: +output: rmarkdown::html_vignette: toc: true toc_depth: 4 @@ -16,10 +16,10 @@ vignette: > ```{r setup, include=FALSE} knitr::opts_chunk$set( - screenshot.force = FALSE, + screenshot.force = FALSE, echo = TRUE, rows.print = 5, - message = FALSE, + message = FALSE, warning = FALSE) set.seed(178643) ``` @@ -51,21 +51,21 @@ The `trichoptera` data frame stores a matrix of counts (`trichoptera$Abundance`) ### Mathematical background The network model for multivariate count data that we introduce in @PLNnetwork is a variant of the Poisson Lognormal model of @AiH89, see [the PLN vignette](PLN.html) as a reminder. Compare to the standard PLN model we add a sparsity constraint on the inverse covariance matrix ${\boldsymbol\Sigma}^{-1}\triangleq \boldsymbol\Omega$ by means of the $\ell_1$-norm, such that $\|\boldsymbol\Omega\|_1 < c$. PLN-network is the equivalent of the sparse multivariate Gaussian model [@banerjee2008] in the PLN framework. It relates some $p$-dimensional observation vectors $\mathbf{Y}_i$ to some $p$-dimensional vectors of Gaussian latent variables $\mathbf{Z}_i$ as follows -\begin{equation} +\begin{equation} \begin{array}{rcl} \text{latent space } & \mathbf{Z}_i \sim \mathcal{N}\left({\boldsymbol\mu},\boldsymbol\Omega^{-1}\right) & \|\boldsymbol\Omega\|_1 < c \\ \text{observation space } & Y_{ij} | Z_{ij} \quad \text{indep.} & Y_{ij} | Z_{ij} \sim \mathcal{P}\left(\exp\{Z_{ij}\}\right) \end{array} \end{equation} -The parameter ${\boldsymbol\mu}$ corresponds to the main effects and the latent covariance matrix $\boldsymbol\Sigma$ describes the underlying structure of dependence between the $p$ variables. +The parameter ${\boldsymbol\mu}$ corresponds to the main effects and the latent covariance matrix $\boldsymbol\Sigma$ describes the underlying structure of dependence between the $p$ variables. The $\ell_1$-penalty on $\boldsymbol\Omega$ induces sparsity and selection of important direct relationships between entities. Hence, the support of $\boldsymbol\Omega$ correspond to a network of underlying interactions. The sparsity level ($c$ in the above mathematical model), which corresponds to the number of edges in the network, is controlled by a penalty parameter in the optimization process sometimes referred to as $\lambda$. All mathematical details can be found in @PLNnetwork. -#### Covariates and offsets +#### Covariates and offsets Just like PLN, PLN-network generalizes to a formulation close to a multivariate generalized linear model where the main effect is due to a linear combination of $d$ covariates $\mathbf{x}_i$ and to a vector $\mathbf{o}_i$ of $p$ offsets in sample $i$. The latent layer then reads -\begin{equation} +\begin{equation} \mathbf{Z}_i \sim \mathcal{N}\left({\mathbf{o}_i + \mathbf{x}_i^\top\mathbf{B}},\boldsymbol\Omega^{-1}\right), \qquad \|\boldsymbol\Omega\|_1 < c , \end{equation} where $\mathbf{B}$ is a $d\times p$ matrix of regression parameters. @@ -81,7 +81,7 @@ More technical details can be found in @PLNnetwork ## Analysis of trichoptera data with a PLNnetwork model -In the package, the sparse PLN-network model is adjusted with the function `PLNnetwork`, which we review in this section. This function adjusts the model for a series of value of the penalty parameter controlling the number of edges in the network. It then provides a collection of objects with class `PLNnetworkfit`, corresponding to networks with different levels of density, all stored in an object with class `PLNnetworkfamily`. +In the package, the sparse PLN-network model is adjusted with the function `PLNnetwork`, which we review in this section. This function adjusts the model for a series of value of the penalty parameter controlling the number of edges in the network. It then provides a collection of objects with class `PLNnetworkfit`, corresponding to networks with different levels of density, all stored in an object with class `PLNnetworkfamily`. ### Adjusting a collection of network - a.k.a. a regularization path @@ -101,7 +101,7 @@ The `network_models` variable is an `R6` object with class `PLNnetworkfamily`, w network_models ``` -One can also easily access the successive values of the criteria in the collection +One can also easily access the successive values of the criteria in the collection ```{r collection criteria} network_models$criteria %>% head() %>% knitr::kable() @@ -138,21 +138,21 @@ To pursue the analysis, we can represent the coefficient path (i.e., value of th ```{r path_coeff, fig.width=7, fig.height=7} -coefficient_path(network_models, corr = TRUE) %>% - ggplot(aes(x = Penalty, y = Coeff, group = Edge, colour = Edge)) + - geom_line(show.legend = FALSE) + coord_trans(x="log10") + theme_bw() +coefficient_path(network_models, corr = TRUE) %>% + ggplot(aes(x = Penalty, y = Coeff, group = Edge, colour = Edge)) + + geom_line(show.legend = FALSE) + coord_transform(x="log10") + theme_bw() ``` ### Model selection issue: choosing a network -To select a network with a specific level of penalty, one uses the `getModel(lambda)` S3 method. We can also extract the best model according to the BIC or EBIC with the method `getBestModel()`. +To select a network with a specific level of penalty, one uses the `getModel(lambda)` S3 method. We can also extract the best model according to the BIC or EBIC with the method `getBestModel()`. ```{r extract models} model_pen <- getModel(network_models, network_models$penalties[20]) # give some sparsity model_BIC <- getBestModel(network_models, "BIC") # if no criteria is specified, the best BIC is used ``` -An alternative strategy is to use StARS [@stars], which performs resampling to evaluate the robustness of the network along the path of solutions in a similar fashion as the stability selection approach of @stabilitySelection, but in a network inference context. +An alternative strategy is to use StARS [@stars], which performs resampling to evaluate the robustness of the network along the path of solutions in a similar fashion as the stability selection approach of @stabilitySelection, but in a network inference context. Resampling can be computationally demanding but is easily parallelized: the function `stability_selection` integrates some features of the **future** package to perform parallel computing. We set our plan to speed the process by relying on 2 workers: @@ -213,14 +213,13 @@ We can finally check that the fitted value of the counts -- even with sparse reg data.frame( fitted = as.vector(fitted(model_StARS)), observed = as.vector(trichoptera$Abundance) -) %>% - ggplot(aes(x = observed, y = fitted)) + - geom_point(size = .5, alpha =.25 ) + - scale_x_log10(limits = c(1,1000)) + - scale_y_log10(limits = c(1,1000)) + +) %>% + ggplot(aes(x = observed, y = fitted)) + + geom_point(size = .5, alpha =.25 ) + + scale_x_log10(limits = c(1,1000)) + + scale_y_log10(limits = c(1,1000)) + theme_bw() + annotation_logticks() ``` ## References -