Converter o código SAS NLMIXED para regressão gama inflada a zero em R


11

Estou tentando executar uma regressão inflada a zero para uma variável de resposta contínua em R. Estou ciente de uma implementação gamlss, mas eu realmente gostaria de experimentar esse algoritmo de Dale McLerran, que é conceitualmente um pouco mais direto. Infelizmente, o código está no SAS e não sei como reescrevê-lo para algo como nlme.

O código é o seguinte:

proc nlmixed data=mydata;
  parms b0_f=0 b1_f=0 
        b0_h=0 b1_h=0 
        log_theta=0;


  eta_f = b0_f + b1_f*x1 ;
  p_yEQ0 = 1 / (1 + exp(-eta_f));


  eta_h = b0_h + b1_h*x1;
  mu    = exp(eta_h);
  theta = exp(log_theta);
  r = mu/theta;


  if y=0 then
     ll = log(p_yEQ0);
  else
     ll = log(1 - p_yEQ0)
          - lgamma(theta) + (theta-1)*log(y) - theta*log(r) - y/r;


  model y ~ general(ll);
  predict (1 - p_yEQ0)*mu out=expect_zig;
  predict r out=shape;
  estimate "scale" theta;
run;

De: http://listserv.uga.edu/cgi-bin/wa?A2=ind0805A&L=sas-l&P=R20779

ADICIONAR:

Nota: Não há efeitos mistos presentes aqui - apenas corrigidos.

A vantagem desse ajuste é que (embora os coeficientes sejam os mesmos que se você ajustasse separadamente uma regressão logística para P (y = 0) e uma regressão de erro gama com link de log para E (y | y> 0)), você pode estimar a função combinada E (y) que inclui os zeros. Pode-se prever esse valor no SAS (com um CI) utilizando a linha predict (1 - p_yEQ0)*mu.

Além disso, é possível escrever declarações de contraste personalizadas para testar a significância das variáveis ​​preditoras em E (y). Por exemplo, aqui está outra versão do código SAS que usei:

proc nlmixed data=TestZIG;
      parms b0_f=0 b1_f=0 b2_f=0 b3_f=0
            b0_h=0 b1_h=0 b2_h=0 b3_h=0
            log_theta=0;


        if gifts = 1 then x1=1; else x1 =0;
        if gifts = 2 then x2=1; else x2 =0;
        if gifts = 3 then x3=1; else x3 =0;


      eta_f = b0_f + b1_f*x1 + b2_f*x2 + b3_f*x3;
      p_yEQ0 = 1 / (1 + exp(-eta_f));

      eta_h = b0_h + b1_h*x1 + b2_h*x2 + b3_h*x3;
      mu    = exp(eta_h);
      theta = exp(log_theta);
      r = mu/theta;

      if amount=0 then
         ll = log(p_yEQ0);
      else
         ll = log(1 - p_yEQ0)
              - lgamma(theta) + (theta-1)*log(amount) -                      theta*log(r) - amount/r;

      model amount ~ general(ll);
      predict (1 - p_yEQ0)*mu out=expect_zig;
      estimate "scale" theta;
    run; 

Então, para estimar "presente1" versus "presente2" (b1 versus b2), podemos escrever esta declaração de estimativa:

estimate "gift1 versus gift 2" 
 (1-(1 / (1 + exp(-b0_f -b1_f))))*(exp(b0_h + b1_h)) - (1-(1 / (1 + exp(-b0_f -b2_f))))*(exp(b0_h + b2_h)) ; 

R pode fazer isso?


2
user779747 observou em sua postagem cruzada no Rhelp que isso havia sido postado aqui primeiro. Eu não vi uma solicitação específica para postar esse aviso no SO, mas alguns de nós (a maioria?) Esperam isso porque essa é a expectativa declarada nas L Mailing Lists.
Dwin

Respostas:


9

Tendo passado algum tempo nesse código, parece-me que basicamente:

1) Faz uma regressão logística com o lado direito b0_f + b1_f*x1e y > 0como variável alvo,

2) Para as observações para as quais y> 0, executa uma regressão com o lado direito b0_h + b1_h*x1, uma probabilidade Gamma e link=log,

3) Também estima o parâmetro de forma da distribuição gama.

Maximiza a probabilidade em conjunto, o que é bom, porque você só precisa fazer uma chamada de função. No entanto, a probabilidade se separa de qualquer maneira, para que você não obtenha melhores estimativas de parâmetros.

Aqui está um código R que faz uso da glmfunção para economizar esforços de programação. Pode não ser o que você gostaria, pois obscurece o próprio algoritmo. O código certamente também não é tão limpo quanto deveria / deveria ser.

McLerran <- function(y, x)
{
  z <- y > 0
  y.gt.0 <- y[y>0]
  x.gt.0 <- x[y>0]

  m1 <- glm(z~x, family=binomial)
  m2 <- glm(y.gt.0~x.gt.0, family=Gamma(link=log))

  list("p.ygt0"=m1,"ygt0"=m2)
}

# Sample data
x <- runif(100)
y <- rgamma(100, 3, 1)      # Not a function of x (coef. of x = 0)
b <- rbinom(100, 1, 0.5*x)  # p(y==0) is a function of x
y[b==1] <- 0

foo <- McLerran(y,x)
summary(foo$ygt0)

