R के लिए शून्य-फुलाया गामा प्रतिगमन के लिए SAS NLMIXED कोड परिवर्तित करें

Question

मैं आर में लगातार प्रतिक्रिया चर के लिए शून्य-फुलाया हुआ प्रतिगमन चलाने की कोशिश कर रहा हूं। मैं एक गेम कार्यान्वयन के बारे में जानता हूं, लेकिन मैं वास्तव में डेल मैक्लेरन द्वारा इस एल्गोरिदम को आज़माना चाहूंगा जो कि वैचारिक रूप से थोड़ा अधिक सीधा है। दुर्भाग्य से, कोड एसएएस में है और मुझे यकीन नहीं है कि इसे लूमे जैसी चीज के लिए फिर से कैसे लिखा जाए।

कोड निम्नानुसार है:

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;

प्रेषक: http://listserv.uga.edu/cgi-bin/wa?A2=ind0805A&L=sas-l&P=R20779

जोड़ें:

नोट: यहाँ कोई मिश्रित प्रभाव मौजूद नहीं हैं - केवल निश्चित।

इस फिटिंग का लाभ यह है कि (भले ही गुणांक समान हो, जैसे कि आप P (y = 0) के लिए लॉजिस्टिक रिग्रेशन को अलग से फिट करते हैं और E (y | y> 0) लॉग लिंक के साथ एक गामा त्रुटि रिग्रेशन) आप कर सकते हैं संयुक्त फ़ंक्शन E (y) का अनुमान लगाएं जिसमें शून्य शामिल हैं। एसएएस (सीआई के साथ) लाइन का उपयोग करके इस मूल्य का अनुमान लगा सकते हैं predict (1 - p_yEQ0)*mu।

इसके अलावा, कोई व्यक्ति ई (y) पर भविष्यवाणियों के महत्व का परीक्षण करने के लिए कस्टम कंट्रास्ट स्टेटमेंट लिखने में सक्षम है। उदाहरण के लिए, एसएएस कोड का एक और संस्करण यहां मैंने उपयोग किया है:

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; 

फिर "गिफ्ट 1" बनाम "गिफ्ट 2" (बी 1 बनाम बी 2) का अनुमान लगाने के लिए हम यह अनुमान कथन लिख सकते हैं:

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

क्या आर ऐसा कर सकता है?

Comments

user779747 ने Rhelp को अपनी क्रॉस पोस्टिंग में ध्यान दिया कि यह यहाँ पहले पोस्ट किया गया था। मैंने एसओ में इस तरह के नोटिस को पोस्ट करने के लिए एक विशिष्ट अनुरोध नहीं देखा है, लेकिन क्रॉस-हेल्परेस में से कुछ (अधिकांश?) हमसे इसकी उम्मीद करते हैं क्योंकि आर मेलिंग लिस्ट में बताई गई अपेक्षा है।

— DWIN

Answer 1

इस कोड पर कुछ समय बिताने के बाद, यह मुझे ऐसा प्रतीत होता है जैसे कि यह मूल रूप से है:

1) एक लॉजिस्टिक रिग्रेशन दाहिने हाथ की ओर b0_f + b1_f*x1और y > 0एक लक्ष्य चर के रूप में करता है,

2) उन टिप्पणियों के लिए जिनके लिए y> 0, दाहिने हाथ की ओर एक प्रतिगमन करता है b0_h + b1_h*x1, एक गामा संभावना है link=log, और

3) गामा वितरण के आकार पैरामीटर का भी अनुमान लगाता है।

यह संयुक्त रूप से संभावना को अधिकतम करता है, जो अच्छा है, क्योंकि आपको केवल एक फ़ंक्शन कॉल करना है। हालांकि, संभावना वैसे भी अलग हो जाती है, इसलिए आपको परिणाम के रूप में बेहतर पैरामीटर अनुमान नहीं मिलता है।

यहां कुछ आर कोड है जो glmप्रोग्रामिंग प्रयास को बचाने के लिए फ़ंक्शन का उपयोग करता है। यह वह नहीं हो सकता है जो आप चाहते हैं, क्योंकि यह एल्गोरिथम को अस्पष्ट करता है। कोड निश्चित रूप से उतना साफ नहीं है जितना यह हो सकता है / होना चाहिए।

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

गामा वितरण के लिए आकार पैरामीटर गामा परिवार के लिए 1 / फैलाव पैरामीटर के बराबर है। गुणांक और अन्य सामान जिसे आप प्रोग्राम के रूप में एक्सेस करना चाहते हैं, वापसी मूल्य सूची के अलग-अलग तत्वों पर पहुँचा जा सकता है:

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

दिनचर्या के आउटपुट का उपयोग करके भविष्यवाणी की जा सकती है। यहां कुछ और आर कोड दिए गए हैं जिनसे पता चलता है कि अपेक्षित मूल्य और कुछ अन्य जानकारी कैसे उत्पन्न की जाती है:

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

और एक नमूना रन:

> 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 

अब गुणांक निष्कर्षण और विरोधाभासों के लिए:

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 

Comments

आप "भागों" (यानी पीआर (y> 0) के लिए लॉजिट रिग्रेशन) और E (y | y> 0) के लिए गामा रिग्रेशन के साथ क्या हो रहा है, इस संबंध में सही हैं, लेकिन यह संयुक्त अनुमान है (और मानक त्रुटियां, CI) यह मुख्य हित के हैं - यानी ई (वाई)। इस मात्रा की भविष्यवाणियां एसएएस कोड में (1 - p_yEQ0) * म्यू से की जाती हैं। यह सूत्रीकरण आपको इस संयुक्त मूल्य पर गुणांक पर विपरीत आचरण करने की अनुमति देता है।

— B_Miner

@B_Miner - मैंने कुछ कोड + उदाहरण जोड़े हैं जो भविष्यवाणी के मुद्दे को आंशिक रूप से संबोधित करते हैं, जो कि इंगित करने के लिए धन्यवाद।

— 17

क्या यह सिर्फ अलग-अलग अनुमान नहीं है? SAS में, NLMIXED ई (y) के बिंदु अनुमान के साथ-साथ एक CI (मुझे विश्वास है कि डेल्टा विधि का उपयोग करके) का अनुमान लगाने के लिए योग्यता प्रदान करेगा। साथ ही, आप पैरामीट्रिक परिकल्पना का परीक्षण करने के लिए उपयोगकर्ता के परिभाषित विरोधाभासों को लिख सकते हैं जैसा कि मैंने ऊपर दिखाया है। एक आर विकल्प होना चाहिए?

— B_Miner

खैर, हाँ और नहीं। उदाहरण का उपयोग करने के लिए, लौटा foo.pred$fitई (y) का बिंदु अनुमान देता है, लेकिन घटक foo.pred$pred.ygt0$predआपको E (y | y> 0) देगा। मैंने y, BTW के लिए मानक त्रुटि गणना में जोड़ा, se.fit के रूप में लौटा। गुणांक को घटकों से गुणांक ( foo.pred$pred.ygt0) और गुणांक ( foo.pred$pred.p.ygt0) द्वारा प्राप्त किया जा सकता है ; मैं थोड़ी देर में एक निष्कर्षण दिनचर्या और एक विपरीत दिनचर्या लिखूंगा।

— जम्मन

क्या आप यह बता सकते हैं कि यह कहां से आता है: se.fit <- sqrt (((1-p0) * se.ev) ^ 2 + (ev * se.p0) ^ 2 + (se.p0 * se.ev) ^ 2)

— B_Miner