https://github.com/cran/laeken
Tip revision: 0212be6ca8944f359e081e9e78e5aabbf0958791 authored by Andreas Alfons on 04 June 2010, 00:00:00 UTC
version 0.1
version 0.1
Tip revision: 0212be6
thetaISE.R
# ----------------------------------------
# Authors: Josef Holzer and Andreas Alfons
# Vienna University of Technology
# ----------------------------------------
thetaISE <- function(x, k, ...) {
## initializations
if(!is.numeric(x) || length(x) == 0) stop("'x' must be a numeric vector")
if(!is.numeric(k) || length(k) == 0 || k[1] < 1) {
stop("'k' must be a positive integer")
} else k <- k[1]
if(any(i <- is.na(x))) x <- x[!i] # remove missing values
x <- sort(x)
n <- length(x)
if(k >= n) stop("'k' must be smaller than the number of observed values")
x0 <- x[n-k] # threshold (scale parameter)
y <- x[(n-k+1):n]/x0 # relative excesses
## integrated squared error distance criterion
ISE <- function(theta, y, k) {
f <- theta*y^(-1-theta)
theta^2/(2*theta+1) - 2*sum(f)/k
}
## minimize
localNlm <- function(f, p = NULL, ...) {
if(is.null(p)) p <- thetaHill(x, k) # starting parameter
nlm(f, p, ...)
}
localNlm(ISE, y=y, k=k, ...)$estimate
}