Параметри розподілу Вейбулла і для даних про швидкість вітру

Привіт, може бути показано те саме, щоб отримати параметр форми та масштабу для модифікованого методу максимальної ймовірності

Оскільки @zaynah розмістив у коментарях, що, як вважають, дані слідкують за розподілом Weibull, я надам короткий посібник про те, як оцінити параметри такого розподілу за допомогою MLE (Максимальна оцінка ймовірності). На сайті є аналогічний пост про швидкість вітру та розподіл Weibull.

1. Завантажте та встановітьR , це безкоштовно
2. Необов’язково: завантажте та встановіть RStudio , який є чудовим IDE для R, що забезпечує безліч корисних функцій, таких як підсвічування синтаксису та інше.
3. Встановіть пакети MASSі carвиконавши: install.packages(c("MASS", "car")). Завантажте їх, ввівши: library(MASS)і library(car).
4. Імпортуйте свої дані вR . Наприклад, якщо у вас є дані в Excel, збережіть їх як текстовий файл з обмеженим доступом (.txt) та імпортуйте їх за Rдопомогоюread.table .
5. Використовуйте функцію fitdistrдля обчислення оцінок максимальної правдоподібності вашого розподілу Вейбулла: fitdistr(my.data, densfun="weibull", lower = 0). Щоб побачити повністю відпрацьований приклад, дивіться посилання внизу відповіді.
6. Складіть QQ-графік, щоб порівняти свої дані з розподілом Weibull з параметрами масштабу та форми, оціненими в точці 5: qqPlot(my.data, distribution="weibull", shape=, scale=)

Навчальний посібник Віто Річчі з примірного розподілу R- хороша відправна точка з цього питання. І на цьому сайті є численні публікації (див. Цю публікацію також).

Щоб побачити повністю відпрацьований приклад використання fitdistr, ознайомтеся з цією публікацією .

Розглянемо приклад у R:

# Load packages

library(MASS)
library(car)

# First, we generate 1000 random numbers from a Weibull distribution with
# scale = 1 and shape = 1.5

rw <- rweibull(1000, scale=1, shape=1.5)

# We can calculate a kernel density estimation to inspect the distribution
# Because the Weibull distribution has support [0,+Infinity), we are truncate
# the density at 0

par(bg="white", las=1, cex=1.1)
plot(density(rw, bw=0.5, cut=0), las=1, lwd=2,
xlim=c(0,5),col="steelblue")

# Now, we can use fitdistr to calculate the parameters by MLE
# The option "lower = 0" is added because the parameters of the Weibull distribution need to be >= 0

fitdistr(rw, densfun="weibull", lower = 0)

     shape        scale   
  1.56788999   1.01431852 
 (0.03891863) (0.02153039)

Максимальні оцінки ймовірності близькі до тих, які ми довільно встановлюємо при генерації випадкових чисел. Порівняємо наші дані за допомогою QQ-Plot з гіпотетичним розподілом Weibull з параметрами, які ми оцінили за допомогою fitdistr:

qqPlot(rw, distribution="weibull", scale=1.014, shape=1.568, las=1, pch=19)

Пункти добре вирівняні на лінії та здебільшого в межах конвертів 95% впевненості. Ми зробимо висновок, що наші дані сумісні з розповсюдженням Weibull. Це, звичайно, очікувалося, оскільки ми відібрали наші значення з дистрибуції Вейбулла.

Оцінка (форма) та c (шкала) розподілу Вейбула без MLE$k$$c$

Цей папір перераховано п'ять методів для оцінки параметрів розподілу Вейбулла на швидкість вітру. Я поясню тут три з них.

Від засобів і стандартного відхилення

$k$

Найменші квадрати підходять до спостережуваного розподілу

$n$$0-V_{1},V_{1}-V_{2},\ldots, V_{n-1}-V_{n}$$f_{1}, f_{2},\ldots,f_{n}$$p_{1}=f_{1}, p_{2}=f_{1}+f_{2}, \ldots, p_{n}=p_{n-1}+f_{n}$$y=a+bx$

Середня і квалітна швидкості вітру

$V_{m}$$V_{0.25}$$V_{0.75}$ $\left[p(V\leq V_{0.25})=0.25, p(V\leq V_{0.75})=0.75\right]$$c$$k$

Порівняння чотирьох методів

Ось приклад Rпорівняння чотирьох методів:

library(MASS)  # for "fitdistr"

set.seed(123)
#-----------------------------------------------------------------------------
# Generate 10000 random numbers from a Weibull distribution
# with shape = 1.5 and scale = 1
#-----------------------------------------------------------------------------

rw <- rweibull(10000, shape=1.5, scale=1)

#-----------------------------------------------------------------------------
# 1. Estimate k and c by MLE
#-----------------------------------------------------------------------------

fitdistr(rw, densfun="weibull", lower = 0)
shape         scale   
1.515380298   1.005562356 

#-----------------------------------------------------------------------------
# 2. Estimate k and c using the leas square fit
#-----------------------------------------------------------------------------

