Merge pull request #1 from aboddie/Fix-dsd-labels

Allow dsd=True to work for core representation
opensdmx · Dec 20, 2024 · dbd70f0 · dbd70f0
2 parents b289c0f + 377aac2
commit dbd70f0
Show file tree

Hide file tree

Showing 4 changed files with 50 additions and 7 deletions.
diff --git a/R/Class-SDMXDimension.R b/R/Class-SDMXDimension.R
@@ -38,6 +38,7 @@ setClass("SDMXDimension",
           conceptVersion = "character", #optional
           conceptAgency = "character", #optional
           conceptSchemeRef = "character", #optional
+          conceptSchemeVersion = "character", #optional
           conceptSchemeAgency = "character", #optional
           codelist = "character", #optional
           codelistVersion = "character", #optional
@@ -63,6 +64,7 @@ setClass("SDMXDimension",
           conceptVersion = "1.0",
           conceptAgency = "ORG",
           conceptSchemeRef = "CONCEPT_SCHEME",
+          conceptSchemeVersion = "1.0",
           conceptSchemeAgency = "ORG",
           codelist = "CODELIST",
           codelistVersion = "1.0",

diff --git a/R/SDMXConcepts-methods.R b/R/SDMXConcepts-methods.R
@@ -40,6 +40,11 @@ concepts.SDMXConcepts <- function(xmlObj, namespaces){
                               "//mes:Structures/str:Concepts/str:Concept",
                               namespaces = c(mes = as.character(messageNs),
                                              str = as.character(strNs)))
+    conceptsXML <- c(conceptsXML,
+                    getNodeSet(xmlObj,
+                              "//mes:Structures/str:Concepts/str:ConceptScheme/str:Concept",
+                              namespaces = c(mes = as.character(messageNs),
+                                             str = as.character(strNs))))
   }else{
     conceptsXML <- getNodeSet(xmlObj,
                               "//mes:Concepts/str:Concept",

diff --git a/R/SDMXData-methods.R b/R/SDMXData-methods.R
@@ -79,9 +79,9 @@ addLabels.SDMXData <- function(data, dsd){
       clName <- components[clMatcher, "codelist"]
       if(is.null(clName) || all(is.na(clName))){
         #try to grab codelist using regexpr on codelist
-        clMatcher <- regexpr(column, components$codelist, ignore.case = TRUE)
-        attr(clMatcher,"match.length")[is.na(clMatcher)] <- -1
-        clName <- components[attr(clMatcher,"match.length")>1, "codelist"]
+        clMatcher2 <- regexpr(column, components$codelist, ignore.case = TRUE)
+        attr(clMatcher2,"match.length")[is.na(clMatcher2)] <- -1
+        clName <- components[attr(clMatcher2,"match.length")>1, "codelist"]
         if(length(clName)>1) clName <- clName[1]
       }
 
@@ -91,6 +91,34 @@ addLabels.SDMXData <- function(data, dsd){
         if(!(clName %in% codelists)){
           clName <- NULL
         }
+        }else if(length(clName)==0){
+          #check if component has a conceptSchemeRef and if so try to resolve
+          #codelist from conceptscheme.
+          conceptSchemeRef <- components[clMatcher, "conceptSchemeRef"]
+          if(length(conceptSchemeRef)>0 && !is.na(conceptSchemeRef)){
+            codelists <- sapply(slot(slot(dsd,"codelists"), "codelists"), slot, "id")
+            conceptSchemeVersion <- components[clMatcher, "conceptSchemeVersion"]
+            conceptSchemeAgency <- components[clMatcher, "conceptSchemeAgency"]
+            conceptSchemes <- slot(slot(dsd, "concepts"), "conceptSchemes")
+            clFound <- FALSE
+            for(conceptScheme in conceptSchemes){
+              if(conceptSchemeRef == conceptScheme@id &&
+              conceptSchemeAgency == conceptScheme@agencyID &&
+              conceptSchemeVersion == conceptScheme@version){
+                for(concept in conceptScheme@Concept){
+                  if(concept@id == column){
+                    coreRepresentation = concept@coreRepresentation
+                    if(coreRepresentation %in% codelists){
+                      clName <- coreRepresentation
+                      clFound <- TRUE
+                      break
+                    } 
+                  }
+                }
+                if(clFound){break}
+              }
+            }
+        }
       }
 
     }else{

diff --git a/R/SDMXDimension-methods.R b/R/SDMXDimension-methods.R
@@ -45,6 +45,7 @@ SDMXDimension <- function(xmlObj, namespaces){
   conceptVersion <- NULL
   conceptAgency <- NULL
   conceptSchemeRef <- NULL
+  conceptSchemeVersion <- NULL
   conceptSchemeAgency <- NULL
   codelist <- NULL
   codelistVersion <- NULL
@@ -64,10 +65,16 @@ SDMXDimension <- function(xmlObj, namespaces){
     #concepts
     if(!is.null(conceptRefXML)){
       conceptRef = xmlGetAttr(conceptRefXML, "id")
-      conceptVersion = xmlGetAttr(conceptRefXML, "maintainableParentVersion")
-      conceptAgency = xmlGetAttr(conceptRefXML, "agencyID")
-      #TODO conceptSchemeRef?
-      #TODO conceptSchemeAgency
+      package = xmlGetAttr(conceptRefXML, "package")
+      if(package == "conceptscheme"){
+        conceptSchemeRef = xmlGetAttr(conceptRefXML, "maintainableParentID")
+        conceptSchemeVersion = xmlGetAttr(conceptRefXML, "maintainableParentVersion") 
+        conceptSchemeAgency = xmlGetAttr(conceptRefXML, "agencyID")
+      }else{
+        conceptVersion = xmlGetAttr(conceptRefXML, "maintainableParentVersion")
+        conceptAgency = xmlGetAttr(conceptRefXML, "agencyID")
+      }
+
     }
 
     #codelists
@@ -201,6 +208,7 @@ SDMXDimension <- function(xmlObj, namespaces){
             conceptVersion = conceptVersion,
             conceptAgency = conceptAgency,
             conceptSchemeRef = conceptSchemeRef,
+            conceptSchemeVersion = conceptSchemeVersion,
             conceptSchemeAgency = conceptSchemeAgency,
             codelist = codelist,
             codelistVersion = codelistVersion,