From noreply at r-forge.r-project.org  Thu Jul  4 14:40:02 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Thu,  4 Jul 2013 14:40:02 +0200 (CEST)
Subject: [Georob-commits] r10 - in pkg: . R man
Message-ID: <20130704124003.0C1E6184F6E@r-forge.r-project.org>

Author: papritz
Date: 2013-07-04 14:40:02 +0200 (Thu, 04 Jul 2013)
New Revision: 10

Modified:
   pkg/ChangeLog
   pkg/DESCRIPTION
   pkg/NAMESPACE
   pkg/R/georob.S3methods.R
   pkg/R/georob.cv.R
   pkg/R/georob.exported.functions.R
   pkg/R/georob.private.functions.R
   pkg/man/cv.georob.Rd
   pkg/man/georob.Rd
   pkg/man/georob.control.Rd
   pkg/man/plot.georob.Rd
Log:
changes in transformations of rotation angles of anisotropic variograms


Modified: pkg/ChangeLog
===================================================================
--- pkg/ChangeLog	2013-06-12 13:24:39 UTC (rev 9)
+++ pkg/ChangeLog	2013-07-04 12:40:02 UTC (rev 10)
@@ -106,3 +106,11 @@
 * georob.private.functions.R (all functions): substituting [["x"]] for $x in all lists
 * georob.S3methods.R (all functions): substituting [["x"]] for $x in all lists
 * variogram.R (all functions): substituting [["x"]] for $x in all lists
+
+
+2013-07-02  Andreas Papritz  <papritz at env.ethz.ch>
+
+* georob.exported.functions.R (georob, param.transf, fwd.transf, dfwd.transf, bwd.transf): new transformation of rotation angles
+* georob.private.functions.R (georob.fit, prepare.likelihood.calculations): new transformation of rotation angles
+* georob.S3methods.R (print.georob, summary.georob): new transformation of rotation angles
+* georob.cv.R (cv.georob): passing initial values of aniso and fit.aniso to georob via update

Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2013-06-12 13:24:39 UTC (rev 9)
+++ pkg/DESCRIPTION	2013-07-04 12:40:02 UTC (rev 10)
@@ -1,8 +1,8 @@
 Package: georob
 Type: Package
 Title: Robust Geostatistical Analysis of Spatial Data
-Version: 0.1-0
-Date: 2012-12-14
+Version: 0.1-1
+Date: 2013-06-20
 Authors at R: c(
   person( "Andreas", "Papritz", role = c( "cre", "aut" ), 
           email =  "andreas.papritz at env.ethz.ch" ),
@@ -17,4 +17,4 @@
          and block kriging predictions, along with utility functions for 
          cross-validation and for unbiased back-transformation of kriging 
          predictions of log-transformed data.
-License: GPL
+License: GPL (>= 2)

Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE	2013-06-12 13:24:39 UTC (rev 9)
+++ pkg/NAMESPACE	2013-07-04 12:40:02 UTC (rev 10)
@@ -31,7 +31,7 @@
   validate.predictions              # ok
 )
 
-# documented but unexported functions
+# documented but not exported functions
 #
 #   deviance.georob,                # ok
 #   fixed.effects.georob,           # ok

Modified: pkg/R/georob.S3methods.R
===================================================================
--- pkg/R/georob.S3methods.R	2013-06-12 13:24:39 UTC (rev 9)
+++ pkg/R/georob.S3methods.R	2013-07-04 12:40:02 UTC (rev 10)
@@ -90,6 +90,7 @@
   ## 2012-02-07 AP change for anisotropic variograms 
   ## 2012-12-18 AP invisible(x)
   ## 2013-06-12 AP substituting [["x"]] for $x in all lists
+  ## 2013-07-02 AP new transformation of rotation angles
   
   ## code borrowed from print.lmrob for printing fixed effects coeffcients
   
@@ -123,7 +124,7 @@
     
     cat("\n")
     cat( "Anisotropy parameters: ", "\n" )
-    aniso <- x[["aniso"]][["aniso"]] * c( rep(1, 2), rep( 180/pi, 3 ) )
+    aniso <- x[["aniso"]][["aniso"]]
     names( aniso ) <- ifelse(
       x[["initial.objects"]][["fit.aniso"]],
       names( aniso ),
@@ -484,6 +485,7 @@
   ## 2013-04-23 AP new names for robustness weights
   ## 2013-05-31 AP revised expansion of covariance matrices
   ## 2013-06-12 AP substituting [["x"]] for $x in all lists
+  ## 2013-07-03 AP new transformation of rotation angles
   
   covmat       <- expand( object[["cov"]] )
   
@@ -521,7 +523,7 @@
   
   if( !object[["aniso"]][["isotropic"]] ) ans[["param"]] <- rbind( 
     ans[["param"]],
-    as.matrix( object[["aniso"]][["aniso"]], ncol = 1 ) * c( rep( 1, 2 ), rep( 180/pi, 3 ) )
+    as.matrix( object[["aniso"]][["aniso"]], ncol = 1 )
   )
   
   colnames( ans[["param"]] ) <- "Estimate"
@@ -579,29 +581,47 @@
         )
         sel.names <- sel.names[sr]
         
-        ff <- c( rep( 1, length( object[["param"]] ) + 2 ), rep( 180/pi, 3 ) )
-        names( ff ) <- names( c( object[["param"]], object[["aniso"]][["aniso"]] ) )
-        
         ci[sel.names, ] <- t( 
           sapply(
             sel.names,
-            function( x, param, f, se, param.tf, trafo.fct, inv.trafo.fct ){
+            function( x, param, se, param.tf, trafo.fct, inv.trafo.fct ){
               inv.trafo.fct[[param.tf[x]]]( 
                 trafo.fct[[param.tf[x]]]( param[x] ) + 
                 c(-1, 1) * se[x] * qnorm( (1-signif)/2, lower.tail = FALSE ) 
               )
             },
             param         = c( object[["param"]], object[["aniso"]][["aniso"]] ),
-            f             = ff,
             se            = se,
             param.tf      = object[["param.tf"]],
             trafo.fct     = object[["fwd.tf"]],
             inv.trafo.fct = object[["bwd.tf"]]
           )
         )
-        is.angle <- rownames( ci ) %in% c( "omega", "phi", "zeta" )
-        if( sum(is.angle) > 0 ) ci[is.angle, ] <- ci[is.angle, ] * 180/pi
         
+        if( !object[["aniso"]][["isotropic"]] ){
+        
+          ## map angles to halfcircle
+          
+          if( !object[["aniso"]][["isotropic"]] ){
+            sel <- match( "omega", rownames(ci) )
+            if( !is.na( sel ) ){
+              ci[sel, ] <- ifelse( ci[sel, ] <   0., ci[sel, ] + 180., ci[sel, ] )
+              ci[sel, ] <- ifelse( ci[sel, ] > 180., ci[sel, ] - 180., ci[sel, ] )
+            }
+            sel <- match( "phi", rownames(ci) )
+            if( !is.na( sel ) ){
+              ci[sel, ] <- ifelse( ci[sel, ] <   0., ci[sel, ] + 180., ci[sel, ] )
+              ci[sel, ] <- ifelse( ci[sel, ] > 180., ci[sel, ] - 180., ci[sel, ] )
+            }
+            sel <- match( "zeta", rownames(ci) )
+            if( !is.na( sel ) ){
+              ci[sel, ] <- ifelse( ci[sel, ] < -90., ci[sel, ] + 180., ci[sel, ] )
+              ci[sel, ] <- ifelse( ci[sel, ] >  90., ci[sel, ] - 180., ci[sel, ] )
+            }
+          }
+          
+        }
+        
         ans[["param"]] <- cbind( ans[["param"]], ci )
         if( correlation ) ans[["cor.tf.param"]] <- cor.tf.param
         

Modified: pkg/R/georob.cv.R
===================================================================
--- pkg/R/georob.cv.R	2013-06-12 13:24:39 UTC (rev 9)
+++ pkg/R/georob.cv.R	2013-07-04 12:40:02 UTC (rev 10)
@@ -12,6 +12,8 @@
     duplicates.in.same.set = TRUE,
     re.estimate = TRUE, param = object[["param"]], 
     fit.param = object[["initial.objects"]][["fit.param"]],
+    aniso = object[["aniso"]][["aniso"]], 
+    fit.aniso = object[["initial.objects"]][["fit.aniso"]],
     return.fit = FALSE, reduced.output = TRUE,
     lgn = FALSE,
     ncores = min( nset, detectCores() ),
@@ -74,12 +76,14 @@
   ## 2013-05-23 AP correct handling of missing observations
   ## 2013-05-24 AP separate initial variogram parameters for each cross-validation set
   ## 2013-06-12 AP substituting [["x"]] for $x in all lists
+  ## 2013-07-02 AP passing initial values of aniso and fit.aniso to georob via update
     
   ## auxiliary function that fits the model and computes the predictions of
   ## a cross-validation set
   
   f.aux <- function( 
-    ..i.., object, formula, data, sets, re.estimate, param, fit.param, lgn, verbose, ...
+    ..i.., object, formula, data, sets, re.estimate, 
+    param, fit.param, aniso, fit.aniso, lgn, verbose, ...
   ){  ## cv function
     
     if (verbose) cat( "\n\n  processing cross-validation set", ..i.., "\n" ) 
@@ -93,6 +97,7 @@
         gamma = FALSE, lambda = FALSE, n = FALSE, nu = FALSE,
         f1 = FALSE, f2  =FALSE, omega = FALSE, phi = FALSE, zeta = FALSE      
       )[names( param )]
+      fit.aniso <- c( f1 = FALSE, f2 = FALSE, omega = FALSE, phi = FALSE, zeta = FALSE )
     }
     
     ## change environment of terms and formula so that subset selection works for update            
@@ -104,14 +109,16 @@
     
     if( ( is.matrix( param ) || is.data.frame( param ) ) )  param <- param[..i..,]
     if( ( is.matrix( fit.param ) || is.data.frame( fit.param ) ) )  fit.param <- fit.param[..i..,]
+    if( ( is.matrix( aniso ) || is.data.frame( param ) ) )  aniso <- aniso[..i..,]
+    if( ( is.matrix( fit.aniso ) || is.data.frame( fit.aniso ) ) )  fit.aniso <- fit.aniso[..i..,]
 
     t.georob <- update( 
       object, 
       formula = formula,
       data = data,
       subset = -sets[[..i..]] ,
-      param = param,
-      fit.param = fit.param,
+      param = param, fit.param = fit.param,
+      aniso = aniso, fit.aniso = fit.aniso,
       verbose = verbose,
       ...
     )
@@ -242,13 +249,21 @@
   ## check dimension of param and fit.param
   
   if( ( is.matrix( param ) || is.data.frame( param ) ) && nrow( param )!= nset ) stop(
-    "param must have 'nset' rows if it is a matrix or data frame"  
+    "'param' must have 'nset' rows if it is a matrix or data frame"  
   )
     
   if( ( is.matrix( fit.param ) || is.data.frame( fit.param ) ) && nrow( param )!= nset ) stop(
-    "fit.param must have 'nset' rows if it is a matrix or data frame"  
+    "'fit.param' must have 'nset' rows if it is a matrix or data frame"  
   )
     
+  if( ( is.matrix( aniso ) || is.data.frame( aniso ) ) && nrow( aniso )!= nset ) stop(
+    "'aniso' must have 'nset' rows if it is a matrix or data frame"  
+  )
+    
+  if( ( is.matrix( fit.aniso ) || is.data.frame( fit.aniso ) ) && nrow( aniso )!= nset ) stop(
+    "'fit.aniso' must have 'nset' rows if it is a matrix or data frame"  
+  )
+    
   ## loop over all cross-validation sets
   
   if( .Platform[["OS.type"]] == "windows" ){
@@ -270,8 +285,8 @@
       data = data,
       sets = sets,
       re.estimate = re.estimate,
-      param = param,
-      fit.param = fit.param,
+      param = param, fit.param = fit.param,
+      aniso = aniso, fit.aniso = fit.aniso,
       lgn = lgn,
       verbose = verbose,
       ...
@@ -291,8 +306,8 @@
       data = data,
       sets = sets,
       re.estimate = re.estimate,
-      param = param,
-      fit.param = fit.param,
+      param = param, fit.param = fit.param,
+      aniso = aniso, fit.aniso = fit.aniso,
       lgn = lgn,
       verbose = verbose,
       mc.cores = ncores,

Modified: pkg/R/georob.exported.functions.R
===================================================================
--- pkg/R/georob.exported.functions.R	2013-06-12 13:24:39 UTC (rev 9)
+++ pkg/R/georob.exported.functions.R	2013-07-04 12:40:02 UTC (rev 10)
@@ -77,6 +77,7 @@
   ## 2013-05-23 AP correct handling of missing observations and to construct model.frame
   ## 2013-06-03 AP handling design matrices with rank < ncol(x)
   ## 2013-06-12 AP substituting [["x"]] for $x in all lists
+  ## 2013-07-02 AP new transformation of rotation angles
   
   ## check whether input is complete
   
@@ -395,7 +396,7 @@
     )
     
     param = t.georob[["param"]][names(fit.param)]
-    aniso = t.georob[["aniso"]][["aniso"]][names(fit.aniso)] * c( 1, 1, rep( 180/pi, 3 ) )
+    aniso = t.georob[["aniso"]][["aniso"]][names(fit.aniso)]
     
   }
   
