Fix a bug in plot.inertia when xax or yax are not 1 or 2

adeverse · Oct 31, 2023 · 28a5325 · 28a5325
1 parent acb7aad
commit 28a5325
Show file tree

Hide file tree

Showing 3 changed files with 16 additions and 9 deletions.
diff --git a/R/ade4-plot.R b/R/ade4-plot.R
@@ -1635,11 +1635,11 @@
   f_row <- function(posi = NULL, pos){
     graphnames <- c(if(length(lightrow) > 0) {"light_row"}, "heavy_row", if(!is.null(posi)) {"eig"})
 
-    g1 <- do.call("s.label", c(list(dfxy = lightrow, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$light_row))
+    g1 <- do.call("s.label", c(list(dfxy = lightrow, xax = 1, yax = 2, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$light_row))
     if(type == "label")
-      g2 <- do.call("s.label", c(list(dfxy = heavyrow, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$heavy_row))
+      g2 <- do.call("s.label", c(list(dfxy = heavyrow, xax = 1, yax = 2, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$heavy_row))
     else
-      g2 <- do.call("s.class", c(list(dfxy = cont_row, fac = fac_row, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$heavy_row))
+      g2 <- do.call("s.class", c(list(dfxy = cont_row, fac = fac_row, xax = 1, yax = 2, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$heavy_row))
     grow <- do.call("superpose", list(g1, g2))
     grow@Call <- call("superpose", list(g1@Call, g2@Call))
 
@@ -1653,11 +1653,11 @@
   f_col <- function(posi = NULL, pos) {
     graphnames <- c(if(length(lightcol) > 0) {"light_col"}, "heavy_col", if(!is.null(posi)) {"eig"})
 
-    g3 <- do.call("s.label", c(list(dfxy = lightcol, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$light_col))
+    g3 <- do.call("s.label", c(list(dfxy = lightcol, xax = 1, yax = 2, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$light_col))
     if(type == "label")
-      g4 <- do.call("s.label", c(list(dfxy = heavycol, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$heavy_col))
+      g4 <- do.call("s.label", c(list(dfxy = heavycol, xax = 1, yax = 2, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$heavy_col))
     else
-      g4 <- do.call("s.class", c(list(dfxy = cont_col, fac = fac_col, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$heavy_col))
+      g4 <- do.call("s.class", c(list(dfxy = cont_col, fac = fac_col, xax = 1, yax = 2, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$heavy_col))
     gcol <- do.call("superpose", list(g3, g4))
     gcol@Call <- call("superpose", list(g3@Call, g4@Call))
 

diff --git a/man/plot.inertia.Rd b/man/plot.inertia.Rd
@@ -81,11 +81,12 @@
 \examples{
 # First example
 data(bf88, package = "ade4")
-coa1 <- ade4::dudi.coa(bf88$S1, scannf = FALSE, nf = 2)
+coa1 <- ade4::dudi.coa(bf88$S1, scannf = FALSE, nf = 3)
 
 ###### row=T / col=F
-res11 <- ade4::inertia(coa1, row = TRUE, col = FALSE, nf = 2)
-g11 <- plot(res11, threshold = 0.06)
+res11 <- ade4::inertia(coa1, row = TRUE, col = FALSE, nf = 3)
+g111 <- plot(res11, threshold = 0.06)
+g112 <- plot(res11, threshold = 0.06, xax = 1, yax = 3)
 g12 <- plot(res11, threshold = 0.06, plabels.boxes.draw = TRUE, plines.lwd = 0,
   light_row.ppoints.cex = 0, posieig = "bottomleft")
 g13 <- score(res11, threshold = 0.06)

diff --git a/tests/ade4-functions.R b/tests/ade4-functions.R
@@ -99,6 +99,12 @@ score(res23, posieig = "bottomri")
 score(res23, posieig = c(0.5, 0.5))
 score(res23, posieig = c(0.5, 0.5, 2, 2))
 
+data(doubs, package = "ade4")
+afc <- ade4::dudi.coa(doubs$fish, scannf = FALSE, nf = 5)
+ic <- ade4::inertia.dudi(afc, row.inertia=TRUE, col.inertia=TRUE)
+plot(ic, contrib = "abs", threshold = 0.1, type = "label")
+plot(ic, contrib="abs", threshold = 0.1, type = "label", xax = 3, yax = 4) 
+
 
 ##################### plot.acm
 data(lascaux, package = "ade4")