tests/tinytest/test-endPoint.R

In texmex: Statistical Modelling of Extreme Values

for(Family in list(gpd,gev)){
  pst <- function(msg) texmexPst(msg,Family=Family)
  set.seed(12345)

  for(i in 1:5){
    th <- switch(Family$name,GPD=0.3,GEV=-Inf)
    fit <- evm(rnorm(100),th=th,family=Family)
    co <- coef(fit)
    ep.current <- endPoint(fit,verbose=FALSE,.unique=TRUE)
    ep.target <- switch(Family$name,GPD=ifelse(co[2] < 0, th-exp(co[1])/co[2],Inf),
                        GEV=ifelse(co[3] < 0, co[1]-exp(co[2])/co[3],Inf))
    expect_equivalent(ep.current, ep.target, label=pst("endPoint:checkcalcforevmOptnocovariates"))

    fit <- evm(rnorm(100),th=th,family=Family,method="simulate",trace=50000)
    co <- coef(fit$map)
    ep.current <- endPoint(fit,verbose=FALSE,.unique=TRUE)
    ep.target <- switch(Family$name,GPD=ifelse(co[2] < 0, th-exp(co[1])/co[2],Inf),
                        GEV=ifelse(co[3] < 0, co[1]-exp(co[2])/co[3],Inf))
    expect_equivalent(ep.current, ep.target, label=pst("endPoint:checkcalcforevmSimnocovariates"))
  }

  # test with covariates

  n <- 50
  mu <- 1
  for(i in 1:5){
    X <- data.frame(a = rnorm(n),b = runif(n,-0.1,0.1))
    param <- switch(Family$name,GPD=X,GEV=cbind(mu,X))
    th <- switch(Family$name,GPD=0,GEV=-Inf)
    X$Y <- Family$rng(n,param,list(threshold=th))
    fit <- evm("Y",data=X,phi=~a,xi=~b,th=th,family=Family)
    lp <- linearPredictors(fit)$link
    ep.current <- endPoint(fit,verbose=FALSE,.unique=FALSE)
    ep.target <- switch(Family$name,GPD=ifelse(lp[,2] < 0, th-exp(lp[,1])/lp[,2],Inf),
                        GEV=ifelse(lp[,3] < 0, lp[,1]-exp(lp[,2])/lp[,3],Inf))
    expect_equivalent(ep.current, ep.target, label=pst("endPoint:checkcalcforevmSimwithcovariates"))
  }
}