@@ -644,14 +645,14 @@
     variance = "log", snugget = "log", nugget = "log", scale = "log", 
     a = "identity", alpha = "identity", beta = "identity", delta = "identity", 
     gamma = "identity", lambda = "identity", n = "identity", nu = "identity",
-    f1 = "log", f2  ="log", omega = "identity", phi = "identity", zeta = "identity"
+    f1 = "log", f2  ="log", omega = "rad", phi = "rad", zeta = "rad"
   )
 {
   
   ## function sets meaningful defaults for transformation of variogram
   ## parameters
   
-  ## 2012-11-27 A. Papritz
+  ## 2013-07-02 A. Papritz
   
   c( 
     variance = variance, snugget = snugget, nugget = nugget, scale = scale,
@@ -671,9 +672,9 @@
   
   ## definition of forward transformation of variogram parameters
   
-  ## 2012-11-27 A. Papritz
+  ## 2013-07-02 A. Papritz
   
-  list( log = function(x) log(x),  identity = function(x) x, ... )
+  list( log = function(x) log(x),  identity = function(x) x, rad = function(x) x/180*pi, ... )
 }
 
 ## ======================================================================
@@ -685,10 +686,15 @@
   
   ## definition of first derivative of forward transformation of variogram
   ## parameters
+  ## NOTE: dfwd.transf[["rad"]] must be equal to one since sine and cosine 
+  ## are evaluated for transformed angles
   
-  ## 2012-11-27 A. Papritz
+  ## 2013-07-02 A. Papritz
   
-  list( log = function(x) 1/x, identity = function(x) rep(1, length(x)), ... )  
+  list( 
+    log = function(x) 1/x, identity = function(x) rep(1, length(x)), 
+    rad = function(x) rep(1., length(x)), ... 
+  )  
   
 }
 
@@ -701,9 +707,9 @@
   
   ## definition of backward transformation of variogram parameters
   
-  ## 2012-11-27 A. Papritz
+  ## 2013-07-02 A. Papritz
   
-  list( log = function(x) exp(x), identity = function(x) x, ... )
+  list( log = function(x) exp(x), identity = function(x) x, rad = function(x) x/pi*180, ... )
   
 }
 

Modified: pkg/R/georob.private.functions.R
===================================================================
--- pkg/R/georob.private.functions.R	2013-06-12 13:24:39 UTC (rev 9)
+++ pkg/R/georob.private.functions.R	2013-07-04 12:40:02 UTC (rev 10)
@@ -1083,6 +1083,7 @@
   ## 2012-11-27 AP changes in check allowed parameter range
   ## 2013-02-04 AP solving estimating equations for xi
   ## 2013-06-12 AP substituting [["x"]] for $x in all lists
+  ## 2013-07-02 AP new transformation of rotation angles
   
   ##  function transforms (1) the variogram parameters back to their
   ##  original scale; computes (2) the correlation matrix, its inverse
@@ -1102,7 +1103,7 @@
   )
   names( param ) <- param.name
   
-  aniso <- c( adjustable.param, fixed.param )[aniso.name]
+  fwd.tf.aniso <- aniso<- c( adjustable.param, fixed.param )[aniso.name]
   
   aniso <- sapply(
     aniso.name,
@@ -1180,12 +1181,12 @@
     
     lik.item[["aniso"]][["aniso"]] <- aniso
     lik.item[["aniso"]][["sincos"]] <- list(
-      co = unname( cos( aniso["omega"] ) ),
-      so = unname( sin( aniso["omega"] ) ),
-      cp = unname( cos( aniso["phi"] ) ),
-      sp = unname( sin( aniso["phi"] ) ),
-      cz = unname( cos( aniso["zeta"] ) ),
-      sz = unname( sin( aniso["zeta"] ) )
+      co = unname( cos( fwd.tf.aniso["omega"] ) ),
+      so = unname( sin( fwd.tf.aniso["omega"] ) ),
+      cp = unname( cos( fwd.tf.aniso["phi"] ) ),
+      sp = unname( sin( fwd.tf.aniso["phi"] ) ),
+      cz = unname( cos( fwd.tf.aniso["zeta"] ) ),
+      sz = unname( sin( fwd.tf.aniso["zeta"] ) )
     )
     
     n <- NCOL( lag.vectors)
@@ -1435,48 +1436,6 @@
         ( c( 0., 0., -1. / aniso[["aniso"]]["f2"]^2 )[1:n] * aniso[["sclmat"]] ) * aux^2 
       )
     },
