From 23c89310e2160baa4117592fd2362d548400b184 Mon Sep 17 00:00:00 2001 From: Allen Boddie Date: Thu, 19 Dec 2024 13:44:35 -0500 Subject: [PATCH 1/5] Allow conceptXML to find nodes under ConceptScheme --- R/SDMXConcepts-methods.R | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/R/SDMXConcepts-methods.R b/R/SDMXConcepts-methods.R index 0cc21ff..b034c40 100644 --- 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", From acc315d5c8271c7371aeeaa9b0e67c45bced15df Mon Sep 17 00:00:00 2001 From: Allen Boddie Date: Thu, 19 Dec 2024 14:38:28 -0500 Subject: [PATCH 2/5] Add information for concept scheme for dimension. --- R/Class-SDMXDimension.R | 2 ++ R/SDMXDimension-methods.R | 16 ++++++++++++---- 2 files changed, 14 insertions(+), 4 deletions(-) diff --git a/R/Class-SDMXDimension.R b/R/Class-SDMXDimension.R index 3540fc1..6386de1 100644 --- 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/SDMXDimension-methods.R b/R/SDMXDimension-methods.R index 2139602..98a208d 100644 --- 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(pacakge == "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, From b1edd485c467bf7f89cd5e9756de386af40c384d Mon Sep 17 00:00:00 2001 From: Allen Boddie Date: Thu, 19 Dec 2024 14:49:12 -0500 Subject: [PATCH 3/5] Typo --- R/SDMXDimension-methods.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/SDMXDimension-methods.R b/R/SDMXDimension-methods.R index 98a208d..caf069c 100644 --- a/R/SDMXDimension-methods.R +++ b/R/SDMXDimension-methods.R @@ -66,7 +66,7 @@ SDMXDimension <- function(xmlObj, namespaces){ if(!is.null(conceptRefXML)){ conceptRef = xmlGetAttr(conceptRefXML, "id") package = xmlGetAttr(conceptRefXML, "package") - if(pacakge == "conceptscheme"){ + if(package == "conceptscheme"){ conceptSchemeRef = xmlGetAttr(conceptRefXML, "maintainableParentID") conceptSchemeVersion = xmlGetAttr(conceptRefXML, "maintainableParentVersion") conceptSchemeAgency = xmlGetAttr(conceptRefXML, "agencyID") From c468d6ed2f3a7b75e8e190eb5cff833c61318c94 Mon Sep 17 00:00:00 2001 From: Allen Boddie Date: Fri, 20 Dec 2024 13:04:47 -0500 Subject: [PATCH 4/5] check if component has a conceptSchemeRef and if so try to resolve codelist from conceptscheme. --- R/SDMXData-methods.R | 34 +++++++++++++++++++++++++++++++--- 1 file changed, 31 insertions(+), 3 deletions(-) diff --git a/R/SDMXData-methods.R b/R/SDMXData-methods.R index 6d0d486..0da0c4d 100644 --- 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@id){ + for(concept in conceptScheme){ + if(concept@id == column){ + coreRepresentation = concept@coreRepresentation + if(coreRepresentation %in% codelists){ + clName <- coreRepresentation + clFound <- TRUE + break + } + } + } + if(newCLFound){break} + } + } + } } }else{ From 377aac2988d92647181a5e9f7e65f6afbc6109db Mon Sep 17 00:00:00 2001 From: Allen Boddie Date: Fri, 20 Dec 2024 14:01:06 -0500 Subject: [PATCH 5/5] Allow to break when codelist found --- R/SDMXData-methods.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/SDMXData-methods.R b/R/SDMXData-methods.R index 0da0c4d..4aab872 100644 --- a/R/SDMXData-methods.R +++ b/R/SDMXData-methods.R @@ -104,8 +104,8 @@ addLabels.SDMXData <- function(data, dsd){ for(conceptScheme in conceptSchemes){ if(conceptSchemeRef == conceptScheme@id && conceptSchemeAgency == conceptScheme@agencyID && - conceptSchemeVersion == conceptScheme@id){ - for(concept in conceptScheme){ + conceptSchemeVersion == conceptScheme@version){ + for(concept in conceptScheme@Concept){ if(concept@id == column){ coreRepresentation = concept@coreRepresentation if(coreRepresentation %in% codelists){ @@ -115,7 +115,7 @@ addLabels.SDMXData <- function(data, dsd){ } } } - if(newCLFound){break} + if(clFound){break} } } }