比较不同R软件包中使用MLE拟合的GPD的回报水平。

huangapple go评论96阅读模式
英文:

Compare return levels of fitted GPD using MLE in different R packages

问题

以下是您要翻译的内容:

"This question is related to this post: https://stackoverflow.com/questions/27524131/calculation-of-return-levels-based-on-a-gpd-in-different-r-packages

I want to constraint "potvalues" data to be in a period of 6 years, this is, 16 observations per year as the number of samples is 96. I want to do the calculation of return levels (mle parameters estimation and GP model) with extRemes package and compare the result with extremeStat package.

Be aware of the parameter 'truncate=0.4956645' to get exactly a threshold of 50.

Why result of line 51 (d$quant[28, ,drop=FALSE]) is not exactly equal to result of line 45 (rl.extremes2), if extremeStat package is using the same package extRemes with MLE and GP to do the calculation?"


# sample data:
potvalues <- c(
  58.5,44.2,49.6,59.3,48.3,60.9,94.5,47.1,45.3,57.6,48.2,46.2,44.2,50.6,42.1,52.7,80.9,
  58.5,51.3,48.4,51.7,71.9,60.1,64.4,43.5,55.5,49.3,58.2,47.5,43.7,45.2,52.8,42.2,46.4,
  96.1,47.5,50.1,42.4,60.9,72.6,51.6,59.4,80.5,63.7,59.9,45.0,66.7,47.6,53.3,43.1,51.0,
  46.2,53.6,59.8,51.7,46.7,42.6,44.5,45.0,50.0,44.0,89.9,44.2,47.8,53.3,43.0,55.7,44.6,
  44.6,54.9,45.1,43.9,78.7,45.5,64.0,42.7,47.4,57.0,105.4,64.3,43.2,50.4,80.2,49.9,71.6,
  47.4,44.1,47.6,55.2,44.4,78.6,50.8,42.4,47.1,43.5,51.4)

#------------------------------------------------------------------------------------------#

#Count events over threshold
excesses = potvalues > th
sum(excesses)

# Data corresponding to a period of 6 years

#-------------------------------------------------------------------------------------------#
# MLE Fitting of GPD - package extRemes
# If fit period is 6 years, then I have 16 obs by year

pot.ext2 <- extRemes::fevd(potvalues, method = "MLE", type="GP", threshold=th, 
                           time.units="16/year")


npy2=16  #pot.ext2$npy
span2=5.9375 #pot.ext2$span

w2 = 96/npy2   #Duration of the fit period (6 years)
lambda2 = sum(excesses)/w2
Tr=c(2,5,10,20,50,100)
myp2 = (1 - (1/(lambda2*Tr)))
myp2 = myp2[myp2>0]
#Get return level using quantile function!
vel1 = extRemes::qevd(myp2, loc = pot.ext2$threshold, scale = pot.ext2$results$par[1], 
            shape = pot.ext2$results$par[2], 
            threshold = pot.ext2$threshold, type = "GP")
vel1
# return levels with 6 years, 16 obs, using return.level function
rl.extremes2 <-  extRemes::return.level(pot.ext2, conf = 0.05,
                             return.period= c(2,5,10,20,50,100))
rl.extremes2 <- as.numeric(rl.extremes2)
rl.extremes2
#------------------------------------------------------------------------------------------#
npy=16
Tr=c(2,5,10,20,50,100)
p = (1 - (1/(npy*Tr)))
d <- extremeStat::distLquantile(potvalues, truncate=0.4956645, probs=p, quiet=TRUE, list=TRUE)
d$quant[28, ,drop=FALSE]

dlf <- extremeStat::distLextreme(potvalues, quiet=TRUE, npy=16, truncate=0.4956645)
dlf$returnlev["threshold",1]
dlf$returnlev[28, , drop=FALSE]
英文:

This question is related to this post: https://stackoverflow.com/questions/27524131/calculation-of-return-levels-based-on-a-gpd-in-different-r-packages

I want to constraint "potvalues" data to be in a period of 6 years, this is, 16 observations per year as the number of samples is 96. I want to do the calculation of return levels (mle parameters estimation and GP model) with extRemes package and compare the result with extremeStat package.

Be aware of the parameter truncate=0.4956645 to get exactly a threshold of 50.

