आर

Question

में 3 पैरामीटर वीबुल वितरण को फ़िट करना मैं आर में कुछ डेटा विश्लेषण कर रहा हूं और मैं यह समझने की कोशिश कर रहा हूं कि मेरे डेटा को 3 पैरामीटर वेबुल वितरण में कैसे फिट किया जाए। मैंने पाया कि इसे 2 पैरामीटर वेबुल के साथ कैसे किया जाए, लेकिन 3 पैरामीटर के साथ इसे कैसे करना है, यह जानने में बहुत कम आया है।

यहाँ है मैं fitdistr का उपयोग कर डेटा() मास पैकेज से समारोह कैसे फिट:

y <- fitdistr(x[[6]], 'weibull') 

x[[6]] मेरी डेटा के एक उपसमूह है और y वह जगह है जहाँ मैं फिटिंग का परिणाम भंडारण कर रहा हूँ।

Answer 1

सबसे पहले, आप FAdist package पर देखना चाहेंगे। हालांकि, उस rweibull3 से rweibull पर जाने के लिए इतनी मेहनत नहीं है: dweibull

> dweibull3 
function (x, shape, scale = 1, thres = 0, log = FALSE) 
dweibull(x - thres, shape, scale, log) 
<environment: namespace:FAdist> 

को

> rweibull3 
function (n, shape, scale = 1, thres = 0) 
thres + rweibull(n, shape, scale) 
<environment: namespace:FAdist> 

और इसी तरह dweibull3 से तो हमारे पास इस

> x <- rweibull3(200, shape = 3, scale = 1, thres = 100) 
> fitdistr(x, function(x, shape, scale, thres) 
     dweibull(x-thres, shape, scale), list(shape = 0.1, scale = 1, thres = 0)) 
     shape   scale   thres  
    2.42498383  0.85074556 100.12372297 
( 0.26380861) ( 0.07235804) ( 0.06020083) 

संपादित करें: के रूप में टिप्पणी में उल्लिखित, वितरण फिट करने की कोशिश करते समय विभिन्न चेतावनियां दिखाई देती हैं इस तरह से

Error in optim(x = c(60.7075705026659, 60.6300379017397, 60.7669410153573, : 
    non-finite finite-difference value [3] 
There were 20 warnings (use warnings() to see them) 
Error in optim(x = c(60.7075705026659, 60.6300379017397, 60.7669410153573, : 
    L-BFGS-B needs finite values of 'fn' 
In dweibull(x, shape, scale, log) : NaNs produced 

मेरे लिए में आयन पहली बार में यह केवल NaNs produced था, और कि पहली बार जब मैं इसे देख तो मैंने सोचा था कि यह इतना सार्थक के बाद से अनुमान अच्छे थे नहीं है नहीं है। कुछ खोज करने के बाद यह काफी लोकप्रिय समस्या प्रतीत होता था और मुझे न तो कारण और न ही समाधान मिल रहा था। एक विकल्प stats4 पैकेज और mle() फ़ंक्शन का उपयोग कर सकता है, लेकिन इसमें कुछ समस्याएं भी लगती थीं। लेकिन मैं danielmedic द्वारा code का एक संशोधित संस्करण का उपयोग करने के जो मैं कई बार जाँच की है आप की पेशकश कर सकते हैं:

thres <- 60 
x <- rweibull(200, 3, 1) + thres 

EPS = sqrt(.Machine$double.eps) # "epsilon" for very small numbers 

llik.weibull <- function(shape, scale, thres, x) 
{ 
    sum(dweibull(x - thres, shape, scale, log=T)) 
} 

thetahat.weibull <- function(x) 
{ 
    if(any(x <= 0)) stop("x values must be positive") 

    toptim <- function(theta) -llik.weibull(theta[1], theta[2], theta[3], x) 

    mu = mean(log(x)) 
    sigma2 = var(log(x)) 
    shape.guess = 1.2/sqrt(sigma2) 
    scale.guess = exp(mu + (0.572/shape.guess)) 
    thres.guess = 1 

    res = nlminb(c(shape.guess, scale.guess, thres.guess), toptim, lower=EPS) 

    c(shape=res$par[1], scale=res$par[2], thres=res$par[3]) 
} 

thetahat.weibull(x) 
    shape  scale  thres 
3.325556 1.021171 59.975470