Salut,
rien de bien direct. 2 Solutions, soit tu édites via un logiciel de graphisme soit tu édite le code source des fonctions d'ade4.
Ce package a l'avantage de fournir un code directement accessible du coup tu peux facilement le modifier. il faut juste repérer les bonnes fonctions.
Je te propose de ne pas vraiment passer par un scatter qui produit souvent un graphique où tout se supperpose. Donc ci-dessous une version modifiée de s.arrow qui est la fonction qui trace les flêches des variables dans toutes les représentations de ce type dans ade4.
1ère étape, on ajoute un argument "colboxes" à la fonction scatterutil.eti.circ qui deveint scatterutil.eti.circ2 pour ne pas écraser la version d'origine.
Code : Tout sélectionner
scatterutil.eti.circ2 <-
function (x, y, label, clabel, origin = c(0, 0), boxes = TRUE, colboxes="white")
{
if (is.null(label))
return(invisible())
if (any(is.na(label)))
return(invisible())
if (any(label == ""))
return(invisible())
xref <- x - origin[1]
yref <- y - origin[2]
for (i in 1:(length(x))) {
cha <- as.character(label[i])
cha <- paste(" ", cha, " ", sep = "")
cex0 <- par("cex") * clabel
xh <- strwidth(cha, cex = cex0)
yh <- strheight(cha, cex = cex0) * 5/6
if ((xref[i] > yref[i]) & (xref[i] > -yref[i])) {
x1 <- x[i] + xh/2
y1 <- y[i]
}
else if ((xref[i] > yref[i]) & (xref[i] <= (-yref[i]))) {
x1 <- x[i]
y1 <- y[i] - yh
}
else if ((xref[i] <= yref[i]) & (xref[i] <= (-yref[i]))) {
x1 <- x[i] - xh/2
y1 <- y[i]
}
else if ((xref[i] <= yref[i]) & (xref[i] > (-yref[i]))) {
x1 <- x[i]
y1 <- y[i] + yh
}
if (boxes) {
rect(x1 - xh/2, y1 - yh, x1 + xh/2, y1 + yh, col =colboxes,
border = 1)
}
text(x1, y1, cha, cex = cex0)
}
}
étape 2 on incorpore cette modification à la fonction s.arrow
Code : Tout sélectionner
s.arrow2 <-
function (dfxy, xax = 1, yax = 2, label = row.names(dfxy), clabel = 1,
pch = 20, cpoint = 0, boxes = TRUE, edge = TRUE, origin = c(0,
0), xlim = NULL, ylim = NULL, grid = TRUE, addaxes = TRUE,
cgrid = 1, sub = "", csub = 1.25, possub = "bottomleft",
pixmap = NULL, contour = NULL, area = NULL, add.plot = FALSE, colboxes="white")
{
arrow1 <- function(x0, y0, x1, y1, len = 0.1, ang = 15, lty = 1,
edge) {
d0 <- sqrt((x0 - x1)^2 + (y0 - y1)^2)
if (d0 < 1e-07)
return(invisible())
segments(x0, y0, x1, y1, lty = lty)
h <- strheight("A", cex = par("cex"))
if (d0 > 2 * h) {
x0 <- x1 - h * (x1 - x0)/d0
y0 <- y1 - h * (y1 - y0)/d0
if (edge)
arrows(x0, y0, x1, y1, angle = ang, length = len,
lty = 1)
}
}
dfxy <- data.frame(dfxy)
opar <- par(mar = par("mar"))
on.exit(par(opar))
par(mar = c(0.1, 0.1, 0.1, 0.1))
coo <- scatterutil.base(dfxy = dfxy, xax = xax, yax = yax,
xlim = xlim, ylim = ylim, grid = grid, addaxes = addaxes,
cgrid = cgrid, include.origin = TRUE, origin = origin,
sub = sub, csub = csub, possub = possub, pixmap = pixmap,
contour = contour, area = area, add.plot = add.plot)
if (grid & !add.plot)
scatterutil.grid(cgrid)
if (addaxes & !add.plot)
abline(h = 0, v = 0, lty = 1)
if (cpoint > 0)
points(coo$x, coo$y, pch = pch, cex = par("cex") * cpoint)
for (i in 1:(length(coo$x))) arrow1(origin[1], origin[2],
coo$x[i], coo$y[i], edge = edge)
if (clabel > 0)
scatterutil.eti.circ2(coo$x, coo$y, label, clabel, origin,
boxes,colboxes=colboxes)
if (csub > 0)
scatterutil.sub(sub, csub, possub)
box()
invisible(match.call())
}
Et voilà ce que ça donne avec un exemple reproductible.
Code : Tout sélectionner
data(meaudret)
env.pca <- dudi.pca(meaudret$env)
code de la figure ci-dessous
s.arrow2(env.pca$co,colboxes=c("transparent"))
s.arrow2(env.pca$co[1:5,],colboxes=c("red"),add.p=T)
s.arrow2(env.pca$co[6:9,],colboxes=c("blue"),add.p=T)