#181 - addition of SRV + GFC implementation

eblondel · Dec 30, 2024 · f9540cf · f9540cf
1 parent e8f4dc0
commit f9540cf
Show file tree

Hide file tree

Showing 38 changed files with 2,438 additions and 625 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -217,6 +217,8 @@ export(ISOFeatureCatalogue)
 export(ISOFeatureCatalogueDescription)
 export(ISOFeatureOperation)
 export(ISOFeatureType)
+export(ISOFeatureType19115_3)
+export(ISOFeatureType19139)
 export(ISOFeatureTypeInfo)
 export(ISOFileName)
 export(ISOFormat)
@@ -361,6 +363,8 @@ export(ISORoleType)
 export(ISOSRVParameter)
 export(ISOSRVParameterDirection)
 export(ISOSRVServiceIdentification)
+export(ISOSRVServiceIdentification19115_3)
+export(ISOSRVServiceIdentification19139)
 export(ISOSampleBasedInspection)
 export(ISOSampleDimension)
 export(ISOScale)
@@ -372,6 +376,8 @@ export(ISOSecurityConstraints)
 export(ISOSensor)
 export(ISOSeries)
 export(ISOServiceIdentification)
+export(ISOServiceIdentification19115_3)
+export(ISOServiceIdentification19139)
 export(ISOSource)
 export(ISOSpatialRepresentation)
 export(ISOSpatialRepresentationType)

