将SAS中的PROC NLMIXED的SPCM-ZIP模型转换为R

时间:2018-09-11 21:15:56

标签: r sas

我正在尝试从SAS中的PROC NLMIXED转换为R中的平滑参数计数模型零膨胀的泊松,该模型和SAS代码来自论文https://onlinelibrary.wiley.com/doi/abs/10.1111/jors.12280

我拥有的SAS代码:

proc nlmixed data=a maxiter=10000 tech=dbldog gconv=0 HESS method=gauss subgrad=gradient;
paramters a0 0 a1 0 g0 0 g1 0 b0 0 b1 0 b2 0 b3 0 d0 0 d1 0 d2 0 d3 0 gamma 0 c 0;
bounds 0<=gamma<=100, &minwz<=c<=&maxwz;
G = transition function based on gamma, c, and spatial weight variable
linpinf = zero inflated regression
infprob = 1/(1+exp(-linpinfl))
lambda = exp(count regression)
if &yvar=0 then
  ll = log(infprob + (1-infprob*exp(-lambda));
else ll = log((1-infprob)) - lambda + &yvar*log(lambda) - lgamma(&yvar + 1);
model &yvar ~ general(ll);
run;

我没有写出所有回归和过渡函数以节省空间。

在R中,我已经能够使用optim复制标准的ZIP模型,但是一旦添加了转移函数,我就不会获得相似的系数估算值。

我的R代码:

spcmzip <- function(beta,a0,a1,g0,g1,x0,x1,x2,d0,d1,d2,y) {  
gamma=beta[11]
c=beta[12]

G <- NA
if (gamma >= 0 && gamma <= 100 && c >= minwz && c<= maxwz) {
  G <- 1/(1+exp(-gamma*(wshale_tight-c)/stdwz))
}

lin      <- beta[5]*x0+beta[6]*x1+beta[7]*x2+beta[8]*d0*G+beta[9]*d1*G+beta[10]*d2*G
linpinfl <- beta[1]*a0+beta[2]*a1+beta[3]*g0*G+beta[4]*g1*G
infprob  <- 1/(1+exp(-linpinfl))
lambda   <- exp(lin)

yt <- c()
for (i in 1:length(y)) {
  if (y[i]==0) {
    yt[i] <- log(infprob[i] + (1-infprob[i])*exp(-lambda[i]))
  } else {
    yt[i] <- log((1-infprob[i])) - lambda[i] + y[i]*log(lambda[i]) - lgamma(y[i]+1)
  }
}

logl <- (sum(yt))
return (-logl) 
}

mle <- optim(c(0,0,0,0,0,0,0,0,0,0,0,0),spcmzip,a0=a0,a1=a1,g0=g0,g1=g1,x0=x0,x1=x1,
         x2=x2,d0=d0,d1=d1,d2=d2,
         y=y,method="Nelder-Mead",hessian=FALSE)

但是,使用“ Nelder-Mead”方法并选择不使用粗麻布是我可以进行估计的唯一方法,并且系数与SAS几乎没有相似之处。我认为问题的部分原因在于,优化者并没有进行双重折衷优化,这可能是为什么此方法不起作用的重要原因。

人们是否知道R中有任何软件包可以解决此类优化问题?还是有人看到我的代码明显有问题?

0 个答案:

没有答案