0

我有RasterStack几个400MB光栅文件，我想将它们与rasterVIS密度函数进行比较。问题是情节的标签相互重叠。情节看起来像这样...... 情节看起来像这样

那么是否可以将rasterVis密度图中的标签更改为侧面的图例？

我尝试过类似的事情

library(raster)
library(rasterVis)

Rasterstack = stack(Rasterfile1,Rasterfile2,Rasterfile3,Rasterfile4)
labels = names(RasterStack)

densityplot(RasterStack, xlab="density", ylab="value", 
             auto.key= list(space="right", lines=TRUE, text=labels))
#or just#
densityplot(RasterStack, xlab="density", ylab="value", auto.key=T)

我也尝试了这里提到的解决方案，但它对我不起作用，因为它会生成不可处理的矢量大小。有任何想法吗？

4

1 回答 1

0

通过改编密度图函数的 RasterVis 源代码找到了解决方案。

library(raster)
library(rasterVis)

#Adapted density plot function#

dp <- function(x, data = NULL, layers, FUN, maxpixels = 1e+05,
                   xlab = '', ylab = '', main = '',
                   par.settings = rasterTheme(), auto.key = list(columns = 4, space = "top"), ...) {
      
      if (!missing(layers)) x <- subset(x, layers)
      nl <- nlayers(x)
                
      if (nl > 1) {
        dat <- raster2dat(x, FUN, maxpixels)
        p <- densityplot(~values,
                         data = dat, groups = ind,
                         breaks = 100,
                         par.settings = par.settings, pch = '.',
                         xlab = xlab, ylab = ylab, main = main, auto.key = auto.key, 
                         panel = panel.superpose,
                         panel.groups = function(x, group.value, col.line, ...) {
                           panel.densityplot(x, col.line = col.line,
                                             plot.points = FALSE, ...)
                           # d <- density(x, na.rm = TRUE)
                           # i <- which.max(d$y)
                           # ltext(d$x[i],d$y[i],
                           #       group.value,
                           #       adj = c(0.3,0),
                           #       col = col.line,
                           #       cex = 0.7)
                          })
      } else {
        p <- densityplot(x, maxpixels = maxpixels,
                         main = main, xlab=xlab, ylab=ylab, ...)
      }
      p
    }


 #raster2dat function from the RaserVis package#

    raster2dat <- function(x, FUN, maxpixels){
      nl <- nlayers(x)
      if (maxpixels < ncell(x)) {
        dat <- sampleRandom(x, maxpixels)
      } else {
        dat <- getValues(x)
      }
      if (nl>1){
        dat <- as.data.frame(dat)
        ##http://r.789695.n4.nabble.com/Column-order-in-stacking-unstacking-td3349953.html
        idx <- sprintf("%s%03d", "X", 1:nl) 
        names(dat) <- idx
        dat <- stack(dat)
        z <- getZ(x)
        if (!missing(FUN) & !is.null(z)){
          FUN <- match.fun(FUN)   
          dat$ind <- factor(FUN(z))[dat$ind]
        } else {
          nms <- names(x)
          nms <- reorder(factor(nms), 1:nl)
          dat$ind <- nms[dat$ind]
        }
        dat
      } else {
        dat ##nl==1 --> raster2dat gives a vector 
      }
    }
    
    #Test

    f <- system.file("external/test.grd", package="raster")
    r <- raster(f)
    s <- stack(r, r-500, r+500, r - 120)
    
    dp(s)
于 2020-10-12T21:50:26.950 回答