Convierta el código SAS NLMIXED para la regresión gamma inflada a cero a R


11

Estoy tratando de ejecutar una regresión inflada a cero para una variable de respuesta continua en R. Soy consciente de una implementación gamlss, pero realmente me gustaría probar este algoritmo de Dale McLerran que es conceptualmente un poco más sencillo. Desafortunadamente, el código está en SAS y no estoy seguro de cómo volver a escribirlo para algo como nlme.

El código es el siguiente:

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

AÑADIR:

Nota: Aquí no hay efectos mixtos, solo fijos.

La ventaja de este ajuste es que (aunque los coeficientes son los mismos que si ajusta por separado una regresión logística a P (y = 0) y una regresión de error gamma con enlace de registro a E (y | y> 0)) puede estimar la función combinada E (y) que incluye los ceros. Uno puede predecir este valor en SAS (con un CI) usando la línea predict (1 - p_yEQ0)*mu.

Además, uno puede escribir declaraciones de contraste personalizadas para probar la importancia de las variables predictoras en E (y). Por ejemplo, aquí hay otra versión del código SAS que he usado:

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; 

Luego, para estimar "gift1" versus "gift2" (b1 versus b2) podemos escribir esta declaración de estimación:

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

¿Puede R hacer esto?


2
user779747 notó en su publicación cruzada en Rhelp que esto se había publicado aquí primero. No he visto una solicitud específica para publicar dicho aviso en SO, pero algunos (¿la mayoría?) De nosotros, los colaboradores cruzados, lo esperamos porque esa es la expectativa establecida en las Listas de Correo R.
DWin

Respuestas:


9

Después de pasar un tiempo en este código, me parece que básicamente:

1) Hace una regresión logística con el lado derecho b0_f + b1_f*x1y y > 0como una variable objetivo,

2) Para aquellas observaciones para las cuales y> 0, realiza una regresión con el lado derecho b0_h + b1_h*x1, una probabilidad Gamma y link=log,

3) También estima el parámetro de forma de la distribución Gamma.

Maximiza la probabilidad de forma conjunta, lo cual es bueno, porque solo tiene que hacer una llamada a la función. Sin embargo, la probabilidad se separa de todos modos, por lo que no obtendrá estimaciones de parámetros mejoradas como resultado.

Aquí hay un código R que hace uso de la glmfunción para ahorrar esfuerzo de programación. Esto puede no ser lo que le gustaría, ya que oscurece el algoritmo en sí. El código ciertamente tampoco es tan limpio como podría / debería 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

El parámetro de forma para la distribución Gamma es igual a 1 / el parámetro de dispersión para la familia Gamma. Se puede acceder a los coeficientes y otras cosas a las que le gustaría acceder programáticamente en los elementos individuales de la lista de valores de retorno:

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

La predicción se puede hacer usando la salida de la rutina. Aquí hay más código R que muestra cómo generar los valores esperados y alguna otra información:

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

Y una muestra de ejecución:

> 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 

Ahora para la extracción de coeficientes y los 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
Tiene razón con respecto a lo que está sucediendo con las "partes" (es decir, la regresión logarítmica para PR (y> 0) y la regresión gamma para E (y | y> 0), pero es la estimación combinada (y los errores estándar, IC) que son de interés principal, es decir, E (y). Las predicciones de esta cantidad se hacen en el código SAS mediante (1 - p_yEQ0) * mu. Esta formulación le permite realizar contrastes en los coeficientes de este valor combinado.
B_Miner

@B_Miner: agregué algunos ejemplos de código + que abordan parcialmente el problema de predicción, gracias por señalarlo.
jbowman

Sin embargo, ¿no son solo estimaciones separadas? En SAS, NLMIXED dará la capacidad de estimar la estimación puntual de E (y), así como un IC (usando el método delta, creo). Además, puede escribir contrastes definidos por el usuario de los parámetros como se muestra arriba para probar hipótesis lineales. Debe haber una alternativa R?
B_Miner

Pues sí y no. Para usar el ejemplo, la devolución foo.pred$fitda la estimación puntual de E (y), pero el componente foo.pred$pred.ygt0$predle daría E (y | y> 0). Agregué el cálculo de error estándar para y, por cierto, devuelto como se.fit. Los coeficientes pueden obtenerse de los componentes mediante coeficientes ( foo.pred$pred.ygt0) y coeficientes ( foo.pred$pred.p.ygt0); Escribiré una rutina de extracción y una rutina de contraste dentro de poco.
jbowman

¿Puede describir de dónde proviene esto: se.fit <- sqrt (((1-p0) * se.ev) ^ 2 + (ev * se.p0) ^ 2 + (se.p0 * se.ev) ^ 2)
B_Miner
Al usar nuestro sitio, usted reconoce que ha leído y comprende nuestra Política de Cookies y Política de Privacidad.
Licensed under cc by-sa 3.0 with attribution required.