在gam mgcv中通过线性函数进行平滑预测

时间:2019-11-18 23:53:05

标签: r gam mgcv

我正在使用R进行大型bam模型的平滑处理,包括通过矩阵预测变量和'by'变量的线性函数项。我们正在探索自干扰起的干扰强度和时间如何影响电流响应。观察结果是每2分钟采集一次的鸟类存在/缺失数据的向量。我们将2分钟时滞的矩阵与存在干扰或不存在干扰的“ by”变量矩阵进行拟合,并在同一模型中包括两种干扰类型。

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”的相应数据。

    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)

我们对鸟类和干扰类型有观察,现在选择感兴趣的时间窗口来探索干扰的影响。我们将使用20分钟的窗口,因此有10个滞后。

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

现在创建具有20分钟干扰历史记录的矩阵,并删除前20分钟的数据,以便完成所有行。

    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)

我还想预测干扰历史减少的情况下的鸟类反应,以及模型中出现的所有其他变量。

为全1的Dist1创建新的数据矩阵,并创建用于预测的新数据列表。

    #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)

现在,我想针对时间变量LagHist绘制对象“ predReal”和“ predND”的预测拟合度和se。该图应类似于x(0至20分钟)的x轴且y轴在响应范围上的plot(mod1)的结果。希望有一种简单的方法来绘制这些预测,而我只是没有想到。

感谢您的帮助,感谢您的宝贵时间!

-内特

0 个答案:

没有答案