Call:
glm(formula = y.gt.0 ~ x.gt.0, family = Gamma(link = log))

Deviance Residuals: 
     Min        1Q    Median        3Q       Max  
-2.08888  -0.44446  -0.06589   0.28111   1.31066  

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)   1.2033     0.1377   8.737 1.44e-12 ***
x.gt.0       -0.2440     0.2352  -1.037    0.303    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1   1 

(Dispersion parameter for Gamma family taken to be 0.3448334)

    Null deviance: 26.675  on 66  degrees of freedom
Residual deviance: 26.280  on 65  degrees of freedom
AIC: 256.42

Number of Fisher Scoring iterations: 6

O parâmetro de forma para a distribuição Gamma é igual a 1 / o parâmetro de dispersão para a família Gamma. Coeficientes e outras coisas que você deseja acessar programaticamente podem ser acessados ​​nos elementos individuais da lista de valores de retorno:

> coefficients(foo$p.ygt0)
(Intercept)           x 
   2.140239   -2.393388 

A previsão pode ser feita usando a saída da rotina. Aqui está mais um código R que mostra como gerar valores esperados e outras informações:

# Predict expected value
predict.McLerren <- function(model, x.new)
{
  x <- as.data.frame(x.new)
  colnames(x) <- "x"
  x$x.gt.0 <- x$x

  pred.p.ygt0 <- predict(model$p.ygt0, newdata=x, type="response", se.fit=TRUE)
  pred.ygt0 <- predict(model$ygt0, newdata=x, type="response", se.fit=TRUE)  

  p0 <- 1 - pred.p.ygt0$fit
  ev <- (1-p0) * pred.ygt0$fit

  se.p0 <- pred.p.ygt0$se.fit
  se.ev <- pred.ygt0$se.fit

  se.fit <- sqrt(((1-p0)*se.ev)^2 + (ev*se.p0)^2 + (se.p0*se.ev)^2)

  list("fit"=ev, "p0"=p0, "se.fit" = se.fit,
       "pred.p.ygt0"=pred.p.ygt0, "pred.ygt0"=pred.ygt0)
}

E uma amostra:

> x.new <- seq(0.05,0.95,length=5)
> 
> foo.pred <- predict.McLerren(foo, x.new)
> foo.pred$fit
       1        2        3        4        5 
2.408946 2.333231 2.201889 2.009979 1.763201 
> foo.pred$se.fit
        1         2         3         4         5 
0.3409576 0.2378386 0.1753987 0.2022401 0.2785045 
> foo.pred$p0
        1         2         3         4         5 
0.1205351 0.1733806 0.2429933 0.3294175 0.4291541 

Agora, para a extração por coeficiente e os contrastes:

coef.McLerren <- function(model)
{
  temp1 <- coefficients(model$p.ygt0)
  temp2 <- coefficients(model$ygt0)
  names(temp1) <- NULL
  names(temp2) <- NULL
  retval <- c(temp1, temp2)
  names(retval) <- c("b0.f","b1.f","b0.h","b1.h")
  retval
}

contrast.McLerren <- function(b0_f, b1_f, b2_f, b0_h, b1_h, b2_h)
{
  (1-(1 / (1 + exp(-b0_f -b1_f))))*(exp(b0_h + b1_h)) - (1-(1 / (1 + exp(-b0_f -b2_f))))*(exp(b0_h + b2_h))
}


> coef.McLerren(foo)
      b0.f       b1.f       b0.h       b1.h 
 2.0819321 -1.8911883  1.0009568  0.1334845 

2
Você está correto em relação ao que está acontecendo com as "partes" (ou seja, regressão logit para PR (y> 0) e regressão gama para E (y | y> 0), mas é a estimativa combinada (e erros padrão, IC) que são de interesse principal - ou seja, E (y). As previsões desta quantidade são feitas no código SAS por (1 - p_yEQ0) * mu. Esta formulação permite realizar contrastes nos coeficientes desse valor combinado.
B_Miner

@B_Miner - Adicionei alguns exemplos de código + que abordam parcialmente o problema de previsão, obrigado por apontar isso.
jbowman

Mas isso não é apenas estimativas separadas? No SAS, o NLMIXED fornecerá a capacidade de estimar a estimativa pontual de E (y), bem como um IC (usando o método delta que acredito). Além disso, você pode escrever contrastes definidos pelo usuário dos parâmetros como mostrados acima para testar hipóteses lineares. Deve haver uma alternativa R?
B_Miner

Bem, sim e não. Para usar o exemplo, o retornado foo.pred$fitfornece a estimativa pontual de E (y), mas o componente foo.pred$pred.ygt0$predfornece E (y | y> 0). Eu adicionei no cálculo de erro padrão para y, BTW, retornado como se.fit. Os coeficientes podem ser obtidos dos componentes por coeficientes ( foo.pred$pred.ygt0) e coeficientes ( foo.pred$pred.p.ygt0); Escreverei uma rotina de extração e uma rotina de contraste daqui a pouco.
jbowman

Você pode descrever de onde isso vem: se.fit <- sqrt (((1-p0) * se.ev) ^ 2 + (ev * se.p0) ^ 2 + (se.p0 * se.ev) ^ 2)
B_Miner
Ao utilizar nosso site, você reconhece que leu e compreendeu nossa Política de Cookies e nossa Política de Privacidade.
Licensed under cc by-sa 3.0 with attribution required.