如何在 Spatstat 中创建带有覆盖两个标记的图例的组合颜色图？

Posted 2023-02-16

【中文标题】如何在 Spatstat 中创建带有覆盖两个标记的图例的组合颜色图？

【英文标题】：How do I create a combined colour plot with legend overlaying two marks in Spatstat?

【发布时间】：2021-12-20 04:03:46

【问题描述】：

我想在 Spatstat 中创建一个带有图例的两个标记的组合颜色图，以在一个点过程模式中显示物种以及多个物种的直径。

我从这个情节开始：

    set.seed(42)
    species  <- LETTERS[1:16]
    diameter <- sample(15:50,16,TRUE)
    x        <- sample(2:18,16,TRUE)
    y        <- sample(2:18,16,TRUE)
    library(spatstat)
    Dat <- data.frame(x,y,species,diameter)
    X   <- as.ppp(Dat,W=square(20))
    marks(X)$species <- factor(marks(X)$species)
    ccc <- (1:16)[as.numeric(factor(marks(X)$species))]
    # Here ccc will just be 1:16 since there are the same number
    # of species as points, but in general ccc will be a vector of
    # length = npoints(X), with entries determined by the species
    # associated with the given point.
    newPal  <- vector("list",4)
    newPal[[1]] <- colorRampPalette(c("green","red"))(10)
    newPal[[2]] <- heat.colors(16)
    newPal[[3]] <- topo.colors(16)

newPal[[4]] <- terrain.colors(16)
for(k in 1:4) 
    palette(newPal[[k]])
    plot(X,which.marks="diameter",maxsize=1,main="")
    plot(X,which.marks="diameter",maxsize=1,bg=ccc,add=TRUE)
    if(k < 4) readline("Go? ")

【参考方案1】：

您需要任何平面点图案文件“X”（.ppp），其中“dbh”（胸高直径）作为数字变量，“species”（作为数字编码的因子（但仍然是分类变量））作为标记.

感谢 Rolf Turner：

dbhAndSpecies <- function(X,palfn=c("hcl","heat","terrain","topo","cm","rainbow"),
                          palnm="Spectral",...) 
library(spatstat)
if(!(all(c("species","dbh") %in% names(marks(X))))) 
    whinge <- paste0("The marks of \"X\" must be a data frame",
                     " having columns \"species\" and \"dbh\".\n")
    stop(whinge)


X  <- shift(X,origin="bottomleft")
xr <- Window(X)$xrange
yr <- Window(X)$yrange
X  <- affine(X,mat=diag(c(5/xr[2],10/yr[2])))

lbls <- c("Ash","Beech","Lime","FieldMaple","Oak","WychElm",
          "Alder","An","Birch","Sallow","CrabApple","Blackthorn",
          "Hawthorn","Larch","WildService","Whitebeam","Holly","Privet",
          "Yew","Rose","Dogwood","GuelderRose","Hazel","Spindle")
lbls <- substr(lbls,1,5)
ok   <- (1:24) %in% marks(X)$species
marks(X)$species <- factor(marks(X)$species,levels=(1:24)[ok],labels=lbls[ok])
nspec <- length(levels(marks(X)$species))
palfn <- match.arg(palfn)
if(palfn=="hcl") 
    pal <- hcl.colors(n=nspec,palette=palnm)
 else 
    if(palfn != "rainbow") palfn <- paste0(palfn,".colors")
    palfn <- get(palfn)
    pal <- palfn(n=nspec)

kul <- (1:nspec)[as.numeric(factor(marks(X)$species))]
oldPal <- palette(pal)
on.exit(palette(oldPal))
OP <- par(xpd=NA)
on.exit(par(OP),add=TRUE)
plot(X,which.marks="dbh",maxsize=1,...)
plot(X,which.marks="dbh",maxsize=1,bg=kul,add=TRUE)
leg <- levels(marks(X)$species)
legend("right",pch=20,col=1:nspec,legend=leg,inset=-0.02,title="Species")

【讨论】：

抱歉，这在spatstat 的未来版本中将不起作用。它利用了spatstat 代码中的一个错误，该错误将很快关闭。您将需要使用基本图形尽快制作此图。