n <- 100 # number of bins
breaks <- seq(0, max(rw), length.out=n)

freqs <- as.vector(prop.table(table(cut(rw, breaks = breaks))))
cum.freqs <- c(0, cumsum(freqs)) 

xi <- log(breaks)
yi <- log(-log(1-cum.freqs))

# Fit the linear regression
least.squares <- lm(yi[is.finite(yi) & is.finite(xi)]~xi[is.finite(yi) & is.finite(xi)])
lin.mod.coef <- coefficients(least.squares)

k <- lin.mod.coef[2]
k
1.515115
c <- exp(-lin.mod.coef[1]/lin.mod.coef[2])
c
1.006004

#-----------------------------------------------------------------------------
# 3. Estimate k and c using the median and quartiles
#-----------------------------------------------------------------------------

med <- median(rw)
quarts <- quantile(rw, c(0.25, 0.75))

k <- log(log(0.25)/log(0.75))/log(quarts[2]/quarts[1])
k
1.537766
c <- med/log(2)^(1/k)
c
1.004434

#-----------------------------------------------------------------------------
# 4. Estimate k and c using mean and standard deviation.
#-----------------------------------------------------------------------------

k <- (sd(rw)/mean(rw))^(-1.086)
c <- mean(rw)/(gamma(1+1/k))
k
1.535481
c
1.006938

Всі методи дають дуже схожі результати. Максимально вірогідний підхід має ту перевагу, що стандартні помилки параметрів Вейбулла наведені безпосередньо.

Використання завантажувальної стрічки для додавання точкових інтервалів довіри до PDF або CDF

Ми можемо використовувати непараметричну завантажувальну стрічку для побудови точкових довірчих інтервалів навколо PDF та CDF передбачуваного розподілу Weibull. Ось Rсценарій:

#-----------------------------------------------------------------------------
# 5. Bootstrapping the pointwise confidence intervals
#-----------------------------------------------------------------------------

set.seed(123)

rw.small <- rweibull(100,shape=1.5, scale=1)

xs <- seq(0, 5, len=500)


boot.pdf <- sapply(1:1000, function(i) {
  xi <- sample(rw.small, size=length(rw.small), replace=TRUE)
  MLE.est <- suppressWarnings(fitdistr(xi, densfun="weibull", lower = 0))  
  dweibull(xs, shape=as.numeric(MLE.est[[1]][13]), scale=as.numeric(MLE.est[[1]][14]))
}
)

boot.cdf <- sapply(1:1000, function(i) {
  xi <- sample(rw.small, size=length(rw.small), replace=TRUE)
  MLE.est <- suppressWarnings(fitdistr(xi, densfun="weibull", lower = 0))  
  pweibull(xs, shape=as.numeric(MLE.est[[1]][15]), scale=as.numeric(MLE.est[[1]][16]))
}
)   

#-----------------------------------------------------------------------------
# Plot PDF
#-----------------------------------------------------------------------------

par(bg="white", las=1, cex=1.2)
plot(xs, boot.pdf[, 1], type="l", col=rgb(.6, .6, .6, .1), ylim=range(boot.pdf),
     xlab="x", ylab="Probability density")
for(i in 2:ncol(boot.pdf)) lines(xs, boot.pdf[, i], col=rgb(.6, .6, .6, .1))

# Add pointwise confidence bands

quants <- apply(boot.pdf, 1, quantile, c(0.025, 0.5, 0.975))
min.point <- apply(boot.pdf, 1, min, na.rm=TRUE)
max.point <- apply(boot.pdf, 1, max, na.rm=TRUE)
lines(xs, quants[1, ], col="red", lwd=1.5, lty=2)
lines(xs, quants[3, ], col="red", lwd=1.5, lty=2)
lines(xs, quants[2, ], col="darkred", lwd=2)
#lines(xs, min.point, col="purple")
#lines(xs, max.point, col="purple")

#-----------------------------------------------------------------------------
# Plot CDF
#-----------------------------------------------------------------------------

par(bg="white", las=1, cex=1.2)
plot(xs, boot.cdf[, 1], type="l", col=rgb(.6, .6, .6, .1), ylim=range(boot.cdf),
     xlab="x", ylab="F(x)")
for(i in 2:ncol(boot.cdf)) lines(xs, boot.cdf[, i], col=rgb(.6, .6, .6, .1))

# Add pointwise confidence bands

quants <- apply(boot.cdf, 1, quantile, c(0.025, 0.5, 0.975))
min.point <- apply(boot.cdf, 1, min, na.rm=TRUE)
max.point <- apply(boot.cdf, 1, max, na.rm=TRUE)
lines(xs, quants[1, ], col="red", lwd=1.5, lty=2)
lines(xs, quants[3, ], col="red", lwd=1.5, lty=2)
lines(xs, quants[2, ], col="darkred", lwd=2)
lines(xs, min.point, col="purple")
lines(xs, max.point, col="purple")