提高R中估计参数模型的性能

时间:2019-04-14 23:05:15

标签: r optimization mixed-models

我开发了一种将威胁关联性纳入随机效应和协变量之间的混合模型的方法。我在SAS下使用nlmixed进行处理。我的数据集有9个变量,用于8834行。

我有6个参数可以估算。

proc nlmixed data=naisga tech=NMSIMP seed=101;
parms beta0=-2.40 beta1=-0.28 delta0=0 delta1=0 sx=1 sb=1;
eta= beta0 + beta1*mat_age_dec + b;
expeta = exp(eta);
p = expeta/(1+expeta);
py = log((p**petitpoids) * ((1-p)**(1-petitpoids)));
sqrt2pi = sqrt(2*constant('pi'));
px = -log(sx) - log(sqrt2pi*mat_age_dec) - (log(mat_age_dec)-delta0 + delta1*b)**2  / (2*sx**2);
LL = px + py;
model petitpoids~general(LL);
random b ~ normal(0,sb) subject=matid;
run; 

对于固定参数,我得到了这个结果。

beta0   -3.1908
beta1   0.4374  

具有很好的计算时间。

因此,我想在R中实现这一点,并编写了以下代码。我试图在nlmixed proc中重现SAS方法。

library(fastGHQuad)
library(lme4)

set.seed(101)

data.naisga = read.csv2(file.choose(), sep=",", header = TRUE)

#Creation of my variable to predict
#Here is my Y
data.naisga$poidsnais.dummy = data.naisga$poidsnais<= 2500

#Mother age in decades
#Here is my X
data.naisga$mat_age_dec = data.naisga$mat_age / 10

#Deletion of missing rows for my predictor
data.naisga2 <- data.naisga[!is.na(data.naisga$mat_age),]

我的数据如下所示。

matid poidsnais dprenat mat_age sexe matrace fumeuse poidsnais.dummy mat_age_dec  
1    39      3720      NA      15    2       2      NA   FALSE         1.5
2    39      3260       4      17    1       2      NA   FALSE         1.7
3    39      3910       0      19    1       2      NA   FALSE         1.9
4    39      3320       0      24    1       2       2   FALSE         2.4
5    39      2480       6      25    1       2       2   TRUE         2.5
6    62      2381       5      17    2       2      NA   TRUE         1.7
init.par <- c(-2.40,-0.28,0,0,1,1)

#Function with join density
YX.terme = function(par,y,x,b)
{
  #Parameters to estimate
  beta = par[1:2]
  #Parameters of conditional density of X by b 
  delta = par[3:4]
  logsigmax = par[5]
  #Sigma of b
  logsigmab = par[6]

  py = ifelse(y==1,exp(cbind(1,x)%*%beta),1)/(1+exp(cbind(1,x)%*%beta))
  px = exp((-(x-delta[1]-delta[2]*b)^2)/(2*exp(logsigmax)))/exp(logsigmax/2)
  dG = exp(-b^2/(2*exp(logsigmab)))/exp(logsigmab/2)

  prod(py*(px+log(1.000001))*dG)

}

YX.vec = Vectorize(YX.terme,"b")

rule100 <- gaussHermiteData(100)

#Function which compute my likelihood
YX.mixte = function(par,y,x,id)
{
  uid = unique(id)
  ll = 0

  ll = sapply(uid, FUN = function(i) ll + log(ghQuad(YX.vec,rule100,par=par,y=y[id==i],x=x[id==i])))
  return(-sum(ll))
}

#optim to estimate my parameters 

mat.age.fit = optim(init.par,fn=YX.mixte,method="BFGS",y=data.naisga2$poidsnais.dummy,x=data.naisga2$mat_age_dec,id=data.naisga2$matid,control=list(trace=10,reltol=1e-2))

此优化部分非常慢,这就是为什么我将reltol参数降低为1e-2的原因。即使我使用速度更快的CG解算器,optim几乎要花费整整一天的时间来计算参数,但结果却非常不稳定。

因此,我想知道我的实际代码是否正常,或者是否可以通过其他方法对其进行改进以提高其性能。如果您知道一些减少我的优化部分的计算时间的好窍门,我将不胜感激。

0 个答案:

没有答案