From 561c577679fe2666a3c029a6765ee78829d732ef Mon Sep 17 00:00:00 2001
From: Raimon Tolosana-Delgado <tolosa53@fwg206.ad.fz-rossendorf.de>
Date: Wed, 14 Jul 2021 18:30:44 +0200
Subject: [PATCH] gmGeostats v0.10-8

---
 DESCRIPTION                               |  4 +-
 NAMESPACE                                 |  4 +-
 R/abstractClasses.R                       |  6 +-
 R/gmSpatialModel.R                        |  2 +-
 R/gmValidationStrategy.R                  | 70 ++++++++++++++---------
 R/gstatCompatibility.R                    |  1 +
 vignettes/register_new_layer_datatype.Rmd | 35 +++++++++++-
 7 files changed, 85 insertions(+), 37 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 3a9b161..ff80217 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,5 +1,5 @@
 Package: gmGeostats
-Version: 0.10-7.9006
+Version: 0.10-8
 Date: 2020-10-05
 Title: Geostatistics for Compositional Analysis
 Authors@R: c(person(given = "Raimon", 
@@ -63,8 +63,8 @@ Collate:
     'compositionsCompatibility.R'
     'gstatCompatibility.R'
     'variograms.R'
-    'gmValidationStrategy.R'
     'gmAnisotropy.R'
+    'gmValidationStrategy.R'
     'abstractClasses.R'
     'accuracy.R'
     'data.R'
diff --git a/NAMESPACE b/NAMESPACE
index 1268eb1..9874ed5 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -124,8 +124,6 @@ S3method(swath,rcomp)
 S3method(unmask,DataFrameStack)
 S3method(unmask,SpatialPixels)
 S3method(unmask,data.frame)
-S3method(validate,LeaveOneOut)
-S3method(validate,NfoldCrossValidation)
 S3method(variogramModelPlot,gmEVario)
 S3method(variogramModelPlot,gstatVariogram)
 S3method(variogramModelPlot,logratioVariogram)
@@ -213,6 +211,7 @@ export(swarmPlot)
 export(swath)
 export(unmask)
 export(validate)
+export(validate_gmSpatialModel)
 export(variogram)
 export(variogramModelPlot)
 export(variogram_gmSpatialModel)
@@ -236,6 +235,7 @@ exportMethods(as.gstat)
 exportMethods(logratioVariogram)
 exportMethods(predict)
 exportMethods(stackDim)
+exportMethods(validate)
 exportMethods(variogram)
 import(RColorBrewer)
 import(compositions)
diff --git a/R/abstractClasses.R b/R/abstractClasses.R
index 52939af..51c9155 100644
--- a/R/abstractClasses.R
+++ b/R/abstractClasses.R
@@ -12,8 +12,7 @@ setOldClass("gmDirectSamplingParameters")
 setOldClass("gmTurningBands")
 setOldClass("gmSequentialSimulation")
 setOldClass("gmCholeskyDecomposition")
-setOldClass("NfoldCrossValidation")
-setOldClass("LeaveOneOut")
+
 
 # abstract classes
 # cat("creating spatial method parameter classes: superclass creation\n")
@@ -72,8 +71,7 @@ setClassUnion(name="gmGaussianMethodParameters",
 #' 
 #' @export
 setClassUnion(name="gmSpatialMethodParameters", 
-              members=c("NULL",
-                        "gmNeighbourhoodSpecification",
+              members=c("gmNeighbourhoodSpecification",
                         "gmMPSParameters",
                         "gmValidationStrategy")
 )
diff --git a/R/gmSpatialModel.R b/R/gmSpatialModel.R
index c489ab1..d4cb2d2 100644
--- a/R/gmSpatialModel.R
+++ b/R/gmSpatialModel.R
@@ -306,7 +306,7 @@ as.gstat.gmSpatialModel <- function(object, ...){
     if(any(is.infinite(beta))) beta = NULL
     # neighbourhood
     ng = object@parameters
-    if(!is(ng, "gmGaussianMethodParameters")) stop("as.gstat: object@parameters must be of class 'gmGaussianMethodParameters'!")
+    if(!is(ng, "gmKrigingNeighbourhood")) stop("as.gstat: object@parameters must be of class 'gmGaussianMethodParameters'!")
     res = compo2gstatLR(coords=coords, compo=compo, V=Vinv, lrvgLMC=lrvgLMC, 
                         nscore=FALSE, formulaterm = formulaterm, prefix=prefix, beta=beta, 
                         nmax=ng$nmax, nmin=ng$nmin, omax=ng$omax, maxdist=ng$maxdist, force=ng$force)
diff --git a/R/gmValidationStrategy.R b/R/gmValidationStrategy.R
index 256a2bf..11cd8bb 100644
--- a/R/gmValidationStrategy.R
+++ b/R/gmValidationStrategy.R
@@ -45,6 +45,9 @@ LeaveOneOut = function(){
   return(res)
 }
 
+setOldClass("LeaveOneOut")
+setOldClass("NfoldCrossValidation")
+
 
 #### validation methods -------------
 #' Validate a spatial model
@@ -61,7 +64,7 @@ LeaveOneOut = function(){
 #' @export
 #' @family validation functions 
 #' @family accuracy functions
-#'
+#' @name validate_gmSpatialModel
 #' @examples
 #' data("Windarling")
 #' X = Windarling[,c("Easting","Northing")]
@@ -74,38 +77,41 @@ LeaveOneOut = function(){
 #' vs2 = NfoldCrossValidation(nfolds=sample(1:10, nrow(X), replace=TRUE))
 #' vs2
 #' \dontrun{ v2 = validate(gs, strategy=vs2) # quite slow }
-validate <- function(object, strategy, ...) UseMethod("validate", strategy)
+NULL
+
+#' @rdname validate_gmSpatialModel
+#' @export
+setGeneric("validate", function(object, strategy, ...){
+  standardGeneric("validate")
+})
 
 
-#' @describeIn validate Validate a spatial model
-#' @method validate LeaveOneOut
+#' @rdname validate_gmSpatialModel
 #' @export
-validate.LeaveOneOut = function(object, strategy, ...){
-  if("gstat" %in% class(object)){
-    n = nrow(object$data[[1]]$data)
-  }else if(is(object, "gmSpatialModel")){
-    n = nrow(object@data)
-  }else{
-    object = try(as.gmSpatialModel(object))
-    if(class(object)=="try-error") stop("validate.LeaveOneOut: provided object not interpretable")
-    n = nrow(object@data)
-  }
+setMethod("validate",signature(object="gstat", strategy="LeaveOneOut"),
+       function(object, strategy, ...){
+  n = nrow(object$data[[1]]$data)
   v = validate(object, NfoldCrossValidation(nfolds=n, doAll=TRUE))
   return(v)
-}
+})
 
-#' @describeIn validate Validate a spatial model
-#' @method validate NfoldCrossValidation
+#' @rdname validate_gmSpatialModel
 #' @export
-validate.NfoldCrossValidation = function(object, strategy, ...){
-  # manage "gstat" case
-  if("gstat" %in% class(object)){
-    warning("validate: object provided is of class 'gstat', attempting 'gstat.cv(..., remove.all=TRUE, all.residuals=TRUE)'")
-    return(gstat::gstat.cv(object, nfold=strategy$nfolds, remove.all = TRUE, all.residuals = TRUE))
-  }
+setMethod("validate",signature(object="gmSpatialModel", strategy="LeaveOneOut"),
+  function(object, strategy, ...){
+    n = nrow(object@data)
+    v = validate(object, NfoldCrossValidation(nfolds=n, doAll=TRUE))
+    return(v)
+})
+
+
+
+
+#' @rdname validate_gmSpatialModel
+#' @export
+setMethod("validate",signature(object="gmSpatialModel", strategy="NfoldCrossValidation"),
+          function(object, strategy, ...){
   # manage "gmSpatialModel" case
-  object = try(as.gmSpatialModel(object))
-  if(class(object)=="try-error") stop("validate.NfoldCrossValidation: provided object not interpretable")
   # interpret the information about the n-folds provided
   n = strategy$nfolds
   m = nrow(object@data)
@@ -138,7 +144,19 @@ validate.NfoldCrossValidation = function(object, strategy, ...){
   # reorder and return
   res = res[nms,] 
   return(res)
-}
+})
 
 
 
+
+
+#' @rdname validate_gmSpatialModel
+#' @export
+setMethod("validate",signature(object="gstat", strategy="NfoldCrossValidation"),
+          function(object, strategy, ...){
+            # manage "gstat" case
+              warning("validate: object provided is of class 'gstat', attempting 'gstat.cv(..., remove.all=TRUE, all.residuals=TRUE)'")
+              return(gstat::gstat.cv(object, nfold=strategy$nfolds, remove.all = TRUE, all.residuals = TRUE))
+          })
+
+
diff --git a/R/gstatCompatibility.R b/R/gstatCompatibility.R
index 8b4e981..c7ab6ce 100644
--- a/R/gstatCompatibility.R
+++ b/R/gstatCompatibility.R
@@ -1,4 +1,5 @@
 #### gstat easy/easier interface for multivariate data
+setOldClass("gstat")
 
 #' Fit an LMC to an empirical variogram
 #' 
diff --git a/vignettes/register_new_layer_datatype.Rmd b/vignettes/register_new_layer_datatype.Rmd
index 8b4c0a9..ce6fc07 100644
--- a/vignettes/register_new_layer_datatype.Rmd
+++ b/vignettes/register_new_layer_datatype.Rmd
@@ -150,10 +150,41 @@ image_cokriged.circular = function(x, ...){
 image_cokriged(theta.prds.back, ivar="theta")
 ```
 
+## An excursion on superclasses classes 
 
-## future work
+"gmGeostats" uses a mixture of S3 and S4 classes to manage the several kinds of objects, S3 classes mostly preferred for simple configuration objects, models and data elements, and S4 classes mostly in use for large compound spatial models and data containers. S4 classes, though being somewhat more complex to handle and slightly slower, have the advantage to allow for multiple dispatch, which this package extensively uses. S4 classes require its fields (called "slots") to strictly belong to a specific class. To handle this condition, and at the same time allow for multiple methods of specification, estimation, fitting and prediction of spatial models and random functions, "gmGeostats" provides a series of abstract classes controlling allowing certain fields to contain certain kinds of objects:
 
-In future extensions of this vignette we will discuss the way to create own structural functions (variograms) and estimation models/methods adapted to the nature of the data, and register them to the package.
+**gmNeighbourhoodSpecification** contains a description of the neighbourhood of a point during interpolation/simulation.
+
+**EmpiricalStructuralFunctionSpecification** contains a desciption of empirical structural functions, typically empirical variograms in different formats (e.g. "gstatVariogram" from package "gstat", or "logratioVariogram" from package "compositions").
+
+**ModelStructuralFunctionSpecification**, equivalent to the preceding one, this class contains specifications of models for structural functions (e.g. "variogramModel" or "CompLinModCoReg" for packages "gstat" resp. "compositions").
+
+**gmValidationStrategy** describes the way a model should be validated.
+
+**gmGaussianSimulationAlgorithm** specifies the exact gaussian simulation algorithm to be used, and provides its parameters (e.g. number of bands for Turning Bands).
+
+**gmTrainingImage** for multipoint statistics (MPS) methods, this abstract class gathers all ways to specify a gridded image.
+
+**gmUnconditionalSpatialModel** convenience class of the union of "gmTrainingImage" and "gmGaussianModel" (a concrete class containing "ModelStructuralFunctionSpecification" with some extra information), it is thought to contain all specifications of an unconditional random function.
+
+**gmMPSParameters**, analogous to "gmGaussianSimulationAlgorithm" or "gmValidationStrategy", this abstract class contains all specifications of MPS algorithms available.
+
+**gmSpatialMethodParameters** is a large container of both two-point and multipoint methods, i.e. descriptors of specific algorithms and their parameters. This union class should only contain other abstract claases!
+
+The package "methods" provides a way of checking the subclasses and superclasses of any specific class, thanks to the function `classesToAM()`:
+```{r}
+classesToAM("gmSpatialMethodParameters", includeSubclasses = TRUE)
+```
+The matrix contain a 1 if the row class is a subclass of the column class, and 0 otherwise.
+
+
+
+
+
+## Future work
+
+In future extensions of this vignette we will discuss the way to create own structural functions (variograms) and estimation models/methods adapted to the nature of the data, and register them to the package (usage of `setIs()` and coercion in conjunction with the abstract classes mention, `validate()`- and `predict()`-methods, creation of own `make.gm****Model()` data containers, etc).
 
 
 
-- 
GitLab