注意：以下代码将试图分配大量的内存并可能使您的机器崩溃。

Question

我有一个人，他们位置的小数据集，以及他们是否相互了解。它是拥有1000人的数据集的子集。鉴于每个人都可以认识任何其他人，潜在链接的数量增长到n ^ 2以下。我想使用小子集拟合模型，以获得作为距离函数的链接概率，以便我可以使用更宽的数据集执行模拟。

我有两个问题：

我不确定如何从拟合的GAM对象创建预测区间。
使用posterior simulation或使用来自R-sig-mixed的this technique生成预测间隔在计算上是禁止的。

以下是我的问题的一个示例，使用R-sig-mixed中的技术生成间隔。请注意，最后一步将抛出一个关于无法分配大型向量的错误，除非您使用的是非常令人印象深刻的机器。

#Some fake location data
set.seed(13)
x = runif(50)*2
y = runif(50)*2
d = cbind(ID = 1:50,as.matrix(dist(data.frame(x,y))))

我想将链接建模为距离的函数。更多虚假数据：

library(reshape)
mdata <- melt(as.data.frame(d), id=c("ID"),measure.vars = colnames(d)[2:ncol(d)],variable.name="distance") 
mdata$popularity = rnorm(25,sd=.3)
colnames(mdata)[colnames(mdata)=="variable"] = "knows"
colnames(mdata)[colnames(mdata)=="value"] = "distance"
mdata = subset(mdata,ID!=knows)
a = exp(1/(mdata$distance/runif(nrow(mdata))^mdata$distance)+mdata$popularity+rnorm(nrow(mdata),sd=.001))
mdata$prlink = a/(1+a)
with(mdata,plot(distance,prlink))
mdata$link = runif(nrow(mdata))<mdata$prlink
mdata$ID = as.factor(mdata$ID)
mdata$knows = as.factor(mdata$knows)
mdata$dum=1 #this facilitates predicting from the population of the model, later

现在，我对数据进行建模：

library(mgcv)
mod = gam(link~s(distance)+s(ID,bs="re",by=dum)+s(knows,bs="re",by=dum),data=mdata,family=binomial(link="logit"))
plot(mod,pages=1)
summary(mod)

现在，我想将拟合的模型应用于我的主数据集：

x = runif(1000)*2
y = runif(1000)*2
d = cbind(ID = 1:1000,as.matrix(dist(data.frame(x,y))))
mdata <- melt(as.data.frame(d),id.vars = "ID") 
colnames(mdata)[colnames(mdata)=="variable"] = "knows"
colnames(mdata)[colnames(mdata)=="value"] = "distance"
mdata = subset(mdata,ID!=knows)
mdata$dum=0; mdata$ID=1; mdata$knows=2 #These are needed for prediction, even though I am predicting from the population of the model, not one of the levels.

一些计时工具......

tic <- function(gcFirst = TRUE, type=c("elapsed", "user.self", "sys.self"))
{
   type <- match.arg(type)
   assign(".type", type, envir=baseenv())
   if(gcFirst) gc(FALSE)
   tic <- proc.time()[type]         
   assign(".tic", tic, envir=baseenv())
   invisible(tic)
}

toc <- function()
{
   type <- get(".type", envir=baseenv())
   toc <- proc.time()[type]
   tic <- get(".tic", envir=baseenv())
   print(toc - tic)
   invisible(toc)
}
tic()
p = predict(mod,newdata=mdata,type="response")
toc()

只需预测我的机器上的点估计需要31秒。现在尝试获取预测间隔，首先得到设计矩阵......

tic()
Designmat = predict(mod,newdata=mdata,type="lpmatrix")
toc()

这花了我47秒，在我的电脑工作时冻结了我的电脑。

现在这里是获取我在R-sig-mixed上发现的预测间隔的技术......

注意：以下代码将试图分配大量的内存并可能使您的机器崩溃。

tic()
predvar <- diag(Designmat %*% vcov(mod) %*% t(Designmat))
SE <- sqrt(predvar) 
SE2 <- sqrt(predvar+mod$sig2) 
tfrac <- qt(0.975, mod$df.residual)
interval = tfrac*SE2
toc()

>Error: cannot allocate vector of size 7435.7 Gb

还有另一种方式???

Answer 1

您需要避免计算Designmat %*% vcov(mod) %*% t(Designmat)。毕竟你只需要对角线。试试这个：

tmp <- Designmat %*% vcov(mod)

library(compiler)
diagMult <- cmpfun(function(m1, m2) sapply(seq_len(nrow(m1)), 
                                            function(i) m1[i,] %*% m2[,i]))
predvar <-  diagMult(tmp, t(Designmat))

（未经过彻底测试。如果某个软件包中尚未编译版本，则应使用Rcpp实现该功能以提高速度。）

使用具有非常大的数据集的广义加性模型编码预测区间

注意：以下代码将试图分配大量的内存并可能使您的机器崩溃。

1 个答案: