R gam-mgcv中基于线性泛函的光滑预测

我正在研究R中的一个大型bam模型，该模型通过矩阵预测器和“by”变量进行平滑处理，包括线性函数项。我们正在探索扰动强度和扰动时间如何影响电流响应。观察结果是每2分钟获取的鸟类存在/不存在数据的向量。我们正在用滞后存在/不存在干扰的矩阵“by”变量拟合2分钟时滞矩阵，并在同一模型中包括两种干扰类型

bam（Bird~s（TimeLag，by=Disturbance1History，bs=“gp”）+s（TimeLag，by=Disturbance2History，bs=“gp”），family=binomial（））

我已经对模型进行了拟合，并创建了一个新的数据对象，该对象是模型所有元素的列表，包括维度与模型匹配的矩阵，因为这是predict.gam在拟合此类模型时的要求。其目的是通过改变干扰水平，使用矩阵“by”变量预测响应，以探索暴露于干扰的程度如何随时间影响鸟类，特别是在其他干扰类型的历史背景下

那么，如何用矩阵预测器和“by”变量绘制预测响应数据

以下是一些数据和简单模型以及预测，以帮助说明：

    library(data.table)
    library(mgcv)
    library(tidyverse)

每两分钟进行一次四小时的鸟类存在/不存在，以及两种干扰类型“Dist1”和“Dist2”的相应数据

现在，我想根据时间变量LagHist绘制对象“predReal”和“predND”的预测拟合和se。曲线图应与曲线图（mod1）的结果相似，x轴为0-20分钟，y轴为响应标度。希望有一个简单的方法来描绘这些预测，我只是没有想到它

感谢您的帮助，谢谢您抽出时间

---

-Nate

Hi njk，感谢您花时间准备问题的数据。我可以运行您的代码，大致了解您想要了解的内容。那么也许把你的问题分成两个独立的问题？第一部分是关于高斯平滑是否合适，第二部分是关于结果的可视化？您还可以将代码块中的一些注释问题转化为实际文本。谢谢。我简化了这个问题。谢谢你的帮助。嗨，njk，谢谢你花时间准备这个问题的数据。我可以运行您的代码，大致了解您想要了解的内容。那么也许把你的问题分成两个独立的问题？第一部分是关于高斯平滑是否合适，第二部分是关于结果的可视化？您还可以将代码块中的一些注释问题转化为实际文本。谢谢。我简化了这个问题。我感谢你的帮助。

    BirdRaw<-c(1,0,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0,1,0,1,0,0,0,1,1,0,1,0,1,1,
             1,0,1,1,0,0,0,0,0,1,0,1,0,0,0,0,0,1,0,1,0,0,0,1,1,0,1,0,1,1,
             1,0,1,1,0,0,0,0,0,1,1,1,0,0,0,0,0,1,0,0,0,0,0,1,1,0,1,0,1,1,
             1,0,1,0,0,0,1,0,0,1,1,1,0,0,0,0,0,1,0,1,0,0,0,1,0,0,1,0,1,1)

    Dist1Raw<-c(1,0,1,1,0,0,0,0,0,1,1,1,0,0,0,0,0,1,0,1,0,0,0,1,1,0,1,0,1,1,
              1,0,1,1,0,0,0,0,0,1,1,1,0,0,0,0,0,1,0,1,0,0,0,1,1,0,1,0,1,1,
              1,0,1,1,0,0,0,0,0,1,1,1,0,0,0,0,0,1,0,1,0,0,0,1,1,0,1,0,1,1,
              1,0,1,1,0,0,0,0,0,1,1,1,0,0,0,0,0,1,0,1,0,0,0,1,1,0,1,0,1,1)

    Dist2Raw<-c(0,0,0,1,0,0,0,0,0,0,1,0,0,0,0,1,0,0,0,0,0,0,0,0,1,0,1,0,0,0,
              0,0,0,1,0,0,0,0,0,0,1,0,0,0,0,1,0,0,0,0,0,0,0,0,1,0,1,0,0,0,
              0,0,0,1,0,0,0,0,0,0,1,0,0,0,0,1,0,0,0,0,0,0,0,0,1,0,1,0,0,0,
              0,0,0,1,0,0,0,0,0,0,1,0,0,0,0,1,0,0,0,0,0,0,0,0,1,0,1,0,0,0)

    df<-data.table(Bird=BirdRaw, Dist1=Dist1Raw, Dist2=Dist2Raw)

    LagWindow <- 10 # 10 surveys, so 20 minute window

    Dist1Hist<-df[,shift(Dist1,1:LagWindow)]%>% drop_na("V10")
    Dist2Hist<-df[,shift(Dist2,1:LagWindow)]%>% drop_na("V10")

    LagHist <- matrix(rep(2*(1:LagWindow),dim(Dist1Hist)[1]),
    ncol=LagWindow, byrow=T)

    BirdHist<-df[,shift(Dist1,1:LagWindow)][, "Bird" := df[,Bird]]%>%
drop_na("V10")
    Bird<-BirdHist$Bird

#remove some objects
    rm(df, BirdRaw,BirdHist ,Dist1Raw, Dist2Raw, LagWindow)

    mod1<- bam(Bird ~ s(LagHist,by=as.matrix(Dist1Hist), bs="gp")+
    + s(LagHist,by=as.matrix(Dist2Hist),
    bs="gp"),family=binomial())

    plot(mod1, pages=1,xlab="Time since disturbance")
    summary(mod1)

    Dist1Hist<-as.matrix(Dist1Hist)
    Dist2Hist<-as.matrix(Dist2Hist)
    pdlistReal<-list(Dist1Hist, Dist2Hist, LagHist, Bird)
    names(pdlistReal)<-c("Dist1Hist", "Dist2Hist", "LagHist", "Bird")

    predReal<-predict(mod1,pdlistReal, type="response",se.fit=TRUE)

    #multiply by 0
    Dist1Hist<-Dist1Hist*0

    #create list of elements for new data prediction with decreased Dist1 history
    pdlistND<-list(Dist1Hist, Dist2Hist, LagHist, Bird)
    names(pdlistND)<-c("Dist1Hist", "Dist2Hist", "LagHist", "Bird")
    predND<-predict(mod1,pdlistND, type="response",se.fit=TRUE)

    head(predReal)
    head(predND)