From dca35711bd39ecff9e94190611e0e8d587e93e44 Mon Sep 17 00:00:00 2001 From: eblondel Date: Tue, 10 May 2022 00:04:34 +0200 Subject: [PATCH] #187 further work on SWE components, QuantityRange --- NAMESPACE | 1 + R/ISOAbstractObject.R | 11 ++- R/SWEAbstractDataComponent.R | 13 +-- R/SWEAbstractSimpleComponent.R | 10 +-- R/SWECount.R | 14 +++- R/SWEQuantityRange.R | 82 +++++++++++++++++++ R/SWEText.R | 14 +++- README.md | 2 +- .../coverage/geometa_coverage_inventory.csv | 2 +- .../coverage/geometa_coverage_summary.csv | 2 +- .../coverage/geometa_coverage_summary.md | 2 +- man/SWEAbstractDataComponent.Rd | 6 +- man/SWEAbstractSimpleComponent.Rd | 6 +- man/SWECount.Rd | 6 ++ man/SWEQuantityRange.Rd | 54 ++++++++++++ man/SWEText.Rd | 6 ++ tests/testthat/test_SWEQuantityRange.R | 23 ++++++ 17 files changed, 224 insertions(+), 30 deletions(-) create mode 100644 R/SWEQuantityRange.R create mode 100644 man/SWEQuantityRange.Rd create mode 100644 tests/testthat/test_SWEQuantityRange.R diff --git a/NAMESPACE b/NAMESPACE index 5b07c831..7ee29fef 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -323,6 +323,7 @@ export(SWEAbstractDataComponent) export(SWEAbstractObject) export(SWEAbstractSimpleComponent) export(SWECount) +export(SWEQuantityRange) export(SWEText) export(cacheISOClasses) export(convert_metadata) diff --git a/R/ISOAbstractObject.R b/R/ISOAbstractObject.R index 16712041..c28eaa4e 100644 --- a/R/ISOAbstractObject.R +++ b/R/ISOAbstractObject.R @@ -918,7 +918,16 @@ ISOAbstractObject <- R6Class("ISOAbstractObject", }), collapse = " ") txtNode <- xmlTextNode(mts) if(field == "value"){ - rootXML$addNode(txtNode) + if(field == "value" && self$value_as_field){ + wrapperNode <- xmlOutputDOM( + tag = field, + nameSpace = namespaceId + ) + wrapperNode$addNode(txtNode) + rootXML$addNode(wrapperNode$value()) + }else{ + rootXML$addNode(txtNode) + } }else{ wrapperNode <- xmlOutputDOM(tag = field, nameSpace = namespaceId) wrapperNode$addNode(txtNode) diff --git a/R/SWEAbstractDataComponent.R b/R/SWEAbstractDataComponent.R index 7fb3a01a..c2824648 100644 --- a/R/SWEAbstractDataComponent.R +++ b/R/SWEAbstractDataComponent.R @@ -35,12 +35,15 @@ SWEAbstractDataComponent <- R6Class("SWEAbstractDataComponent", #'@description Initializes an object of class \link{SWEAbstractDataComponent} #'@param xml object of class \link{XMLInternalNode-class} from \pkg{XML} #'@param element element - #'@param attrs attrs - #'@param defaults defaults - #'@param wrap wrap - initialize = function(xml = NULL, element = NULL, attrs = list(), defaults = list(), wrap = TRUE){ + #'@param updatable updatable + #'@param optional optional + #'@param definition definition + initialize = function(xml = NULL, element = NULL, updatable = NULL, optional = FALSE, definition = NULL){ if(is.null(element)) element <- private$xmlElement - super$initialize(xml, element = element, attrs = attrs, defaults = defaults, wrap = wrap) + super$initialize(xml, element = element, attrs = list(), defaults = list(), wrap = FALSE) + if(!is.null(updatable)) if(is.logical(updatable)) self$setAttr("updatable", tolower(updatable)) + self$setAttr("optional", tolower(optional)) + if(!is.null(definition)) self$setAttr("definition", definition) }, #'@description Set definition diff --git a/R/SWEAbstractSimpleComponent.R b/R/SWEAbstractSimpleComponent.R index 97db15ce..613ae079 100644 --- a/R/SWEAbstractSimpleComponent.R +++ b/R/SWEAbstractSimpleComponent.R @@ -23,12 +23,12 @@ SWEAbstractSimpleComponent <- R6Class("SWEAbstractSimpleComponent", #'@description Initializes an object of class \link{SWEAbstractSimpleComponent} #'@param xml object of class \link{XMLInternalNode-class} from \pkg{XML} #'@param element element - #'@param attrs attrs - #'@param defaults defaults - #'@param wrap wrap - initialize = function(xml = NULL, element = NULL, attrs = list(), defaults = list(), wrap = TRUE){ + #'@param updatable updatable + #'@param optional optional + #'@param definition definition + initialize = function(xml = NULL, element = NULL, updatable = NULL, optional = FALSE, definition = NULL){ if(is.null(element)) element <- private$xmlElement - super$initialize(xml, element = element, attrs = attrs, defaults = defaults, wrap = wrap) + super$initialize(xml, element = element, updatable = updatable, optional = optional, definition = definition) } ) ) \ No newline at end of file diff --git a/R/SWECount.R b/R/SWECount.R index db499dfe..be0c9a1d 100644 --- a/R/SWECount.R +++ b/R/SWECount.R @@ -30,8 +30,14 @@ SWECount <- R6Class("SWECount", #'@param xml object of class \link{XMLInternalNode-class} from \pkg{XML} #'@param constraint constraint #'@param value value - initialize = function(xml = NULL, constraint = NULL, value = NULL){ - super$initialize(xml, element = private$xmlElement) + #'@param updatable updatable + #'@param optional optional + #'@param definition definition + initialize = function(xml = NULL, + constraint = NULL, value = NULL, + updatable = NULL, optional = FALSE, definition = NULL){ + super$initialize(xml, element = private$xmlElement, + updatable = updatable, optional = optional, definition = definition) if(is.null(xml)){ self$constraint <- constraint self$value <- value @@ -39,13 +45,13 @@ SWECount <- R6Class("SWECount", }, #'@description setConstraint - #'@param constraint + #'@param constraint constraint setConstraint = function(constraint){ self$constraint <- constraint }, #'@description setValue - #'@param value + #'@param value value setValue = function(value){ self$value <- value } diff --git a/R/SWEQuantityRange.R b/R/SWEQuantityRange.R new file mode 100644 index 00000000..246adfe7 --- /dev/null +++ b/R/SWEQuantityRange.R @@ -0,0 +1,82 @@ +#' SWEQuantityRange +#' +#' @docType class +#' @importFrom R6 R6Class +#' @export +#' @keywords ISO SWE +#' @return Object of \code{\link{R6Class}} for modelling an SWE QuantityRange +#' @format \code{\link{R6Class}} object. +#' +#' @references +#' OGC Geography Markup Language. https://www.ogc.org/standards/swecommon +#' +#' @author Emmanuel Blondel +#' +SWEQuantityRange <- R6Class("SWEQuantityRange", + inherit = SWEAbstractSimpleComponent, + private = list( + xmlElement = "QuantityRange", + xmlNamespacePrefix = "SWE" + ), + public = list( + + #'@field uom uom + uom = NULL, + + #'@field constraint constraint + constraint = NULL, + + #'@field value value + value = matrix(NA_real_, 1, 2), + + #'@description Initializes an object of class \link{SWEQuantityRange} + #'@param xml object of class \link{XMLInternalNode-class} from \pkg{XML} + #'@param constraint constraint + #'@param value value + #'@param updatable updatable + #'@param optional optional + #'@param definition definition + initialize = function(xml = NULL, + constraint = NULL, value = NULL, + updatable = NULL, optional = FALSE, definition = NULL){ + super$initialize(xml, element = private$xmlElement, + updatable = updatable, optional = optional, definition = definition) + if(is.null(xml)){ + self$setConstraint(constraint) + self$setValue(value) + } + }, + + #'@description setUom + #'@param uom uom + setUom = function(uom){ + self$uom <- uom + }, + + #'@description setConstraint + #'@param constraint constraint + setConstraint = function(constraint){ + self$constraint <- constraint + }, + + #'@description setValue + #'@param value value + setValue = function(value){ + if(!is.numeric(value)){ + stop("Values should be numeric") + } + if(is.vector(value)){ + if(length(value)!="2"){ + stop("Vector of values should of length 2") + } + }else if(is.matrix(value)){ + if(!all(dim(value)==c(1,2))){ + stop("Matrix of values should be of dimensions 1,2") + } + }else{ + stop("Value should be either a vector or matrix") + } + self$value <- value + } + ) +) \ No newline at end of file diff --git a/R/SWEText.R b/R/SWEText.R index a56027e4..8e9c1cd2 100644 --- a/R/SWEText.R +++ b/R/SWEText.R @@ -30,8 +30,14 @@ SWEText <- R6Class("SWEText", #'@param xml object of class \link{XMLInternalNode-class} from \pkg{XML} #'@param constraint constraint #'@param value value - initialize = function(xml = NULL, constraint = NULL, value = NULL){ - super$initialize(xml, element = private$xmlElement) + #'@param updatable updatable + #'@param optional optional + #'@param definition definition + initialize = function(xml = NULL, + constraint = NULL, value = NULL, + updatable = NULL, optional = FALSE, definition = NULL){ + super$initialize(xml, element = private$xmlElement, + updatable = updatable, optional = optional, definition = definition) if(is.null(xml)){ self$constraint <- constraint self$value <- value @@ -39,13 +45,13 @@ SWEText <- R6Class("SWEText", }, #'@description setConstraint - #'@param constraint + #'@param constraint constraint setConstraint = function(constraint){ self$constraint <- constraint }, #'@description setValue - #'@param value + #'@param value value setValue = function(value){ self$value <- value } diff --git a/README.md b/README.md index a3472829..5b40d976 100644 --- a/README.md +++ b/README.md @@ -37,4 +37,4 @@ We thank in advance people that use ``geometa`` for citing it in their work / pu |GML 3.2.1 (ISO 19136) |Geographic Markup Language |GML |[![GML 3.2.1 (ISO 19136)](https://img.shields.io/badge/-37%25-ff0c0c.svg)](https://github.com/eblondel/geometa) | 63| 106| |GML 3.2.1 Coverage (OGC GMLCOV) |OGC GML Coverage Implementation Schema |GMLCOV |[![GML 3.2.1 Coverage (OGC GMLCOV)](https://img.shields.io/badge/-100%25-4a4ea8.svg)](https://github.com/eblondel/geometa) | 1| 0| |GML 3.3 Referenceable Grid (OGC GML) |OGC GML Referenceable Grid |GMLRGRID |[![GML 3.3 Referenceable Grid (OGC GML)](https://img.shields.io/badge/-100%25-4a4ea8.svg)](https://github.com/eblondel/geometa) | 5| 0| -|SWE 2.0 |Sensor Web Enablement (SWE) Common Data Model |SWE |[![SWE 2.0](https://img.shields.io/badge/-17%25-ad0f0f.svg)](https://github.com/eblondel/geometa) | 5| 25| +|SWE 2.0 |Sensor Web Enablement (SWE) Common Data Model |SWE |[![SWE 2.0](https://img.shields.io/badge/-20%25-ff0c0c.svg)](https://github.com/eblondel/geometa) | 6| 24| diff --git a/inst/extdata/coverage/geometa_coverage_inventory.csv b/inst/extdata/coverage/geometa_coverage_inventory.csv index 3a3ee821..438dbc81 100644 --- a/inst/extdata/coverage/geometa_coverage_inventory.csv +++ b/inst/extdata/coverage/geometa_coverage_inventory.csv @@ -495,7 +495,7 @@ "SWE 2.0","Sensor Web Enablement (SWE) Common Data Model","SWE","Matrix","",FALSE "SWE 2.0","Sensor Web Enablement (SWE) Common Data Model","SWE","NilValues","",FALSE "SWE 2.0","Sensor Web Enablement (SWE) Common Data Model","SWE","Quantity","",FALSE -"SWE 2.0","Sensor Web Enablement (SWE) Common Data Model","SWE","QuantityRange","",FALSE +"SWE 2.0","Sensor Web Enablement (SWE) Common Data Model","SWE","QuantityRange","SWEQuantityRange",TRUE "SWE 2.0","Sensor Web Enablement (SWE) Common Data Model","SWE","Text","SWEText",TRUE "SWE 2.0","Sensor Web Enablement (SWE) Common Data Model","SWE","TextEncoding","",FALSE "SWE 2.0","Sensor Web Enablement (SWE) Common Data Model","SWE","Time","",FALSE diff --git a/inst/extdata/coverage/geometa_coverage_summary.csv b/inst/extdata/coverage/geometa_coverage_summary.csv index 9a53281d..a326662d 100644 --- a/inst/extdata/coverage/geometa_coverage_summary.csv +++ b/inst/extdata/coverage/geometa_coverage_summary.csv @@ -8,4 +8,4 @@ "GML 3.2.1 (ISO 19136)","Geographic Markup Language","GML",63,106,37.28 "GML 3.2.1 Coverage (OGC GMLCOV)","OGC GML Coverage Implementation Schema","GMLCOV",1,0,100 "GML 3.3 Referenceable Grid (OGC GML)","OGC GML Referenceable Grid","GMLRGRID",5,0,100 -"SWE 2.0","Sensor Web Enablement (SWE) Common Data Model","SWE",5,25,16.67 +"SWE 2.0","Sensor Web Enablement (SWE) Common Data Model","SWE",6,24,20 diff --git a/inst/extdata/coverage/geometa_coverage_summary.md b/inst/extdata/coverage/geometa_coverage_summary.md index a0d07d51..616c29f1 100644 --- a/inst/extdata/coverage/geometa_coverage_summary.md +++ b/inst/extdata/coverage/geometa_coverage_summary.md @@ -9,4 +9,4 @@ |GML 3.2.1 (ISO 19136) |Geographic Markup Language |GML |[![GML 3.2.1 (ISO 19136)](https://img.shields.io/badge/-37%25-ff0c0c.svg)](https://github.com/eblondel/geometa) | 63| 106| |GML 3.2.1 Coverage (OGC GMLCOV) |OGC GML Coverage Implementation Schema |GMLCOV |[![GML 3.2.1 Coverage (OGC GMLCOV)](https://img.shields.io/badge/-100%25-4a4ea8.svg)](https://github.com/eblondel/geometa) | 1| 0| |GML 3.3 Referenceable Grid (OGC GML) |OGC GML Referenceable Grid |GMLRGRID |[![GML 3.3 Referenceable Grid (OGC GML)](https://img.shields.io/badge/-100%25-4a4ea8.svg)](https://github.com/eblondel/geometa) | 5| 0| -|SWE 2.0 |Sensor Web Enablement (SWE) Common Data Model |SWE |[![SWE 2.0](https://img.shields.io/badge/-17%25-ad0f0f.svg)](https://github.com/eblondel/geometa) | 5| 25| +|SWE 2.0 |Sensor Web Enablement (SWE) Common Data Model |SWE |[![SWE 2.0](https://img.shields.io/badge/-20%25-ff0c0c.svg)](https://github.com/eblondel/geometa) | 6| 24| diff --git a/man/SWEAbstractDataComponent.Rd b/man/SWEAbstractDataComponent.Rd index 391f5a8c..984f20cb 100644 --- a/man/SWEAbstractDataComponent.Rd +++ b/man/SWEAbstractDataComponent.Rd @@ -12,11 +12,9 @@ \item{element}{element} -\item{attrs}{attrs} +\item{updatable}{updatable} -\item{defaults}{defaults} - -\item{wrap}{wrap} +\item{optional}{optional} \item{definition}{definition} diff --git a/man/SWEAbstractSimpleComponent.Rd b/man/SWEAbstractSimpleComponent.Rd index e4f746d8..ebe4683b 100644 --- a/man/SWEAbstractSimpleComponent.Rd +++ b/man/SWEAbstractSimpleComponent.Rd @@ -12,11 +12,11 @@ \item{element}{element} -\item{attrs}{attrs} +\item{updatable}{updatable} -\item{defaults}{defaults} +\item{optional}{optional} -\item{wrap}{wrap} +\item{definition}{definition} } \value{ Object of \code{\link{R6Class}} for modelling an SWE Abstract simple component diff --git a/man/SWECount.Rd b/man/SWECount.Rd index e80cd498..7d3da8df 100644 --- a/man/SWECount.Rd +++ b/man/SWECount.Rd @@ -10,6 +10,12 @@ \arguments{ \item{xml}{object of class \link{XMLInternalNode-class} from \pkg{XML}} +\item{updatable}{updatable} + +\item{optional}{optional} + +\item{definition}{definition} + \item{constraint}{constraint} \item{value}{value} diff --git a/man/SWEQuantityRange.Rd b/man/SWEQuantityRange.Rd new file mode 100644 index 00000000..3800f994 --- /dev/null +++ b/man/SWEQuantityRange.Rd @@ -0,0 +1,54 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/SWEQuantityRange.R +\docType{class} +\name{SWEQuantityRange} +\alias{SWEQuantityRange} +\title{SWEQuantityRange} +\format{ +\code{\link{R6Class}} object. +} +\arguments{ +\item{xml}{object of class \link{XMLInternalNode-class} from \pkg{XML}} + +\item{updatable}{updatable} + +\item{optional}{optional} + +\item{definition}{definition} + +\item{uom}{uom} + +\item{constraint}{constraint} + +\item{value}{value} +} +\value{ +Object of \code{\link{R6Class}} for modelling an SWE QuantityRange +} +\description{ +Initializes an object of class \link{SWEQuantityRange} + +setUom + +setConstraint + +setValue +} +\section{Fields}{ + +\describe{ +\item{\code{uom}}{uom} + +\item{\code{constraint}}{constraint} + +\item{\code{value}}{value} +}} + +\references{ +OGC Geography Markup Language. https://www.ogc.org/standards/swecommon +} +\author{ +Emmanuel Blondel +} +\keyword{ISO} +\keyword{SWE} diff --git a/man/SWEText.Rd b/man/SWEText.Rd index 3a94f412..f399760c 100644 --- a/man/SWEText.Rd +++ b/man/SWEText.Rd @@ -10,6 +10,12 @@ \arguments{ \item{xml}{object of class \link{XMLInternalNode-class} from \pkg{XML}} +\item{updatable}{updatable} + +\item{optional}{optional} + +\item{definition}{definition} + \item{constraint}{constraint} \item{value}{value} diff --git a/tests/testthat/test_SWEQuantityRange.R b/tests/testthat/test_SWEQuantityRange.R new file mode 100644 index 00000000..689bf921 --- /dev/null +++ b/tests/testthat/test_SWEQuantityRange.R @@ -0,0 +1,23 @@ +# test_SWEQuantityRange.R +# Author: Emmanuel Blondel +# +# Description: Unit tests for classes inheriting SWEQuantityRange.R +#======================= +require(geometa, quietly = TRUE) +require(sf) +require(testthat) + +conQuantityRange("SWEQuantityRange") + +test_that("SWEQuantityRange",{ + testthat::skip_on_cran() + #encoding + qr <- SWEQuantityRange$new(value = matrix(c(0,1),1,2)) + xml <- qr$encode() + expect_is(xml, "XMLInternalNode") + #decoding + qr2 <- SWEQuantityRange$new(xml = xml) + xml2 <- qr2$encode() + #assert object identity + expect_true(ISOAbstractObject$compare(qr, qr2)) +})