Commit efbb8850 authored by Jana Ulrich's avatar Jana Ulrich
Browse files

added derivatives of nll after parameters

parent 3994dcb6
......@@ -348,14 +348,14 @@ IDF.nll <- function(mu=0,sigma=1,xi=0,theta=0,eta=1,x,d,use.log=F,DEBUG=F) {
#' gev.d.fit(xdat=example$dat,ds = example$d,ydat=as.matrix(example[,c('cov1','cov2')])
#' ,mul=c(1,2),sigl=1)
'gev.d.fit'<-
gev.d.fit<-
function(xdat, ds, ydat = NULL, mul = NULL, sigl = NULL, shl = NULL, thetal = NULL, etal = NULL,
mulink = identity, siglink = identity, shlink = identity, thetalink = identity, etalink = identity,
muinit = NULL, siginit = NULL, shinit = NULL, thetainit = NULL, etainit = NULL,
show = TRUE, method = "Nelder-Mead", maxit = 10000, ...)
{
#
# obtains mles etc for gev(d) distn
# obtains mles etc for d-gev distn
#
# test for NA values:
......@@ -431,7 +431,7 @@ IDF.nll <- function(mu=0,sigma=1,xi=0,theta=0,eta=1,x,d,use.log=F,DEBUG=F) {
# function to calculate neg log-likelihood:
gev.lik <- function(a) {
# computes neg log lik of gev(d) model
# computes neg log lik of d-gev model
mu <- mulink(mumat %*% (a[1:npmu]))
sigma <- siglink(sigmat %*% (a[seq(npmu + 1, length = npsc)]))
xi <- shlink(shmat %*% (a[seq(npmu + npsc + 1, length = npsh)]))
......@@ -447,6 +447,28 @@ IDF.nll <- function(mu=0,sigma=1,xi=0,theta=0,eta=1,x,d,use.log=F,DEBUG=F) {
sum(log(sigma.d)) + sum(y^(-1/xi)) + sum(log(y) * (1/xi + 1))
}
#####################################################################################
# derivations of nll after d-gev-parameters (for boosting):
# get parameters from covariates and a (vector containing predictors)
# mu <- mulink(mumat %*% (a[1:npmu]))
# sigma <- siglink(sigmat %*% (a[seq(npmu + 1, length = npsc)]))
# xi <- shlink(shmat %*% (a[seq(npmu + npsc + 1, length = npsh)]))
# theta <- thetalink(thmat %*% (a[seq(npmu + npsc + npsh + 1, length = npth)]))
# eta <- etalink(etmat %*% (a[seq(npmu + npsc + npsh + npth + 1, length = npet)]))
# xd <- xdat*(ds+theta)^eta
# y <- 1 + xi * (xd/sigma - mu)
#
# nll <- log(sigma/(ds+theta)^eta) + y^(-1/xi) + log(y) * (1/xi + 1)
# dnll.mu <- -xi/y
# dnll.sigma <- 1/(sigma+xi*xd/(1-mu*xi))
# dnll.xi <- 1/(xi+sigma/(xd-mu*sigma))
# dnll.theta <- - eta*sigma*(mu*xi-1)/(ds+theta)/(-xi*xd+mu*xi*sigma-sigma)
# dnll.eta <- -sigma*(mu*xi-1)*log(ds+theta)/(-xi*xd+mu*xi*sigma-sigma)
#####################################################################################
# finding minimum of log-likelihood:
x <- optim(init, gev.lik, hessian = TRUE, method = method,
control = list(maxit = maxit, ...))
......
Markdown is supported
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