gnfit_fixed.R

# Title     : TODO
# Objective : TODO
# Created by: erwan
# Created on: 15/05/2020
##
## Exported symobls in package `gnFit`
##

## Exported package methods

gnfit_fixed <- function (dat, dist, df = NULL, pr = NULL, threshold = NULL)
{
    dat <- as.numeric(dat)
    x <- NULL
    z <- list()
    op <- par(mfrow = c(1, 2))
    if (is.null(pr)) {
        if (dist == "gev" | dist == "gpd")
            stop("Enter Parameters!")
        else if (dist == "t") {
            if (df > 2) {
                loc <- mean(dat)
                sc <- sqrt((df - 2) * var(dat)/df)
                xdat <- (dat - loc)/sc
                prob <- pt(xdat, df)
            }
            else stop("DF must be > 2")
        }
        else if (dist == "gum") {
            sc <- sqrt(6 * var(dat)/pi^2)
            loc <- mean(dat) - 0.577 * sc
            pr <- c(loc, sc, 0)
            prob <- gevf(pr, dat)
        }
        else {
            loc <- mean(dat)
            ifelse(dist == "norm", sc <- sd(dat), NA)
            ifelse(dist == "laplace", sc <- sqrt(var(dat)/2),
                NA)
            ifelse(dist == "logis", sc <- sqrt(3 * var(dat)/pi^2),
                NA)
            prob <- get(paste0("p", dist))(dat, loc, sc)
        }
    }
    else {
        if (dist == "gev") {
            prob <- gevf(pr, dat)
        }
        else if (dist == "gum") {
            pr[3] <- 0
            prob <- gevf(pr, dat)
        }
        else if (dist == "gpd")
            if (!is.null(threshold)) {
                u <- threshold
                dat <- dat[dat > u]
                prob <- gpdf(pr, u, dat)
            }
            else stop("threshold is missing!")
    }
    n <- length(dat)
    k <- seq(1:n)
    qnor <- qnorm(sort(prob))
    pnor <- pnorm((qnor - mean(qnor))/sd(qnor))
    w <- round((sum((pnor - (2 * k - 1)/(2 * n))^2) + 1/(12 *
        n)) * (1 + 0.5/n), 4)
    if (w < 0.0275) {
        pval <- 1 - exp(-13.953 + 775.5 * w - 12542.61 * w^2)
    }
    else if (w < 0.051) {