added derivatives of nll after parameters

R/IDF.R

@@ -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, ...))