Commit f9c8ae08 authored by Le Roux Erwan's avatar Le Roux Erwan
Browse files

[EXTREME ESTIMATOR][GEV MARGIN FIT][BAYESIAN] add fevd.R to use fedv package...

[EXTREME ESTIMATOR][GEV MARGIN FIT][BAYESIAN] add fevd.R to use fedv package in the Bayesian mode. Also, fix fevd method, by creating my own method "myfevd" that avoid code crash when using mode use.phi=FALSE
parent a47f9865
No related merge requests found
Showing with 1050 additions and 0 deletions
+1050 -0
This diff is collapsed.
...@@ -5,73 +5,69 @@ ...@@ -5,73 +5,69 @@
library(extRemes) library(extRemes)
library(stats4) library(stats4)
library(SpatialExtremes) library(SpatialExtremes)
source('myfevd.R')
# Sample from a GEV
set.seed(42) set.seed(42)
N <- 1000 N <- 1000
loc = 0; scale = 1; shape <- 0.1 loc = 0; scale = 1; shape <- 0.1
x_gev <- rgev(N, loc = loc, scale = scale, shape = shape) x_gev <- rgev(N, loc = loc, scale = scale, shape = shape)
start_loc = 0; start_scale = 1; start_shape = 1
# res = fevd(x_gev, method='GMLE') # fevdPriorMy <- function (theta, q, p, log = FALSE){
# x = theta["shape"] + 0.5
fevdPriorMy <- function (theta, q, p, log = FALSE){ #
x = theta["shape"] + 0.5 # print(theta)
# print(theta["location"])
print(theta) # print(dunif(theta["location"]))
print(theta["location"]) # print(theta[0])
print(dunif(theta["location"])) # dfun <- function(th) dbeta(th[1], shape1 = th[2], shape2 = th[3],
print(theta[0]) # log = log)
dfun <- function(th) dbeta(th[1], shape1 = th[2], shape2 = th[3], # th <- cbind(theta, q, p)
log = log) # res <- apply(th, 1, dfun)
th <- cbind(theta, q, p) # return(prod(res))
res <- apply(th, 1, dfun) # }
return(prod(res))
}
fevdPriorMyMy <- function (theta, q, p, log = FALSE){ fevdPriorMyMy <- function (theta, q, p, log = FALSE){
print(theta) # print(theta)
print(q) # print(q)
print(p) # print(p)
x = theta[length(theta)] x = theta[length(theta)]
# + 0.5 enables to shift the Beta law in the interval [-0.5, 0.5] # + 0.5 enables to shift the Beta law in the interval [-0.5, 0.5]
res = dbeta(x + 0.5, q, p, log = TRUE) res = dbeta(x + 0.5, q, p, log = TRUE)
return(res) return(res)
} }
print(pbeta(1.0, 1, 1)) print(pbeta(1.0, 1, 1))
print(pbeta(0.5, 1, 1)) print(pbeta(0.5, 1, 1))
print(fevdPriorMy(2.0, 0.0, 0.0)) print(fevdPriorMyMy(2.0, 0.0, 0.0))
res = fevd(x_gev, method='Bayesian', priorFun="fevdPriorMyMy", priorParams=list(q=c(6), p=c(9)), iter=5000)
# res = fevd(x_gev, method='Bayesian', priorFun="fevdPriorMyMy", priorParams=list(q=c(6), p=c(9)), iter=5000, verbose=TRUE, use.phi=FALSE)
res = fevd_fixed(x_gev, method='Bayesian', priorFun="fevdPriorMyMy", priorParams=list(q=c(6), p=c(9)), iter=5000, verbose=TRUE, use.phi=FALSE)
# res = fevd(x_gev, method='GMLE', iter=5000, verbose=TRUE, use.phi=FALSE)
print(res) print(res)
# res = fevd(x_gev, method='Bayesian')
# print(res)
priorFun="shapePriorBeta"
shapePriorBeta print(res$method)
# print(res$priorFun)
# print(res$priorParams)
# print(shapePriorBeta(0.0, 6, 9)) m = res$results
# priorParams=list(q=c(1, 1, 6), p=c(1, 1, 9)) print(dim(m))
# p.i <- do.call(priorFun, c(list(1.0), priorParams)) print(m)
# print(p.i) print(m[1,])
print(m[1,1])
# priorFun <- "shapePriorBeta"
# priorParams <- list(q = 6, p = 9)
# priorFun <- "fevdPriorDefault"
# priorParams <- list(q = 6, p = 9)
# e = do.call(priorFun, c(list(0.0), priorParams))
# print(e)
#
# print(res$method)
# print(res$priorFun)
# print(res$priorParams)
# m = res$results
# print(m[2,1])
# print(class(res$chain.info)) # print(class(res$chain.info))
# print(res$chain.info[[1]]) # ch = res$chain.info
# print(dim(ch))
# print(ch)
# # summary(res) # # summary(res)
# print(attributes(res)) print(attributes(res))
# print('here') # print('here')
# print(attr(res, 'chain.info')) # print(attr(res, 'chain.info'))
# print(attr(res, "method")) # print(attr(res, "method"))
...@@ -81,19 +77,7 @@ shapePriorBeta ...@@ -81,19 +77,7 @@ shapePriorBeta
# print(res.method) # print(res.method)
# p.i <- do.call(shapePriorBeta, c(list(theta = c(-0.12572432087762, -0.0567634605386987, 0.133782230298093)), priorParams=list(q = 6, p = 9)))
# print(p.i)
# a = fevd(x_gev, method='Bayesian', priorFun="shapePriorBeta", priorParams=list(q = 6, p = 9))
# priorParams=list(v=c(0.1, 10, 0.1)),
# initial=list(location=0, scale=0.1, shape=-0.5)),
# print(a)
#
# # S3 method for fevd.bayesian
# summary(a, FUN = "mean", burn.in = 499)
# print(a.results)
# Bayesian method is using a normal distribution functions for the shape parameter # Bayesian method is using a normal distribution functions for the shape parameter
# GMLE distribution is using a Beta distribution for the shape parameter # GMLE distribution is using a Beta distribution for the shape parameter
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment