2015-04-17 41 views
0

我在R和它的包中比較新。我正在使用adehabitatHS包來計算和繪製一些選擇性數據。不過,我有一些麻煩,主要是在繪圖時。adehabitat包劇情操縱

第一個是,默認情況下,程序使用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

+0

我添加了校正後的圖,只是分辨率問題。 – user12257

回答

0

您有幾種選擇。您可以使用str()函數查看wiRatio對象的結構,並提取適合繪圖的元素。

或者,您可以很容易地修改源代碼。類別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(如我在上面的例子中)。

+0

非常感謝!你給我像三隻手!我會使用你的代碼,並會讓你知道,如果我設法修改傳說! – user12257