From 5883a9ef7f56dcc70e0444c75ed7604acdbffcf8 Mon Sep 17 00:00:00 2001 From: alexym2 Date: Sat, 20 Jul 2024 13:20:45 +0200 Subject: [PATCH 1/3] Update get_weighted_eigen() (#4) --- DESCRIPTION | 9 ++++----- R/eig.R | 11 ++++++++++- R/pca.R | 4 ++-- README.Rmd | 2 +- README.md | 2 +- tests/testthat/test_eig.R | 6 ++++-- vignettes/Comparison.Rmd | 16 ++++------------ 7 files changed, 26 insertions(+), 24 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 2b896e6..2a27143 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: FactoMineR2 Type: Package Title: Multivariate exploratory data analysis in R -Version: 0.2.0 +Version: 0.2.1 Authors@R: c( person("Alex", "Martinez", , "yahiaoui-martinez.alex@outlook.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-5315-675X")) @@ -10,13 +10,12 @@ Description: Perform PCA, MFA, CA, MFA. License: MIT + file LICENSE URL: https://github.com/alexym1/FactoMineR2, https://alexym1.github.io/FactoMineR2 BugReports: https://github.com/alexym1/FactoMineR2/issues -Imports: +Suggests: covr, + devtools, factoextra, FactoMineR, - knitr -Suggests: - devtools, + knitr, renv, testthat VignetteBuilder: diff --git a/R/eig.R b/R/eig.R index 4c5ce90..28320a7 100755 --- a/R/eig.R +++ b/R/eig.R @@ -37,7 +37,16 @@ get_weighted_eigen <- function(X) { weights <- row.w / sum(row.w) svd_res <- svd(t(t(X) * sqrt(weights))) - eigs <- list(values = svd_res$d^2, vectors = svd_res$v) + V <- svd_res$v + U <- svd_res$u + + mult <- sign(as.vector(crossprod(rep(1, nrow(V)), as.matrix(V)))) + mult[mult == 0] <- 1 + U <- t(t(U) * mult) + V <- t(t(V) * mult) + U <- U/sqrt(weights) + + eigs <- list(values=svd_res$d^2, vectors=V, U=U) colnames(eigs[[2]]) <- paste0("Dim.", 1:ncol(X)) rownames(eigs[[2]]) <- colnames(X) diff --git a/R/pca.R b/R/pca.R index 5eb3c87..14c8e80 100755 --- a/R/pca.R +++ b/R/pca.R @@ -19,7 +19,7 @@ #' head() #' @export pca_ind_coords <- function(X, eigenvectors) { - return(-1 * as.matrix(X) %*% eigenvectors) + return(as.matrix(X) %*% eigenvectors) } @@ -99,7 +99,7 @@ pca_ind_contrib <- function(ind_coords, eigenvalues) { #' head() #' @export pca_var_coords <- function(eigenvalues, eigenvectors) { - var_coords <- -1 * (eigenvectors %*% diag(sqrt(eigenvalues))) + var_coords <- eigenvectors %*% diag(sqrt(eigenvalues)) colnames(var_coords) <- paste0("Dim.", 1:ncol(var_coords)) return(var_coords) } diff --git a/README.Rmd b/README.Rmd index 693f991..0962dd1 100755 --- a/README.Rmd +++ b/README.Rmd @@ -17,7 +17,7 @@ knitr::opts_chunk$set( # FactoMineR2 -![](https://img.shields.io/badge/github%20version-0.2.0-orange.svg) +![](https://img.shields.io/badge/github%20version-0.2.1-orange.svg) [![R-CMD-check](https://github.com/alexym1/FactoMineR2/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/alexym1/FactoMineR2/actions/workflows/R-CMD-check.yaml) [![Codecov test coverage](https://codecov.io/gh/alexym1/FactoMineR2/branch/master/graph/badge.svg)](https://app.codecov.io/gh/alexym1/FactoMineR2?branch=master) diff --git a/README.md b/README.md index 94baacd..725ff37 100755 --- a/README.md +++ b/README.md @@ -5,7 +5,7 @@ -![](https://img.shields.io/badge/github%20version-0.2.0-orange.svg) +![](https://img.shields.io/badge/github%20version-0.2.1-orange.svg) [![R-CMD-check](https://github.com/alexym1/FactoMineR2/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/alexym1/FactoMineR2/actions/workflows/R-CMD-check.yaml) [![Codecov test coverage](https://codecov.io/gh/alexym1/FactoMineR2/branch/master/graph/badge.svg)](https://app.codecov.io/gh/alexym1/FactoMineR2?branch=master) diff --git a/tests/testthat/test_eig.R b/tests/testthat/test_eig.R index 75d4f58..369da8d 100755 --- a/tests/testthat/test_eig.R +++ b/tests/testthat/test_eig.R @@ -18,11 +18,13 @@ test_that("Testing get_weighted_eigen()", { df_eigs <- get_weighted_eigen(df) gf_eigs <- get_weighted_eigen(gf) - expect_identical(names(df_eigs), c("values", "vectors")) + expect_identical(names(df_eigs), c("values", "vectors", "U")) expect_identical(length(df_eigs[[1]]), ncol(df)) expect_identical(dim(df_eigs[[2]]), c(ncol(df), ncol(df))) + expect_identical(dim(df_eigs[[3]]), c(nrow(df), ncol(df))) - expect_identical(names(gf_eigs), c("values", "vectors")) + expect_identical(names(gf_eigs), c("values", "vectors", "U")) expect_identical(length(gf_eigs[[1]]), ncol(gf)) expect_identical(dim(gf_eigs[[2]]), c(ncol(gf), ncol(gf))) + expect_identical(dim(gf_eigs[[3]]), c(nrow(gf), ncol(gf))) }) diff --git a/vignettes/Comparison.Rmd b/vignettes/Comparison.Rmd index 7a9da89..47799cf 100755 --- a/vignettes/Comparison.Rmd +++ b/vignettes/Comparison.Rmd @@ -37,12 +37,9 @@ head(res_pca$eig) ```{r} # Get eigvalues and eigvectors with FactoMineR2 X_active <- X[-1, -10] +X_active_scaled <- standardize(X_active, scale = TRUE) -X_active_scaled <- X_active |> - standardize(scale = TRUE) - -eigs <- X_active_scaled |> - get_weighted_eigen() +eigs <- get_weighted_eigen(X_active_scaled) df_eigs <- data.frame( eigenvalue = eigs$values, @@ -167,14 +164,9 @@ res_pca$quanti.sup$coord ```{r} # Get supplementary CONTINUOUS variables coordinates with FactoMineR2 X_sup <- X[-1, 10, drop = FALSE] +X_sup_scaled <- standardize(X_sup, scale = TRUE) -center <- as.vector(crossprod(weights, as.matrix(X_sup))) -std <- sqrt(as.vector(crossprod(weights, as.matrix(X_sup^2)) - center^2)) -X_sup_scaled <- (X_sup - center) / std - -A <- t(X_sup_scaled * weights) -U <- svd.triplet(X_active_scaled)$U -var_sup_coords <- A %*% U +var_sup_coords <- t(X_sup_scaled * weights) %*% eigs$U var_sup_coords[,1:5] ``` From 799951c15c73281c8482b1afa6193dccb0de56e4 Mon Sep 17 00:00:00 2001 From: alexym2 Date: Sat, 20 Jul 2024 14:10:36 +0200 Subject: [PATCH 2/3] Update facto_pca --- NEWS.md | 7 +++++++ R/facto_pca.R | 9 ++------- 2 files changed, 9 insertions(+), 7 deletions(-) diff --git a/NEWS.md b/NEWS.md index 6753917..8376eb4 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,10 @@ +# FactoMineR2 0.2.1 + +* `get_weighted_eigen()` now returns U matrix as expected (#4) +* `pca_ind_coords()` & `pca_var_coords()` return same signs of the corresponding coordinates as FactoMineR. +* `facto_pca()` has been updated. Now, it returns the same output as `FactoMineR::PCA()`. + + # FactoMineR2 0.2.0 * `facto_pca()` is a wrapper function that mimics `FactoMineR::PCA()`. diff --git a/R/facto_pca.R b/R/facto_pca.R index 35433e1..30953af 100755 --- a/R/facto_pca.R +++ b/R/facto_pca.R @@ -99,13 +99,8 @@ facto_pca <- function(X, ncp = 5, scale.unit = TRUE, ind_sup = NULL, quanti_sup X_sup <- X[, quanti_sup, drop = FALSE] } - center <- as.vector(crossprod(weights, as.matrix(X_sup))) - std <- sqrt(as.vector(crossprod(weights, as.matrix(X_sup^2)) - center^2)) - X_sup_scaled <- (X_sup - center) / std - - A <- t(X_sup_scaled * weights) - U <- FactoMineR::svd.triplet(X_active_scaled)$U - var_sup_coords <- A %*% U + X_sup_scaled <- standardize(X_sup, scale = scale.unit) + var_sup_coords <- t(X_sup_scaled * weights) %*% eigs$U res_pca$var.sup <- list( coord = var_sup_coords, From 74dba9ace7cb684061b1403f6511a60bfbae6c1b Mon Sep 17 00:00:00 2001 From: alexym2 Date: Sat, 20 Jul 2024 18:52:42 +0200 Subject: [PATCH 3/3] Update .md files & DESCRIPTION --- .github/CONTRIBUTING.md | 2 +- DESCRIPTION | 7 ++++--- R/eig.R | 4 ++-- vignettes/Comparison.Rmd | 28 ++++++++++++++-------------- 4 files changed, 21 insertions(+), 20 deletions(-) diff --git a/.github/CONTRIBUTING.md b/.github/CONTRIBUTING.md index 924f199..9239563 100755 --- a/.github/CONTRIBUTING.md +++ b/.github/CONTRIBUTING.md @@ -67,7 +67,7 @@ username, and links to relevant issue(s)/PR(s). * 4. Copy/Paste the latest bullet of `NEWS.md` in the PR description. -* 5. If your code is approved, bump to version the following files: +* 5. Bump to version the following files: * `Description` * `NEWS.md` diff --git a/DESCRIPTION b/DESCRIPTION index 2a27143..af0092c 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -10,12 +10,13 @@ Description: Perform PCA, MFA, CA, MFA. License: MIT + file LICENSE URL: https://github.com/alexym1/FactoMineR2, https://alexym1.github.io/FactoMineR2 BugReports: https://github.com/alexym1/FactoMineR2/issues -Suggests: +Imports: covr, - devtools, factoextra, FactoMineR, - knitr, + knitr +Suggests: + devtools, renv, testthat VignetteBuilder: diff --git a/R/eig.R b/R/eig.R index 28320a7..c2121e7 100755 --- a/R/eig.R +++ b/R/eig.R @@ -44,9 +44,9 @@ get_weighted_eigen <- function(X) { mult[mult == 0] <- 1 U <- t(t(U) * mult) V <- t(t(V) * mult) - U <- U/sqrt(weights) + U <- U / sqrt(weights) - eigs <- list(values=svd_res$d^2, vectors=V, U=U) + eigs <- list(values = svd_res$d^2, vectors = V, U = U) colnames(eigs[[2]]) <- paste0("Dim.", 1:ncol(X)) rownames(eigs[[2]]) <- colnames(X) diff --git a/vignettes/Comparison.Rmd b/vignettes/Comparison.Rmd index 47799cf..8f1f982 100755 --- a/vignettes/Comparison.Rmd +++ b/vignettes/Comparison.Rmd @@ -63,8 +63,8 @@ head(res_pca$ind$coord) ```{r} # Get principal components with FactoMineR2 -ind_coords <- X_active_scaled |> pca_ind_coords(eigs$vectors) -ind_coords[,1:5] |> head() +ind_coords <- pca_ind_coords(X_active_scaled, eigs$vectors) +head(ind_coords[,1:5]) ``` ```{r} @@ -74,8 +74,8 @@ head(res_pca$ind$cos2) ```{r} # Get individual cos2 with FactoMineR2 -ind_cos2 <- ind_coords |> pca_ind_cos2() -ind_cos2[,1:5] |> head() +ind_cos2 <- pca_ind_cos2(ind_coords) +head(ind_cos2[,1:5]) ``` ```{r} @@ -85,8 +85,8 @@ head(res_pca$ind$contrib) ```{r} # Get individual contributions with FactoMineR2 -ind_contrib <- ind_coords |> pca_ind_contrib(df_eigs$eigenvalue) -ind_contrib[,1:5] |> head() +ind_contrib <- pca_ind_contrib(ind_coords, df_eigs$eigenvalue) +head(ind_contrib[,1:5]) ``` ### Supplementary individuals @@ -115,7 +115,7 @@ res_pca$ind.sup$cos2 ```{r} # Get supplementary individuals cos2 with FactoMineR2 -ind_sup_cos2 <- ind_sup_coords |> pca_ind_cos2() +ind_sup_cos2 <- pca_ind_cos2(ind_sup_coords) ind_sup_cos2[,1:5] ``` @@ -129,8 +129,8 @@ head(res_pca$var$coord) ```{r} # Get variable coordinates with FactoMineR2 -var_coords <- df_eigs$eigenvalue |> pca_var_coords(eigs$vectors) -var_coords[,1:5] |> head() +var_coords <- pca_var_coords(df_eigs$eigenvalue, eigs$vectors) +head(var_coords[,1:5]) ``` ```{r} @@ -140,8 +140,8 @@ head(res_pca$var$cos2) ```{r} # Get variable cos2 with FactoMineR2 -var_cos2 <- var_coords |> pca_var_cos2() -var_cos2[,1:5] |> head() +var_cos2 <- pca_var_cos2(var_coords) +head(var_cos2[,1:5]) ``` ```{r} @@ -151,8 +151,8 @@ head(res_pca$var$contrib) ```{r} # Get variable contributions with FactoMineR2 -var_contrib <- var_cos2 |> pca_var_contrib() -var_contrib[,1:5] |> head() +var_contrib <- pca_var_contrib(var_cos2) +head(var_contrib[,1:5]) ``` ### Supplementary variables @@ -177,6 +177,6 @@ res_pca$quanti.sup$cos2 ```{r} # Get supplementary variables cos2 with FactoMineR2 -var_sup_cos2 <- var_sup_coords |> pca_var_cos2() +var_sup_cos2 <- pca_var_cos2(var_sup_coords) var_sup_cos2[,1:5] ```