adehabitat包情节操纵

时间:2015-04-17 06:02:33

标签: r plot

我在R及其套餐中相对较新。我正在使用adehabitatHS包来计算和绘制一些选择性数据。然而,我遇到了一些麻烦,主要是在策划时。

第一个是默认程序使用名称" habitat"对于x轴,我需要使用" Msp"代替。

第二个是我需要编辑第一个(左上角),特别是第三个(左下角)。由于第三个情节的图例太大,我也想对值进行排序。有谁知道如何处理这种情节,是否可以这样做?

请查找附上我的代码,数据集和图表的副本。

Dataset

代码:

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()

enter image description here

1 个答案:

答案 0 :(得分:0)

您有几种选择。您可以使用wiRatio函数查看str()对象的结构,并提取相应的绘图元素。

或者,您可以非常轻松地修改源代码。类wi的对象的plot方法中的标签使用来自该对象(names(wi))的值的名称,因此这是您需要挖掘的位置。这是修改过的函数,我将其重命名为将其与原始函数区分开来。

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)
  }
}

我将自定义标签传递给my.labels参数。

ploWi(wiRatio, noorder = FALSE, my.labels = paste("bugabuga", 1:16, sep = ""))

enter image description here

我将离开你作为练习来修改上述功能以调整图例。

关于值的排序,只需使用noorder = FALSE(如上例所示)。