Skip to content

Commit 0256518

Browse files
eblondeleblondel
authored
Merge pull request #216 from aboddie/master
Add references to request parameters and support dsd=true for source who use core representations for their concepts
2 parents e1dcec6 + 2d25ddc commit 0256518

12 files changed

+119
-28
lines changed

‎R/Class-SDMXDimension.R

+2
Original file line numberDiff line numberDiff line change
@@ -38,6 +38,7 @@ setClass("SDMXDimension",
3838
conceptVersion = "character", #optional
3939
conceptAgency = "character", #optional
4040
conceptSchemeRef = "character", #optional
41+
conceptSchemeVersion = "character", #optional
4142
conceptSchemeAgency = "character", #optional
4243
codelist = "character", #optional
4344
codelistVersion = "character", #optional
@@ -63,6 +64,7 @@ setClass("SDMXDimension",
6364
conceptVersion = "1.0",
6465
conceptAgency = "ORG",
6566
conceptSchemeRef = "CONCEPT_SCHEME",
67+
conceptSchemeVersion = "1.0",
6668
conceptSchemeAgency = "ORG",
6769
codelist = "CODELIST",
6870
codelistVersion = "1.0",

‎R/Class-SDMXRequestParams.R

+3-1
Original file line numberDiff line numberDiff line change
@@ -17,7 +17,8 @@
1717
#' @slot flowRef an object of class "character" giving the flowRef to be queried
1818
#' @slot key an object of class "character" giving the key (SDMX url formatted) to be used for the query
1919
#' @slot start an object of class "character" giving the start time
20-
#' @slot end an object of class "character" giving the end time
20+
#' @slot end an object of class "character" giving the end time
21+
#' @slot references an object of class "character" giving the instructions to return (or not) the artefacts referenced by the artefact to be returned
2122
#' @slot compliant an object of class "logical" indicating if the web-service is compliant with the SDMX REST web-service specifications
2223
#'
2324
#' @section Warning:
@@ -40,6 +41,7 @@ setClass("SDMXRequestParams",
4041
key = "character_OR_NULL",
4142
start = "character_OR_numeric_OR_NULL",
4243
end = "character_OR_numeric_OR_NULL",
44+
references = "character_OR_NULL",
4345
compliant = "logical"
4446
),
4547
prototype = list(),

‎R/SDMXConcepts-methods.R

+5
Original file line numberDiff line numberDiff line change
@@ -40,6 +40,11 @@ concepts.SDMXConcepts <- function(xmlObj, namespaces){
4040
"//mes:Structures/str:Concepts/str:Concept",
4141
namespaces = c(mes = as.character(messageNs),
4242
str = as.character(strNs)))
43+
conceptsXML <- c(conceptsXML,
44+
getNodeSet(xmlObj,
45+
"//mes:Structures/str:Concepts/str:ConceptScheme/str:Concept",
46+
namespaces = c(mes = as.character(messageNs),
47+
str = as.character(strNs))))
4348
}else{
4449
conceptsXML <- getNodeSet(xmlObj,
4550
"//mes:Concepts/str:Concept",

‎R/SDMXData-methods.R

+31-3
Original file line numberDiff line numberDiff line change
@@ -79,9 +79,9 @@ addLabels.SDMXData <- function(data, dsd){
7979
clName <- components[clMatcher, "codelist"]
8080
if(is.null(clName) || all(is.na(clName))){
8181
#try to grab codelist using regexpr on codelist
82-
clMatcher <- regexpr(column, components$codelist, ignore.case = TRUE)
83-
attr(clMatcher,"match.length")[is.na(clMatcher)] <- -1
84-
clName <- components[attr(clMatcher,"match.length")>1, "codelist"]
82+
clMatcher2 <- regexpr(column, components$codelist, ignore.case = TRUE)
83+
attr(clMatcher2,"match.length")[is.na(clMatcher2)] <- -1
84+
clName <- components[attr(clMatcher2,"match.length")>1, "codelist"]
8585
if(length(clName)>1) clName <- clName[1]
8686
}
8787

@@ -91,6 +91,34 @@ addLabels.SDMXData <- function(data, dsd){
9191
if(!(clName %in% codelists)){
9292
clName <- NULL
9393
}
94+
}else if(length(clName)==0){
95+
#check if component has a conceptSchemeRef and if so try to resolve
96+
#codelist from conceptscheme.
97+
conceptSchemeRef <- components[clMatcher, "conceptSchemeRef"]
98+
if(length(conceptSchemeRef)>0 && !is.na(conceptSchemeRef)){
99+
codelists <- sapply(slot(slot(dsd,"codelists"), "codelists"), slot, "id")
100+
conceptSchemeVersion <- components[clMatcher, "conceptSchemeVersion"]
101+
conceptSchemeAgency <- components[clMatcher, "conceptSchemeAgency"]
102+
conceptSchemes <- slot(slot(dsd, "concepts"), "conceptSchemes")
103+
clFound <- FALSE
104+
for(conceptScheme in conceptSchemes){
105+
if(conceptSchemeRef == conceptScheme@id &&
106+
conceptSchemeAgency == conceptScheme@agencyID &&
107+
conceptSchemeVersion == conceptScheme@version){
108+
for(concept in conceptScheme@Concept){
109+
if(concept@id == column){
110+
coreRepresentation = concept@coreRepresentation
111+
if(coreRepresentation %in% codelists){
112+
clName <- coreRepresentation
113+
clFound <- TRUE
114+
break
115+
}
116+
}
117+
}
118+
if(clFound){break}
119+
}
120+
}
121+
}
94122
}
95123

96124
}else{

‎R/SDMXDimension-methods.R

+13-4
Original file line numberDiff line numberDiff line change
@@ -45,6 +45,7 @@ SDMXDimension <- function(xmlObj, namespaces){
4545
conceptVersion <- NULL
4646
conceptAgency <- NULL
4747
conceptSchemeRef <- NULL
48+
conceptSchemeVersion <- NULL
4849
conceptSchemeAgency <- NULL
4950
codelist <- NULL
5051
codelistVersion <- NULL
@@ -64,10 +65,16 @@ SDMXDimension <- function(xmlObj, namespaces){
6465
#concepts
6566
if(!is.null(conceptRefXML)){
6667
conceptRef = xmlGetAttr(conceptRefXML, "id")
67-
conceptVersion = xmlGetAttr(conceptRefXML, "maintainableParentVersion")
68-
conceptAgency = xmlGetAttr(conceptRefXML, "agencyID")
69-
#TODO conceptSchemeRef?
70-
#TODO conceptSchemeAgency
68+
package = xmlGetAttr(conceptRefXML, "package")
69+
if(package == "conceptscheme"){
70+
conceptSchemeRef = xmlGetAttr(conceptRefXML, "maintainableParentID")
71+
conceptSchemeVersion = xmlGetAttr(conceptRefXML, "maintainableParentVersion")
72+
conceptSchemeAgency = xmlGetAttr(conceptRefXML, "agencyID")
73+
}else{
74+
conceptVersion = xmlGetAttr(conceptRefXML, "maintainableParentVersion")
75+
conceptAgency = xmlGetAttr(conceptRefXML, "agencyID")
76+
}
77+
7178
}
7279

7380
#codelists
@@ -123,6 +130,7 @@ SDMXDimension <- function(xmlObj, namespaces){
123130
if(is.null(conceptVersion)) conceptVersion <- as.character(NA)
124131
if(is.null(conceptAgency)) conceptAgency <- as.character(NA)
125132
if(is.null(conceptSchemeRef)) conceptSchemeRef <- as.character(NA)
133+
if(is.null(conceptSchemeVersion)) conceptSchemeVersion <- as.character(NA)
126134
if(is.null(conceptSchemeAgency)) conceptSchemeAgency <- as.character(NA)
127135

128136
if(is.null(codelist)) codelist <- as.character(NA)
@@ -201,6 +209,7 @@ SDMXDimension <- function(xmlObj, namespaces){
201209
conceptVersion = conceptVersion,
202210
conceptAgency = conceptAgency,
203211
conceptSchemeRef = conceptSchemeRef,
212+
conceptSchemeVersion = conceptSchemeVersion,
204213
conceptSchemeAgency = conceptSchemeAgency,
205214
codelist = codelist,
206215
codelistVersion = codelistVersion,

‎R/SDMXREST21RequestBuilder-methods.R

+2-1
Original file line numberDiff line numberDiff line change
@@ -82,7 +82,8 @@ SDMXREST21RequestBuilder <- function(regUrl, repoUrl, accessKey = NULL, complian
8282
if(is.null(obj@version)) obj@version = "latest"
8383
req <- sprintf("%s/datastructure/%s/%s/%s/",obj@regUrl, obj@agencyId, obj@resourceId, obj@version)
8484
if(forceProviderId) req <- paste(req, obj@providerId, sep = "/")
85-
req <- paste0(req, "?references=children") #TODO to see later to have arg for this
85+
if(is.null(obj@references)) obj@references = "children"
86+
req <- paste0(req, "?references=", obj@references)
8687

8788
#require key
8889
if(!is.null(accessKey)){

‎R/SDMXRequestParams-methods.R

+5-4
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@
55
#' @usage
66
#' SDMXRequestParams(regUrl, repoUrl, accessKey,
77
#' providerId, agencyId, resource, resourceId, version,
8-
#' flowRef, key, start, end, compliant)
8+
#' flowRef, key, start, end, references = NULL, compliant)
99
#'
1010
#' @param regUrl an object of class "character" giving the base Url of the SDMX service registry
1111
#' @param repoUrl an object of class "character" giving the base Url of the SDMX service repository
@@ -21,22 +21,23 @@
2121
#' @param key an object of class "character" giving the key (SDMX url formatted) to be used for the query
2222
#' @param start an object of class "character" giving the start time
2323
#' @param end an object of class "character" giving the end time
24+
#' @param references an object of class "character" giving the instructions to return (or not) the artefacts referenced by the artefact to be returned
2425
#' @param compliant an object of class "logical" indicating if the web-service is compliant with the SDMX REST web-service specifications
2526
#'
2627
#' @examples
2728
#' #how to create a SDMXRequestParams object
2829
#' params <- SDMXRequestParams(
2930
#' regUrl = "", repoUrl ="", accessKey = NULL,
3031
#' providerId = "", agencyId ="", resource = "data", resourceId = "",
31-
#' version = "", flowRef = "", key = NULL, start = NULL, end = NULL, compliant = FALSE
32+
#' version = "", flowRef = "", key = NULL, start = NULL, end = NULL, references = NULL, compliant = FALSE
3233
#' )
3334
#' @export
3435
#'
3536
SDMXRequestParams <- function(regUrl, repoUrl, accessKey, providerId, agencyId, resource, resourceId, version = NULL,
36-
flowRef, key = NULL, start = NULL, end = NULL, compliant){
37+
flowRef, key = NULL, start = NULL, end = NULL, references = NULL, compliant){
3738
new("SDMXRequestParams",
3839
regUrl = regUrl, repoUrl = repoUrl, accessKey = accessKey, providerId = providerId,
3940
agencyId = agencyId, resource = resource, resourceId = resourceId, version = version,
40-
flowRef = flowRef, key = key, start = start, end = end)
41+
flowRef = flowRef, key = key, start = start, end = end, references = references)
4142
}
4243

‎R/SDMXServiceProvider-methods.R

+8-1
Original file line numberDiff line numberDiff line change
@@ -168,7 +168,14 @@ setSDMXServiceProviders <- function(){ # nocov start
168168
builder = SDMXREST21RequestBuilder(
169169
regUrl = "https://api.imf.org/external/sdmx/2.1",
170170
repoUrl = "https://api.imf.org/external/sdmx/2.1",
171-
compliant = TRUE)
171+
compliant = TRUE,
172+
formatter = list(
173+
datastructure = function(obj){
174+
if(is.null(obj@references)) obj@references = "descendants"
175+
return(obj)
176+
}
177+
)
178+
)
172179
)
173180

174181
#OECD

‎R/readSDMX.R

+11-5
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@
77
#' provider = NULL, providerId = NULL, providerKey = NULL,
88
#' agencyId = NULL, resource = NULL, resourceId = NULL, version = NULL,
99
#' flowRef = NULL, key = NULL, key.mode = "R", start = NULL, end = NULL, dsd = FALSE,
10-
#' headers = list(), validate = FALSE,
10+
#' headers = list(), validate = FALSE, references = NULL,
1111
#' verbose = !is.null(logger), logger = "INFO", ...)
1212
#'
1313
#' @param file path to SDMX-ML document that needs to be parsed
@@ -48,6 +48,8 @@
4848
#' Recognized if a valid provider or provide id has been specified as argument.
4949
#' @param end an object of class "integer" or "character" giving the SDMX end time to apply.
5050
#' Recognized if a valid provider or provide id has been specified as argument.
51+
#' @param references an object of class "character" giving the instructions to return (or not) the
52+
#' artefacts referenced by the artefact to be returned.
5153
#' @param dsd an Object of class "logical" if an attempt to inherit the DSD should be performed.
5254
#' Active only if \code{"readSDMX"} is used as helper method (ie if data is fetched using
5355
#' an embedded service provider. Default is FALSE
@@ -138,7 +140,7 @@ readSDMX <- function(file = NULL, isURL = TRUE, isRData = FALSE,
138140
provider = NULL, providerId = NULL, providerKey = NULL,
139141
agencyId = NULL, resource = NULL, resourceId = NULL, version = NULL,
140142
flowRef = NULL, key = NULL, key.mode = "R", start = NULL, end = NULL, dsd = FALSE,
141-
headers = list(), validate = FALSE,
143+
headers = list(), validate = FALSE, references = NULL,
142144
verbose = !is.null(logger), logger = "INFO", ...) {
143145

144146
#logger
@@ -203,8 +205,10 @@ readSDMX <- function(file = NULL, isURL = TRUE, isRData = FALSE,
203205
key = key,
204206
start = start,
205207
end = end,
208+
references = references,
206209
compliant = provider@builder@compliant
207210
)
211+
208212
#formatting requestParams
209213
requestFormatter <- provider@builder@formatter
210214
requestParams <- switch(resource,
@@ -451,8 +455,10 @@ readSDMX <- function(file = NULL, isURL = TRUE, isRData = FALSE,
451455

452456
if(resource == "data"){
453457
dsdObj <- readSDMX(providerId = providerId, providerKey = providerKey,
454-
resource = "datastructure", resourceId = dsdRef, headers = headers,
455-
verbose = verbose, logger = logger, ...)
458+
resource = "datastructure", resourceId = dsdRef, headers = headers,
459+
verbose = verbose, references = references, logger = logger, ...)
460+
461+
456462
if(is.null(dsdObj)){
457463
log$WARN(sprintf("Impossible to fetch DSD for dataset '%s'", flowRef))
458464
}else{
@@ -463,7 +469,7 @@ readSDMX <- function(file = NULL, isURL = TRUE, isRData = FALSE,
463469
dsdObj <- lapply(1:length(dsdRef), function(x){
464470
flowDsd <- readSDMX(providerId = providerId, providerKey = providerKey,
465471
resource = "datastructure", resourceId = dsdRef[[x]], headers = headers,
466-
verbose = verbose, logger = logger, ...)
472+
verbose = verbose, references = references, logger = logger, ...)
467473
if(is.null(flowDsd)){
468474
log$INFO(sprintf("Impossible to fetch DSD for dataflow '%s'",resourceId))
469475
}else{

‎man/SDMXRequestParams.Rd

+6-2
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎man/readSDMX.Rd

+4-1
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎tests/testthat/test_Main_Helpers.R

+29-6
Original file line numberDiff line numberDiff line change
@@ -154,14 +154,37 @@ test_that("IMF - datastructure",{
154154
}
155155
})
156156

157+
#No plans to dissiminate data on IMF provider, IMF data avaliable on IMF_DATA.
158+
159+
#IMF_DATA
160+
#----
161+
162+
#-> dataflow
163+
test_that("IMF_DATA - dataflow",{
164+
testthat::skip_on_cran()
165+
sdmx <- readSDMX(providerId = "IMF_DATA", resource = "dataflow")
166+
if(!is.null(sdmx)){
167+
expect_is(sdmx, "SDMXDataFlows")
168+
}
169+
})
170+
171+
#-> datastructure
172+
test_that("IMF_DATA - datastructure",{
173+
testthat::skip_on_cran()
174+
sdmx <- readSDMX(providerId = "IMF_DATA", resource = "datastructure", resourceId = "IMF.STA,DSD_CPI")
175+
if(!is.null(sdmx)){
176+
expect_is(sdmx, "SDMXDataStructureDefinition")
177+
}
178+
})
179+
157180
#-> data
158-
test_that("IMF - data",{
181+
test_that("IMF_DATA - data",{
159182
testthat::skip_on_cran()
160-
#TODO to test, sounds it's not public anymore
161-
#sdmx <- readSDMX(providerId = "IMF", resource = "data", flowRef = "BOP_GBPM6", start = 2020, end = 2020)
162-
#if(!is.null(sdmx)){
163-
# expect_is(sdmx, "SDMXStructureSpecificData")
164-
#}
183+
sdmx <- readSDMX(providerId = "IMF_DATA", resource = "data", flowRef = "IMF.STA,CPI",
184+
key = list("USA", "CPI", "CP01", "IX", "A"), start = 2020, end = 2020)
185+
if(!is.null(sdmx)){
186+
expect_is(sdmx, "SDMXStructureSpecificData")
187+
}
165188
})
166189

167190
#OECD

0 commit comments

Comments
 (0)