From 072179c4842be155dee0ffa99fe726d427bb7cde Mon Sep 17 00:00:00 2001
From: Raimon Tolosana-Delgado <tolosa53@fwg206.ad.fz-rossendorf.de>
Date: Thu, 22 Jul 2021 19:01:17 +0200
Subject: [PATCH] added methods for as.gmCgram
---
DESCRIPTION | 2 +-
NEWS.md | 4 ++++
R/gmAnisotropy.R | 7 ++++++-
R/gstatCompatibility.R | 34 +++++++++++++++++++++++++++++++++-
4 files changed, 44 insertions(+), 3 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index 5aaf6fb..1b8fadd 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,5 +1,5 @@
Package: gmGeostats
-Version: 0.10-8-9000
+Version: 0.10-8-9001
Date: 2021-07-15
Title: Geostatistics for Compositional Analysis
Authors@R: c(person(given = "Raimon",
diff --git a/NEWS.md b/NEWS.md
index 0ca5835..590be6e 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,3 +1,7 @@
+# gmGeostats 0.10.8-9001
+
+* (2021-07-22) conversion methods between variogram models: `as.gmCgram()` methods for "variogramModel" and "variogramModelList" objects (from package "gstat")
+
# gmGeostats 0.10.8-9000
* (2021-07-15) documented abstract union classes, specifying required methods for the member classes
diff --git a/R/gmAnisotropy.R b/R/gmAnisotropy.R
index fc387eb..83eef9b 100644
--- a/R/gmAnisotropy.R
+++ b/R/gmAnisotropy.R
@@ -51,7 +51,12 @@ as.AnisotropyScaling.AnisotropyScaling = function(x) x
#' @export
as.AnisotropyScaling.numeric = function(x){
if(length(x)==2) return(anis2D.par2A(ratio=x[2], angle=x[1]))
- if(length(x)==5) stop("as.AnisotropyScaling: 3D from 5-vector values not yet implemented") # return(anis3D.par2A(ratios=x[4:5], angles=x[1:3]))
+ if(length(x)==5){
+ if(sum( (x[4:5]-1)^2)<1e-12){
+ return(diag(3))
+ }
+ stop("as.AnisotropyScaling: 3D from arbitrary 5-vector values not yet implemented") # return(anis3D.par2A(ratios=x[4:5], angles=x[1:3]))
+ }
stop("as.AnisotropyScaling.numeric: only works for length=2 1.angle+1.ratio, or lenth=5 3.angles+2.ratios")
}
diff --git a/R/gstatCompatibility.R b/R/gstatCompatibility.R
index bcf7b7a..c7bfed6 100644
--- a/R/gstatCompatibility.R
+++ b/R/gstatCompatibility.R
@@ -699,7 +699,39 @@ as.LMCAnisCompo.variogramModelList <-
#' @describeIn as.gmCgram Convert theoretical structural functions to gmCgram format
#' @method as.gmCgram variogramModelList
-as.gmCgram.variogramModelList = function(m, ...) stop("not yet available")
+as.gmCgram.variogramModelList = function(m, ...){
+ as.gmCgram(as.LMCAnisCompo(m, ...), ...)
+ }
+
+
+#' @describeIn as.gmCgram Convert theoretical structural functions to gmCgram format
+#' @method as.gmCgram variogramModel
+as.gmCgram.variogramModel = function(m, ...){
+ # extract nugget
+ isNugget = m$model=="Nug"
+ if(any(isNugget)){
+ nuggetValue = m[isNugget, "psill"]
+ m = m[!isNugget,, drop=FALSE]
+ }
+ # extract model names
+ modelName = gsi.validModels[paste("vg", m$model,sep=".")]
+ # if any model name is not identified
+ if(any(is.na(modelName))){
+ stop("as.gmCgram.variogramModel: found an unidentified variogram model; check content of internal variable gsi.valiModels to see which models are permissible")
+ }
+ # otherwise, extract parametres
+ tt = function(x) t(t(x))
+ out = setCgram(type = modelName[1], nugget = tt(nuggetValue), sill = tt(m[1, "psill"]), anisRanges =
+ as.AnisotropyScaling(unlist(m[1, -(1:4)])), extraPar = m[1, "kappa"])
+ if(nrow(m)>1){
+ for(im in 1:nrow(m)){
+ out = out + setCgram(type = modelName[im], sill = tt(m[im, "psill"]), anisRanges =
+ as.AnisotropyScaling(unlist(m[im, -(1:4)])), extraPar = m[im, "kappa"])
+
+ }
+ }
+ return(out)
+}
--
GitLab