Merge branch 'master' of github.com:sdray/ade4

.github/workflows/R-CMD-check.yaml

@@ -58,7 +58,7 @@ jobs:
 
       - uses: r-lib/actions/check-r-package@v2
         with:
-          args: 'c("--no-manual", "--as-cran", "--run-dontrun")'
+          args: 'c("--no-manual", "--as-cran")'
           error-on: '"error"'
           check-dir: '"check"'
 

R/loocv.R

@@ -55,7 +55,7 @@ loocv.between <- function(x, nax = 0, progress = FALSE, parallel = FALSE, ...)
         ## The original analysis can be any dudi, so wee need to start from dudiCall$call:
         jcall1 <- dudiCall$call
         ## Change the df argument to discard row #ind1:
-        jcall1[[2]] <- data.frame(eval.parent(jcall1[[2]]))[-ind1, , drop = FALSE]
+        jcall1[[2]] <- data.frame(eval.parent(jcall1[[2]], n = 2))[-ind1, , drop = FALSE]
         ## Check that the scannf argument is set to FALSE:
         if (any(names(jcall1) == "scannf")) jcall1[[which(names(jcall1) == "scannf")]] <- FALSE
         else {

R/scalewt.R

@@ -66,7 +66,7 @@ meanfacwt <- function(df, fac = NULL, wt = rep(1/nrow(df), nrow(df)), drop = FAL
       fac <- as.factor(fac)
       if(drop)
         fac <- factor(fac)
-      res <- t(sapply(split(df,fac),colMeans))
+      res <- do.call("rbind", lapply(split(df,fac),colMeans))
     }
   } else {
     if(is.null(fac)) { ## no factor
@@ -77,10 +77,7 @@ meanfacwt <- function(df, fac = NULL, wt = rep(1/nrow(df), nrow(df)), drop = FAL
          fac <- factor(fac)
       df.list <- split(df, fac)
       wt.list <- split(wt, fac)
-      if(ncol(df) > 1)
-        res <- t(sapply(1:nlevels(fac), function(x) apply(df.list[[x]], 2, stats::weighted.mean, w = wt.list[[x]])))
-      else
-        res <- as.matrix(sapply(1:nlevels(fac), function(x) apply(df.list[[x]], 2, stats::weighted.mean, w = wt.list[[x]])))
+      res <- do.call("rbind", lapply(1:nlevels(fac), function(x) apply(df.list[[x]], 2, stats::weighted.mean, w = wt.list[[x]])))
       rownames(res) <- names(df.list)
     }
   }
@@ -110,7 +107,6 @@ covfacwt <- function(df, fac = NULL, wt = rep(1/nrow(df), nrow(df)), drop = FALS
 
 
 
-## attention works only with data.frame or matrix
 varfacwt <- function(df, fac = NULL, wt = rep(1 / nrow(df), nrow(df)), drop = FALSE) {
   df <- data.frame(df)
   nr <- nrow(df)
@@ -123,7 +119,7 @@ varfacwt <- function(df, fac = NULL, wt = rep(1 / nrow(df), nrow(df)), drop = FA
         fac <- factor(fac)
       df.list <- split(df, fac)
       wt.list <- split(wt, fac)
-      res <- t(sapply(1:nlevels(fac), FUN = function(x) {apply(df.list[[x]], 2, varwt, wt = wt.list[[x]])}))
+      res <- do.call("rbind", lapply(1:nlevels(fac), function(x) apply(df.list[[x]], 2, varwt, w = wt.list[[x]])))
       rownames(res) <- names(df.list)
       }
   return(res)

README.md

@@ -1,10 +1,9 @@
-# pkgdown <img src="man/figures/logo.svg" align="right" />
+# [ade4](http://pbil.univ-lyon1.fr/ADE-4/) <img src="man/figures/logo.svg" align="right" />
 [![CRAN_Release_Badge](http://www.r-pkg.org/badges/version-ago/ade4)](http://cran.r-project.org/package=ade4)
 [![CRAN Downloads](https://cranlogs.r-pkg.org/badges/ade4)](https://cran.r-project.org/package=ade4)
 [![R-CMD-check](https://github.com/sdray/ade4/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/sdray/ade4/actions/workflows/R-CMD-check.yaml)
 [![License: GPL v3](https://img.shields.io/badge/License-GPLv3-blue.svg)](https://www.gnu.org/licenses/gpl-3.0)
 
-# [ade4](http://pbil.univ-lyon1.fr/ADE-4/)
 Analysis of Ecological Data: Exploratory and Euclidean Methods in Environmental Sciences
 
 Installing *ade4*