在ggplot geom_raster中具有不同斜率的逻辑回归之间进行插值

Question

使用简单的逻辑增长模型，我想绘制一个基于等高线/梯度的图，显示增长参数 (r) 如何改变曲线的斜率和渐近线。

我想在绘制的曲线之间进行插值，而不是只显示一组线。

所以我尝试了以下方法：

#Using these packages
library(ggplot2)
library(tidyr)

# The logistic function applied to a vector of time steps (t)
# K is carrying capacity - asymptote
# N0 is initial population density
# r is growth rate - slope
LogGr <- function(r,K,N0,t){
  d <- vapply(t,function(t) K/(1+(K/N0-1)*exp(-r*t)),numeric(1))
}

# time steps - daily over 4 years
t<-1:(365*4)

# r values - lots of them
r <- as.list(seq(0,0.1,0.001))

# using lapply to run each growth parameter - faster than for loop
ld <- lapply(r,LogGr,K=1,N0=0.00001,t=t)

# create data frame - col of population densities (N) for each r value
df <- data.frame(matrix(unlist(ld), nrow=length(t), byrow=F))
# Add time column (days)
df$Days <- t
# Rename cols for ease of viewing
colnames(df) <- c(as.character(as.vector(r)),"Days")

# Transform to long data format - facilitate ggplot colouring
Data <- gather(df,key=Gr,value=N,-Days)

# GGplot geom_raster plot
# My problem lies here somewhere - I may be misunderstanding the interpolate param.
ggplot(Data,aes(x=Days,y=round(N,3)))+
  geom_raster(aes(fill=as.numeric(Gr)),interpolate=T)+
  labs(y="Population Density",col="Growth Rate")

我希望颜色在曲线之间进行插值。

编辑： 在将给定范围内的r 值的数量增加到seq(0,0.1,0.00001) 之后，我能够使用上述代码生成带有插值的栅格。

所以这个问题变成了'如何控制 geom_raster 中的插值将传播多远？但这现在可能是一个重复的问题。即将更新。

Answer 1

我建议使用 stat_summary_hex() geom 来完成这项任务。我提供了一个缩放功能，让您可以使用填充比例。如果需要，请输入viridis::scale_fill_viridis(rescaler = scale_fn)。

scale_fn <- function(x, to = c(0, 1), from = NULL) {
    ifelse(x<max(x)/10, 
           scales::rescale(x,
                           to = to,
                           from = c(0, max(x)/10)),
           1)}

ggplot(Data,aes(x=Days,y=round(N,3)))+
  stat_summary_hex(aes(z=as.numeric(Gr)))+
  labs(y="Population Density",col="Growth Rate")+
  viridis::scale_fill_viridis()

要使用geom_raster，您应该为每个网格点设置一个值。插值参数将平滑每个光栅图块之间的值，因此生成的图像看起来很平滑。

试试下面的方法看看有什么不同：

ggplot(faithfuld, aes(waiting, eruptions)) +
 geom_raster(aes(fill = density), interpolate = TRUE)