diff --git a/R/ISOAbstractPropertyType.R b/R/ISOAbstractPropertyType.R
@@ -26,6 +26,8 @@ ISOAbstractPropertyType <- R6Class("ISOAbstractPropertyType",
      definition = NULL,
      #'@field cardinality cardinality [1..1]: ISOMultiplicity
      cardinality = NULL,
+     #'@field designation designatio [0..1]: character (=> ISO 19115-3)
+     designation = NULL,
      #'@field definitionReference definitionReference [0..1]
      definitionReference = NULL,
      #'@field featureCatalogue featureCatalogue [0..1]
@@ -40,9 +42,17 @@ ISOAbstractPropertyType <- R6Class("ISOAbstractPropertyType",
      },
 
      #'@description Set member name
-     #'@param memberName member name object of class \link{character} or \link{ISOLocalName}
+     #'@param memberName member name object of class \link{character} (in ISO 19139 and 19115-3) 
+     #'or \link{ISOLocalName} (in ISO 19139 only)
      setMemberName = function(memberName){
-       if(!is(memberName,"ISOLocalName")) memberName <- ISOLocalName$new(value = memberName)
+       switch(getMetadataStandard(),
+        "19139" = {
+          if(!is(memberName,"ISOLocalName")) memberName <- ISOLocalName$new(value = memberName)
+        },
+        "19115-3" = {
+          memberName <- ISOElementSequence$new(value = memberName)
+        }
+       )
        self$memberName <- memberName
      },
 
@@ -60,7 +70,38 @@ ISOAbstractPropertyType <- R6Class("ISOAbstractPropertyType",
      #'@param lower lower
      #'@param upper upper
      setCardinality = function(lower, upper){
-       self$cardinality = ISOMultiplicity$new(lower = lower, upper = upper)
+       self$cardinality = switch(getMetadataStandard(),
+         "19139" = ISOMultiplicity$new(lower = lower, upper = upper),
+         "19115-3" = {
+           lower_str = switch(as.character(lower),
+             "0" = "0",
+             "1" = "1",
+             "Inf" = "*",
+             "-Inf" = "*",
+             as.character(lower)
+           )
+           upper_str = switch(as.character(upper),
+              "0" = "0",
+              "1" = "1",
+              "Inf" = "*",
+              "-Inf" = "*",
+              as.character(upper)
+           )
+           card = paste0(lower_str, "..", upper_str)
+           if(lower == 1 & upper == 1) card = "1"
+           card
+         }
+       )
+     },
+
+     #'@description Set designation
+     #'@param designation designation
+     #'@param locales locale designations, as \link{list}
+     setDesignation = function(designation, locales = NULL){
+       self$designation <- designation
+       if(!is.null(locales)){
+         self$designation <- self$createLocalisedProperty(designation, locales)
+       }
      },
 
      #'@description Set definition reference

diff --git a/R/ISOCodeListValue.R b/R/ISOCodeListValue.R
@@ -167,7 +167,7 @@ ISOCodeListValue$values = function(class, labels = FALSE){
   }
   if(element == "MD_ScopeCode") element <- "MX_ScopeCode"
   cl = getISOCodelist(element)
-  out = sapply(cl$codeEntry, function(x){x$identifier$value})
+  out = sapply(cl$codeEntry, function(x){if(is(x$identifier, "ISOScopedName")) x$identifier$value else x$identifier})
   if(labels){
     out = data.frame(
       out,

diff --git a/R/ISOCodelist.R b/R/ISOCodelist.R
@@ -57,7 +57,7 @@ ISOCodelist <- R6Class("ISOCodelist",
        if(pretty){
          entries <- do.call("rbind", lapply(entries, function(entry){
            data.frame(
-             identifier = entry$identifier,
+             identifier = if(is(entry$identifier,"ISOScopedName")) entry$identifier$value else entry$identifier,
              description = entry$description,
              stringsAsFactors = FALSE
            )

diff --git a/R/ISOFeatureAttribute.R b/R/ISOFeatureAttribute.R
@@ -75,11 +75,19 @@ ISOFeatureAttribute <- R6Class("ISOFeatureAttribute",
      },
 
      #'@description Set value measurement unit
-     #'@param uom uom, object of class \link{GMLUnitDefinition}
+     #'@param uom uom, object of class \link{GMLUnitDefinition} (in ISO 19139) 
+     #'or \link{ISOUomIdentifier} / \link{character} (in ISO 19115-3)
      setValueMeasurementUnit = function(uom){
-       if(!is(uom, "GMLUnitDefinition")){
-         stop("The argument should be an object of class 'GMLUnitDefinition")
-       } 
+       switch(getMetadataStandard(),
+        "19139" = {
+          if(!is(uom, "GMLUnitDefinition")){
+            stop("The argument should be an object of class 'GMLUnitDefinition")
+          } 
+        },
+        "19115-3" = {
+          if(!is(uom, "ISOUomIdentifier")) uom = ISOUomIdentifier$new(value = uom)
+        }
+       )
        self$valueMeasurementUnit <- uom
      },
 

diff --git a/R/ISOFeatureCatalogue.R b/R/ISOFeatureCatalogue.R
@@ -109,11 +109,20 @@ ISOFeatureCatalogue <- R6Class("ISOFeatureCatalogue",
       },
 
       #'@description Set producer
-      #'@param producer object of class \link{ISOResponsibleParty}
+      #'@param producer object of class \link{ISOResponsibleParty} (in ISO 19139) or \link{ISOResponsibility} (in ISO 19115-3)
       setProducer = function(producer){
-        if(!is(producer,"ISOResponsibleParty")){
-          stop("The argument should be a 'ISOResponsibleParty' object")
-        }
+        switch(getMetadataStandard(),
+          "19139" = {
+            if(!is(producer,"ISOResponsibleParty")){
+              stop("The argument should be a 'ISOResponsibleParty' object")
+            }
+          },
+          "19115-3" = {
+            if(!is(producer,"ISOResponsibility")){
+              stop("The argument should be a 'ISOResponsibility' object")
+            }
+          }
+        )
         self$producer <- producer
       },
 

diff --git a/R/ISOFeatureType.R b/R/ISOFeatureType.R
@@ -56,7 +56,9 @@
 #'  xml <- md$encode()
 #'  
 #' @references 
-#'   ISO 19110:2005 Methodology for Feature cataloguing
+#'   - ISO 19110 - GFC 1.0 https://schemas.isotc211.org/19110/-/gfc/1.0/gfc/#element_FC_FeatureType (in ISO 19139)
+#'   
+#'   - ISO 19110 - GFC 1.1 https://schemas.isotc211.org/19110/gfc/1.1/gfc/#element_FC_FeatureType (in ISO 19115-3)
 #' 
 #' @author Emmanuel Blondel <emmanuel.blondel1@@gmail.com>
 #'
@@ -67,189 +69,19 @@ ISOFeatureType <- R6Class("ISOFeatureType",
      xmlNamespacePrefix = "GFC"
    ),
    public = list(
-
-     #'@field typeName typeName [1..1]: ISOLocalName
-     typeName = NULL,
-     #'@field definition definition [0..1]: character
-     definition = NULL,
-     #'@field code code [0..1]: character
-     code = NULL,
-     #'@field isAbstract isAbstract [1..1]: logical
-     isAbstract = FALSE,
-     #'@field aliases aliases [0..*]: ISOLocalName
-     aliases = list(),
-     #'@field inheritsFrom inheritsFrom [0..*]: ISOInheritanceRelation
-     inheritsFrom = list(),
-     #'@field inheritsTo inheritsTo [0..*]: ISOInheritanceRelation
-     inheritsTo = list(),
-     #'@field featureCatalogue featureCatalogue: ISOFeatureCatalogue
-     featureCatalogue = NA,
-     #'@field constrainedBy constrainedBy [0..*]: ISOConstraint
-     constrainedBy = list(),
-     #'@field definitionReference definitionReference [0..*]: ISODefinitionReference
-     definitionReference = list(),
-     #'@field carrierOfCharacteristics carrierOfCharacteristics [0..*]: ISOCarrierOfCharacteristics
-     carrierOfCharacteristics = list(),
-
+
      #'@description Initializes object
      #'@param xml object of class \link{XMLInternalNode-class}
      initialize = function(xml = NULL){
        super$initialize(xml = xml)
-     },
-
-     #'@description Set type name
-     #'@param typeName type name, object of class \link{ISOLocalName} or \link{character}
-     setTypeName = function(typeName){
-       if(!is(typeName,"ISOLocalName")) typeName <- ISOLocalName$new(value = typeName)
-       self$typeName <- typeName
-     },
-
-     #'@description Set definition
-     #'@param definition definition
-     #'@param locales list of localized definitions. Default is \code{NULL}
-     setDefinition = function(definition, locales = NULL){
-       self$definition <- definition
-       if(!is.null(locales)){
-         self$definition <- self$createLocalisedProperty(definition, locales)
-       }
-     },
-
-     #'@description Set code
-     #'@param code definition
-     #'@param locales list of localized codes. Default is \code{NULL}
-     setCode = function(code, locales = NULL){
-       self$code = code
-       if(!is.null(locales)){
-         self$code <- self$createLocalisedProperty(code, locales)
-       }
-     },
-
-     #'@description Set whether feature type is abstract
-     #'@param isAbstract object of class \link{logical}
-     setIsAbstract = function(isAbstract){
-       if(!is.logical(isAbstract)) isAbstract <- as.logical(isAbstract)
-       if(is.na(isAbstract)){
-         stop("Value cannot be coerced to 'logical'")
-       }
-       self$isAbstract <- isAbstract
-     },
-
-     #'@description Adds alias
-     #'@param alias object of class \link{ISOLocalName} or \link{character}
-     #'@return \code{TRUE} if added, \code{FALSE} otherwise
-     addAlias = function(alias){
-       if(!is(alias, "ISOLocalName")){
-         alias <- ISOLocalName$new(value = alias)
-       }
-       return(self$addListElement("aliases", alias))
-     },
-
-     #'@description Deletes alias
-     #'@param alias object of class \link{ISOLocalName} or \link{character}
-     #'@return \code{TRUE} if deleted, \code{FALSE} otherwise
-     delAlias = function(alias){
-       if(!is(alias, "ISOLocalName")){
-         alias <- ISOLocalName$new(value = alias)
-       }
-       return(self$delListElement("aliases", alias))
-     },
-
-     #'@description Adds 'inheritsFrom' relation
-     #'@param rel rel, object of class \link{ISOInheritanceRelation}
-     #'@return \code{TRUE} if added, \code{FALSE} otherwise
-     addInheritsFrom = function(rel){
-       if(!is(rel, "ISOInheritanceRelation")){
-         stop("Argument value should be an object of class 'ISOInheritanceRelation'")
-       }
-       return(self$addListElement("inheritsFrom", rel))
-     },
-
-     #'@description Deletes 'inheritsFrom' relation
-     #'@param rel rel, object of class \link{ISOInheritanceRelation}
-     #'@return \code{TRUE} if deleted, \code{FALSE} otherwise
-     delInheritsFrom = function(rel){
-       if(!is(rel, "ISOInheritanceRelation")){
-         stop("Argument value should be an object of class 'ISOInheritanceRelation'")
-       }
-       return(self$delListElement("inheritsFrom", rel))
-     },
-
-     #'@description Adds 'inheritsTo' relation
-     #'@param rel rel, object of class \link{ISOInheritanceRelation}
-     #'@return \code{TRUE} if added, \code{FALSE} otherwise
-     addInheritsTo = function(rel){
-       if(!is(rel, "ISOInheritanceRelation")){
-         stop("Argument value should be an object of class 'ISOInheritanceRelation'")
-       }
-       return(self$addListElement("inheritsTo", rel))
-     },
-
-     #'@description Deletes 'inheritsTo' relation
-     #'@param rel rel, object of class \link{ISOInheritanceRelation}
-     #'@return \code{TRUE} if deleted, \code{FALSE} otherwise
-     delInheritsTo = function(rel){
-       if(!is(rel, "ISOInheritanceRelation")){
-         stop("Argument value should be an object of class 'ISOInheritanceRelation'")
-       }
-       return(self$delListElement("inheritsTo", rel))
-     },
-
-     #'@description Set feature catalogue
-     #'@param fc object of class \link{ISOFeatureCatalogue}
-     setFeatureCatalogue = function(fc){
-       if(!is(fc, "ISOFeatureCatalogue")){
-         stop("Argument value should be an object of class 'ISOFeatureCatalogue'")
-       }
-       self$featureCatalogue = fc
-     },
-
-     #'@description Adds constraint
-     #'@param constraint constraint, object of class \link{ISOConstraint}
-     #'@return \code{TRUE} if added, \code{FALSE} otherwise
-     addConstraint = function(constraint){
-       if(!is(constraint, "ISOConstraint")){
-         constraint <- ISOConstraint$new(description = constraint)
-       }
-       return(self$addListElement("constrainedBy", constraint))
-     },
-
-     #'@description Deletes constraint
-     #'@param constraint constraint, object of class \link{ISOConstraint}
-     #'@return \code{TRUE} if deleted, \code{FALSE} otherwise
-     delConstraint = function(constraint){
-       if(!is(constraint, "ISOConstraint")){
-         constraint <- ISOConstraint$new(description = constraint)
-       }
-       return(self$delListElement("constrainedBy", constraint))
-     },
-
-     #'@description Set definition reference
-     #'@param definitionReference object of class \link{ISODefinitionReference}
-     setDefinitionReference = function(definitionReference){
-       if(!is(definitionReference, "ISODefinitionReference")){
-         stop("The argument should be an object of class 'ISODefinitionReference'")
-       }
-       self$definitionReference = definitionReference
-     },
-
-     #'@description Adds characteristic
-     #'@param characteristic characteristic, object inheriting class \link{ISOAbstractCarrierOfCharacteristics}
-     #'@return \code{TRUE} if added, \code{FALSE} otherwise
-     addCharacteristic = function(characteristic){
-       if(!is(characteristic, "ISOAbstractCarrierOfCharacteristics")){
-         stop("The argument should be an object of class extending 'ISOAbstractCarrierOfCharacteristics'")
-       }
-       return(self$addListElement("carrierOfCharacteristics", characteristic))
-     },
-
-     #'@description Deletes characteristic
-     #'@param characteristic characteristic, object inheriting class \link{ISOAbstractCarrierOfCharacteristics}
-     #'@return \code{TRUE} if deleted, \code{FALSE} otherwise
-     delCharacteristic = function(characteristic){
-       if(!is(characteristic, "ISOAbstractCarrierOfCharacteristics")){
-         stop("The argument should be an object of class extending 'ISOAbstractCarrierOfCharacteristics'")
-       }
-       return(self$delListElement("carrierOfCharacteristics", characteristic))
      }
    )         
 )
+
+ISOFeatureType$new = function(xml = NULL){
+  self <- switch(getMetadataStandard(),
+   "19139" = ISOFeatureType19139$new(xml = xml),
+   "19115-3" = ISOFeatureType19115_3$new(xml = xml)
+  )
+  return(self)
+}