-    
-#     omega = {
-#       drotmat <- with(
-#         aniso[["sincos"]],
-#         rbind(
-#           c(             cp*co,            -cp*so, 0. ),
-#           c(  co*sz*sp + cz*so,  cz*co - sz*sp*so, 0. ),
-#           c( -cz*co*sp + sz*so,  co*sz + cz*sp*so, 0. )
-#         )[ 1:n, 1:n, drop = FALSE ]
-#       )
-#       colSums( 
-#         ( aniso[["sclmat"]] * drotmat %*% t(x) ) * ( aniso[["sclmat"]] * aux ) 
-#       )
-#     },
-#     
-#     phi = {
-#       drotmat <- with(
-#         aniso[["sincos"]],
-#         rbind(
-#           c(    -sp*so,    -co*sp,     cp ),
-#           c(  cp*sz*so,  cp*co*sz,  sz*sp ),
-#           c( -cz*cp*so, -cz*cp*co, -cz*sp )
-#         )[ 1:n, 1:n, drop = FALSE ]
-#       )
-#       colSums( 
-#         ( aniso[["sclmat"]] * drotmat %*% t(x) ) * ( aniso[["sclmat"]] * aux ) 
-#       )
-#     },
-#     
-#     zeta = {
-#       drotmat <- with(
-#         aniso[["sincos"]],
-#         rbind(
-#           c(                0.,               0.,     0. ),
-#           c(  co*sz + cz*sp*so, cz*co*sp - sz*so, -cz*cp ),
-#           c( -cz*co + sz*sp*so, co*sz*sp + cz*so, -cp*sz )
-#         )[ 1:n, 1:n, drop = FALSE ]
-#       )
-#       colSums( 
-#         ( aniso[["sclmat"]] * drotmat %*% t(x) ) * ( aniso[["sclmat"]] * aux ) 
-#       )
-#     },
     omega = {
       drotmat <- with(
         aniso[["sincos"]],
@@ -3260,6 +3219,7 @@
   ## 2013-05-06 AP changes for solving estimating equations for xi
   ## 2013-06-12 AP changes in stored items of Valpha object
   ## 2013-06-12 AP substituting [["x"]] for $x in all lists
+  ## 2013-07-03 AP new transformation of rotation angles
   
   ##  ToDos:
   
@@ -3586,10 +3546,6 @@
 #     "undefined transformation of anisotropy parameter"
 #   )
   
-  ##  convert angles to radian
-  
-  aniso[c("omega", "phi", "zeta" )] <- aniso[c("omega", "phi", "zeta" )] / 180 * pi
-  
   ##  transform initial anisotropy parameters
   
   transformed.aniso <- sapply(
@@ -4009,6 +3965,37 @@
     
   }
   
+  ## map angles to halfcircle
+  
+  if( !result.list[["aniso"]][["isotropic"]] ){
+    
+    if( result.list[["aniso"]][["aniso"]]["omega"] < 0. ){
+      result.list[["aniso"]][["aniso"]]["omega"] <- 
+      result.list[["aniso"]][["aniso"]]["omega"] + 180.
+    }
+    if( result.list[["aniso"]][["aniso"]]["omega"] > 180. ){
+      result.list[["aniso"]][["aniso"]]["omega"] <- 
+      result.list[["aniso"]][["aniso"]]["omega"] - 180.
+    }
+    if( result.list[["aniso"]][["aniso"]]["phi"] < 0. ){
+      result.list[["aniso"]][["aniso"]]["phi"] <- 
+      result.list[["aniso"]][["aniso"]]["phi"] + 180.
+    }
+    if( result.list[["aniso"]][["aniso"]]["phi"] > 180. ){
+      result.list[["aniso"]][["aniso"]]["phi"] <- 
+      result.list[["aniso"]][["aniso"]]["phi"] - 180.
+    }
+    if( result.list[["aniso"]][["aniso"]]["zeta"] < 90. ){
+      result.list[["aniso"]][["aniso"]]["zeta"] <- 
+      result.list[["aniso"]][["aniso"]]["zeta"] + 180.
+    }
+    if( result.list[["aniso"]][["aniso"]]["zeta"] > 90. ){
+      result.list[["aniso"]][["aniso"]]["zeta"] <- 
+      result.list[["aniso"]][["aniso"]]["zeta"] - 180.
+    }
+  
+  }
+  
   ##      result.list[["df.model"]] <- r.df
   
   if( full.output ){

Modified: pkg/man/cv.georob.Rd
===================================================================
--- pkg/man/cv.georob.Rd	2013-06-12 13:24:39 UTC (rev 9)
+++ pkg/man/cv.georob.Rd	2013-07-04 12:40:02 UTC (rev 10)
@@ -1,4 +1,4 @@
-% 2013-06-12 A. Papritz
+% 2013-07-02 A. Papritz
 % R CMD Rdconv -t html -o bla.html cv.georob.Rd ; open bla.html; R CMD Rd2pdf --force cv.georob.Rd; 
 
 \encoding{macintosh}
@@ -24,7 +24,9 @@
 \method{cv}{georob}(object, formula = NULL, subset = NULL, nset = 10, 
     seed = NULL, sets = NULL, duplicates.in.same.set = TRUE, 
     re.estimate = TRUE, param = object[["param"]], 
-    fit.param = object[["initial.objects"]][["fit.param"]], 
+    fit.param = object[["initial.objects"]][["fit.param"]],
+    aniso = object[["aniso"]][["aniso"]], 
+    fit.aniso = object[["initial.objects"]][["fit.aniso"]],
     return.fit = FALSE, reduced.output = TRUE, lgn = FALSE, 
     ncores = min(nset, detectCores()), verbose = 0, ...)
 }
@@ -82,6 +84,25 @@
   cross-validation sets and \code{colnames(param)} must match
   \code{names(object[["param"]])}.}
   
+  \item{aniso}{an optional named numeric vector or a matrix or data frame
+  with anisotropy parameters passed by \code{\link[stats]{update}} to
+  \code{\link{georob}}, see \emph{Details}.  If \code{aniso} is a matrix
+  (or a data frame) then it must have \code{nset} rows and
+  \code{length(object[["aniso"]][["aniso"]])} columns with initial values
+  of anisotropy parameters for the \code{nset} cross-validation sets and
+  \code{colnames(aniso)} must match
+  \code{names(object[["aniso"]][["aniso"]])}.}
+  
+  \item{fit.aniso}{an optional named logical vector or a matrix or data
+  frame defining which anisotropy parameters should be adjusted when passed
+  by \code{\link[stats]{update}} to \code{\link{georob}}, see
+  \emph{Details}.  If \code{fit.aniso} is a matrix (or a data frame) then
+  it must have \code{nset} rows and
+  \code{length(object[["aniso"]][["aniso"]])} columns with anisotropy
+  parameter fitting flags for the \code{nset} cross-validation sets and
+  \code{colnames(aniso)} must match
+  \code{names(object[["aniso"]][["aniso"]])}.}
+  
   \item{return.fit}{logical controlling whether information about the fit
   should be returned for when re-estimating the model with the reduced data
   sets (default \code{TRUE}).}

Modified: pkg/man/georob.Rd
===================================================================
--- pkg/man/georob.Rd	2013-06-12 13:24:39 UTC (rev 9)
+++ pkg/man/georob.Rd	2013-07-04 12:40:02 UTC (rev 10)
@@ -117,7 +117,7 @@
     \itemize{
     
       \item{\code{f1}: ratio \eqn{f_1} of lengths of second and first
-        second semi-principal axes of an ellipsoidal surface with constant
+        semi-principal axes of an ellipsoidal surface with constant
         semivariance in \eqn{\mathrm{I}\!\mathrm{R}^3}{R^3} (default \code{f1 = 1}).}
       
       \item{\code{f2}: ratio \eqn{f_2} of lengths of third and first

Modified: pkg/man/georob.control.Rd
===================================================================
--- pkg/man/georob.control.Rd	2013-06-12 13:24:39 UTC (rev 9)
+++ pkg/man/georob.control.Rd	2013-07-04 12:40:02 UTC (rev 10)
@@ -1,4 +1,4 @@
-% 2013-06-12 A. Papritz
+% 2013-07-02 A. Papritz
 % R CMD Rdconv -t html -o bla.html georob.control.Rd ; open bla.html; R CMD Rd2pdf --force georob.control.Rd; 
 \encoding{macintosh}
 \name{georob.control}
@@ -44,8 +44,8 @@
 param.transf(variance = "log", snugget = "log", nugget = "log", scale = "log", 
     a = "identity", alpha = "identity", beta = "identity", delta = "identity", 
     gamma = "identity", lambda = "identity", n = "identity", nu = "identity",
-    f1 = "log", f2  ="log", omega = "identity", phi = "identity",
-    zeta = "identity")
+    f1 = "log", f2  ="log", omega = "rad", phi = "rad",
+    zeta = "rad")
   
 fwd.transf(...)
 
@@ -282,12 +282,13 @@
 
   The arguments \code{param.tf}, \code{fwd.tf}, \code{deriv.fwd.tf},
   \code{bwd.tf} define the transformations of the variogram parameters for
-  robust REML estimation.  Implemented are currently \code{"log"} and
-  \code{"identity"} (= no) transformations.  These are the possible values
-  that the many arguments of the function \code{param.transf} accept (as
-  quoted character strings) and these are the names of the list
-  components returned by \code{fwd.transf}, \code{dfwd.transf} and 
-  \code{bwd.transf}.  Additional transformations can be implemented by:
+  robust REML estimation.  Implemented are currently \code{"log"},
+  \code{"rad"} (conversion from degree to radian) and \code{"identity"} (= no)
+  transformations.  These are the possible values that the many arguments
+  of the function \code{param.transf} accept (as quoted character strings)
+  and these are the names of the list components returned by
+  \code{fwd.transf}, \code{dfwd.transf} and \code{bwd.transf}.  Additional
+  transformations can be implemented by:
   
   \enumerate{
   

Modified: pkg/man/plot.georob.Rd
===================================================================
--- pkg/man/plot.georob.Rd	2013-06-12 13:24:39 UTC (rev 9)
+++ pkg/man/plot.georob.Rd	2013-07-04 12:40:02 UTC (rev 10)
@@ -1,4 +1,4 @@
-% 2012-12-14 A. Papritz
+% 2013-07-01 A. Papritz
 % R CMD Rdconv -t html -o bla.html plot.georob.Rd ; open bla.html; R CMD Rd2pdf --force plot.georob.Rd; 
 
 \encoding{macintosh}
@@ -46,19 +46,19 @@
   grouping the lag distances or a numeric vector with the upper bounds of a
   set of contiguous bins.}
   
-  \item{xy.angle.def}{an numeric vector defining angular classes
-  in the horizontal plane for computing directional variograms.
+  \item{xy.angle.def}{an numeric vector defining angular classes in the
+  horizontal plane for computing directional variograms.
   \code{xy.angle.def} must contain an ascending sequence of azimuth angles
-  in degrees from north (positive clockwise to south), see \emph{Details}.
-  Omnidirectional variograms are computed with the default 
-  \code{c(0,180)}.}
+  in degrees from north (positive clockwise to south), see
+  \code{\link{sample.variogram}}.  Omnidirectional variograms are computed
+  with the default \code{c(0,180)}.}
   
-  \item{xz.angle.def}{an numeric vector defining angular classes
-  in the \eqn{x}-\eqn{z}-plane for computing directional variograms.
+  \item{xz.angle.def}{an numeric vector defining angular classes in the
+  \eqn{x}-\eqn{z}-plane for computing directional variograms.
   \code{xz.angle.def} must contain an ascending sequence of angles in
   degrees from zenith (positive clockwise to nadir), see
-  \emph{Details}.  Omnidirectional variograms are computed with the default
-  \code{c(0,180)}.}
+  \code{\link{sample.variogram}}.  Omnidirectional variograms are computed
+  with the default \code{c(0,180)}.}
   
   \item{max.lag}{positive numeric defining the largest lag distance for
   which semivariances should be computed (default no restriction).}


From noreply at r-forge.r-project.org  Tue Jul  9 13:15:07 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue,  9 Jul 2013 13:15:07 +0200 (CEST)
Subject: [Georob-commits] r11 - in pkg: . R man
Message-ID: <20130709111507.BD664184D79@r-forge.r-project.org>

Author: papritz
Date: 2013-07-09 13:15:07 +0200 (Tue, 09 Jul 2013)
New Revision: 11

Modified:
   pkg/ChangeLog
   pkg/R/georob.cv.R
   pkg/R/georob.private.functions.R
   pkg/man/cv.georob.Rd
Log:
changes for fitting geometrically anisotropic variogram functions


Modified: pkg/ChangeLog
===================================================================
--- pkg/ChangeLog	2013-07-04 12:40:02 UTC (rev 10)
+++ pkg/ChangeLog	2013-07-09 11:15:07 UTC (rev 11)
@@ -114,3 +114,13 @@
 * georob.private.functions.R (georob.fit, prepare.likelihood.calculations): new transformation of rotation angles
 * georob.S3methods.R (print.georob, summary.georob): new transformation of rotation angles
 * georob.cv.R (cv.georob): passing initial values of aniso and fit.aniso to georob via update
+
+
+2013-07-05  Andreas Papritz  <papritz at env.ethz.ch>
+
+* georob.cv.R (cv.georob): return "variogram.model" as part of 'fit' component
+
+
+2013-07-09  Andreas Papritz  <papritz at env.ethz.ch>
+
+* georob.private.functions.R (georob.fit): catching errors occuring when fitting anisotropic variogram models with default anisotropy parameters

Modified: pkg/R/georob.cv.R
===================================================================
--- pkg/R/georob.cv.R	2013-07-04 12:40:02 UTC (rev 10)
+++ pkg/R/georob.cv.R	2013-07-09 11:15:07 UTC (rev 11)
@@ -77,6 +77,7 @@
   ## 2013-05-24 AP separate initial variogram parameters for each cross-validation set
   ## 2013-06-12 AP substituting [["x"]] for $x in all lists
   ## 2013-07-02 AP passing initial values of aniso and fit.aniso to georob via update
+  ## 2013-07-05 AP return "variogram.model" as part of fit componnent
     
   ## auxiliary function that fits the model and computes the predictions of
   ## a cross-validation set
@@ -165,7 +166,7 @@
       
       t.georob <- t.georob[c(  
         "tuning.psi", "converged", "convergence.code",
-        "gradient", "param", "aniso",
+        "gradient", "variogram.model", "param", "aniso",
         "coefficients"
       )]
       

Modified: pkg/R/georob.private.functions.R
===================================================================
--- pkg/R/georob.private.functions.R	2013-07-04 12:40:02 UTC (rev 10)
+++ pkg/R/georob.private.functions.R	2013-07-09 11:15:07 UTC (rev 11)
@@ -1480,7 +1480,7 @@
     
     NA
   ) / ( hs * alpha^2 )
-  
+    
   ##  partial derivative of scaled lag distance with respect to scale
   ##  parameter
   
@@ -3220,6 +3220,8 @@
   ## 2013-06-12 AP changes in stored items of Valpha object
   ## 2013-06-12 AP substituting [["x"]] for $x in all lists
   ## 2013-07-03 AP new transformation of rotation angles
+  ## 2013-07-09 AP catching errors occuring when fitting anisotropic
+  ##               variograms with default anisotropy parameters
   
   ##  ToDos:
   
@@ -3527,7 +3529,17 @@
   if( aniso["zeta"] < -90. ||  aniso["zeta"] > 90. ) stop(
     "initial value of parameter 'zeta' must be in [-90, 90]" 
   )
-
+  
+  ## adjust default initial values of anisotropy parameters if these are
+  ## fitted
+  
+  if( fit.aniso["omega"] && aniso["f1"] == 1. ) aniso["f1"] <- aniso["f1"] - sqrt( .Machine$double.eps )
+  if( fit.aniso["phi"] ){
+    if( aniso["f1"] == 1. ) aniso["f1"] <- aniso["f1"] - sqrt( .Machine$double.eps )
+    if( aniso["f2"] == 1. ) aniso["f2"] <- aniso["f2"] - sqrt( .Machine$double.eps )
+  }
+  if( fit.aniso["zeta"] && aniso["f2"] == 1. ) aniso["f2"] <- aniso["f2"] - sqrt( .Machine$double.eps )
+  
   ##  rearrange and check flags controlling anisotropy parameter fitting 
   
   fit.aniso <- fit.aniso[aniso.name]

Modified: pkg/man/cv.georob.Rd
===================================================================
--- pkg/man/cv.georob.Rd	2013-07-04 12:40:02 UTC (rev 10)
+++ pkg/man/cv.georob.Rd	2013-07-09 11:15:07 UTC (rev 11)
@@ -1,4 +1,4 @@
-% 2013-07-02 A. Papritz
+% 2013-07-05 A. Papritz
 % R CMD Rdconv -t html -o bla.html cv.georob.Rd ; open bla.html; R CMD Rd2pdf --force cv.georob.Rd; 
 
 \encoding{macintosh}
@@ -180,8 +180,8 @@
   \code{georob}, fitted for the \eqn{K} reduced data set
   (\code{reduced.output = FALSE}), or \eqn{K} lists with the components
   \code{tuning.psi}, \code{converged}, \cr \code{convergence.code},
-  \code{gradient}, \code{param}, \code{aniso$aniso}, \code{coefficients}
-  along with the standard errors of
+  \code{gradient}, \code{variogram.model}, \code{param},
+  \code{aniso$aniso}, \code{coefficients} along with the standard errors of
   \eqn{\widehat{\mbox{\boldmath$\beta$\unboldmath}}}{hat\beta}, see
   \code{\link{georobObject}}.
  


From noreply at r-forge.r-project.org  Wed Jul 10 11:02:18 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Wed, 10 Jul 2013 11:02:18 +0200 (CEST)
Subject: [Georob-commits] r12 - in pkg: . R man
Message-ID: <20130710090218.64F43183A2A@r-forge.r-project.org>

Author: papritz
Date: 2013-07-10 11:02:14 +0200 (Wed, 10 Jul 2013)
New Revision: 12

Modified:
   pkg/ChangeLog
   pkg/R/georob.exported.functions.R
   pkg/R/georob.private.functions.R
   pkg/man/cv.georob.Rd
   pkg/man/georob.Rd
Log:
computing robust intial values of parameters by minimizing sum of squared estimating equations


Modified: pkg/ChangeLog
===================================================================
--- pkg/ChangeLog	2013-07-09 11:15:07 UTC (rev 11)
+++ pkg/ChangeLog	2013-07-10 09:02:14 UTC (rev 12)
@@ -124,3 +124,10 @@
 2013-07-09  Andreas Papritz  <papritz at env.ethz.ch>
 
 * georob.private.functions.R (georob.fit): catching errors occuring when fitting anisotropic variogram models with default anisotropy parameters
+
+
+2013-07-10  Andreas Papritz  <papritz at env.ethz.ch>
+
+* georob.exported.functions.R (georob): computing robust initial variogram parameter estimates by minimizing sum of squared estimating equations
+* georob.private.functions.R (georob.fit, compute.estimating.equations): computing robust initial variogram parameter estimates by minimizing sum of squared estimating equations
+

Modified: pkg/R/georob.exported.functions.R
===================================================================
--- pkg/R/georob.exported.functions.R	2013-07-09 11:15:07 UTC (rev 11)
+++ pkg/R/georob.exported.functions.R	2013-07-10 09:02:14 UTC (rev 12)
@@ -18,7 +18,7 @@
     )[ names(param) ],
     aniso = c( f1 = 1., f2 = 1., omega = 90., phi = 90., zeta = 0. ),
     fit.aniso = c( f1 = FALSE, f2 = FALSE, omega = FALSE, phi = FALSE, zeta = FALSE ),
-    tuning.psi = 2, initial.param  = TRUE,
+    tuning.psi = 2, initial.param  = c( "minimize", "exclude", "no" ),
     control = georob.control( ... ), verbose = 0,
     ...
   )
@@ -188,7 +188,7 @@
       signif( condnum, 2 ), ")\ninitial values of fixed effects coefficients are computed by 'lm'\n\n"
     )
     control[["initial.method"]] <- "lm"