Why result of line 51 (d$quant[28, ,drop=FALSE]) is not exactly equal to result of line 45 (rl.extremes2), if extremeStat package is using the same package extRemes with MLE and GP to do the calculation?

th <- 50

# sample data:
potvalues <- c(
  58.5,44.2,49.6,59.3,48.3,60.9,94.5,47.1,45.3,57.6,48.2,46.2,44.2,50.6,42.1,52.7,80.9,
  58.5,51.3,48.4,51.7,71.9,60.1,64.4,43.5,55.5,49.3,58.2,47.5,43.7,45.2,52.8,42.2,46.4,
  96.1,47.5,50.1,42.4,60.9,72.6,51.6,59.4,80.5,63.7,59.9,45.0,66.7,47.6,53.3,43.1,51.0,
  46.2,53.6,59.8,51.7,46.7,42.6,44.5,45.0,50.0,44.0,89.9,44.2,47.8,53.3,43.0,55.7,44.6,
  44.6,54.9,45.1,43.9,78.7,45.5,64.0,42.7,47.4,57.0,105.4,64.3,43.2,50.4,80.2,49.9,71.6,
  47.4,44.1,47.6,55.2,44.4,78.6,50.8,42.4,47.1,43.5,51.4)

#------------------------------------------------------------------------------------------#

#Count events over threshold
excesses = potvalues > th
sum(excesses)

# Data corresponding to a period of 6 years

#-------------------------------------------------------------------------------------------#
# MLE Fitting of GPD - package extRemes
# If fit period is 6 years, then I have 16 obs by year

pot.ext2 <- extRemes::fevd(potvalues, method = "MLE", type="GP", threshold=th, 
                           time.units="16/year")


npy2=16  #pot.ext2$npy
span2=5.9375 #pot.ext2$span

w2 = 96/npy2   #Duration of the fit period (6 years)
lambda2 = sum(excesses)/w2
Tr=c(2,5,10,20,50,100)
myp2 = (1 - (1/(lambda2*Tr)))
myp2 = myp2[myp2>0]
#Get return level using quantile function!
vel1 = extRemes::qevd(myp2, loc = pot.ext2$threshold, scale = pot.ext2$results$par[1], 
            shape = pot.ext2$results$par[2], 
            threshold = pot.ext2$threshold, type = "GP")
vel1
# return levels with 6 years, 16 obs, using return.level function
rl.extremes2 <-  extRemes::return.level(pot.ext2, conf = 0.05,
                             return.period= c(2,5,10,20,50,100))
rl.extremes2 <- as.numeric(rl.extremes2)
rl.extremes2
#------------------------------------------------------------------------------------------#
npy=16
Tr=c(2,5,10,20,50,100)
p = (1 - (1/(npy*Tr)))
d <- extremeStat::distLquantile(potvalues, truncate=0.4956645, probs=p, quiet=TRUE, list=TRUE)
d$quant[28, ,drop=FALSE]

dlf <- extremeStat::distLextreme(potvalues, quiet=TRUE, npy=16, truncate=0.4956645)
dlf$returnlev["threshold",1]
dlf$returnlev[28, , drop=FALSE]

答案1

得分: 1

以下是你要翻译的内容:

"due to time.units, your shape and scale of the estimated distribution function are different" ... "the probabilities are slightly different, but that doesn't affect the results (see outcommented test)"

Code below shows 1) how extremeStat is doing the calculations of return levels, using extRemes, and 2) how to work directly extRemes using two approaches: extRemes::qevd and extRemes::return.level

Maybe someone expert in the topic can take a decision of which one of the two ways is the 'more suitable', or 'correct' way to calculate the return levels: bb_extRemes or alexys_exRtemes?... the results are similar anyway.

以下是翻译:

"由于时间单位,您估计的分布函数的形状和尺度不同" ... "概率略有不同,但不影响结果(请参见注释的测试)"

下面的代码显示了1)extremeStat如何使用extRemes进行回报水平的计算,以及2)如何直接使用两种方法来使用extRemes:extRemes::qevd和extRemes::return.level

也许某位专家可以决定哪一种方式更合适,或者哪一种是正确的方式来计算回报水平:bb_extRemes还是alexys_exRtemes?... 结果都差不多。

英文:

Here the answer of the author of extremeStat

"due to time.units, your shape and scale of the estimated distribution function are different" ... "the probabilities are slightly different, but that doesn't affect the results (see outcommented test)"

