link functions in gev.d.params for class gev.fit

R/gevdfit.R

@@ -146,12 +146,12 @@ gev.d.fit<-
     if (is.null(thetal)) {
       thmat <- as.matrix(rep(1, length(xdat)))
       if (is.null(thetainit))  
-        thetainit <- 0
+        thetainit <- init.vals$theta
     }else {
       z$trans <- TRUE
       thmat <- cbind(rep(1, length(xdat)), ydat[, thetal])
       if (is.null(thetainit))  
-        thetainit <- c(0, rep(0, length(thetal)))
+        thetainit <- c(init.vals$theta, rep(0, length(thetal)))
     }
     if (is.null(etal)) {
       etmat <- as.matrix(rep(1, length(xdat)))
@@ -296,7 +296,8 @@ gev.d.init <- function(xdat,ds,link){
 #'           ,theta = params[,4],eta = params[,5])
 gev.d.nll <- function(xdat,ds,mut,sig0,xi,theta,eta) {
   # computes neg log lik of d-gev model
-  if(any(c(length(ds),length(mut),length(sig0),length(xi),length(theta),length(eta))!=length(xdat))){
+  if(any(! c(length(ds),length(mut),length(sig0),length(xi),length(theta),length(eta)) %in% 
+         c(1,length(xdat)))){
     warning('Input vectors differ in length, but must have the same length.')
   }
   
@@ -425,11 +426,17 @@ gev.d.params <- function(fit,ydat){
   if(class(fit)=="gev.d.fit"){npet <- length(fit$model[[5]]) + 1}
   
   # inverse link functions
+  if(class(fit)=="gev.d.fit"){
     mulink <- fit$link$mulink$linkinv
     siglink <- fit$link$siglink$linkinv
     shlink <- fit$link$shlink$linkinv
-  if(class(fit)=="gev.d.fit"){thetalink <- fit$link$thetalink$linkinv}
-  if(class(fit)=="gev.d.fit"){etalink <- fit$link$etalink$linkinv}
+    thetalink <- fit$link$thetalink$linkinv
+    etalink <- fit$link$etalink$linkinv
+  }else{
+    mulink <- eval(parse(text=fit$link))[[1]]
+    siglink <- eval(parse(text=fit$link))[[2]]
+    shlink <- eval(parse(text=fit$link))[[3]]
+  }
   
   # covariates matrices
   mumat <- cbind(rep(1, dim(ydat)[1]), matrix(ydat[, fit$model[[1]]],dim(ydat)[1],npmu-1))