-    initial.param <- FALSE
+    initial.param <- "mininimize"
     warning( 
       "design matrix has not full column rank (condition number of X^T X: ", 
       signif( condnum, 2 ), ")\ninitial values of fixed effects coefficients are computed by 'lm'"
@@ -202,7 +202,7 @@
   
   ## adjust choice for initial.method to compute regression coefficients
   
-  if( initial.param ) control[["initial.method"]] <- "lmrob"
+  if( identical( initial.param, "exclude" ) ) control[["initial.method"]] <- "lmrob"
   
   ## compute initial guess of fixed effects parameters (betahat)
   
@@ -318,86 +318,162 @@
   ## prune data set for computing initial values of variogram and
   ## anisotropy parameters by reml
   
-  if( initial.param && tuning.psi < control[["tuning.psi.nr"]] ){
-    
-    t.sel <- switch(
-      control[["initial.method"]],
-      lmrob = r.initial.fit[["rweights"]] > control[["min.rweight"]],
-      stop(
-        "computing initial values of covariance parameters requires 'lmrob' as ",
-        "method for computing initial regression coefficients"
+  initial.param <- match.arg( initial.param )
+  
+  if( tuning.psi < control[["tuning.psi.nr"]] ){
+        
+    if( identical( initial.param, "exclude" ) ){
+      
+      if( verbose > 0 ) cat( "\ncomputing robust initial parameter estimates ...\n" )
+      
+      t.sel <- switch(
+        control[["initial.method"]],
+        lmrob = r.initial.fit[["rweights"]] > control[["min.rweight"]],
+        stop(
+          "computing initial values of covariance parameters requires 'lmrob' as ",
+          "method for computing initial regression coefficients"
+        )
       )
-    )
+      
+      if( verbose > 0 ) cat( 
+        "\ndiscarding", sum( !t.sel ), "of", length( t.sel ), 
+        "observations for computing initial estimates of variogram\nand anisotropy parameter by gaussian reml\n"
+      )
+      
+      ## collect.items for initial object
+      
+      initial.objects <- list(
+        x = as.matrix( x[t.sel, ] ),
+        y = yy[t.sel],
+        betahat = coef( r.initial.fit ),
+        bhat = if( is.null( control[["bhat"]] ) ){
+          rep( 0., length( yy ) )[t.sel]
+        } else {
+          control[["bhat"]][t.sel]
+        },
+        initial.fit = r.initial.fit,
+        locations.objects = list(
+          locations = locations,
+          coordinates = locations.coords[t.sel, ]
+        ),
+        isotropic = aniso.missing
+      )
+      
+      ## estimate model parameters with pruned data set
+      
+      t.georob <- georob.fit(
+        slv = TRUE,
+        envir = envir,
+        initial.objects = initial.objects,
+        variogram.model = variogram.model, param = param, fit.param = fit.param,
+        aniso = aniso, fit.aniso = fit.aniso,
+        param.tf = control[["param.tf"]],
+        fwd.tf = control[["fwd.tf"]], 
+        deriv.fwd.tf = control[["deriv.fwd.tf"]],
+        bwd.tf = control[["bwd.tf"]], 
+        safe.param = control[["safe.param"]],
+        tuning.psi = control[["tuning.psi.nr"]],
+        cov.bhat = control[["cov.bhat"]], full.cov.bhat = control[["full.cov.bhat"]],
+        cov.betahat = control[["cov.betahat"]], 
+        cov.bhat.betahat = control[["cov.bhat.betahat"]],
+        cov.delta.bhat = control[["cov.delta.bhat"]],
+        full.cov.delta.bhat = control[["full.cov.delta.bhat"]],
+        cov.delta.bhat.betahat = control[["cov.delta.bhat.betahat"]],
+        cov.ehat = control[["cov.ehat"]], full.cov.ehat = control[["full.cov.ehat"]],
+        cov.ehat.p.bhat = control[["cov.ehat.p.bhat"]], full.cov.ehat.p.bhat = control[["full.cov.ehat.p.bhat"]],
+        aux.cov.pred.target = control[["aux.cov.pred.target"]],
+        min.condnum = control[["min.condnum"]],
+        rankdef.x = rankdef.x,
+        psi.func = control[["psi.func"]],
+        tuning.psi.nr = tuning.psi,
+        irwls.initial = control[["irwls.initial"]],
+        irwls.maxiter = control[["irwls.maxiter"]],
+        irwls.reltol = control[["irwls.reltol"]],
+        force.gradient = control[["force.gradient"]],
+        zero.dist = control[["zero.dist"]],
+        nleqslv.method =  control[["nleqslv"]][["method"]],
+        nleqslv.control = control[["nleqslv"]][["control"]],
+        optim.method =  control[["optim"]][["method"]],
+        optim.lower = control[["optim"]][["lower"]],
+        optim.upper = control[["optim"]][["upper"]],
+        hessian =       control[["optim"]][["hessian"]],
+        optim.control = control[["optim"]][["control"]],
+        full.output = control[["full.output"]],
+        verbose = verbose
+      )
+      
+      param = t.georob[["param"]][names(fit.param)]
+      aniso = t.georob[["aniso"]][["aniso"]][names(fit.aniso)]
+      
+    } else if( identical( initial.param, "minimize" ) ){
+      
+      if( verbose > 0 ) cat( "\ncomputing robust initial parameter estimates ...\n" )
+      
+      initial.objects <- list(
+        x = as.matrix( x ),
+        y = yy,
+        betahat = coef( r.initial.fit ),
+        bhat = if( is.null( control[["bhat"]] ) ){
+          rep( 0., length( yy ) )
+        } else {
+          control[["bhat"]]
+        },
+        initial.fit = r.initial.fit,
+        locations.objects = list(
+          locations = locations,
+          coordinates = locations.coords
+        ),
+        isotropic = aniso.missing
+      )
+      
+      ## estimate model parameters by minimizing sum( gradient^2)
+      
+      t.georob <- georob.fit(
+        slv = FALSE,
+        envir = envir,
+        initial.objects = initial.objects,
+        variogram.model = variogram.model, param = param, fit.param = fit.param,
+        aniso = aniso, fit.aniso = fit.aniso,
+        param.tf = control[["param.tf"]],
+        fwd.tf = control[["fwd.tf"]], 
+        deriv.fwd.tf = control[["deriv.fwd.tf"]],
+        bwd.tf = control[["bwd.tf"]], 
+        safe.param = control[["safe.param"]],
+        tuning.psi = tuning.psi,
+        cov.bhat = control[["cov.bhat"]], full.cov.bhat = control[["full.cov.bhat"]],
+        cov.betahat = control[["cov.betahat"]], 
+        cov.bhat.betahat = control[["cov.bhat.betahat"]],
+        cov.delta.bhat = control[["cov.delta.bhat"]],
+        full.cov.delta.bhat = control[["full.cov.delta.bhat"]],
+        cov.delta.bhat.betahat = control[["cov.delta.bhat.betahat"]],
+        cov.ehat = control[["cov.ehat"]], full.cov.ehat = control[["full.cov.ehat"]],
+        cov.ehat.p.bhat = control[["cov.ehat.p.bhat"]], full.cov.ehat.p.bhat = control[["full.cov.ehat.p.bhat"]],
+        aux.cov.pred.target = control[["aux.cov.pred.target"]],
+        min.condnum = control[["min.condnum"]],
+        rankdef.x = rankdef.x,
+        psi.func = control[["psi.func"]],
+        tuning.psi.nr = control[["tuning.psi.nr"]],
+        irwls.initial = control[["irwls.initial"]],
+        irwls.maxiter = control[["irwls.maxiter"]],
+        irwls.reltol = control[["irwls.reltol"]],
+        force.gradient = control[["force.gradient"]],
+        zero.dist = control[["zero.dist"]],
+        nleqslv.method =  control[["nleqslv"]][["method"]],
+        nleqslv.control = control[["nleqslv"]][["control"]],
+        optim.method =  control[["optim"]][["method"]],
+        optim.lower = control[["optim"]][["lower"]],
+        optim.upper = control[["optim"]][["upper"]],
+        hessian =       control[["optim"]][["hessian"]],
+        optim.control = control[["optim"]][["control"]],
+        full.output = control[["full.output"]],
+        verbose = verbose
+      )
+      
+      param = t.georob[["param"]][names(fit.param)]
+      aniso = t.georob[["aniso"]][["aniso"]][names(fit.aniso)]
+      
+    }
     
-    if( verbose > 0 ) cat( 
-      "\ndiscarding", sum( !t.sel ), "of", length( t.sel ), 
-      "observations for computing initial estimates of variogram\nand anisotropy parameter by gaussian reml\n"
-    )
-    
-    ## collect.items for initial object
-    
-    initial.objects <- list(
-      x = as.matrix( x[t.sel, ] ),
-      y = yy[t.sel],
-      betahat = coef( r.initial.fit ),
-      bhat = if( is.null( control[["bhat"]] ) ){
-        rep( 0., length( yy ) )[t.sel]
-      } else {
-        control[["bhat"]][t.sel]
-      },
-      initial.fit = r.initial.fit,
-      locations.objects = list(
-        locations = locations,
-        coordinates = locations.coords[t.sel, ]
-      ),
-      isotropic = aniso.missing
-    )
-    
-    ## estimate model parameters with pruned data set
-    
-    t.georob <- georob.fit(
-      envir = envir,
-      initial.objects = initial.objects,
-      variogram.model = variogram.model, param = param, fit.param = fit.param,
-      aniso = aniso, fit.aniso = fit.aniso,
-      param.tf = control[["param.tf"]],
-      fwd.tf = control[["fwd.tf"]], 
-      deriv.fwd.tf = control[["deriv.fwd.tf"]],
-      bwd.tf = control[["bwd.tf"]], 
-      safe.param = control[["safe.param"]],
-      tuning.psi = control[["tuning.psi.nr"]],
-      cov.bhat = control[["cov.bhat"]], full.cov.bhat = control[["full.cov.bhat"]],
-      cov.betahat = control[["cov.betahat"]], 
-      cov.bhat.betahat = control[["cov.bhat.betahat"]],
-      cov.delta.bhat = control[["cov.delta.bhat"]],
-      full.cov.delta.bhat = control[["full.cov.delta.bhat"]],
-      cov.delta.bhat.betahat = control[["cov.delta.bhat.betahat"]],
-      cov.ehat = control[["cov.ehat"]], full.cov.ehat = control[["full.cov.ehat"]],
-      cov.ehat.p.bhat = control[["cov.ehat.p.bhat"]], full.cov.ehat.p.bhat = control[["full.cov.ehat.p.bhat"]],
-      aux.cov.pred.target = control[["aux.cov.pred.target"]],
-      min.condnum = control[["min.condnum"]],
-      rankdef.x = rankdef.x,
-      psi.func = control[["psi.func"]],
-      tuning.psi.nr = control[["tuning.psi.nr"]],
-      irwls.initial = control[["irwls.initial"]],
-      irwls.maxiter = control[["irwls.maxiter"]],
-      irwls.reltol = control[["irwls.reltol"]],
-      force.gradient = control[["force.gradient"]],
-      zero.dist = control[["zero.dist"]],
-      nleqslv.method =  control[["nleqslv"]][["method"]],
-      nleqslv.control = control[["nleqslv"]][["control"]],
-      optim.method =  control[["optim"]][["method"]],
-      optim.lower = control[["optim"]][["lower"]],
-      optim.upper = control[["optim"]][["upper"]],
-      hessian =       control[["optim"]][["hessian"]],
-      optim.control = control[["optim"]][["control"]],
-      full.output = control[["full.output"]],
-      verbose = verbose
-    )
-    
-    param = t.georob[["param"]][names(fit.param)]
-    aniso = t.georob[["aniso"]][["aniso"]][names(fit.aniso)]
-    
   }
   
   ## collect.items for initial object
@@ -420,8 +496,11 @@
   )
   
   ## estimate model parameters
-  
+
+  if( verbose > 0 ) cat( "computing final parameter estimates ...\n" )
+
   r.georob <- georob.fit(
+    slv = TRUE,
     envir = envir,
     initial.objects = initial.objects,
     variogram.model = variogram.model, param = param, fit.param = fit.param,

Modified: pkg/R/georob.private.functions.R
===================================================================
--- pkg/R/georob.private.functions.R	2013-07-09 11:15:07 UTC (rev 11)
+++ pkg/R/georob.private.functions.R	2013-07-10 09:02:14 UTC (rev 12)
@@ -2348,6 +2348,7 @@
 compute.estimating.equations <- 
   function(
     adjustable.param,
+    slv,
     envir,
     variogram.model, fixed.param, param.name, aniso.name,
     param.tf, bwd.tf, safe.param,
@@ -2589,7 +2590,19 @@
     
     assign( "lik.item", lik.item, pos = as.environment( envir ) )
     
-    return( eeq.emp / eeq.exp - 1. )
+    if( slv ){
+      return( eeq.emp / eeq.exp - 1. )
+    } else {
+      res <- sum( (eeq.emp / eeq.exp - 1.)^2 )
+      if( verbose > 1 ) cat( 
+        "  sum(EEQ^2)         :",
+        format( 
+          signif( res, digits = 7 ), 
+          scientific = TRUE, width = 14
+        ), "\n", sep = "" 
+      )
+      return( res )
+    }
     
   } else {
     
@@ -3155,6 +3168,7 @@
 
 georob.fit <- 
   function(
+    slv,
     envir,
     initial.objects,
     variogram.model, param, fit.param,
@@ -3535,10 +3549,10 @@
   
   if( fit.aniso["omega"] && aniso["f1"] == 1. ) aniso["f1"] <- aniso["f1"] - sqrt( .Machine$double.eps )
   if( fit.aniso["phi"] ){
-    if( aniso["f1"] == 1. ) aniso["f1"] <- aniso["f1"] - sqrt( .Machine$double.eps )
-    if( aniso["f2"] == 1. ) aniso["f2"] <- aniso["f2"] - sqrt( .Machine$double.eps )
+    if( aniso["f1"] == 1. ) aniso["f1"] <- aniso["f1"] - 0.0001
+    if( aniso["f2"] == 1. ) aniso["f2"] <- aniso["f2"] - 0.0001
   }
-  if( fit.aniso["zeta"] && aniso["f2"] == 1. ) aniso["f2"] <- aniso["f2"] - sqrt( .Machine$double.eps )
+  if( fit.aniso["zeta"] && aniso["f2"] == 1. ) aniso["f2"] <- aniso["f2"] - 0.0001
   
   ##  rearrange and check flags controlling anisotropy parameter fitting 
   
@@ -3607,7 +3621,7 @@
   if( !identical( t.exp[["message"]], "OK" ) ) stop( t.exp[["message"]] )
   expectations["dpsi"] <- t.exp[["value"]]
   if( verbose > 1 ) cat( 
-    "\nexpectation of psi'(epsilon/sigma)                             :", 
+    "\nexpectation of psi'(epsilon/sigma)                    :", 
     signif( expectations["dpsi"] ), "\n" 
   )
   
@@ -3624,81 +3638,181 @@
   if( !identical( t.exp[["message"]], "OK" ) ) stop( t.exp[["message"]] )
   expectations["psi2"] <- t.exp[["value"]]
   if( verbose > 1 ) cat( 
-    "expectation of (psi(epsilon/sigma))^2                          :", 
+    "expectation of (psi(epsilon/sigma))^2                 :", 
     signif( t.exp[["value"]] ), "\n" 
   )
   
-  
-  
   r.hessian <- NULL
   
   if( tuning.psi < tuning.psi.nr ) {
     
+    ## robust REML estimation
+    
     if( any( c( fit.param, fit.aniso ) ) ){
       
-      ##  some variogram parameters are fitted
+      ##  find roots of estimating equations
       
-      ##  find root of estimating equations
+      if( slv ){
       
-      r.root <- nleqslv(
-        x = c( 
-          transformed.param[ fit.param ], 
-          transformed.aniso[ fit.aniso ] 
-        ),
-        fn = compute.estimating.equations,
-        method = nleqslv.method,
-        control = nleqslv.control,
-        envir = envir,        
-        variogram.model = variogram.model,
-        fixed.param = c( 
-          transformed.param[ !fit.param ], 
-          transformed.aniso[ !fit.aniso ]
-        ),
-        param.name = param.name, 
-        aniso.name = aniso.name,
-        param.tf = param.tf,
-        bwd.tf = bwd.tf,
-        safe.param = safe.param,
-        lag.vectors = lag.vectors,
-        XX = XX, min.condnum = min.condnum, rankdef.x = rankdef.x,
-        yy = yy, betahat = betahat, TT = TT, bhat = bhat, 
-        psi.function = rho.psi.etc[["psi.function"]], 
-        dpsi.function = rho.psi.etc[["dpsi.function"]], 
-        tuning.psi = tuning.psi,
-        tuning.psi.nr = tuning.psi.nr,
-        irwls.initial = irwls.initial,
-        irwls.maxiter = irwls.maxiter,
-        irwls.reltol = irwls.reltol,
-        force.gradient = force.gradient,
-        expectations = expectations,
-        verbose = verbose
-      ) 
+        r.root <- nleqslv(
+          x = c( 
+            transformed.param[ fit.param ], 
+            transformed.aniso[ fit.aniso ] 
+          ),
+          fn = compute.estimating.equations,
+          method = nleqslv.method,
+          control = nleqslv.control,
+          slv = slv,
+          envir = envir,        
+          variogram.model = variogram.model,
+          fixed.param = c( 
+            transformed.param[ !fit.param ], 
+            transformed.aniso[ !fit.aniso ]
+          ),
+          param.name = param.name, 
+          aniso.name = aniso.name,
+          param.tf = param.tf,
+          bwd.tf = bwd.tf,
+          safe.param = safe.param,
+          lag.vectors = lag.vectors,
+          XX = XX, min.condnum = min.condnum, rankdef.x = rankdef.x,
+          yy = yy, betahat = betahat, TT = TT, bhat = bhat, 
+          psi.function = rho.psi.etc[["psi.function"]], 
+          dpsi.function = rho.psi.etc[["dpsi.function"]], 
+          tuning.psi = tuning.psi,
+          tuning.psi.nr = tuning.psi.nr,
+          irwls.initial = irwls.initial,
+          irwls.maxiter = irwls.maxiter,
+          irwls.reltol = irwls.reltol,
+          force.gradient = force.gradient,
+          expectations = expectations,
+          verbose = verbose
+        ) 
+        
+        #       r.param <- r.root[["x"]] names( r.param ) <- names(
+        #       transformed.param[ fit.param ] )
+        
+        r.gradient <- r.root[["fvec"]]
+        names( r.gradient ) <- c(
+          names( transformed.param[ fit.param ] ),
+          names( transformed.aniso[ fit.aniso ] )
+        )
+        
+        r.converged <- r.root[["termcd"]] == 1
+        r.convergence.code <- r.root[["termcd"]] 
+        
+        r.counts <- c( nfcnt = r.root[["nfcnt"]], njcnt = r.root[["njcnt"]] )
+        
+      } else {
+        
+        ## minimize sum of squared estimating equations
+        
+        r.opt.eeq.sq <- optim(
+          par = c( 
+            transformed.param[ fit.param ], 
+            transformed.aniso[ fit.aniso ] 
+          ),
+          fn = compute.estimating.equations,
+          #         gr = gradient.negative.restricted.loglikelihood,
+          method = optim.method, 
+          lower = optim.lower,
+          upper = optim.upper,
+          control = optim.control,
+          hessian = FALSE,
+          slv = slv,
+          envir = envir,        
+          variogram.model = variogram.model,
+          fixed.param = c( 
+            transformed.param[ !fit.param ], 
+            transformed.aniso[ !fit.aniso ]
+          ),
+          param.name = param.name, 
+          aniso.name = aniso.name,
+          param.tf = param.tf,
+          bwd.tf = bwd.tf,
+          safe.param = safe.param,
+          lag.vectors = lag.vectors,
+          XX = XX, min.condnum = min.condnum, rankdef.x = rankdef.x,
+          yy = yy, betahat = betahat, TT = TT, bhat = bhat, 
+          psi.function = rho.psi.etc[["psi.function"]], 
+          dpsi.function = rho.psi.etc[["dpsi.function"]], 
+          tuning.psi = tuning.psi,
+          tuning.psi.nr = tuning.psi.nr,
+          irwls.initial = irwls.initial,
+          irwls.maxiter = irwls.maxiter,
+          irwls.reltol = irwls.reltol,
+          force.gradient = force.gradient,
+          expectations = expectations,
+          verbose = verbose
+        )
+        
+        r.opt.neg.loglik <- r.opt.eeq.sq[["value"]]     
+        r.converged <- r.opt.eeq.sq[["convergence"]] == 0
+        r.convergence.code <- r.opt.eeq.sq[["convergence"]]      
+        r.counts <- r.opt.eeq.sq[["counts"]]
+        
+        if( verbose > 0 ){
+          cat( 
+            "\n  sum(EEQ^2)         :",
+            format( 
+              signif( r.opt.eeq.sq[["value"]], digits = 7 ), 
+              scientific = TRUE, width = 14
+            ), sep = "" 
+          )
+          cat( 
+            "\n  convergence code   :", 
+            format( 
+              signif( r.opt.eeq.sq[["convergence"]], digits = 0 ), 
+              scientific = FALSE, width = 14
+            ), "\n\n", sep = "" 
+          )
+        }
+               
+        #         if( hessian ) r.hessian <- r.opt.eeq.sq[["hessian"]]
+        
+        r.gradient <- compute.estimating.equations(
+          adjustable.param = r.opt.eeq.sq[["par"]],
+          slv = TRUE,
+          envir = envir,        
+          variogram.model = variogram.model,
+          fixed.param = c( 
+            transformed.param[ !fit.param ], 
+            transformed.aniso[ !fit.aniso ]
+          ),
+          param.name = param.name, 
+          aniso.name = aniso.name,
+          param.tf = param.tf,
+          bwd.tf = bwd.tf,
+          safe.param = safe.param,
+          lag.vectors = lag.vectors,
+          XX = XX, min.condnum = min.condnum, rankdef.x = rankdef.x,
+          yy = yy, betahat = betahat, TT = TT, bhat = bhat, 
+          psi.function = rho.psi.etc[["psi.function"]], 
+          dpsi.function = rho.psi.etc[["dpsi.function"]], 
+          tuning.psi = tuning.psi,
+          tuning.psi.nr = tuning.psi.nr,
+          irwls.initial = irwls.initial,
+          irwls.maxiter = irwls.maxiter,
+          irwls.reltol = irwls.reltol,
+          force.gradient = force.gradient,
+          expectations = expectations,
+          verbose = verbose
+        )
+
+      }
       
-      #       r.param <- r.root[["x"]]
-      #       names( r.param ) <- names( transformed.param[ fit.param ] )
-      
-      r.gradient <- r.root[["fvec"]]
-      names( r.gradient ) <- c(
-        names( transformed.param[ fit.param ] ),
-        names( transformed.aniso[ fit.aniso ] )
-      )
-      
-      r.converged <- r.root[["termcd"]] == 1
-      r.convergence.code <- r.root[["termcd"]] 
-      
-      r.counts <- c( nfcnt = r.root[["nfcnt"]], njcnt = r.root[["njcnt"]] )
-      
     } else {
       
       ##  all variogram parameters are fixed
       
-      ##  compute values of estimating equations
+      ##  evaluate estimating equations
       
       r.gradient <- compute.estimating.equations(
         adjustable.param = c( 
           transformed.param[ fit.param ], 
           transformed.aniso[ fit.aniso ] 
         ),
+        slv = TRUE,
         envir = envir,        
         variogram.model = variogram.model,
         fixed.param = c( 
@@ -3737,8 +3851,7 @@
     
     if( any( fit.param ) ){
       
-      ##  some variogram parameters are fitted
-      ##  minimize laplace approximation of negative restricted loglikelihood
+      ##  Gaussian REML estimation
       
       r.opt.neg.restricted.loglik <- optim(
         par = c( 
@@ -3786,7 +3899,6 @@
       
       if( hessian ) r.hessian <- r.opt.neg.restricted.loglik[["hessian"]]
       
-      
       r.gradient <- gradient.negative.restricted.loglikelihood(
         adjustable.param = r.opt.neg.restricted.loglik[["par"]],
         envir = envir,

Modified: pkg/man/cv.georob.Rd
===================================================================
--- pkg/man/cv.georob.Rd	2013-07-09 11:15:07 UTC (rev 11)
+++ pkg/man/cv.georob.Rd	2013-07-10 09:02:14 UTC (rev 12)
@@ -1,4 +1,4 @@
-% 2013-07-05 A. Papritz
+% 2013-07-10 A. Papritz
 % R CMD Rdconv -t html -o bla.html cv.georob.Rd ; open bla.html; R CMD Rd2pdf --force cv.georob.Rd; 
 
 \encoding{macintosh}
@@ -105,7 +105,7 @@
   
   \item{return.fit}{logical controlling whether information about the fit
   should be returned for when re-estimating the model with the reduced data
-  sets (default \code{TRUE}).}
+  sets (default \code{FALSE}).}
   
   \item{reduced.output}{logical controlling whether the complete fitted
   model objects, fitted to the reduced data sets, are returned

Modified: pkg/man/georob.Rd
===================================================================
--- pkg/man/georob.Rd	2013-07-09 11:15:07 UTC (rev 11)
+++ pkg/man/georob.Rd	2013-07-10 09:02:14 UTC (rev 12)
@@ -1,4 +1,4 @@
-% 2013-06-12 A. Papritz
+% 2013-07-10 A. Papritz
 % R CMD Rdconv -t html -o bla.html georob.Rd ; open bla.html; R CMD Rd2pdf --force georob.Rd; 
 
 \encoding{macintosh}
@@ -28,7 +28,8 @@
     aniso = c(f1 = 1, f2 = 1, omega = 90, phi = 90, zeta = 0), 
     fit.aniso = c(f1 = FALSE, f2 = FALSE, omega = FALSE, 
         phi = FALSE, zeta = FALSE), 
-    tuning.psi = 2, initial.param = TRUE, control = georob.control(...),
+    tuning.psi = 2, initial.param = c("minimize", "exclude", "no"), 
+    control = georob.control(...),
     verbose = 0, ...)
 }
 %
@@ -144,12 +145,21 @@
   \item{tuning.psi}{positive numeric.  The tuning constant \eqn{c} of the
     \eqn{\psi_c}-function of the robust REML algorithm.}
     
-  \item{initial.param}{logical.  If \code{TRUE} (default) robust initial
-  values of variogram parameters are computed by discarding outlying
-  observations based on the \dQuote{robustness weights} of the initial fit
-  of the regression model by \code{\link[robustbase]{lmrob}} and fitting
-  the spatial linear model by Gaussian REML to the pruned data set (see
-  \emph{Details}).}
+  \item{initial.param}{character, controlling whether initial values of
+  parameters are computed for solving the estimating equations of the
+  variogram and anisotropy parameters.  
+  
+  If \code{initial.param = "minimize"} (defaullt) robust initial values are
+  computed by minimizing the sum of the squared robustified estimating
+  equations using \code{\link[stats]{optim}} (see \emph{Details}).
+  If \code{initial.param = "exclude"} robust initial values of parameters are
+  computed by discarding outlying observations based on the
+  \dQuote{robustness weights} of the initial fit of the regression model by
+  \code{\link[robustbase]{lmrob}} and fitting the spatial linear model by
+  Gaussian REML to the pruned data set (see \emph{Details}).  
+  For \code{initial.param = "no"} no initial parameter values are computed
+  and the estimating equations are solved with the initial values passed by
+  \code{param} and \code{aniso} to \code{georob}.}
     
   \item{control}{a list specifying parameters that control the behaviour of
   \code{georob}.  Use the function \code{\link{georob.control}} and see its
@@ -308,13 +318,21 @@
     }
   
     Finding the roots of the robustified estimating equations of the
-    variogram parameters is more sensitive to a good choice of initial
-    values than maximizing the Gaussian restricted loglikelihood with
-    respect to the same parameters.  To get good initial values that are
-    often sufficiently close to the roots so that
-    \code{\link[nleqslv]{nleqslv}} converges, one can use
-    \code{initial.param = TRUE}.  This has the following effects:
+    variogram and anisotropy parameters is more sensitive to a good choice
+    of initial values than maximizing the Gaussian restricted loglikelihood
+    with respect to the same parameters.  Two options are implemented to
+    get good initial values that are often sufficiently close to the roots
+    so that \code{\link[nleqslv]{nleqslv}} converges:
     
+    Setting \code{initial.param = "minimize"} invokes
+    \code{\link[stats]{optim}} to minimize the \emph{sum of squared
+    estimating equations}.  The required accuracy of the initial estimates
+    are best controlled by the argument \code{abstol} of
+    \code{\link[stats]{optim}}, e.g. by using the argument
+    \code{control = georob.control(optim = optim.control(optim.control = list(abstol = 1.e-6)))}.
+    
+    Setting \code{initial.param = "exclude"} has the following effects:
+    
     \enumerate{
     
       \item Initial values of the regression parameters are computed by


From noreply at r-forge.r-project.org  Tue Jul 16 09:17:28 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue, 16 Jul 2013 09:17:28 +0200 (CEST)
Subject: [Georob-commits] r13 - in pkg: . R man
Message-ID: <20130716071728.AB5C61859D5@r-forge.r-project.org>

Author: papritz
Date: 2013-07-16 09:17:28 +0200 (Tue, 16 Jul 2013)
New Revision: 13

Modified:
   pkg/ChangeLog
   pkg/DESCRIPTION
   pkg/NAMESPACE
   pkg/R/georob.exported.functions.R
   pkg/R/georob.private.functions.R
   pkg/man/georob.Rd
   pkg/man/georob.control.Rd
Log:
solving estimating equations by BBsolve{BB} (in addition to nleqlsv)


Modified: pkg/ChangeLog
===================================================================
--- pkg/ChangeLog	2013-07-10 09:02:14 UTC (rev 12)
+++ pkg/ChangeLog	2013-07-16 07:17:28 UTC (rev 13)
@@ -131,3 +131,8 @@
 * georob.exported.functions.R (georob): computing robust initial variogram parameter estimates by minimizing sum of squared estimating equations
 * georob.private.functions.R (georob.fit, compute.estimating.equations): computing robust initial variogram parameter estimates by minimizing sum of squared estimating equations
 
+
+2013-07-12  Andreas Papritz  <papritz at env.ethz.ch>
+
+* georob.exported.functions.R (georob, georob.control, bbsolve.control): solving estimating equations by BBsolve{BB} (in addition to nleqlsv)
+* georob.private.functions.R (compute.estimating.equations, compute.expanded.estimating.equations, estimating.eqations.xihat, estimate.xihat, georob.fit, gradient.negative.restricted.loglikelihood, negative.restr.loglikelihood, prepare.likelihood.calculations): solving estimating equations by BBsolve{BB} (in addition to nleqlsv)

Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2013-07-10 09:02:14 UTC (rev 12)
+++ pkg/DESCRIPTION	2013-07-16 07:17:28 UTC (rev 13)
@@ -8,7 +8,7 @@
           email =  "andreas.papritz at env.ethz.ch" ),
   person( "Cornelia", "Schwierz", role = "ctb" ))
 Depends: R(>= 2.14.0), lmtest, nlme, robustbase, sp(>= 0.9-60)
-Imports: constrainedKriging(>= 0.1-9), nleqslv, quantreg, 
+Imports: BB, constrainedKriging(>= 0.2-1), nleqslv, quantreg, 
          RandomFields(>= 2.0.55), spatialCovariance(>= 0.6-4)
 Suggests: geoR
 Description: The georob package provides functions for fitting linear models 

Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE	2013-07-10 09:02:14 UTC (rev 12)
+++ pkg/NAMESPACE	2013-07-16 07:17:28 UTC (rev 13)
@@ -1,5 +1,6 @@
 import( stats, parallel )
 
+importFrom( BB, BBsolve )
 importFrom( constrainedKriging, covmodel, f.point.block.cov, K, preCKrige )
 importFrom( lmtest, waldtest, waldtest.default )
 importFrom( nlme, fixef, fixed.effects, ranef, random.effects )
@@ -10,6 +11,7 @@
 # exported functions
 
 export(
+  bbsolve.control,                  # ok
   bwd.transf,                       # ok
   compress,                         # ok
   cv,                               # ok
@@ -75,8 +77,10 @@
 ##
 ##   compute.covariances,
 ##   compute.estimating.equations,
+##   compute.expanded.estimating.equations,
 ##   compute.semivariance,
 ##   dcorr.dparam,
+##   estimating.eqations.xihat,
 ##   estimate.xihat,
 ##   gcr,
 ##   georob.fit,

Modified: pkg/R/georob.exported.functions.R
===================================================================
--- pkg/R/georob.exported.functions.R	2013-07-10 09:02:14 UTC (rev 12)
+++ pkg/R/georob.exported.functions.R	2013-07-16 07:17:28 UTC (rev 13)
@@ -19,6 +19,7 @@
     aniso = c( f1 = 1., f2 = 1., omega = 90., phi = 90., zeta = 0. ),
     fit.aniso = c( f1 = FALSE, f2 = FALSE, omega = FALSE, phi = FALSE, zeta = FALSE ),
     tuning.psi = 2, initial.param  = c( "minimize", "exclude", "no" ),
+    root.finding = c( "nleqslv", "bbsolve" ),
     control = georob.control( ... ), verbose = 0,
     ...
   )
@@ -78,6 +79,7 @@
   ## 2013-06-03 AP handling design matrices with rank < ncol(x)
   ## 2013-06-12 AP substituting [["x"]] for $x in all lists
   ## 2013-07-02 AP new transformation of rotation angles
+  ## 2013-07-12 AP solving estimating equations by BBsolve{BB} (in addition to nleqlsv)
   
   ## check whether input is complete
   
@@ -315,11 +317,11 @@
   
   aniso.missing <- missing( aniso ) && missing( fit.aniso )
   
-  ## prune data set for computing initial values of variogram and
-  ## anisotropy parameters by reml
-  
   initial.param <- match.arg( initial.param )
+  root.finding <- match.arg( root.finding )
   
+  ## compute initial values of variogram and anisotropy parameters
+  
   if( tuning.psi < control[["tuning.psi.nr"]] ){
         
     if( identical( initial.param, "exclude" ) ){
@@ -362,6 +364,7 @@
       ## estimate model parameters with pruned data set
       
       t.georob <- georob.fit(
+        root.finding = root.finding,
         slv = TRUE,
         envir = envir,
         initial.objects = initial.objects,
@@ -393,6 +396,8 @@
         zero.dist = control[["zero.dist"]],
         nleqslv.method =  control[["nleqslv"]][["method"]],
         nleqslv.control = control[["nleqslv"]][["control"]],
+        bbsolve.method =  control[["bbsolve"]][["method"]],
+        bbsolve.control = control[["bbsolve"]][["control"]],
         optim.method =  control[["optim"]][["method"]],
         optim.lower = control[["optim"]][["lower"]],
         optim.upper = control[["optim"]][["upper"]],
@@ -429,6 +434,7 @@
       ## estimate model parameters by minimizing sum( gradient^2)
       
       t.georob <- georob.fit(
+        root.finding = root.finding,
         slv = FALSE,
         envir = envir,
         initial.objects = initial.objects,
@@ -460,6 +466,8 @@
         zero.dist = control[["zero.dist"]],
         nleqslv.method =  control[["nleqslv"]][["method"]],
         nleqslv.control = control[["nleqslv"]][["control"]],
+        bbsolve.method =  control[["bbsolve"]][["method"]],
+        bbsolve.control = control[["bbsolve"]][["control"]],
         optim.method =  control[["optim"]][["method"]],
         optim.lower = control[["optim"]][["lower"]],
         optim.upper = control[["optim"]][["upper"]],
@@ -500,6 +508,7 @@
   if( verbose > 0 ) cat( "computing final parameter estimates ...\n" )
 
   r.georob <- georob.fit(
+    root.finding = root.finding,
     slv = TRUE,
     envir = envir,
     initial.objects = initial.objects,
@@ -531,6 +540,8 @@
     zero.dist = control[["zero.dist"]],
     nleqslv.method =  control[["nleqslv"]][["method"]],
     nleqslv.control = control[["nleqslv"]][["control"]],
+    bbsolve.method =  control[["bbsolve"]][["method"]],
+    bbsolve.control = control[["bbsolve"]][["control"]],
     optim.method =  control[["optim"]][["method"]],
     optim.lower = control[["optim"]][["lower"]],
     optim.upper = control[["optim"]][["upper"]],
@@ -611,75 +622,23 @@
     rq = rq.control(),
     lmrob = lmrob.control(),
     nleqslv = nleqslv.control(),
+    bbsolve = bbsolve.control(),
     optim = optim.control(),
     full.output = TRUE
   )
 {
   
   ## auxiliary function to set meaningful default values for the
-  ## arguments of the function georob.fit
+
+  ## Arguments: 
   
-  ## Arguments:
-  
-  ## initial.method    character scalar, controlling how the intitial estimate of the fixed-effects
-  ##                   parameters are computed, possible values are 
-  ##                   "rq"    to use rq{quantreg},
-  ##                   "lmrob" to use lmrob{robustbase},
-  ## param.tf       list, used to pass arguents to param.tf{georob}
-  ##                   parameters, implemented values are "log" or "identity" (no transformation)
-  ## fwd.tf
-  ## rho.function      character, defining the rho/psi functions family
-  ## tuning.psi.nr numeric, if tuning.psi exceeds tuning.psi.nr for
-  ##                   logistic or huber rho.function then only one IRWLS iteration is executed
-  ##                   to estimate beta and z
-  ## min.rweight  minimum robustness weights of lmrob fit required for 
-  ##                   including an observations into the pruned data set from which initial values
-  ##                   of variogram and anisotropy parameters are computed by Gaussian REML
-  ## irwls.initial  logical, flag controlling whether IRWLS starts from the lmrob 
-  ##                   estimates of beta and from z=0 (TRUE) or from the previous IRWLS results
-  ## irwls.maxiter     integer, maximum number of IRWLS steps
-  ## irwls.reltol      numeric, relative convergence tolerance for IRWLS, see optim{stats}
-  ## force.gradient    logical, flag controlling whether the gradient (REML) or the
-  ##                   estimation equations should be evaluated if all variogram parameter are 
-  ##                   fixed
-  ## zero.dist         observations from sampling locations less than zero.dist apart will be 
-  ##				   considered as multiple observations from same location
-  ## cov.bhat        logical, flag controlling whether the covariances of bhat should be computed
-  ## full.cov.bhat   logical, flag controlling whether the full covariance matrix of bhat 
-  ##                   is computed (TRUE) or only the diagonal elements (FALSE)
-  ## cov.betahat     logical, flag controlling whether the covariance matrix of betahat 
-  ##                   should be computed
-  ## cov.bhat.betahat  logical, flag controlling whether the covariance matrix of 
-  ##                   bhat and betahat should be computed
-  ## cov.delta.bhat      logical, flag controlling whether the covariances of z-bhat should be computed
-  ## full.cov.delta.bhat logical, flag controlling whether the full covariance matrix of z-bhat 
-  ##                   is computed (TRUE) or only the diagonal elements (FALSE)
-  ## cov.delta.bhat.betahat    logical, flag controlling whether the covariance matrix of z-bhat
-  ##                    and betahat should be computed
-  ## cov.ehat        logical, flag controlling whether the covariances of the resdiuals should be computed
-  ## full.cov.ehat   logical, flag controlling whether the full covariance matrix of the residuals 
-  ##                   is computed (TRUE) or only the diagonal elements (FALSE)
-  ## cov.ehat.p.bhat       logical, flag controlling whether the covariances of the resdiuals+bhat should be computed
-  ## full.cov.ehat.p.bhat  logical, flag controlling whether the full covariance matrix of the resdiuals+bhat 
-  ##                   is computed (TRUE) or only the diagonal elements (FALSE)
-  ## aux.cov.pred.target  logical, flag controlling whether the auxiliary matrix for computing the covariances
-  ##                   of the predicted and true y should be computed
-  ##                   is computed (TRUE) or only the diagonal elements (FALSE)
-  ## min.condnum       minimum condition number for a matrix to be numerically non-singular
-  ## rq                list, see rq{quantreg}
-  ## lmrob             list, see lmrob.control{robustbase}
-  ## nleqslv           list, used to pass arguent to nleqslv, see nleqslv.control{georob}
-  ## optim             list, used to pass arguments to optim, see optim.control{georob}
-  ## full.output       logical, flag used to control the amount of output returned by georob, warning:
-  ##                   is TRUE then the output will not contain all required items required by some methods
-  
-  
   ## 2012-04-21 A. Papritz   
   ## 2012-05-03 AP bounds for safe parameter values
   ## 2012-05-04 AP modifications for lognormal block kriging
   ## 2013-04-23 AP new names for robustness weights
   ## 2013-06-12 AP changes in stored items of Valpha object
   ## 2013-06-12 AP substituting [["x"]] for $x in all lists
+  ## 2013-07-12 AP solving estimating equations by BBsolve{BB} (in addition to nleqlsv)
   
   if( 
     !( all( param.tf %in% names( fwd.tf ) ) &&
@@ -712,7 +671,7 @@
     aux.cov.pred.target = aux.cov.pred.target,
     min.condnum = min.condnum,
     irf.models = c( "DeWijsian", "fractalB", "genB" ),
-    rq = rq, lmrob = lmrob, nleqslv = nleqslv, optim = optim, 
+    rq = rq, lmrob = lmrob, nleqslv = nleqslv, bbsolve = bbsolve, optim = optim, 
     full.output = full.output
   )
   
@@ -834,10 +793,8 @@
   ## function sets meaningful defaults for selected arguments of function
   ## nleqslv{nleqslv} 
   
-  ## 2012-12-14 A. Papritz
+  ## 2013-07-12 A. Papritz
   
-  aux <- function( trace = 0, ... ) list( trace = trace, ... )
-  
   list( 
     method = match.arg( nleqslv.method ),
     global = match.arg( global ),
@@ -847,6 +804,25 @@
 }
 
 ## ======================================================================
+bbsolve.control <-
+  function( 
+    bbsolve.method = c( "2", "3", "1" ), 
+    bbsolve.control = NULL
+  )
+{
+  
+  ## function sets meaningful defaults for selected arguments of function
+  ## BBSolve{BB} 
+  
+  ## 2013-07-12 A. Papritz
+  
+  list( 
+    method = as.integer( match.arg( bbsolve.method ) ),
+    control = bbsolve.control
+  )
+}
+
+## ======================================================================
 optim.control <-
   function( 
     optim.method = c( "BFGS", "Nelder-Mead", "CG", "L-BFGS-B", "SANN", "Brent" ),

Modified: pkg/R/georob.private.functions.R
===================================================================
--- pkg/R/georob.private.functions.R	2013-07-10 09:02:14 UTC (rev 12)
+++ pkg/R/georob.private.functions.R	2013-07-16 07:17:28 UTC (rev 13)
@@ -795,11 +795,35 @@
   
 }
 
+
 ##    ##############################################################################
 
+estimating.eqations.xihat <- function( 
+  res, TT, xihat, nugget, eta, Valpha.inverse.Palpha, 
+  psi.function, tuning.psi
+){
+  
+  ## auxiliary function to compute estimating equations for xihat
+
+  ## 2013-07-12 AP solving estimating equations by BBsolve{BB} (in addition to nleqlsv)
+
+  Ttpsi <- psi.function( res / sqrt( nugget ), tuning.psi )
+  TtT   <- rep( 1, length( Ttpsi ) )      
+  
+  if( sum( duplicated( TT ) > 0 ) ){
+    Ttpsi <- as.vector( tapply( Ttpsi, factor( TT ), sum ) )
+    TtT   <- as.vector( table( TT ) )
+  }
+  
+  Ttpsi - drop( Valpha.inverse.Palpha %*% xihat ) / sqrt( nugget ) / eta
+}
+
+##    ##############################################################################
+
 estimate.xihat <- 
   function(
-    XX, min.condnum, rankdef.x, yy, betahat, TT, xihat, 
+    compute.xihat,
+    XX, min.condnum, rankdef.x, yy, TT, xihat, 
     psi.function, tuning.psi, tuning.psi.nr, 
     maxit, reltol,
     nugget, eta, Valpha.inverse,
@@ -810,30 +834,13 @@
   ## 2013-02-04 AP solving estimating equations for xi
   ## 2013-06-03 AP handling design matrices with rank < ncol(x)
   ## 2013-06-12 AP substituting [["x"]] for $x in all lists
+  ## 2013-07-12 AP solving estimating equations by BBsolve{BB} (in addition to nleqlsv)
    
   ## function computes (1) estimates xihat, bhat, betahat by
   ## solving robustified estimating equations by IRWLS,
   ## (2) the weights of the IRWLS, (3) the unstandardized residuals
   ## (= estimated epsilons); the results are returned as a list
   
-  ## auxiliary function to compute estimating equations for xihat
-  
-  f.eeq <- function( 
-    res, TT, xihat, nugget, eta, Valpha.inverse.Palpha, 
-    psi.function, tuning.psi
-  ){
-    
-    Ttpsi <- psi.function( res / sqrt( nugget ), tuning.psi )
-    TtT   <- rep( 1, length( Ttpsi ) )      
-    
-    if( sum( duplicated( TT ) > 0 ) ){
-      Ttpsi <- as.vector( tapply( Ttpsi, factor( TT ), sum ) )
-      TtT   <- as.vector( table( TT ) )
-    }
-    
-    Ttpsi - drop( Valpha.inverse.Palpha %*% xihat ) / sqrt( nugget ) / eta
-  }
-  
   ##  compute projection matrix Palpha and related items
   
   result <- list( error = FALSE )
@@ -866,102 +873,122 @@
   rownames( result[["Valpha.inverse.Palpha"]] ) <- rownames( XX )
   colnames( result[["Valpha.inverse.Palpha"]] ) <- rownames( XX )
   
-  ##  initialization
+  if( compute.xihat ){
   
-  res <- yy - xihat[TT]
-  
-  eeq.old <- f.eeq(     
-    res, TT, xihat, nugget, eta, result[["Valpha.inverse.Palpha"]], 
-    psi.function, tuning.psi
-  )
-  eeq.old.l2 <- sum( eeq.old^2 )
-
-  if( !is.finite( eeq.old.l2 ) ) {
-    result[["error"]] <- TRUE
-    return( result )
-  }
-  
-  converged <- FALSE
-  
-  if( verbose > 2 ) cat(
-    "\n  IRWLS\n",
-    "      it        L2.old        L2.new      delta.L2\n", sep = ""
-  )
-  
-  ##  IRWLS
-  
-  for( i in 1:maxit ){
+    ##  initialization
     
-    ##  compute new estimates 
+    res <- yy - xihat[TT]
     
-    new <- update.xihat(
-      XX, yy, res, TT, 
-      nugget, eta, 
-      result[["Valpha.inverse.Palpha"]],
-      psi.function, tuning.psi, 
-      verbose
+    eeq.old <- estimating.eqations.xihat(     
+      res, TT, xihat, nugget, eta, result[["Valpha.inverse.Palpha"]], 
+      psi.function, tuning.psi
     )
+    eeq.old.l2 <- sum( eeq.old^2 )
     
-    if( new[["error"]] ) {
+    if( !is.finite( eeq.old.l2 ) ) {
       result[["error"]] <- TRUE
       return( result )
     }
     
+    converged <- FALSE
     
-    ##  evaluate estimating equations for xi and compute its l2 norm
-    
-    eeq.new <- f.eeq(       
-      new[["residuals"]], TT, new[["xihat"]], nugget, eta, result[["Valpha.inverse.Palpha"]], 
-      psi.function, tuning.psi
+    if( verbose > 2 ) cat(
+      "\n  IRWLS\n",
+      "      it        L2.old        L2.new      delta.L2\n", sep = ""
     )
-    eeq.new.l2 <- sum( eeq.new^2 )
     
-    if( !is.finite( eeq.new.l2 ) ) {
-      result[["error"]] <- TRUE
-      return( result )
+    ##  IRWLS
+    
+    for( i in 1:maxit ){
+      
+      ##  compute new estimates 
+      
+      new <- update.xihat(
+        XX, yy, res, TT, 
+        nugget, eta, 
+        result[["Valpha.inverse.Palpha"]],
+        psi.function, tuning.psi, 
+        verbose
+      )
+      
+      if( new[["error"]] ) {
+        result[["error"]] <- TRUE
+        return( result )
+      }
+      
+      
+      ##  evaluate estimating equations for xi and compute its l2 norm
+      
+      eeq.new <- estimating.eqations.xihat(       
+        new[["residuals"]], TT, new[["xihat"]], nugget, eta, result[["Valpha.inverse.Palpha"]], 
+        psi.function, tuning.psi
+      )
+      eeq.new.l2 <- sum( eeq.new^2 )
+      
+      if( !is.finite( eeq.new.l2 ) ) {
+        result[["error"]] <- TRUE
+        return( result )
+      }
+      
+      if( verbose > 2 ) cat( 
+        format( i, width = 8 ),
+        format( 
+          signif( 
+            c( eeq.old.l2, eeq.new.l2, eeq.old.l2 - eeq.new.l2 ), digits = 7 
+          ), scientific = TRUE, width = 14 
+        ), "\n", sep = ""
+      )
+      
+      ##  check for convergence (cf. help( optim ) )
+      
+      if( max( abs( res - new[["residuals"]] ) ) < sqrt(  reltol ) * sqrt( nugget ) ) {
+        converged <- TRUE
+        break
+      }
+      
+      ##  update xihat, residuals and eeq.old.l2
+      
+      eeq.old.l2 <- eeq.new.l2
+      xihat      <- new[["xihat"]]
+      res        <- new[["residuals"]]
+      
     }
     
-    if( verbose > 2 ) cat( 
-      format( i, width = 8 ),
-      format( 
-        signif( 
-          c( eeq.old.l2, eeq.new.l2, eeq.old.l2 - eeq.new.l2 ), digits = 7 
-        ), scientific = TRUE, width = 14 
-      ), "\n", sep = ""
-    )
+    ##  collect output
     
-    ##  check for convergence (cf. help( optim ) )
-
-    if( max( abs( res - new[["residuals"]] ) ) < sqrt(  reltol ) * sqrt( nugget ) ) {
-      converged <- TRUE
-      break
-    }
+    result[["xihat"]]            <- new[["xihat"]]
+    names( result[["xihat"]] )   <- rownames( XX )
     
-    ##  update xihat, residuals and eeq.old.l2
+    result[["residuals"]]        <- new[["residuals"]]
+    result[["rweights"]]         <- new[["rweights"]]
+    result[["converged"]]        <- converged
+    result[["nit"]]              <- i
     
-    eeq.old.l2 <- eeq.new.l2
-    xihat      <- new[["xihat"]]
-    res        <- new[["residuals"]]
+  } else {
     
+    result[["xihat"]]            <- xihat
+    names( result[["xihat"]] )   <- rownames( XX )
+    
+    result[["residuals"]]        <- yy - xihat[TT]
+    
+    result[["rweights"]]         <- ifelse( 
+      abs( std.res <- result[["residuals"]] / sqrt( nugget ) ) < sqrt( .Machine[["double.eps"]] ),
+      1.,
+      psi.function( std.res, tuning.psi ) / std.res
+    )
+    result[["converged"]]        <- NA
+    result[["nit"]]              <- NA_integer_
+    
   }
   
-  ##  collect output
-  
-  result[["xihat"]]            <- new[["xihat"]]
-  names( result[["xihat"]] )   <- rownames( XX )
-  
   result[["bhat"]]             <- drop( result[["Palpha"]] %*% result[["xihat"]] )
   names( result[["bhat"]] )    <- rownames( XX )
   
   result[["betahat"]]          <- drop( result[["Aalpha"]] %*% result[["xihat"]] )
   names( result[["betahat"]] ) <- colnames( XX )
   
-  result[["residuals"]]        <- new[["residuals"]]
-  result[["rweights"]]         <- new[["rweights"]]
   result[["z.star"]]           <- drop( Valpha.inverse %*% result[["bhat"]] )
-  result[["converged"]]        <- converged
-  result[["nit"]]              <- i
-  
+
   return( result )
   
 }
@@ -1065,9 +1092,10 @@
     adjustable.param, variogram.model, fixed.param, param.name, aniso.name,
     param.tf, bwd.tf, safe.param,
     lag.vectors,
-    XX, min.condnum, rankdef.x, yy, betahat, TT, bhat, 
+    XX, min.condnum, rankdef.x, yy, TT, xihat, 
     psi.function, dpsi.function, tuning.psi, tuning.psi.nr, 
     irwls.initial, irwls.maxiter, irwls.reltol,
+    compute.xihat = TRUE,
     compute.Q,
     verbose
   )
@@ -1084,6 +1112,7 @@
   ## 2013-02-04 AP solving estimating equations for xi
   ## 2013-06-12 AP substituting [["x"]] for $x in all lists
   ## 2013-07-02 AP new transformation of rotation angles
+  ## 2013-07-12 AP solving estimating equations by BBsolve{BB} (in addition to nleqlsv)
   
   ##  function transforms (1) the variogram parameters back to their
   ##  original scale; computes (2) the correlation matrix, its inverse
@@ -1286,15 +1315,14 @@
     ##  irwls iteration from initial.object or from previous iteration
     
     if( 
-      !irwls.initial && !is.null( lik.item[["effects"]][["betahat"]] ) &&  
-      !is.null( lik.item[["effects"]][["bhat"]] )
+      !irwls.initial && !is.null( lik.item[["effects"]][["xihat"]] ) 
     ){
-      betahat <- lik.item[["effects"]][["betahat"]]
-      bhat <- lik.item[["effects"]][["bhat"]]
+      xihat <- lik.item[["effects"]][["xihat"]]
     }
     
     lik.item[["effects"]] <- estimate.xihat( 
-      XX, min.condnum, rankdef.x, yy, betahat, TT, bhat, 
+      compute.xihat,
+      XX, min.condnum, rankdef.x, yy, TT, xihat, 
       psi.function, tuning.psi, tuning.psi.nr, 
       irwls.maxiter, irwls.reltol,
       lik.item[["param"]]["nugget"], lik.item[["eta"]], lik.item[["Valpha"]][["Valpha.inverse"]],
@@ -2353,7 +2381,7 @@
     variogram.model, fixed.param, param.name, aniso.name,
     param.tf, bwd.tf, safe.param,
     lag.vectors,
-    XX, min.condnum, rankdef.x, yy, betahat, TT, bhat, 
+    XX, min.condnum, rankdef.x, yy, TT, xihat, 
     psi.function, dpsi.function, 
     tuning.psi, tuning.psi.nr,
     irwls.initial, irwls.maxiter, irwls.reltol,
@@ -2373,6 +2401,7 @@
   ## 2013-04-23 AP new names for robustness weights
   ## 2013-05-06 AP changes for solving estimating equations for xi
   ## 2013-06-12 AP substituting [["x"]] for $x in all lists
+  ## 2013-07-12 AP solving estimating equations by BBsolve{BB} (in addition to nleqlsv)
 
   ##  get lik.item
   
@@ -2381,11 +2410,11 @@
     adjustable.param, variogram.model, fixed.param, param.name, aniso.name,
     param.tf, bwd.tf, safe.param,
     lag.vectors,
-    XX, min.condnum, rankdef.x, yy, betahat, TT, bhat, 
+    XX, min.condnum, rankdef.x, yy, TT, xihat, 
     psi.function, dpsi.function, tuning.psi, tuning.psi.nr,
     irwls.initial, irwls.maxiter, irwls.reltol,
-    compute.Q = FALSE,
-    verbose
+    compute.xihat = TRUE, compute.Q = FALSE,
+    verbose = verbose
   )
   
   ##  check whether generalized covariance matrix is positive definite
@@ -2617,6 +2646,267 @@
 
 ##   ##############################################################################
 
+compute.expanded.estimating.equations <- 
+  function(
+    allpar,
+    slv,
+    envir,
+    variogram.model, fixed.param, param.name, aniso.name,
+    param.tf, bwd.tf, safe.param,
+    lag.vectors,
+    XX, min.condnum, rankdef.x, yy, TT, 
+    psi.function, dpsi.function, 
+    tuning.psi, tuning.psi.nr,
+    irwls.initial, irwls.maxiter, irwls.reltol,
+    force.gradient,
+    expectations,
+    verbose
+  )
+{
+  
+  ## function evaluates the robustified estimating equations of
+  ## variogram parameters derived from the Gaussian log-likelihood
+  
+  ## 2013-07-12 AP solving estimating equations by BBsolve{BB} (in addition to nleqlsv)
+  
+  ## select xihat and variogram parameters
+  
+  xihat <- allpar[ 1:NROW(XX) ]
+  adjustable.param <- allpar[ -(1:NROW(XX)) ]
+
+  ##  get lik.item
+  
+  lik.item <- prepare.likelihood.calculations(
+    envir,
+    adjustable.param, variogram.model, fixed.param, param.name, aniso.name,
+    param.tf, bwd.tf, safe.param,
+    lag.vectors,
+    XX, min.condnum, rankdef.x, yy, TT, xihat, 
+    psi.function, dpsi.function, tuning.psi, tuning.psi.nr,
+    irwls.initial, irwls.maxiter, irwls.reltol,
+    compute.xihat = FALSE, compute.Q = FALSE,
+    verbose
+  )
+  
+  ##  check whether generalized covariance matrix is positive definite
+  
+  if( lik.item[["Valpha"]][["error"]] ) {
+    if( verbose > 0 ) cat(
+      "\n(generalized) correlation matrix Valpha is not positive definite\n"
+    )
+    t.result <- rep( Inf, length( adjustable.param ) )
+    names( t.result ) <- names( adjustable.param )
+    return( t.result )
+  }
+    
+  ##  check whether estimating equations should be computed for fixed parameters
+  
+  if( length( adjustable.param ) == 0 && force.gradient ){
+    adjustable.param <- fixed.param
+  }
+  
+  ##  evaluate estimating equations
+  
+  ##  compute auxiliary items
+  
+  TtT <- as.vector( table( TT ) )
+  
+  ##  compute Cov[bhat]
+  
+  r.cov <- compute.covariances(
+    Valpha.objects = lik.item[["Valpha"]],
+    Aalpha = lik.item[["effects"]][["Aalpha"]],
+    Palpha = lik.item[["effects"]][["Palpha"]],
+    rweights = lik.item[["effects"]][["rweights"]],
+    XX = XX, TT = TT, names.yy = names( yy ),
+    nugget = lik.item[["param"]]["nugget"],
+    eta = lik.item[["eta"]],
+    expectations = expectations,
+    cov.bhat = TRUE, full.cov.bhat = TRUE,
+    cov.betahat = FALSE,
+    cov.bhat.betahat = FALSE,
+    cov.delta.bhat = FALSE, full.cov.delta.bhat = FALSE,
+    cov.delta.bhat.betahat = FALSE,
+    cov.ehat = FALSE, full.cov.ehat = FALSE,
+    cov.ehat.p.bhat = FALSE, full.cov.ehat.p.bhat = FALSE,
+    aux.cov.pred.target = FALSE,
+    extended.output = FALSE,
+    verbose = verbose
+  )
+  
+  if( r.cov[["error"]] ) {
+    if( verbose > 0 ) cat(
+      "\nan error occurred when computing the covariances of fixed and random effects\n"
+    )
+    t.result <- rep( Inf, length( adjustable.param ) )
+    names( t.result ) <- names( adjustable.param )
+    return( t.result )
+  }
+  
+  ## estimating equations for xihat
+  
+  eeq.xihat <- estimating.eqations.xihat(
+    res = lik.item[["effects"]][["residuals"]],
+    TT = TT, xihat = xihat, 
+    nugget = lik.item[["param"]]["nugget"],
+    eta = lik.item[["eta"]],
+    Valpha.inverse.Palpha = lik.item[["effects"]][["Valpha.inverse.Palpha"]],
+    psi.function = psi.function, 
+    tuning.psi = tuning.psi  
+  )
+  
+  ##  initialize estimating equations for variogram parameters
+  
+  eeq.emp <- rep( NA, length( adjustable.param ) )
+  names( eeq.emp ) <- names( adjustable.param )
+  
+  eeq.exp <- rep( NA, length( adjustable.param ) )
+  names( eeq.exp ) <- names( adjustable.param )
+  
+  ##  estimation equation for nugget
+  
+  if( "nugget" %in% names( adjustable.param ) ) {
+    
+    ##  compute trace of Cov[ psi( residuals/sqrt(nugget) ) ]
+    
+    eeq.exp["nugget"] <- sum( 
+      diag( 
+        lik.item[["Valpha"]][["Valpha.inverse"]] %*%             
+        ( 1/TtT * lik.item[["Valpha"]][["Valpha.inverse"]] ) %*% 
+        r.cov[["cov.bhat"]] 
+      ) 
+    )
+    eeq.emp["nugget"] <- sum( 
+      ( lik.item[["effects"]][["z.star"]] )^2 / TtT
+    )
+    
+  }
+  
+  ##  estimation equation for spatial nugget
+  
+  if( "snugget" %in% names( adjustable.param ) ) {
+    
+    ##  compute trace( Valpha^-1 Cov[bhat] )
+    
+    eeq.exp["snugget"] <- sum(
+      rowSums( 
+        (lik.item[["Valpha"]][["Valpha.inverse"]] %*% lik.item[["Valpha"]][["Valpha.inverse"]] ) * 
+        r.cov[["cov.bhat"]]
+      )
+    )
+    eeq.emp["snugget"] <- sum( lik.item[["effects"]][["z.star"]]^2 )
+    
+  }
+  
+  ##  estimation equation for variance
+  
+  if( "variance" %in% names( adjustable.param ) ) {
+    
+    ##  compute trace( Valpha^-1 Cov[bhat] )
+    
+    eeq.exp["variance"] <- sum(
+      rowSums( 
+        ( lik.item[["Valpha"]][["Valpha.inverse"]] %*% lik.item[["Valpha"]][["Valpha0"]] %*% lik.item[["Valpha"]][["Valpha.inverse"]] ) * 
+        r.cov[["cov.bhat"]]
+      )
+    )
+    eeq.emp["variance"] <- sum( 
+      lik.item[["effects"]][["z.star"]] * drop( lik.item[["Valpha"]][["Valpha0"]] %*% lik.item[["effects"]][["z.star"]] )
+    )
+    
+  }
+  
+  ##  estimation equations for scale, extra variogram and anisotropy
+  ##  parameters
+  
+  extra.par <- names( adjustable.param )[ !( 
+    names( adjustable.param ) %in% c( "variance", "snugget", "nugget" )
+  )]
+  
+  for( t.i in extra.par ){
+    
+    ##  compute trace( Valpha^-1 * dValpha/dalpha * Valpha^-1 * Cov[bhat] )
+    
+    dValpha <- dcorr.dparam(
+      x = lag.vectors, variogram.model = variogram.model, param = lik.item[["param"]], 
+      d.param = t.i,
+      aniso = lik.item[["aniso"]],
+      verbose = verbose
+    )
+    ##       if( identical( class( dValpha ), "try-error" ) ){
+    ##         if( verbose > 0 ) cat( "error in dcorr.dparam\n\n" )
+    ##         t.result <- rep( Inf, length( adjustable.param ) )
+    ##         names( t.result ) <- names( adjustable.param )
+    ##         return( t.result )
+    ##       }
+    
+    eeq.exp[t.i] <- sum(
+      rowSums( 
+        (lik.item[["Valpha"]][["Valpha.inverse"]] %*% dValpha %*% lik.item[["Valpha"]][["Valpha.inverse"]]) * 
+        r.cov[["cov.bhat"]]
+      )
+    )
+    eeq.emp[t.i] <- sum( 
+      lik.item[["effects"]][["z.star"]] * drop( dValpha %*% lik.item[["effects"]][["z.star"]] )
+    )
+    
+  }
+  
+  if( verbose > 1 ) {
+    cat( "\n                      ",
+      format( c( "min(xihat)", "max(xihat)" ), width = 14, justify = "right" ), 
+      "\n", sep =""
+    )
+    cat( "  EEQ                :", 
+      format( 
+        signif( range(eeq.xihat), digits = 7 ), 
+        scientific = TRUE, width = 14
+      ), "\n", sep = "" 
+    )
+    cat( "\n                      ",
+      format( names( eeq.emp), width = 14, justify = "right" ), 
+      "\n", sep =""
+    )
+    cat( "  EEQ                :", 
+      format( 
+        signif( eeq.emp / eeq.exp - 1, digits = 7 ), 
+        scientific = TRUE, width = 14
+      ), "\n", sep = "" 
+    )
+    if( verbose > 2 ){
+      cat( "      empirical terms:", 
+        format( 
+          signif( eeq.emp, digits = 7 ), 
+          scientific = TRUE, width = 14
+        ), "\n", sep = "" 
+      )
+      cat( "      expected  terms:", 
+        format( 
+          signif( eeq.exp, digits = 7 ), 
+          scientific = TRUE, width = 14
+        ), "\n", sep = ""
+      )
+    }
+    cat("\n")
+  }
+  
+  ##  store terms in lik.item object
+  
+  lik.item[["eeq"]] <- list(
+    eeq.xihat = eeq.xihat,
+    eeq.emp = eeq.emp,
+    eeq.exp = eeq.exp
+  )
+  
+  assign( "lik.item", lik.item, pos = as.environment( envir ) )
+  
+  return( c( eeq.xihat, eeq.emp / eeq.exp - 1. ) )
+  
+}
+
+
+##   ##############################################################################
+
 negative.restr.loglikelihood <- 
   function(
     adjustable.param,
@@ -2624,7 +2914,7 @@
     variogram.model, fixed.param, param.name, aniso.name,
     param.tf, bwd.tf, safe.param,
     lag.vectors,
-    XX, min.condnum, rankdef.x, yy, betahat, TT, bhat, 
+    XX, min.condnum, rankdef.x, yy, TT, xihat, 
     psi.function, dpsi.function, 
     tuning.psi, tuning.psi.nr, 
     irwls.initial, irwls.maxiter, irwls.reltol,
@@ -2642,6 +2932,7 @@
   ## 2012-11-27 AP changes in parameter back-transformation
   ## 2013-06-03 AP changes for estimating xihat
   ## 2013-06-12 AP substituting [["x"]] for $x in all lists
+  ## 2013-07-12 AP solving estimating equations by BBsolve{BB} (in addition to nleqlsv)
   
   #     sel <- !c( param.name, aniso.name ) %in% names( fixed.param )
   #     names( adjustable.param ) <- c( param.name, aniso.name )[sel]
@@ -2654,10 +2945,10 @@
     adjustable.param, variogram.model, fixed.param, param.name, aniso.name,
     param.tf, bwd.tf, safe.param,
     lag.vectors,
-    XX, min.condnum, rankdef.x, yy, betahat, TT, bhat, 
+    XX, min.condnum, rankdef.x, yy, TT, xihat, 
     psi.function, dpsi.function, tuning.psi, tuning.psi.nr,
     irwls.initial, irwls.maxiter, irwls.reltol,
-    compute.Q = TRUE,
+    compute.xihat = TRUE, compute.Q = TRUE,
     verbose
   )
   
@@ -2740,7 +3031,7 @@
     variogram.model, fixed.param, param.name, aniso.name,
     param.tf, deriv.fwd.tf, bwd.tf, safe.param,
     lag.vectors,
-    XX, min.condnum, rankdef.x, yy, betahat, TT, bhat, 
+    XX, min.condnum, rankdef.x, yy, TT, xihat, 
     psi.function, dpsi.function, d2psi.function, 
     tuning.psi, tuning.psi.nr,
     irwls.initial, irwls.maxiter, irwls.reltol,
@@ -2758,6 +3049,7 @@
   ## 2012-11-04 AP unscaled psi-function
   ## 2012-11-27 AP changes in parameter back-transformation
   ## 2013-06-12 AP substituting [["x"]] for $x in all lists
+  ## 2013-07-12 AP solving estimating equations by BBsolve{BB} (in addition to nleqlsv)
 
   ##   dtrafo.fct <- list(
   ##     log      = function( x ) 1/x,
@@ -2771,10 +3063,10 @@
     adjustable.param, variogram.model, fixed.param, param.name, aniso.name,
     param.tf, bwd.tf, safe.param,
[TRUNCATED]

To get the complete diff run:
    svnlook diff /svnroot/georob -r 13