Code below shows 1) how extremeStat is doing the calculations of return levels, using extRemes, and 2) how to work directly extRemes using two approaches: extRemes::qevd and extRemes::return.level

Maybe someone expert in the topic can take a decision of which one of the two ways is the 'more suitable', or 'correct' way to calculate the return levels: bb_extRemes or alexys_exRtemes?... the results are similar anyway.

# CLEAN ------------------------------------------------------------------------
rm(list=ls())

potvalues <- c(
  58.5,44.2,49.6,59.3,48.3,60.9,94.5,47.1,45.3,57.6,48.2,46.2,44.2,50.6,42.1,52.7,80.9,
  58.5,51.3,48.4,51.7,71.9,60.1,64.4,43.5,55.5,49.3,58.2,47.5,43.7,45.2,52.8,42.2,46.4,
  96.1,47.5,50.1,42.4,60.9,72.6,51.6,59.4,80.5,63.7,59.9,45.0,66.7,47.6,53.3,43.1,51.0,
  46.2,53.6,59.8,51.7,46.7,42.6,44.5,45.0,50.0,44.0,89.9,44.2,47.8,53.3,43.0,55.7,44.6,
  44.6,54.9,45.1,43.9,78.7,45.5,64.0,42.7,47.4,57.0,105.4,64.3,43.2,50.4,80.2,49.9,71.6,
  47.4,44.1,47.6,55.2,44.4,78.6,50.8,42.4,47.1,43.5,51.4)
options(scipen=10) # nicer printing of 0.00000001


bb_extRemes <- function(x, truncate, RPs=c(2,5,10,20,50), npy)
  {
  normalthr <- berryFunctions::quantileMean(x[is.finite(x)], truncate)
  z <- extRemes::fevd(x, method="MLE", type="GP", threshold=normalthr)
  scale <- z$results$par["scale"]
  shape <- z$results$par["shape"]
  probs <- 1-1/(RPs*npy)
  probs2 <- (probs-truncate)/(1-truncate) # correct probabilities for smaller sample proportion
  probs2[probs < truncate] <- 0   # avoid negative values
  probs2[probs2==0] <- NA
  probs2[probs2==1] <- NA
  #alexys
  #excesses <- x > normalthr
  #w2 <- length(x)/npy # Duration of the fit period (6 years)
  #lambda2 <- sum(excesses)/w2
  #probs <- 1 - 1/(lambda2*RPs)
  #probs[probs<0] <- NA  
  #alexys
  out <- extRemes::qevd(p=probs2, scale=scale, shape=shape, threshold=z$threshold, type="GP")
  names(out) <- paste0("RP.", RPs)
  out <- list(RL=out, PAR=c(thr=normalthr, scale=scale, shape=shape, probs=probs2))
  out
  }

alexys_exRtemes <- function(x, threshold, RPs=c(2,5,10,20,50), npy)
  {
  unit <- paste0(npy,"/year")
  z <- extRemes::fevd(x, method="MLE", type="GP", threshold=threshold, time.units=unit)
  excesses <- x > threshold
  w2 <- length(x)/npy # Duration of the fit period (6 years)
  lambda2 <- sum(excesses)/w2
  probs <- 1 - 1/(lambda2*RPs)
  probs[probs<0] <- NA
  ### probs     0.9375000         0.9750000         0.9875000         0.9937500         0.9975000 
  ###probs <- c(0.93803727875591, 0.97521491150236, 0.98760745575118, 0.99380372787559, 0.99752149115024)
  scale <- z$results$par[1]
  shape <- z$results$par[2]
  vel1 <- extRemes::qevd(probs, loc=z$threshold, scale=scale, shape=shape, threshold=z$threshold, type="GP")
  out <- extRemes::return.level(z, return.period=RPs)
  n <- names(out)
  out <- as.numeric(out)
  names(out) <- n
  out <- list(RL=out, PAR=c(thr=z$threshold, scale=scale, shape=shape, probs=probs, lambda2=lambda2))
  out
  }
bb_extRemes(potvalues, truncate=0.4956645, npy=16)
alexys_exRtemes(potvalues, threshold=50, npy=16)

huangapple
  • 本文由 发表于 2020年1月6日 21:48:23
  • 转载请务必保留本文链接:https://go.coder-hub.com/59613277.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定