adehabitat package plot manipulation - r

Question

I am relatively new in R and its packages. I am using the adehabitatHS package to compute and plot some selectivity data. Nevertheless I am having some troubles, mainly while plotting.
The first one is that by default the program uses the name "habitat" for the x-axis and I need to use "Msp" instead.
The second one is that I need to edit the first (top left) and specially the third (bottom left) plots. Since the legend for the third plot is too big and also I would like to sort the values. Does anyone know how to handle this kind of plots, is it possible to do it?
Please find attached my code, a copy of the dataset and the plot.
Dataset
Code:
library(adehabitatHS)
pse<-read.table("pseudos.txt", header=T)
attach(pse)
names(pse)
head(pse)
(wiRatio <- widesI(Diet, Dis))
png(filename = "plotpseudos3.png", width = 500, height = 500)
opar <- par(mfrow=c(2,2))
plot(wiRatio)
par(opar)
dev.off()

Answer 1

You have several options. You can look at the structure of your wiRatio object using str() function and extract the appropriate elements for plotting.
Or, you can modify the source pretty easily. The labels in the plot method for object of class wi uses names of values from that object (names(wi)) so this is where you need to dig. Here is the modified function, which I renamed to distinguish it from the original.
plotWi <- function (x, caxis = 0.7, clab = 1, ylog = FALSE, errbar = c("CI", "SE"),
main = "Manly selectivity measure", noorder = TRUE,
my.labels, ...)
{
errbar <- match.arg(errbar)
opar <- par(ask = TRUE)
on.exit(par(opar))
if (!inherits(x, "wi"))
stop("x should be of class wi")
eb <- ifelse(errbar == "SE", 1, abs(qnorm(x$alpha/length(x$wi))))
if (noorder)
wi <- sort(x$wi, decreasing = TRUE)
else wi <- x$wi
if ((any(wi == 0)) & (ylog)) {
warning("zero values in x, ylog has been set to FALSE")
ylog <- FALSE
}
logy <- ifelse(ylog, "y", "")
if (noorder)
sewi <- x$se.wi[order(x$wi, decreasing = TRUE)]
else sewi <- x$se.wi
sewi[is.na(sewi)] <- 0
nwi <- names(wi)
rgy <- range(c(wi, wi + eb * sewi, wi - eb * sewi))
textleg <- paste("Selection ratios (+/-", errbar, ")")
if (inherits(x, "wiII") | inherits(x, "wiIII"))
textleg <- paste("Global Selection ratios (+/-", errbar,
")")
if (!ylog)
rgy[1] <- 0
plot(wi, axes = FALSE, ylim = rgy, ty = "n", xlab = "", ylab = textleg,
cex.lab = clab, log = logy, main = main, ...)
axis(side = 1, at = c(1:length(wi)), labels = my.labels,
cex.axis = caxis, las = 2)
axis(side = 2, cex.axis = caxis)
box()
points(c(1:length(wi)), wi, pch = 16)
lines(1:length(wi), wi)
abline(h = 1, lwd = 2)
for (i in 1:length(wi)) {
lines(c(i, i), c(wi[i] - eb * sewi[i], wi[i] + eb * sewi[i]))
lines(c(i - 0.1, i + 0.1), c(wi[i] - eb * sewi[i], wi[i] -
eb * sewi[i]))
lines(c(i - 0.1, i + 0.1), c(wi[i] + eb * sewi[i], wi[i] +
eb * sewi[i]))
}
if (inherits(x, "wiI")) {
if (noorder)
Bi <- x$Bi[order(x$wi, decreasing = TRUE)]
else Bi <- x$Bi
plot(Bi, axes = FALSE, ty = "n", xlab = "", cex.lab = clab,
main = "Scaled selection ratios", ...)
axis(side = 1, at = c(1:length(wi)), labels = my.labels,
cex.axis = caxis, las = 2)
axis(side = 2, cex.axis = caxis)
lines(1:length(wi), Bi)
points(c(1:length(wi)), Bi, pch = 16)
box()
if (noorder) {
ut <- x$used.prop[order(x$wi, decreasing = TRUE)]
seu <- x$se.used[order(x$wi, decreasing = TRUE)]
sea <- x$se.avail[order(x$wi, decreasing = TRUE)]
av <- x$avail.prop[order(x$wi, decreasing = TRUE)]
}
else {
ut <- x$used.prop
seu <- x$se.used
sea <- x$se.avail
av <- x$avail.prop
}
rgy <- range(c(av, ut - eb * seu, ut + eb * seu, av -
eb * sea, av + eb * sea))
rgy <- c(rgy[1], rgy[2] + (rgy[2] - rgy[1])/4)
plot(ut, axes = FALSE, ty = "n", xlab = "", cex.lab = clab,
ylim = rgy, main = "Used and available proportions",
ylab = paste("Porportion (+/-", errbar, ")"), ...)
points(1:length(wi) - 0.05, av, pch = 16)
points(1:length(wi) + 0.05, ut, pch = 2)
for (i in 1:length(wi)) {
lines(c(i, i) + 0.05, c(ut[i] - eb * seu[i], ut[i] +
eb * seu[i]))
lines(c(i - 0.02, i + 0.02) + 0.05, c(ut[i] - eb *
seu[i], ut[i] - eb * seu[i]))
lines(c(i - 0.02, i + 0.02) + 0.05, c(ut[i] + eb *
seu[i], ut[i] + eb * seu[i]))
}
if (!x$avknown) {
for (i in 1:length(wi)) {
lines(c(i, i) - 0.05, c(av[i] - eb * sea[i],
av[i] + eb * sea[i]))
lines(c(i - 0.02, i + 0.02) - 0.05, c(av[i] -
eb * sea[i], av[i] - eb * sea[i]))
lines(c(i - 0.02, i + 0.02) - 0.05, c(av[i] +
eb * sea[i], av[i] + eb * sea[i]))
}
}
axis(side = 1, at = c(1:length(wi)), labels = my.labels,
cex.axis = caxis, las = 2)
axis(side = 2, cex.axis = caxis)
box()
legend(1, rgy[2], c("Available", "Used"), pch = c(16,
2), cex = clab)
}
else {
if (noorder)
wij <- x$wij[, order(x$wi, decreasing = TRUE)]
else wij <- x$wij
iii <- as.vector(wij)
rgy <- range(iii[!is.na(iii)])
plot(1, ty = "n", ylim = rgy, xlim = c(1, ncol(wij)),
xlab = "", ylab = paste("Selection ratios"), cex.lab = clab,
log = logy, axes = FALSE, main = main, ...)
axis(side = 1, at = c(1:length(wi)), labels = names(wi),
cex.axis = caxis, las = 2)
axis(side = 2, cex.axis = caxis)
box()
pt <- seq(-0.1, 0.1, by = 0.2/nrow(wij))
for (j in 1:nrow(wij)) {
points(c(1:length(wi)), wij[j, ], pch = 16, col = j)
lines(1:length(wi), wij[j, ], col = j)
abline(h = 1, lwd = 2)
}
rgx <- ncol(wij)/5
legend(ncol(wij) - rgx, rgy[1] + 19 * (rgy[2] - rgy[1])/20,
legend = row.names(wij), pch = 16, col = 1:nrow(wij),
lwd = 1, cex = clab)
}
}
I pass custom labels to the my.labels argument.
ploWi(wiRatio, noorder = FALSE, my.labels = paste("bugabuga", 1:16, sep = ""))
I will leave you as an exercise to modify the above function to tweak the legend.
Regarding the sorting of values, just use noorder = FALSE (as in my above example).