rsdmx/ 0000755 0001762 0000144 00000000000 13241062706 011410 5 ustar ligges users rsdmx/inst/ 0000755 0001762 0000144 00000000000 13241016541 012361 5 ustar ligges users rsdmx/inst/doc/ 0000755 0001762 0000144 00000000000 13241016541 013126 5 ustar ligges users rsdmx/inst/doc/quickstart.Rmd 0000644 0001762 0000144 00000023627 13052644404 016003 0 ustar ligges users
# rsdmx quickstart guide
The goal of this document is to get you up and running with rsdmx as quickly as possible.
``rsdmx`` provides a set of classes and methods to read data and metadata documents exchanged through the Statistical Data and Metadata Exchange (SDMX) framework.
## SDMX - a short introduction
The SDMX framework provides two sets of standard specifications to facilitate the exchange of statistical data:
* standard formats
* web-service specifications
SDMX allows to disseminate both **data** (a dataset) and **metadata** (the description of the dataset).
For this, the SDMX standard provides various types of _documents_, also known as _messages_. Hence there will be:
* **data** SDMX-ML _documents_. The two main _document_ types are the ``Generic`` and ``Compact`` ones. The latter aims to provide a more compact XML document. They are other data _document_ types derivating from the ones previously mentioned.
* **metadata** SDMX-ML _documents_. The main metadata _document_ is known a ``Data Structure Definition`` (DSD). As its name indicates, it _describes_ the structure and organization of a dataset, and will generally include all the master/reference data used to characterize a dataset. The 2 main types of metadata are (1) the ``concepts``, which correspond to the _dimensions_ and/or _attributes_ of the dataset, and (2) the ``codelists`` which inventory the possible values to be used in the representation of _dimensions_ and _attributes_.
For more information about the SDMX standards, you can visit the [SDMX website](http://sdmx.org/), or this [introduction by EUROSTAT](https://webgate.ec.europa.eu/fpfis/mwikis/sdmx/index.php/SDMX).
## How to deal with SDMX in R
[rsdmx](https://cran.r-project.org/package=rsdmx) offers a low-level set of tools to read **data** and **metadata** in the SDMX-ML format. Its strategy is to make it very easy for the user. For this, a unique function named ``readSDMX`` has to be used, whatever it is a ``data`` or ``metadata`` document, or if it is ``local`` or ``remote`` datasource.
What ``rsdmx`` does support:
* a SDMX format abstraction library, with focus on the the main SDMX standard XML format (SDMX-ML), and the support of the three format standard versions (``1.0``, ``2.0``, ``2.1``)
* an interface to SDMX web-services for a list of well-known data providers, such as OECD, EUROSTAT, ECB, UN FAO, UN ILO, etc (a list that should grow in a near future!). See it [in action](https://github.com/opensdmx/rsdmx/blob/master/vignettes/quickstart.Rmd#using-the-helper-approach)!
Let's see then how to use ``rsdmx``!
## Install rsdmx
``rsdmx`` can be installed from CRAN or from its development repository hosted in Github. For the latter, you will need the ``devtools`` package and run:
```{r, eval=FALSE, results="hide"}
devtools::install_github("opensdmx/rsdmx")
```
## Load rsdmx
To load rsdmx in R, do the following:
```{r,eval = FALSE,results="hide"}
library(rsdmx)
```
## Read dataset documents
This section will introduce you on how to read SDMX *dataset* documents, either from _remote_ datasources, or from _local_ SDMX files.
### Read _remote_ datasets
#### using the _raw_ approach (specifying the complete request URL)
The following code snipet shows you how to read a dataset from a remote data source, taking as example the [OECD StatExtracts portal](http://stats.oecd.org): [http://stats.oecd.org/restsdmx/sdmx.ashx/GetData/MIG/TOT../OECD?startTime=2000&endTime=2011](http://stats.oecd.org/restsdmx/sdmx.ashx/GetData/MIG/TOT../OECD?startTime=2000&endTime=2011)
```{r,eval = FALSE,results="hide"}
myUrl <- "http://stats.oecd.org/restsdmx/sdmx.ashx/GetData/MIG/TOT../OECD?startTime=2000&endTime=2011"
dataset <- readSDMX(myUrl)
stats <- as.data.frame(dataset)
```
You can try it out with other datasources, such as from the [**EUROSTAT portal**](http://ec.europa.eu/eurostat/web/sdmx-web-services/rest-sdmx-2.1): [http://ec.europa.eu/eurostat/SDMX/diss-web/rest/data/cdh_e_fos/..PC.FOS1.BE/?startperiod=2005&endPeriod=2011](http://ec.europa.eu/eurostat/SDMX/diss-web/rest/data/cdh_e_fos/..PC.FOS1.BE/?startperiod=2005&endPeriod=2011)
The online rsdmx documentation also provides a list of data providers, either from international or national institutions, and [more request examples](https://github.com/opensdmx/rsdmx/wiki#read-remote-datasets).
#### using the _helper_ approach
Now, the service providers above mentioned are known by ``rsdmx`` which let users using ``readSDMX`` with the helper parameters. The list of service providers can be retrieved doing:
```{r,eval = FALSE,results="hide"}
providers <- getSDMXServiceProviders();
as.data.frame(providers)
```
Note it is also possible to add an SDMX service provider at runtime. For registering a new SDMX service provider by default, please contact me!
Let's see how it would look like for querying an ``OECD`` datasource:
```{r, eval = FALSE,message = FALSE,results="hide"}
sdmx <- readSDMX(providerId = "OECD", resource = "data", flowRef = "MIG",
key = list("TOT", NULL, NULL), start = 2010, end = 2011)
df <- as.data.frame(sdmx)
head(df)
```
It is also possible to query a dataset together with its "definition", handled
in a separate SDMX-ML document named ``DataStructureDefinition`` (DSD). It is
particularly useful when you want to enrich your dataset with all labels. For this,
you need the DSD which contains all reference data.
To do so, you only need to append ``dsd = TRUE`` (default value is ``FALSE``),
to the previous request, and specify ``labels = TRUE`` when calling ``as.data.frame``,
as follows:
```{r, eval = FALSE,message = FALSE,results="hide"}
sdmx <- readSDMX(providerId = "OECD", resource = "data", flowRef = "MIG",
key = list("TOT", NULL, NULL), start = 2010, end = 2011,
dsd = TRUE)
df <- as.data.frame(sdmx, labels = TRUE)
head(df)
```
For embedded service providers that require a user authentication/subscription key or token,
it is possible to specify it in ``readSDMX`` with the ``providerKey`` argument. If provided,
and that the embedded provider requires a specific key parameter, the latter will be appended
to the SDMX web-request. For example, it's the case for the new [https://apiportal.uis.unesco.org/getting-started](UNESCO SDMX API).
Note that in case you are reading SDMX-ML documents with the native approach (with
URLs), instead of the embedded providers, it is also possible to associate a DSD
to a dataset by using the function ``setDSD``. Let's try how it works:
```{r, eval = FALSE,message = FALSE,results="hide"}
#data without DSD
sdmx.data <- readSDMX(providerId = "OECD", resource = "data", flowRef = "MIG",
key = list("TOT", NULL, NULL), start = 2010, end = 2011)
#DSD
sdmx.dsd <- readSDMX(providerId = "OECD", resource = "datastructure", resourceId = "MIG")
#associate data and dsd
sdmx.data <- setDSD(sdmx.data, sdmx.dsd)
```
### Read _local_ datasets
This example shows you how to use ``rsdmx`` with _local_ SDMX files, previously downloaded from [EUROSTAT](http://ec.europa.eu/eurostat).
```{r, eval = FALSE}
#bulk download from Eurostat
tf <- tempfile(tmpdir = tdir <- tempdir()) #temp file and folder
download.file("http://ec.europa.eu/eurostat/estat-navtree-portlet-prod/BulkDownloadListing?sort=1&file=data%2Frd_e_gerdsc.sdmx.zip", tf)
sdmx_files <- unzip(tf, exdir = tdir)
#read local SDMX (set isURL = FALSE)
sdmx <- readSDMX(sdmx_files[2], isURL = FALSE)
stats <- as.data.frame(sdmx)
```
By default, ``readSDMX`` considers the data source is remote. To read a local file, add ``isURL = FALSE``.
## Read metadata documents
This section will introduce you on how to read SDMX **metadata** documents, including ``concepts``, ``codelists`` and a complete ``data structure definition`` (DSD)
### Codelists
Read codelists from [FAO data portal](http://data.fao.org/sdmx/index.html)
```{r,eval = FALSE,results="hide"}
clUrl <- "http://data.fao.org/sdmx/registry/codelist/FAO/CL_FAO_MAJOR_AREA/0.1"
clobj <- readSDMX(clUrl)
cldf <- as.data.frame(clobj)
```
### Data Structure Definition (DSD)
This example illustrates how to read a complete DSD using a [OECD StatExtracts portal](http://stats.oecd.org) data source.
```{r,eval = FALSE,results="hide"}
dsdUrl <- "http://stats.oecd.org/restsdmx/sdmx.ashx/GetDataStructure/TABLE1"
dsd <- readSDMX(dsdUrl)
```
``rsdmx`` is implemented in object-oriented way with ``S4`` classes and methods. The properties of ``S4`` objects are named ``slots`` and can be accessed with the ``slot`` method. The following code snippet allows to extract the list of ``codelists`` contained in the DSD document, and read one codelist as ``data.frame``.
```{r,eval = FALSE,results="hide"}
#get codelists from DSD
cls <- slot(dsd, "codelists")
#get list of codelists
codelists <- sapply(slot(cls, "codelists"), function(x) slot(x, "id"))
#get a codelist
codelist <- as.data.frame(slot(dsd, "codelists"), codelistId = "CL_TABLE1_FLOWS")
```
In a similar way, the ``concepts`` of the dataset can be extracted from the DSD and read as ``data.frame``.
```{r,eval = FALSE,results="hide"}
#get concepts from DSD
concepts <- as.data.frame(slot(dsd, "concepts"))
```
## Save & Reload SDMX R objects
It is possible to save SDMX R objects as RData file (.RData, .rda, .rds), to then
be able to reload them into the R session. It could be of added value for users that
want to keep their SDMX objects in R data files, but also for fast loading of large SDMX
objects (e.g. DSD objects) for use in statistical analyses and R-based web-applications.
To save a SDMX R object to RData file:
```{r, eval = FALSE, results="hide"}
saveSDMX(sdmx, "tmp.RData")
```
To reload a SDMX R object from RData file:
```{r, eval = FALSE, results="hide"}
sdmx <- readSDMX("tmp.RData", isRData = TRUE)
``` rsdmx/inst/doc/quickstart.R 0000644 0001762 0000144 00000006423 13241016541 015450 0 ustar ligges users ## ---- eval=FALSE, results="hide"-----------------------------------------
# devtools::install_github("opensdmx/rsdmx")
## ----eval = FALSE,results="hide"-----------------------------------------
# library(rsdmx)
## ----eval = FALSE,results="hide"-----------------------------------------
# myUrl <- "http://stats.oecd.org/restsdmx/sdmx.ashx/GetData/MIG/TOT../OECD?startTime=2000&endTime=2011"
# dataset <- readSDMX(myUrl)
# stats <- as.data.frame(dataset)
## ----eval = FALSE,results="hide"-----------------------------------------
# providers <- getSDMXServiceProviders();
# as.data.frame(providers)
## ---- eval = FALSE,message = FALSE,results="hide"------------------------
# sdmx <- readSDMX(providerId = "OECD", resource = "data", flowRef = "MIG",
# key = list("TOT", NULL, NULL), start = 2010, end = 2011)
# df <- as.data.frame(sdmx)
# head(df)
## ---- eval = FALSE,message = FALSE,results="hide"------------------------
# sdmx <- readSDMX(providerId = "OECD", resource = "data", flowRef = "MIG",
# key = list("TOT", NULL, NULL), start = 2010, end = 2011,
# dsd = TRUE)
# df <- as.data.frame(sdmx, labels = TRUE)
# head(df)
## ---- eval = FALSE,message = FALSE,results="hide"------------------------
# #data without DSD
# sdmx.data <- readSDMX(providerId = "OECD", resource = "data", flowRef = "MIG",
# key = list("TOT", NULL, NULL), start = 2010, end = 2011)
#
# #DSD
# sdmx.dsd <- readSDMX(providerId = "OECD", resource = "datastructure", resourceId = "MIG")
#
# #associate data and dsd
# sdmx.data <- setDSD(sdmx.data, sdmx.dsd)
## ---- eval = FALSE-------------------------------------------------------
# #bulk download from Eurostat
# tf <- tempfile(tmpdir = tdir <- tempdir()) #temp file and folder
# download.file("http://ec.europa.eu/eurostat/estat-navtree-portlet-prod/BulkDownloadListing?sort=1&file=data%2Frd_e_gerdsc.sdmx.zip", tf)
# sdmx_files <- unzip(tf, exdir = tdir)
#
# #read local SDMX (set isURL = FALSE)
# sdmx <- readSDMX(sdmx_files[2], isURL = FALSE)
# stats <- as.data.frame(sdmx)
#
## ----eval = FALSE,results="hide"-----------------------------------------
# clUrl <- "http://data.fao.org/sdmx/registry/codelist/FAO/CL_FAO_MAJOR_AREA/0.1"
# clobj <- readSDMX(clUrl)
# cldf <- as.data.frame(clobj)
## ----eval = FALSE,results="hide"-----------------------------------------
# dsdUrl <- "http://stats.oecd.org/restsdmx/sdmx.ashx/GetDataStructure/TABLE1"
# dsd <- readSDMX(dsdUrl)
## ----eval = FALSE,results="hide"-----------------------------------------
# #get codelists from DSD
# cls <- slot(dsd, "codelists")
#
# #get list of codelists
# codelists <- sapply(slot(cls, "codelists"), function(x) slot(x, "id"))
#
# #get a codelist
# codelist <- as.data.frame(slot(dsd, "codelists"), codelistId = "CL_TABLE1_FLOWS")
## ----eval = FALSE,results="hide"-----------------------------------------
# #get concepts from DSD
# concepts <- as.data.frame(slot(dsd, "concepts"))
## ---- eval = FALSE, results="hide"---------------------------------------
# saveSDMX(sdmx, "tmp.RData")
## ---- eval = FALSE, results="hide"---------------------------------------
# sdmx <- readSDMX("tmp.RData", isRData = TRUE)
rsdmx/inst/doc/quickstart.html 0000644 0001762 0000144 00000061011 13241016541 016205 0 ustar ligges users
rsdmx quickstart guide
rsdmx quickstart guide
The goal of this document is to get you up and running with rsdmx as quickly as possible.
rsdmx
provides a set of classes and methods to read data and metadata documents exchanged through the Statistical Data and Metadata Exchange (SDMX) framework.
SDMX - a short introduction
The SDMX framework provides two sets of standard specifications to facilitate the exchange of statistical data:
- standard formats
- web-service specifications
SDMX allows to disseminate both data (a dataset) and metadata (the description of the dataset).
For this, the SDMX standard provides various types of documents, also known as messages. Hence there will be:
- data SDMX-ML documents. The two main document types are the
Generic
and Compact
ones. The latter aims to provide a more compact XML document. They are other data document types derivating from the ones previously mentioned.
- metadata SDMX-ML documents. The main metadata document is known a
Data Structure Definition
(DSD). As its name indicates, it describes the structure and organization of a dataset, and will generally include all the master/reference data used to characterize a dataset. The 2 main types of metadata are (1) the concepts
, which correspond to the dimensions and/or attributes of the dataset, and (2) the codelists
which inventory the possible values to be used in the representation of dimensions and attributes.
For more information about the SDMX standards, you can visit the SDMX website, or this introduction by EUROSTAT.
How to deal with SDMX in R
rsdmx offers a low-level set of tools to read data and metadata in the SDMX-ML format. Its strategy is to make it very easy for the user. For this, a unique function named readSDMX
has to be used, whatever it is a data
or metadata
document, or if it is local
or remote
datasource.
What rsdmx
does support:
a SDMX format abstraction library, with focus on the the main SDMX standard XML format (SDMX-ML), and the support of the three format standard versions (1.0
, 2.0
, 2.1
)
an interface to SDMX web-services for a list of well-known data providers, such as OECD, EUROSTAT, ECB, UN FAO, UN ILO, etc (a list that should grow in a near future!). See it in action!
Let's see then how to use rsdmx
!
Install rsdmx
rsdmx
can be installed from CRAN or from its development repository hosted in Github. For the latter, you will need the devtools
package and run:
devtools::install_github("opensdmx/rsdmx")
Load rsdmx
To load rsdmx in R, do the following:
library(rsdmx)
Read dataset documents
This section will introduce you on how to read SDMX dataset documents, either from remote datasources, or from local SDMX files.
Read remote datasets
using the raw approach (specifying the complete request URL)
The following code snipet shows you how to read a dataset from a remote data source, taking as example the OECD StatExtracts portal: http://stats.oecd.org/restsdmx/sdmx.ashx/GetData/MIG/TOT../OECD?startTime=2000&endTime=2011
myUrl <- "http://stats.oecd.org/restsdmx/sdmx.ashx/GetData/MIG/TOT../OECD?startTime=2000&endTime=2011"
dataset <- readSDMX(myUrl)
stats <- as.data.frame(dataset)
You can try it out with other datasources, such as from the EUROSTAT portal: http://ec.europa.eu/eurostat/SDMX/diss-web/rest/data/cdh_e_fos/..PC.FOS1.BE/?startperiod=2005&endPeriod=2011
The online rsdmx documentation also provides a list of data providers, either from international or national institutions, and more request examples.
using the helper approach
Now, the service providers above mentioned are known by rsdmx
which let users using readSDMX
with the helper parameters. The list of service providers can be retrieved doing:
providers <- getSDMXServiceProviders();
as.data.frame(providers)
Note it is also possible to add an SDMX service provider at runtime. For registering a new SDMX service provider by default, please contact me!
Let's see how it would look like for querying an OECD
datasource:
sdmx <- readSDMX(providerId = "OECD", resource = "data", flowRef = "MIG",
key = list("TOT", NULL, NULL), start = 2010, end = 2011)
df <- as.data.frame(sdmx)
head(df)
It is also possible to query a dataset together with its “definition”, handled
in a separate SDMX-ML document named DataStructureDefinition
(DSD). It is
particularly useful when you want to enrich your dataset with all labels. For this,
you need the DSD which contains all reference data.
To do so, you only need to append dsd = TRUE
(default value is FALSE
),
to the previous request, and specify labels = TRUE
when calling as.data.frame
,
as follows:
sdmx <- readSDMX(providerId = "OECD", resource = "data", flowRef = "MIG",
key = list("TOT", NULL, NULL), start = 2010, end = 2011,
dsd = TRUE)
df <- as.data.frame(sdmx, labels = TRUE)
head(df)
For embedded service providers that require a user authentication/subscription key or token,
it is possible to specify it in readSDMX
with the providerKey
argument. If provided,
and that the embedded provider requires a specific key parameter, the latter will be appended
to the SDMX web-request. For example, it's the case for the new https://apiportal.uis.unesco.org/getting-started.
Note that in case you are reading SDMX-ML documents with the native approach (with
URLs), instead of the embedded providers, it is also possible to associate a DSD
to a dataset by using the function setDSD
. Let's try how it works:
#data without DSD
sdmx.data <- readSDMX(providerId = "OECD", resource = "data", flowRef = "MIG",
key = list("TOT", NULL, NULL), start = 2010, end = 2011)
#DSD
sdmx.dsd <- readSDMX(providerId = "OECD", resource = "datastructure", resourceId = "MIG")
#associate data and dsd
sdmx.data <- setDSD(sdmx.data, sdmx.dsd)
Read local datasets
This example shows you how to use rsdmx
with local SDMX files, previously downloaded from EUROSTAT.
#bulk download from Eurostat
tf <- tempfile(tmpdir = tdir <- tempdir()) #temp file and folder
download.file("http://ec.europa.eu/eurostat/estat-navtree-portlet-prod/BulkDownloadListing?sort=1&file=data%2Frd_e_gerdsc.sdmx.zip", tf)
sdmx_files <- unzip(tf, exdir = tdir)
#read local SDMX (set isURL = FALSE)
sdmx <- readSDMX(sdmx_files[2], isURL = FALSE)
stats <- as.data.frame(sdmx)
By default, readSDMX
considers the data source is remote. To read a local file, add isURL = FALSE
.
Read metadata documents
This section will introduce you on how to read SDMX metadata documents, including concepts
, codelists
and a complete data structure definition
(DSD)
Codelists
Read codelists from FAO data portal
clUrl <- "http://data.fao.org/sdmx/registry/codelist/FAO/CL_FAO_MAJOR_AREA/0.1"
clobj <- readSDMX(clUrl)
cldf <- as.data.frame(clobj)
Data Structure Definition (DSD)
This example illustrates how to read a complete DSD using a OECD StatExtracts portal data source.
dsdUrl <- "http://stats.oecd.org/restsdmx/sdmx.ashx/GetDataStructure/TABLE1"
dsd <- readSDMX(dsdUrl)
rsdmx
is implemented in object-oriented way with S4
classes and methods. The properties of S4
objects are named slots
and can be accessed with the slot
method. The following code snippet allows to extract the list of codelists
contained in the DSD document, and read one codelist as data.frame
.
#get codelists from DSD
cls <- slot(dsd, "codelists")
#get list of codelists
codelists <- sapply(slot(cls, "codelists"), function(x) slot(x, "id"))
#get a codelist
codelist <- as.data.frame(slot(dsd, "codelists"), codelistId = "CL_TABLE1_FLOWS")
In a similar way, the concepts
of the dataset can be extracted from the DSD and read as data.frame
.
#get concepts from DSD
concepts <- as.data.frame(slot(dsd, "concepts"))
Save & Reload SDMX R objects
It is possible to save SDMX R objects as RData file (.RData, .rda, .rds), to then
be able to reload them into the R session. It could be of added value for users that
want to keep their SDMX objects in R data files, but also for fast loading of large SDMX
objects (e.g. DSD objects) for use in statistical analyses and R-based web-applications.
To save a SDMX R object to RData file:
saveSDMX(sdmx, "tmp.RData")
To reload a SDMX R object from RData file:
sdmx <- readSDMX("tmp.RData", isRData = TRUE)
rsdmx/tests/ 0000755 0001762 0000144 00000000000 13214045142 012545 5 ustar ligges users rsdmx/tests/testthat/ 0000755 0001762 0000144 00000000000 13214045142 014405 5 ustar ligges users rsdmx/tests/testthat/test_MessageGroup.R 0000644 0001762 0000144 00000001734 12671523140 020202 0 ustar ligges users # test_MessageGroup.R
# Author: Emmanuel Blondel
#
# Description: Unit tests for SDMX MessageGroup methods
#=======================
require(rsdmx, quietly = TRUE)
require(testthat)
context("SDMXMessageGroup")
test_that("MessageGroup - GenericData 2.0",{
file <- system.file("extdata", "SDMXMessageGroupExample_GenericData_2.0.xml",
package = "rsdmx")
xmlObj <- xmlParse(file)
ns <- namespaces.SDMX(xmlObj)
ds <- SDMXMessageGroup(xmlObj, ns)
expect_is(ds, "SDMXMessageGroup")
df <- as.data.frame(ds)
expect_is(df, "data.frame")
})
test_that("MessageGroup - CompactData 2.0",{
file <- system.file("extdata", "SDMXMessageGroupExample_CompactData_2.0.xml",
package = "rsdmx")
xmlObj <- xmlParse(file)
ns <- namespaces.SDMX(xmlObj)
ds <- SDMXMessageGroup(xmlObj, ns)
expect_is(ds, "SDMXMessageGroup")
df <- as.data.frame(ds)
expect_is(df, "data.frame")
})
rsdmx/tests/testthat/test_Header.R 0000644 0001762 0000144 00000003321 12671523366 016775 0 ustar ligges users # test_Header.R
# Author: Emmanuel Blondel
#
# Description: Unit tests for SDMX Header methods
#=======================
require(rsdmx, quietly = TRUE)
require(testthat)
context("SDMXHeader")
test_that("SDMXHeader - 2.0",{
file <- system.file("extdata", "SDMXMessageExample_2.0.xml", package = "rsdmx")
xmlObj <- xmlParse(file)
ns <- namespaces.SDMX(xmlObj)
obj = SDMXHeader(xmlObj, ns)
expect_is(obj, "SDMXHeader")
expect_equal(obj@ID, "data.organization.org")
expect_false(obj@Test)
expect_false(obj@Truncated)
expect_equal(obj@Name, "thename")
expect_equal(obj@Prepared, as.POSIXlt(strptime("2014-03-02T16:29:26", format = "%Y-%m-%dT%H:%M:%S")))
expect_is(obj@Sender, "list")
expect_equal(obj@Sender$id, "ORGANIZATION")
expect_equal(obj@Sender$name$en, "Organization")
expect_equal(obj@Sender$name$fr, "Organisation")
expect_equal(obj@Receiver$id, NA)
expect_equal(obj@ReportingBegin, as.POSIXlt(strptime(ISOdate(2000,1,1), format = "%Y-%m-%d")))
expect_equal(obj@ReportingEnd, as.POSIXlt(strptime(ISOdate(2008,12,31), format = "%Y-%m-%d")))
})
test_that("SDMXHeader - 2.1",{
file <- system.file("extdata", "SDMXMessageExample_2.1.xml", package = "rsdmx")
xmlObj <- xmlParse(file)
ns <- namespaces.SDMX(xmlObj)
obj = SDMXHeader(xmlObj, ns)
expect_is(obj, "SDMXHeader")
expect_equal(obj@ID, "176ea8e40bfc189c8113edf292a3abb4")
expect_false(obj@Test)
expect_equal(obj@Prepared, as.POSIXlt(strptime("2014-07-18T07:04:39", format = "%Y-%m-%dT%H:%M:%S")))
expect_is(obj@Sender, "list")
expect_equal(obj@Sender$id, "ESTAT")
expect_equal(obj@Sender$name$en, "Eurostat")
expect_equal(obj@Receiver$id, "RECEIVER")
})
rsdmx/tests/testthat/test_Soap.R 0000644 0001762 0000144 00000001166 12671524434 016511 0 ustar ligges users # test_SOAP.R
# Author: Emmanuel Blondel
#
# Description: Unit tests for SDMX SOAP responses
#=======================
require(rsdmx, quietly = TRUE)
require(testthat)
context("SDMXSoapResponse")
test_that("SOAP - CompactData",{
file <- system.file("extdata", "SDMX_SOAP_Example.xml", package = "rsdmx")
xmlObj <- xmlParse(file)
ns <- namespaces.SDMX(xmlObj)
expect_true(isSoapRequestEnvelope(xmlObj, ns))
xmlObj <- getSoapRequestResult(xmlObj)
expect_false(isSoapRequestEnvelope(xmlObj, ns))
ds <- SDMXCompactData(xmlObj, ns)
expect_is(ds, "SDMXCompactData")
}) rsdmx/tests/testthat/test_Type.R 0000644 0001762 0000144 00000002114 12613527132 016514 0 ustar ligges users # test_Type.R
# Author: Emmanuel Blondel
#
# Description: Unit tests for SDMX Type
#=======================
require(rsdmx, quietly = TRUE)
require(testthat)
context("SDMXType")
#read test data
file1 <- system.file("extdata", "SDMXMessageExample_2.0.xml", package = "rsdmx")
file2 <- system.file("extdata", "SDMXMessageExample_2.1.xml", package = "rsdmx")
xmlObj1 <- xmlParse(file1)
xmlObj2 <- xmlParse(file2)
test_that("type.SDMXType - 2.0",{
type1 <- type.SDMXType(xmlObj1)
expect_equal(type1, "GenericDataType")
})
test_that("type.SDMXType - 2.1",{
type2 <- type.SDMXType(xmlObj2)
expect_equal(type2, "GenericDataType")
})
test_that("SDMXType - 2.0",{
obj1 <- SDMXType(xmlObj1)
expect_is(obj1, "SDMXType")
})
test_that("SDMXType - 2.1",{
obj2 <- SDMXType(xmlObj2)
expect_is(obj2, "SDMXType")
})
test_that("getType - 2.0",{
obj1 <- SDMXType(xmlObj1)
expect_equal(obj1@type, "GenericDataType")
})
test_that("getType - 2.1",{
obj2 <- SDMXType(xmlObj2)
expect_equal(obj2@type, "GenericDataType")
})
rsdmx/tests/testthat/test_DataStructures.R 0000644 0001762 0000144 00000004240 12671520470 020554 0 ustar ligges users # test_DataStructures.R
# Author: Emmanuel Blondel
#
# Description: Unit tests for SDMX DataStructures methods
#=======================
require(rsdmx, quietly = TRUE)
require(testthat)
context("SDMXDataStructures")
test_that("DataStructures / KeyFamilies - 2.0",{
file <- system.file("extdata", "SDMXDataStructures_Example_2.0.xml",
package = "rsdmx")
xmlObj <- xmlParse(file)
ns <- namespaces.SDMX(xmlObj)
ds <- SDMXDataStructures(xmlObj, ns)
expect_is(ds, "SDMXDataStructures")
expect_equal(length(ds@datastructures), 1L)
ds.df <- as.data.frame(ds)
expect_is(ds.df, "data.frame")
expect_equal(nrow(ds.df), 1L)
expect_equal(colnames(ds.df), c("id","agencyID","Name.en", "version",
"uri", "urn", "isExternalReference", "isFinal",
"validFrom", "validTo"))
expect_equal(ds.df[1,"id"], "TRADE_DATASTRUCTURE")
expect_equal(ds.df[1, "agencyID"], "FAO")
expect_equal(ds.df[1, "Name.en"], "TRADE_DATASTRUCTURE")
expect_equal(ds.df[1, "version"], "0.1")
expect_equal(ds.df[1, "urn"], "urn:sdmx:org.sdmx.infomodel.DataStructure=FAO:TRADE_DATASTRUCTURE[0.1]")
})
test_that("DataStructures / KeyFamilies - 2.1",{
file <- system.file("extdata", "SDMXDataStructures_Example_2.1.xml",
package = "rsdmx")
xmlObj <- xmlParse(file)
ns <- namespaces.SDMX(xmlObj)
ds <- SDMXDataStructures(xmlObj, ns)
expect_is(ds, "SDMXDataStructures")
expect_equal(length(ds@datastructures), 1L)
ds.df <- as.data.frame(ds)
expect_is(ds.df, "data.frame")
expect_equal(nrow(ds.df), 1L)
expect_equal(colnames(ds.df), c("id","agencyID","Name.en", "version",
"uri", "urn", "isExternalReference", "isFinal",
"validFrom", "validTo"))
expect_equal(ds.df[1,"id"], "ECB_EXR1")
expect_equal(ds.df[1, "agencyID"], "ECB")
expect_equal(ds.df[1, "Name.en"], "Exchange Rates")
expect_equal(ds.df[1, "version"], "1.0")
expect_equal(ds.df[1, "urn"], "urn:sdmx:org.sdmx.infomodel.datastructure.DataStructure=ECB:ECB_EXR1(1.0)")
})
rsdmx/tests/testthat/test_DataStructureDefinition.R 0000644 0001762 0000144 00000002451 13120307702 022373 0 ustar ligges users # test_DataStructureDefinition.R
# Author: Emmanuel Blondel
#
# Description: Unit tests for SDMX DataStructureDefinition (DSD) methods
#=======================
require(rsdmx, quietly = TRUE)
require(testthat)
context("SDMXDataStructureDefinition")
test_that("DataStructureDefinition (DSD) - 2.0",{
file <- system.file("extdata", "SDMXDataStructureDefinition_Example_2.0.xml",
package = "rsdmx")
xmlObj <- xmlParse(file)
ns <- namespaces.SDMX(xmlObj)
dsd <- SDMXDataStructureDefinition(xmlObj, ns)
expect_is(dsd, "SDMXDataStructureDefinition")
expect_is(dsd@concepts, "SDMXConcepts")
expect_is(dsd@codelists, "SDMXCodelists")
expect_is(dsd@datastructures, "SDMXDataStructures")
})
test_that("DataStructureDefinition (DSD) - 2.1",{
file <- system.file("extdata", "SDMXDataStructureDefinition_Example_2.1.xml",
package = "rsdmx")
xmlObj <- xmlParse(file)
ns <- namespaces.SDMX(xmlObj)
dsd <- SDMXDataStructureDefinition(xmlObj, ns)
expect_is(dsd, "SDMXDataStructureDefinition")
expect_is(dsd@organisationSchemes, "SDMXOrganisationSchemes")
expect_is(dsd@concepts, "SDMXConcepts")
expect_is(dsd@codelists, "SDMXCodelists")
expect_is(dsd@datastructures, "SDMXDataStructures")
})
rsdmx/tests/testthat/test_Namespaces.R 0000644 0001762 0000144 00000001771 12671523500 017661 0 ustar ligges users # test_Namespaces.R
# Author: Emmanuel Blondel
#
# Description: Unit tests for Namespace functions
#=======================
require(rsdmx, quietly = TRUE)
require(testthat)
context("Namespaces")
test_that("getNamespaces",{
file <- system.file("extdata", "SDMXGenericDataExample_2.0.xml", package = "rsdmx")
sdmx <- readSDMX(file, isURL = FALSE)
namespaces <- getNamespaces(sdmx)
expect_is(namespaces, "data.frame")
expect_equal("uri", colnames(namespaces))
expect_equal(11L, nrow(namespaces))
})
test_that("findNamespace",{
file <- system.file("extdata", "SDMXGenericDataExample_2.0.xml", package = "rsdmx")
sdmx <- readSDMX(file, isURL = FALSE)
namespaces <- getNamespaces(sdmx)
namespace <- findNamespace(namespaces, "generic")
expect_is(namespace, "character")
expect_equal(1L, length(namespace))
expect_equal("http://www.SDMX.org/resources/SDMXML/schemas/v2_0/generic",
as.character(namespace))
})
rsdmx/tests/testthat/test_OrganisationSchemes.R 0000644 0001762 0000144 00000002230 13120307604 021531 0 ustar ligges users # test_OrganisationSchemes.R
# Author: Emmanuel Blondel
#
# Description: Unit tests for SDMX DataStructures methods
#=======================
require(rsdmx, quietly = TRUE)
require(testthat)
context("SDMXOrganisationSchemes")
test_that("OrganisationSchemes - 2.1",{
file <- system.file("extdata", "SDMXOrganisationSchemes_Example_2.1.xml",
package = "rsdmx")
xmlObj <- xmlParse(file)
ns <- namespaces.SDMX(xmlObj)
os <- SDMXOrganisationSchemes(xmlObj, ns)
expect_is(os, "SDMXOrganisationSchemes")
expect_equal(length(os@organisationSchemes), 1L)
os.df <- as.data.frame(os)
expect_is(os.df, "data.frame")
expect_equal(nrow(os.df), 1L)
expect_equal(colnames(os.df), c("id","agencyID", "version",
"uri", "urn", "isExternalReference", "isFinal",
"validFrom", "validTo"))
expect_equal(os.df[1,"id"], "AGENCIES")
expect_equal(os.df[1, "agencyID"], "SDMX")
expect_equal(os.df[1, "version"], "1.0")
expect_equal(os.df[1, "urn"], "urn:sdmx:org.sdmx.infomodel.base.AgencyScheme=SDMX:AGENCIES(1.0)")
})
rsdmx/tests/testthat/test_DataFlows.R 0000644 0001762 0000144 00000002462 12750134064 017465 0 ustar ligges users # test_DataFlows.R
# Author: Emmanuel Blondel
#
# Description: Unit tests for SDMX DataFlows methods
#=======================
require(rsdmx, quietly = TRUE)
require(testthat)
context("SDMXDataFlows")
test_that("DataFlows - 2.1",{
file <- system.file("extdata", "SDMXDataFlows_Example_2.1.xml", package = "rsdmx")
xmlObj <- xmlParse(file)
ns <- namespaces.SDMX(xmlObj)
flow <- SDMXDataFlows(xmlObj, ns)
expect_is(flow, "SDMXDataFlows")
expect_equal(length(flow@dataflows), 5L)
flow.df <- as.data.frame(flow)
expect_is(flow.df, "data.frame")
expect_equal(nrow(flow.df), 5L)
expect_equal(colnames(flow.df), c("id","agencyID",
"Name.fr", "Name.en", "Name.es",
"version", "uri", "urn", "isExternalReference",
"isFinal", "validFrom", "validTo", "dsdRef"))
expect_equal(flow.df[1,"id"], "DS-001")
expect_equal(flow.df[1, "agencyID"], "MYORG")
expect_equal(flow.df[1, "Name.en"], "Dataset 1")
expect_equal(flow.df[1, "version"], "1.0")
expect_equal(flow.df[1, "urn"], "urn:sdmx:org.sdmx.infomodel.datastructure.Dataflow=MYORG:DS-001(1.0)")
expect_equal(flow.df[1, "dsdRef"], "DSD_DS-001")
expect_equal(flow.df[1, "dsd"], NULL)
})
rsdmx/tests/testthat/test_CompactData.R 0000644 0001762 0000144 00000001400 12671520312 017745 0 ustar ligges users # test_CompactData.R
# Author: Emmanuel Blondel
#
# Description: Unit tests for SDMX CompactData methods
#=======================
require(rsdmx, quietly = TRUE)
require(testthat)
context("SDMXCompactData")
test_that("CompactData 2.0",{
file <- system.file("extdata", "SDMXCompactDataExample_2.0.xml", package = "rsdmx")
xmlObj <- xmlParse(file)
ns <- namespaces.SDMX(xmlObj)
ds <- SDMXCompactData(xmlObj, ns)
expect_is(ds, "SDMXCompactData")
df <- as.data.frame(ds)
expect_is(df, "data.frame")
#test absence data
expect_true(is.na(df[nrow(df),]$YEA))
expect_true(is.na(df[nrow(df),]$OBS_VALUE))
expect_true(is.na(df[nrow(df)-1,]$YEA))
expect_true(is.na(df[nrow(df)-1,]$OBS_VALUE))
}) rsdmx/tests/testthat/test_Footer.R 0000644 0001762 0000144 00000003042 12671520546 017040 0 ustar ligges users # test_Footer.R
# Author: Emmanuel Blondel
#
# Description: Unit tests for SDMX Footer methods
#=======================
require(rsdmx, quietly = TRUE)
require(testthat)
context("SDMXFooter")
test_that("SDMXFooter - 2.0",{
file <- system.file("extdata", "SDMXMessageExample_2.0.xml", package = "rsdmx")
xmlObj <- xmlParse(file)
ns <- namespaces.SDMX(xmlObj)
obj = SDMXFooter(xmlObj, ns)
expect_is(obj, "SDMXFooter")
expect_equal(length(obj@messages),0)
})
test_that("SDMXFooter - 2.1",{
file <- system.file("extdata", "SDMXMessageExample_2.1.xml", package = "rsdmx")
xmlObj <- xmlParse(file)
ns <- namespaces.SDMX(xmlObj)
obj = SDMXFooter(xmlObj, ns)
expect_is(obj, "SDMXFooter")
obj.messages = obj@messages
expect_equal(length(obj@messages),2)
obj1 = obj.messages[[1]]
expect_is(obj1, "SDMXFooterMessage")
expect_equal(obj1@code, "413")
expect_equal(obj1@severity, "Information")
obj1.messages = obj1@messages
expect_equal(length(obj1.messages),3)
expect_equal(obj1.messages[[1]], "info message 1")
expect_equal(obj1.messages[[2]], "info message 2")
expect_equal(obj1.messages[[3]], "info message 3")
obj2 = obj.messages[[2]]
expect_is(obj2, "SDMXFooterMessage")
expect_equal(obj2@code, "413")
expect_equal(obj2@severity, "Warning")
obj2.messages = obj2@messages
expect_equal(length(obj2.messages),2)
expect_equal(obj2.messages[[1]], "warning message 1")
expect_equal(obj2.messages[[2]], "warning message 2")
}) rsdmx/tests/testthat/test_Main_Helpers.R 0000644 0001762 0000144 00000044466 13235421130 020151 0 ustar ligges users # test_Main_Helpers.R
# Author: Emmanuel Blondel
#
# Description: Unit tests for SDMX Main methods
# using helpers to build the SDMX request
#=======================
require(rsdmx, quietly = TRUE)
require(testthat)
context("SDMXHelpers")
#testing main helpers arguments
#-> dataflow
test_that("Main helpers arguments",{
testthat::skip_on_travis()
testthat::skip_on_cran()
#existing provider
providerId1 <- "IMF"
provider1 <- findSDMXServiceProvider(providerId1)
sdmx <- readSDMX(provider = provider1, resource = "dataflow")
expect_false(is.null(sdmx))
expect_is(sdmx, "SDMXDataFlows")
sdmx <- readSDMX(providerId = providerId1, resource = "dataflow")
expect_false(is.null(sdmx))
expect_is(sdmx, "SDMXDataFlows")
#wrong provider
providerId2 <- "IMF!"
provider2 <- findSDMXServiceProvider(providerId2)
expect_error(readSDMX(provider = provider2, resource = "dataflow"), "Provider should be an instance of 'SDMXServiceProvider'")
expect_error(readSDMX(providerId = providerId2, resource = "dataflow"), "No provider with identifier IMF!")
#wrong request
expect_error(readSDMX(providerId = "KNOEMA", resource = "data", flowRef = "SADG2015-WRONG"),
"HTTP request failed with status: 400 Dataset not found.")
})
#international data providers
#ECB
#---
#-> dataflow
test_that("ECB - dataflow",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "ECB", resource = "dataflow")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataFlows")
}
})
#-> datastructure
test_that("ECB - datastructure",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "ECB", resource = "datastructure", resourceId = "ECB_DD1")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataStructureDefinition")
}
})
#-> data
test_that("ECB - data",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "ECB", resource = "data",
flowRef = "DD", key = "M.SE.BSI_STF.RO.4F_N", key.mode = "SDMX",
start = 2010, end = 2010)
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXGenericData")
}
})
#ESTAT (EUROSTAT)
#---------------
#-> dataflow
test_that("ESTAT - dataflow",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "ESTAT", resource = "dataflow")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataFlows")
}
})
#-> datastructure
test_that("ESTAT - datastructure",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "ESTAT", resource = "datastructure", resourceId = "DSD_nama_gdp_c")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataStructureDefinition")
}
})
#-> data
test_that("ESTAT - data",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "ESTAT", resource = "data",
flowRef = "cdh_e_fos", key = list(NULL, NULL, "PC", "FOS1", "BE"),
start = 2005, end = 2010)
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXGenericData")
}
})
#IMF
#---
#-> dataflow
test_that("IMF - dataflow",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "IMF", resource = "dataflow", agencyId = "IMF")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataFlows")
}
})
#-> datastructure
test_that("IMF - datastructure",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "IMF", resource = "datastructure", resourceId = "BOP")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataStructureDefinition")
}
})
#-> data
test_that("IMF - data",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "IMF", resource = "data",
flowRef = "BOP_GBPM6", start = 2010, end = 2015)
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXStructureSpecificData")
}
})
#OECD
#----
#-> dataflow
test_that("OECD - dataflow",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "OECD", resource = "dataflow")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataFlows")
}
})
#-> datastructure
test_that("OECD - datastructure",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "OECD", resource = "datastructure", resourceId = "TABLE1")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataStructureDefinition")
}
})
#-> data
test_that("OECD - data",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "OECD", resource = "data",
flowRef = "MIG", key = list("TOT", NULL, NULL), start = 2011, end = 2011)
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXMessageGroup")
}
})
#UNSD (UN-DATA)
#----
#-> dataflow
test_that("UNSD - dataflow",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "UNSD", resource = "dataflow")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataFlows")
}
})
#-> datastructure
test_that("UNSD - datastructure",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "UNSD", resource = "datastructure", resourceId = "CountryData")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataStructureDefinition")
}
})
#-> data
test_that("UNSD - data",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "UNSD", resource = "data",
flowRef = "DF_UNDATA_COUNTRYDATA", key = NULL,
start = 2011, end = 2011)
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXGenericData")
}
})
#FAO (UN-FAO)
#------------
#-> datastructure
test_that("FAO - datastructure",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "FAO", resource = "datastructure", resourceId = "FAOSTAT")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataStructureDefinition")
}
})
#-> data
test_that("FAO - data",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "FAO", resource = "data",
flowRef = "CROP_PRODUCTION", key = list(NULL, "156", "5312", NULL, NULL),
start = "2010", end = "2014")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXGenericData")
}
})
#ILO (UN-ILO)
#------------
#-> datastructure
test_that("ILO - datastructure",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "ILO", resource = "datastructure", resourceId = "YI_ALB_EAP_TEAP_SEX_AGE_NB")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataStructureDefinition")
}
})
#-> data
test_that("ILO - data",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "ILO", resource = "data",
flowRef = "DF_CPI_FRA_CPI_TCPI_COI_RT", key = "ALL", key.mode = "SDMX",
start = "2010-01-01", end = "2014-12-31")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXGenericData")
}
})
#UIS (UNESCO)
#------------
#-> dataflow
test_that("UIS - dataflow",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "UIS", resource = "dataflow")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataFlows")
}
})
#-> datastructure
test_that("UIS - datastructure",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "UIS", resource = "datastructure", resourceId = "EDULIT_DS")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataStructureDefinition")
}
})
#-> data
test_that("UIS - data",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "UIS", resource = "data",
flowRef = "EDULIT_DS", key = list("OFST_1_CP", NULL),
start = "2000", end = "2015")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXMessageGroup")
}
})
#UIS2 (UNESCO - new API https://apiportal.uis.unesco.org)
#------------
#-> dataflow
test_that("UIS2 - dataflow",{
testthat::skip_on_travis()
testthat::skip_on_cran()
apiKey <- Sys.getenv("UIS_API_KEY")
if(apiKey != ""){
sdmx <- readSDMX(providerId = "UIS2", providerKey = apiKey, resource = "dataflow")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataFlows")
}
}
})
#-> datastructure
test_that("UIS2 - datastructure",{
testthat::skip_on_travis()
testthat::skip_on_cran()
apiKey <- Sys.getenv("UIS_API_KEY")
if(apiKey != ""){
sdmx <- readSDMX(providerId = "UIS2", providerKey = apiKey, resource = "datastructure", resourceId = "CE")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataStructureDefinition")
}
}
})
#-> data
test_that("UIS2 - data",{
testthat::skip_on_travis()
testthat::skip_on_cran()
apiKey <- Sys.getenv("UIS_API_KEY")
if(apiKey != ""){
sdmx <- readSDMX(providerId = "UIS2", providerKey = apiKey, resource = "data",
flowRef = "CE", start = "2000", end = "2015")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXStructureSpecificData")
}
}
})
#WBG_WITS
#--------
#-> dataflow
test_that("WBG_WITS - dataflow",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "WBG_WITS", resource = "dataflow")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataFlows")
}
})
#-> datastructure
test_that("WBG_WITS - datastructure",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "WBG_WITS", resource = "datastructure", resourceId = "TARIFF_TRAINS")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataStructureDefinition")
}
})
#-> data
test_that("WBG_WITS - data",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "WBG_WITS", resource = "data",
key = ".840.000.020110.reported", key.mode = "SDMX",
flowRef = "DF_WITS_Tariff_TRAINS", start = "2000", end = "2015")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXGenericData")
}
})
#national data providers
#ABS (Australia)
#-------------
#-> datastructure
test_that("ABS - datastructure",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "ABS", resource = "datastructure", resourceId = "ALC")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataStructureDefinition")
}
})
#-> data
test_that("ABS - data",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "ABS", resource = "data",
flowRef = "ALC", key = "1.1+2.1+2+3+5+4.6+10+11+12+15+14.A", key.mode = "SDMX",
start = "2000", end = "2015")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXMessageGroup")
}
})
#NBB (Belgium)
#-------------
#-> datastructure
test_that("NBB - datastructure",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "NBB", resource = "datastructure", resourceId = "QNA")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataStructureDefinition")
}
})
#-> data
test_that("NBB - data",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "NBB", resource = "data",
flowRef = "QNA", key = "all", key.mode = "SDMX",
start = "2000", end = "2015")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXMessageGroup")
}
})
#INSEE (France)
#-------------
#-> dataflow
test_that("INSEE - dataflow",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "INSEE", resource = "dataflow")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataFlows")
}
})
#-> datastructure
test_that("INSEE - datastructure",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "INSEE", resource = "datastructure", resourceId = "CONSO-MENAGES-2010")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataStructureDefinition")
}
})
#-> data
test_that("INSEE - data",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "INSEE", resource = "data",
flowRef = "CONSO-MENAGES-2010", key = "all", key.mode = "SDMX",
start = 2010, end = 2015)
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXStructureSpecificData")
}
})
#INEGI (MEXICO)
#-------------
#-> dataflow
test_that("INEGI - dataflow",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "INEGI", resource = "dataflow")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataFlows")
}
})
#-> datastructure
test_that("INEGI - datastructure",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "INEGI", resource = "datastructure", resourceId = "NAWWE")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataStructureDefinition")
}
})
#-> data
test_that("INEGI - data",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "INEGI", resource = "data",
flowRef = "DF_PIB_PB2008", start = 2010, end = 2015)
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXGenericData")
}
})
#ISTAT (ITALY)
#-------------
#-> dataflow
test_that("ISTAT - dataflow",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "ISTAT", resource = "dataflow")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataFlows")
}
})
#-> datastructure
#TODO investigate issue with xmlNamespaceDefinitions (XML)
test_that("ISTAT - datastructure",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "ISTAT", resource = "datastructure", resourceId = "DCCV_CONSACQUA")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataStructureDefinition")
}
})
#-> data
test_that("ISTAT - data",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "ISTAT", resource = "data",
flowRef = "12_60", start = 2015, end = 2015)
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXGenericData")
}
})
#NOMIS (UK)
#----------
#-> dataflow
test_that("NOMIS - dataflow",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "NOMIS", resource = "dataflow")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataFlows")
}
})
#-> datastructure
test_that("NOMIS - datastructure",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "NOMIS", resource = "datastructure", resourceId = "NM_1_1")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataStructureDefinition")
}
})
#-> data
test_that("NOMIS - data",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "NOMIS", resource = "data", flowRef="NM_1_1")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXGenericData")
}
})
#LSD (LITHUANIA)
#-------------
#-> dataflow
test_that("LSD - dataflow",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "LSD", resource = "dataflow")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataFlows")
}
})
#-> datastructure
test_that("LSD - datastructure",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "LSD", resource = "datastructure", resourceId = "M8020420")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataStructureDefinition")
}
})
#-> data
test_that("LSD - data",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "LSD", resource = "data",
flowRef = "S3R629_M3010217", start = 2010, end = 2015)
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXGenericData")
}
})
#STAT_E (Estonia)
#-------------
#-> datastructure
test_that("STAT_EE - datastructure",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "STAT_EE", resource = "datastructure", resourceId = "KK11")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataStructureDefinition")
}
})
#-> data
test_that("STAT_EE - data",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "STAT_EE", resource = "data",
flowRef = "KK11", key = "all", key.mode = "SDMX",
start = "2015", end = "2015")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXMessageGroup")
}
})
#other data providers
#KNOEMA
#------
#-> dataflow
test_that("KNOEMA - dataflow",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "KNOEMA", resource = "dataflow")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataFlows")
}
})
#-> datastructure
test_that("KNOEMA - datastructure",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "KNOEMA", resource = "datastructure", resourceId = "SADG2015")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataStructureDefinition")
}
})
#-> data
test_that("KNOEMA - data",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "KNOEMA", resource = "data", flowRef = "SADG2015")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXStructureSpecificData")
}
})
#WIDUKIND
#--------
#-> dataflow
test_that("WIDUKIND - dataflow",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "WIDUKIND", resource = "dataflow")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataFlows")
}
})
#-> datastructure
test_that("WIDUKIND - datastructure",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "WIDUKIND", resource = "datastructure",
agencyId = "INSEE", resourceId = "POP-EVO")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataStructureDefinition")
}
})
#-> data
test_that("WIDUKIND - data",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(providerId = "WIDUKIND", resource = "data", agencyId = "INSEE",
flowRef = "IPCH-2015-FR-COICOP", key = "a.07120.indice", key.mode="SDMX",
start = 2010, end = 2015)
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXStructureSpecificData")
}
})
rsdmx/tests/testthat/test_GenericData.R 0000644 0001762 0000144 00000005414 12671523034 017750 0 ustar ligges users # test_GenericData.R
# Author: Emmanuel Blondel
#
# Description: Unit tests for SDMX GenericData methods
#=======================
require(rsdmx, quietly = TRUE)
require(testthat)
context("SDMXGenericData")
test_that("GenericData 2.0",{
file <- system.file("extdata", "SDMXGenericDataExample_2.0.xml", package = "rsdmx")
xmlObj <- xmlParse(file)
ns <- namespaces.SDMX(xmlObj)
ds <- SDMXGenericData(xmlObj, ns)
expect_is(ds, "SDMXGenericData")
df <- as.data.frame(ds)
expect_is(df, "data.frame")
expect_equal(c(paste(rep("C",5),1:5,sep=""),
"UNITS", "UNIT_MULTIPLIER", "obsTime", "obsValue"), names(df))
#test absence data
expect_true(is.na(df[nrow(df),]$obsValue))
expect_true(is.na(df[nrow(df),]$obsTime))
})
test_that("GenericData - 2.0 - Eurostat",{
file <- system.file("extdata", "Example_Eurostat_2.0.xml", package = "rsdmx")
xmlObj <- xmlParse(file)
ns <- namespaces.SDMX(xmlObj)
ds <- SDMXGenericData(xmlObj, ns)
expect_is(ds, "SDMXGenericData")
df <- as.data.frame(ds)
expect_is(df, "data.frame")
# test df content
expect_equal(df, structure(list(UNIT = c("PC", "PC"), REASON = c("ECO", "ECO"),
ENTERPR = c("OTH", "YHE"), NACE_R2 = c("B-E", "M"),
GEO = c("PL", "PL"), FREQ = c("A", "A"),
obsTime = rep("2009",2),
obsValue = c(16.8, 18)), .Names = c("UNIT", "REASON", "ENTERPR", "NACE_R2", "GEO", "FREQ", "obsTime", "obsValue"), class = "data.frame",
row.names = 1:2))
})
test_that("GenericData - 2.1",{
file <- system.file("extdata", "SDMXGenericDataExample_2.1.xml", package = "rsdmx")
xmlObj <- xmlParse(file)
ns <- namespaces.SDMX(xmlObj)
ds <- SDMXGenericData(xmlObj, ns)
expect_is(ds, "SDMXGenericData")
df <- as.data.frame(ds)
expect_is(df, "data.frame")
# test df content
expect_true(all(df == structure(list(UNIT = rep("PC",4),
Y_GRAD = c(rep("TOTAL",2),rep("Y_GE1990",2)),
FOS07 = rep("FOS1",4),
GEO = rep("BE",4),
FREQ = rep("A",4),
obsTime = rep(c("2009","2006"),2),
obsValue = c(NA, NA,43.75,NA),
OBS_STATUS = rep("na",4)),
.Names = c("UNIT", "Y_GRAD","FOS07", "GE0",
"FREQ", "obsTime", "obsValue"),
class = "data.frame",
row.names = 1:4), na.rm = TRUE))
})
rsdmx/tests/testthat/test_saveSDMX.R 0000644 0001762 0000144 00000001420 13026345204 017221 0 ustar ligges users # test_saveSDMX.R
# Author: Emmanuel Blondel
#
# Description: Unit tests for SDMX save methods
#=======================
require(rsdmx, quietly = TRUE)
require(testthat)
context("saveSDMX")
test_that("saveSDMX",{
file <- system.file("extdata", "SDMXCodelists_Example_2.0.xml", package = "rsdmx")
sdmx <- readSDMX(file, isURL = FALSE)
sdmx.copy <- sdmx
saveSDMX(sdmx.copy, "tmp.RData")
rm(sdmx.copy)
sdmx.copy <- readSDMX("tmp.RData", isRData = TRUE)
for(slotName in slotNames(sdmx)){
if(slotName == "xmlObj"){
expect_true(all(sapply(XML::compareXMLDocs(sdmx@xmlObj, sdmx.copy@xmlObj), length) == 0))
}else{
expect_true(identical(slot(sdmx,slotName), slot(sdmx.copy,slotName)))
}
}
}) rsdmx/tests/testthat/test_ServiceProvider.R 0000644 0001762 0000144 00000004701 12657150374 020722 0 ustar ligges users # test_ServiceProvider.R
# Author: Emmanuel Blondel
#
# Description: Unit tests for SDMX Service Provider
#=======================
require(rsdmx, quietly = TRUE)
require(testthat)
context("SDMXServiceProvider")
test_that("SDMXServiceProvider - constructor",{
requestBuilder <- SDMXRequestBuilder(
regUrl = "http://www.myorg.org/registry",
repoUrl = "http://www.myorg.org/repository",
formatter = list(
dataflow = function(obj){return(obj)},
datastructure = function(obj){return(obj)},
data = function(obj){return(obj)}
),
handler = list(
dataflow = function(obj){return(obj@regUrl)},
datastructure = function(obj){return(obj@regUrl)},
data = function(obj){return(obj@repoUrl)}
),
compliant = TRUE)
provider <- SDMXServiceProvider(
agencyId = "MYORG", name = "My Organization",
builder = requestBuilder
)
expect_is(provider, "SDMXServiceProvider")
expect_equal(provider@agencyId, "MYORG")
expect_equal(provider@name, "My Organization")
expect_equal(provider@scale, "international")
expect_true(is.na(provider@country))
expect_is(provider@builder, "SDMXRequestBuilder")
})
test_that("SDMXServiceProvider - methods",{
providers <- getSDMXServiceProviders()
expect_is(providers, "SDMXServiceProviders")
nbOfProviders <- length(providers@providers)
expect_true(nbOfProviders > 0)
expect_is(as.data.frame(providers), "data.frame")
#add a provider
requestBuilder <- SDMXRequestBuilder(
regUrl = "http://www.myorg.org/registry",
repoUrl = "http://www.myorg.org/repository",
formatter = list(
dataflow = function(obj){return(obj)},
datastructure = function(obj){return(obj)},
data = function(obj){return(obj)}
),
handler = list(
dataflow = function(obj){return(obj@regUrl)},
datastructure = function(obj){return(obj@regUrl)},
data = function(obj){return(obj@repoUrl)}
),
compliant = TRUE)
provider <- SDMXServiceProvider(
agencyId = "MYORG", name = "My Organization",
builder = requestBuilder
)
addSDMXServiceProvider(provider)
providers <- getSDMXServiceProviders()
expect_equal(length(providers@providers), nbOfProviders+1)
#find a provider
oecd <- findSDMXServiceProvider("OECD")
expect_is(oecd, "SDMXServiceProvider")
expect_equal(oecd@agencyId, "OECD")
})
rsdmx/tests/testthat/test_Codelists.R 0000644 0001762 0000144 00000001756 12671520276 017545 0 ustar ligges users # test_Codelists.R
# Author: Emmanuel Blondel
#
# Description: Unit tests for SDMX Codelists methods
#=======================
require(rsdmx, quietly = TRUE)
require(testthat)
context("SDMXCodelists")
test_that("Codelists - 2.0",{
file <- system.file("extdata", "SDMXCodelists_Example_2.0.xml", package = "rsdmx")
xmlObj <- xmlParse(file)
ns <- namespaces.SDMX(xmlObj)
codelists <- SDMXCodelists(xmlObj, ns)
expect_is(codelists, "SDMXCodelists")
expect_equal(length(codelists@codelists), 1L)
df <- as.data.frame(codelists)
expect_is(df, "data.frame")
})
test_that("Codelists - 2.1",{
file <- system.file("extdata", "SDMXCodelists_Example_2.1.xml", package = "rsdmx")
xmlObj <- xmlParse(file)
ns <- namespaces.SDMX(xmlObj)
codelists <- SDMXCodelists(xmlObj, ns)
expect_is(codelists, "SDMXCodelists")
expect_equal(length(codelists@codelists), 1L)
df <- as.data.frame(codelists)
expect_is(df, "data.frame")
}) rsdmx/tests/testthat/test_Main.R 0000644 0001762 0000144 00000006011 13014562050 016451 0 ustar ligges users # test_Main.R
# Author: Emmanuel Blondel
#
# Description: Unit tests for SDMX Main methods
#=======================
require(rsdmx, quietly = TRUE)
require(testthat)
context("SDMX")
#SDMX datasets
#------------
file <- system.file("extdata", "SDMXGenericDataExample_2.0.xml", package = "rsdmx")
sdmxObj <- readSDMX(file, isURL = FALSE)
test_that("readSDMX - 2.0",{
expect_is(sdmxObj, "SDMXGenericData")
})
#tests for 2.1
file2 <- system.file("extdata", "SDMXGenericDataExample_2.1.xml", package = "rsdmx")
sdmxObj2 <- readSDMX(file2, isURL = FALSE)
test_that("readSDMX - 2.1",{
expect_is(sdmxObj2, "SDMXGenericData")
})
#SDMXConcepts
#-----------
test_that("readSDMX - SDMXConcepts - 2.0",{
file <- system.file("extdata", "SDMXConcepts_Example_2.0.xml",
package = "rsdmx")
sdmxObj <- readSDMX(file, isURL = FALSE)
expect_is(sdmxObj, "SDMXConcepts")
})
test_that("readSDMX - SDMXConcepts (conceptScheme) - 2.0",{
file <- system.file("extdata", "SDMXConceptSchemes_Example_2.0.xml",
package = "rsdmx")
sdmxObj <- readSDMX(file, isURL = FALSE)
expect_is(sdmxObj, "SDMXConcepts")
})
test_that("readSDMX - SDMXConcepts (conceptScheme) - 2.1",{
file <- system.file("extdata", "SDMXConceptSchemes_Example_2.1.xml",
package = "rsdmx")
sdmxObj <- readSDMX(file, isURL = FALSE)
expect_is(sdmxObj, "SDMXConcepts")
})
#SDMXCodelists
#-------------
test_that("readSDMX - SDMXCodelists - 2.0",{
file <- system.file("extdata", "SDMXCodelists_Example_2.0.xml",
package = "rsdmx")
sdmxObj <- readSDMX(file, isURL = FALSE)
expect_is(sdmxObj, "SDMXCodelists")
})
test_that("readSDMX - SDMXCodelists - 2.0",{
file <- system.file("extdata", "SDMXCodelists_Example_2.1.xml",
package = "rsdmx")
sdmxObj <- readSDMX(file, isURL = FALSE)
expect_is(sdmxObj, "SDMXCodelists")
})
#SDMXDataStructureDefinition (DSD)
#--------------------------------
test_that("readSDMX - SDMXDataStructureDefinition (DSD) - 2.0",{
file <- system.file("extdata", "SDMXDataStructureDefinition_Example_2.0.xml",
package = "rsdmx")
dsd <- readSDMX(file, isURL = FALSE)
expect_is(dsd, "SDMXDataStructureDefinition")
expect_is(dsd@concepts, "SDMXConcepts")
expect_is(dsd@codelists, "SDMXCodelists")
expect_is(dsd@datastructures, "SDMXDataStructures")
})
test_that("readSDMX - Catch 400 bad request", {
testthat::skip_on_travis()
testthat::skip_on_cran()
expect_error(
sdmx <- readSDMX(providerId = "KNOEMA", resource = "data", flowRef = "bad_ref")
)
})
test_that("readSDMX - Catch good request that fails for other reason (bad proxy)", {
testthat::skip_on_travis()
testthat::skip_on_cran()
old_opts <- options()
options(RCurlOptions = list("proxy" = "bad_proxy"))
expect_error(
sdmx <- readSDMX(providerId = "KNOEMA", resource = "data", flowRef = "SADG2015")
)
options(old_opts)
}) rsdmx/tests/testthat/test_Concepts.R 0000644 0001762 0000144 00000003126 12671520342 017355 0 ustar ligges users # test_Concepts.R
# Author: Emmanuel Blondel
#
# Description: Unit tests for SDMX Concepts methods
#=======================
require(rsdmx, quietly = TRUE)
require(testthat)
context("SDMXConcepts")
test_that("Concepts 2.0 - with Concepts (backward compatibility with 1.0)",{
file <- system.file("extdata", "SDMXConcepts_Example_2.0.xml", package = "rsdmx")
xmlObj <- xmlParse(file)
ns <- namespaces.SDMX(xmlObj)
concepts <- SDMXConcepts(xmlObj, ns)
expect_is(concepts, "SDMXConcepts")
df <- as.data.frame(concepts)
expect_is(df, "data.frame")
expect_equal(colnames(df), c("id", "version","en"))
expect_equal(nrow(df), 15L)
})
test_that("Concepts - 2.0 - with ConceptSchemes",{
file <- system.file("extdata", "SDMXConceptSchemes_Example_2.0.xml",
package = "rsdmx")
xmlObj <- xmlParse(file)
ns <- namespaces.SDMX(xmlObj)
concepts <- SDMXConcepts(xmlObj, ns)
expect_is(concepts, "SDMXConcepts")
df <- as.data.frame(concepts)
expect_is(df, "data.frame")
expect_equal(colnames(df), c("id", "urn","en"))
expect_equal(nrow(df), 15L)
})
test_that("Concepts - 2.1 - with ConceptSchemes",{
file <- system.file("extdata", "SDMXConceptSchemes_Example_2.1.xml",
package = "rsdmx")
xmlObj <- xmlParse(file)
ns <- namespaces.SDMX(xmlObj)
concepts <- SDMXConcepts(xmlObj, ns)
expect_is(concepts, "SDMXConcepts")
df <- as.data.frame(concepts)
expect_is(df, "data.frame")
expect_equal(colnames(df), c("id", "urn","en"))
expect_equal(nrow(df), 15L)
})
rsdmx/tests/testthat/test_Schema.R 0000644 0001762 0000144 00000002270 12671524432 017002 0 ustar ligges users # test_Schema.R
# Author: Emmanuel Blondel
#
# Description: Unit tests for SDMX Schema methods
#=======================
require(rsdmx, quietly = TRUE)
require(testthat)
context("SDMXSchema")
#read test data
file1 <- system.file("extdata", "SDMXMessageExample_2.0.xml", package = "rsdmx")
file2 <- system.file("extdata", "SDMXMessageExample_2.1.xml", package = "rsdmx")
xmlObj1 <- xmlParse(file1)
xmlObj2 <- xmlParse(file2)
ns1 <- namespaces.SDMX(xmlObj1)
ns2 <- namespaces.SDMX(xmlObj2)
test_that("version.SDMXSchema - 2.0",{
schema1 = version.SDMXSchema(xmlObj1, ns1)
expect_equal(schema1, "2.0")
})
test_that("version.SDMXSchema - 2.1",{
schema2 = version.SDMXSchema(xmlObj2, ns2)
expect_equal(schema2, "2.1")
})
test_that("SDMXSchema - 2.0",{
obj1 = SDMXSchema(xmlObj1, ns1)
expect_is(obj1, "SDMXSchema")
})
test_that("SDMXSchema - 2.1",{
obj2 = SDMXSchema(xmlObj2, ns2)
expect_is(obj2, "SDMXSchema")
})
test_that("getVersion - 2.0",{
obj1 = SDMXSchema(xmlObj1, ns1)
expect_equal(obj1@version, "2.0")
})
test_that("getVersion - 2.1",{
obj2 = SDMXSchema(xmlObj2, ns2)
expect_equal(obj2@version, "2.1")
})
rsdmx/tests/testthat/test_Data.R 0000644 0001762 0000144 00000004461 13136134612 016451 0 ustar ligges users # test_Data.R
# Author: Emmanuel Blondel
#
# Description: Unit tests for SDMX Data methods
#=======================
require(rsdmx, quietly = TRUE)
require(testthat)
context("SDMXData")
test_that("DSD is properly associated to an SDMXData object",{
data <- readSDMX(providerId = "UIS", resource = "data",
flowRef = "EDULIT_DS", key = list("OFST_1_CP", NULL),
start = "2000", end = "2015")
dsd <- readSDMX(providerId = "UIS", resource = "datastructure",
resourceId = "EDULIT_DS")
expect_equal(slot(data,"dsdRef"), "EDULIT_DS")
expect_true(is.null(slot(data,"dsd")))
data <- setDSD(data, dsd)
expect_false(is.null(slot(data,"dsd")))
expect_is(slot(data,"dsd"), "SDMXDataStructureDefinition")
})
test_that("DSD is properly fetched by readSDMX and associated to the dataset",{
data <- readSDMX(providerId = "UIS", resource = "data",
flowRef = "EDULIT_DS", key = list("OFST_1_CP", NULL),
start = "2000", end = "2015",
dsd = TRUE)
expect_false(is.null(slot(data,"dsd")))
expect_is(slot(data,"dsd"), "SDMXDataStructureDefinition")
})
#20170615 deactivate test (nb of requests limited in KNOEMA makes this test fail)
#test_that("DSD is properly fetched by readSDMX when there is no dsdRef (using flowRef)",{
#data <- readSDMX(providerId = "KNOEMA", resource = "data",
# flowRef = "SADG2015", dsd = TRUE)
#expect_false(is.null(slot(data,"dsd")))
#expect_is(slot(data,"dsd"), "SDMXDataStructureDefinition")
#})
test_that("Dataset is correctly enriched with labels using the DSD",{
sdmx.data <- readSDMX(providerId = "UIS", resource = "data",
flowRef = "CAI_DS", dsd = TRUE)
data <- as.data.frame(sdmx.data)
data.enriched <- as.data.frame(sdmx.data, labels = TRUE)
expect_true(ncol(data.enriched) > ncol(data))
expect_true(all(data["CAI_IND"] == data.enriched["CAI_IND"]))
expect_true(all(data["LOCATION"] == data.enriched["LOCATION"]))
expect_true(all(data["TIME_FORMAT"] == data.enriched["TIME_FORMAT"]))
expect_true(all(data["obsTime"] == data.enriched["obsTime"]))
expect_true(all(data["obsValue"] == data.enriched["obsValue"]))
})
rsdmx/tests/testthat/test_RequestBuilder.R 0000644 0001762 0000144 00000014327 13041505702 020536 0 ustar ligges users # test_RequestBuilder.R
# Author: Emmanuel Blondel
#
# Description: Unit tests for SDMX Service request builder
#=======================
require(rsdmx, quietly = TRUE)
require(testthat)
context("SDMXRequestBuilder")
test_that("a custom SDMXRequestBuilder",{
request <- SDMXRequestBuilder(
regUrl = "http://www.myorg.org/registry",
repoUrl = "http://www.myorg.org/repository",
accessKey = NULL,
formatter = list(
dataflow = function(obj){return(obj)},
datastructure = function(obj){return(obj)},
data = function(obj){return(obj)}
),
handler = list(
dataflow = function(obj){return(obj@regUrl)},
datastructure = function(obj){return(obj@regUrl)},
data = function(obj){
req <- sprintf("%s/%s/data/%s/%s/%s/%s",
obj@repoUrl, obj@agencyId, obj@flowRef, obj@key,
obj@start, obj@end)
return(req)
}
),
compliant = TRUE)
expect_is(request, "SDMXRequestBuilder")
expect_equal(request@regUrl, "http://www.myorg.org/registry")
expect_equal(request@repoUrl, "http://www.myorg.org/repository")
expect_is(request@formatter, "list")
expect_is(request@handler, "list")
expect_equal(request@compliant, TRUE)
params <- SDMXRequestParams(regUrl = "http://www.myorg.org/registry",
repoUrl = "http://www.myorg.org/repository",
accessKey = NULL,
providerId = "MYORG", agencyId = "MYORG", resource = "data", flowRef = "FLOW", resourceId = NULL,
key = "KEY", start = 2000, end = 2010, compliant = TRUE)
webRequest <- request@handler$data(params)
expect_equal(webRequest, "http://www.myorg.org/repository/MYORG/data/FLOW/KEY/2000/2010")
})
test_that("a simple SDMXREST20RequestBuilder",{
request <- SDMXREST20RequestBuilder(regUrl = "http://www.myorg.org/registry",
repoUrl = "http://www.myorg.org/repository",
compliant = TRUE)
expect_is(request, "SDMXREST20RequestBuilder")
expect_equal(request@regUrl, "http://www.myorg.org/registry")
expect_equal(request@repoUrl, "http://www.myorg.org/repository")
expect_is(request@formatter, "list")
expect_is(request@handler, "list")
expect_equal(request@compliant, TRUE)
params <- SDMXRequestParams(regUrl = "http://www.myorg.org/registry",
repoUrl = "http://www.myorg.org/repository",
accessKey = NULL,
providerId = "MYORG", agencyId = "MYORG", resource = "data", flowRef = "FLOW", resourceId = NULL,
key = "KEY", start = 2000, end = 2010, compliant = TRUE)
webRequest <- request@handler$data(params)
expect_equal(webRequest, "http://www.myorg.org/repository/Data/FLOW/KEY/MYORG?startPeriod=2000&endPeriod=2010")
})
test_that("a simple SDMXREST21RequestBuilder",{
request <- SDMXREST21RequestBuilder(regUrl = "http://www.myorg.org/registry",
repoUrl = "http://www.myorg.org/repository",
compliant = TRUE)
expect_is(request, "SDMXREST21RequestBuilder")
expect_equal(request@regUrl, "http://www.myorg.org/registry")
expect_equal(request@repoUrl, "http://www.myorg.org/repository")
expect_is(request@formatter, "list")
expect_is(request@handler, "list")
expect_equal(request@compliant, TRUE)
params <- SDMXRequestParams(regUrl = "http://www.myorg.org/registry",
repoUrl = "http://www.myorg.org/repository",
accessKey = NULL,
providerId = "MYORG", agencyId = "MYORG", resource = "data", flowRef = "FLOW", resourceId = NULL,
key = "KEY", start = 2000, end = 2010, compliant = TRUE)
webRequest <- request@handler$data(params)
expect_equal(webRequest, "http://www.myorg.org/repository/data/FLOW/KEY/all/?startPeriod=2000&endPeriod=2010")
})
test_that("a simple SDMXDotStatRequestBuilder",{
request <- SDMXDotStatRequestBuilder(regUrl = "http://www.myorg.org/registry",
repoUrl = "http://www.myorg.org/repository")
expect_is(request, "SDMXDotStatRequestBuilder")
expect_equal(request@regUrl, "http://www.myorg.org/registry")
expect_equal(request@repoUrl, "http://www.myorg.org/repository")
expect_is(request@formatter, "list")
expect_is(request@handler, "list")
expect_equal(request@compliant, FALSE)
params <- SDMXRequestParams(regUrl = "http://www.myorg.org/registry",
repoUrl = "http://www.myorg.org/repository",
accessKey = NULL,
providerId = "MYORG", agencyId = "MYORG", resource = "data", flowRef = "FLOW", resourceId = NULL,
key = "KEY", start = 2000, end = 2010, compliant = TRUE)
webRequest <- request@handler$data(params)
expect_equal(webRequest, "http://www.myorg.org/repository/GetData/FLOW/KEY/all?startPeriod=2000&endPeriod=2010")
})
test_that("a simple SDMXDotStatRequestBuilder - customized with some formatting",{
request <- SDMXDotStatRequestBuilder(regUrl = "http://www.myorg.org/registry",
repoUrl = "http://www.myorg.org/repository")
request@formatter$data <- function(obj){
obj@flowRef <- paste0("**_",obj@flowRef,"_**")
return(obj)
}
params <- SDMXRequestParams(regUrl = "http://www.myorg.org/registry",
repoUrl = "http://www.myorg.org/repository",
accessKey = NULL,
providerId = "MYORG", agencyId = "MYORG", resource = "data", flowRef = "FLOW", resourceId = NULL,
key = "KEY", start = 2000, end = 2010, compliant = TRUE)
params <- request@formatter$data(params)
webRequest <- request@handler$data(params)
expect_equal(webRequest, "http://www.myorg.org/repository/GetData/**_FLOW_**/KEY/all?startPeriod=2000&endPeriod=2010")
})
rsdmx/tests/testthat/test_CrossSectionalData.R 0000644 0001762 0000144 00000001143 12671520352 021322 0 ustar ligges users # test_CrossSectionalData.R
# Author: Emmanuel Blondel
#
# Description: Unit tests for SDMX CrossSectionalData methods
#=======================
require(rsdmx, quietly = TRUE)
require(testthat)
context("SDMXCrossSectionalData")
test_that("CrossSectionalData 1.0",{
file <- system.file("extdata", "SDMXCrossSectionalDataExample_1.0.xml", package = "rsdmx")
xmlObj <- xmlParse(file)
ns <- namespaces.SDMX(xmlObj)
ds <- SDMXCrossSectionalData(xmlObj, ns)
expect_is(ds, "SDMXCrossSectionalData")
df <- as.data.frame(ds)
expect_is(df, "data.frame")
}) rsdmx/tests/testthat/test_StructureSpecificData.R 0000644 0001762 0000144 00000001264 12671524440 022043 0 ustar ligges users # test_StructureSpecificData.R
# Author: Emmanuel Blondel
#
# Description: Unit tests for SDMX StructureSpecificData methods
#=======================
require(rsdmx, quietly = TRUE)
require(testthat)
context("SDMXStructureSpecificData")
test_that("StructureSpecificData 2.1",{
file <- system.file("extdata", "SDMXStructureSpecificDataExample_2.1.xml", package = "rsdmx")
xmlObj <- xmlParse(file)
ns <- namespaces.SDMX(xmlObj)
ds <- SDMXStructureSpecificData(xmlObj, ns)
expect_is(ds, "SDMXStructureSpecificData")
df <- as.data.frame(ds)
expect_is(df, "data.frame")
expect_false(is.null(df))
expect_true(nrow(df) > 0)
}) rsdmx/tests/test-all.R 0000644 0001762 0000144 00000000046 12421213454 014417 0 ustar ligges users library(testthat)
test_check("rsdmx") rsdmx/NAMESPACE 0000644 0001762 0000144 00000005553 13120303732 012630 0 ustar ligges users import("methods")
import("XML")
import("RCurl")
importFrom("plyr", "rbind.fill")
importFrom("utils", "packageVersion")
exportClasses(
SDMX,
SDMXSchema,
SDMXHeader,
SDMXFooterMessage,
SDMXFooter,
SDMXType,
SDMXStructureType,
SDMXConcept,
SDMXConceptScheme,
SDMXConcepts,
SDMXCode,
SDMXCodelist,
SDMXCodelists,
SDMXDimension,
SDMXTimeDimension,
SDMXPrimaryMeasure,
SDMXAttribute,
SDMXComponents,
SDMXDataStructure,
SDMXDataStructures,
SDMXDataStructureDefinition,
SDMXItemScheme,
SDMXOrganisationScheme,
SDMXOrganisation,
SDMXAgency,
SDMXAgencyScheme,
SDMXOrganisationSchemes,
SDMXData,
SDMXGenericData,
SDMXCompactData,
SDMXUtilityData,
SDMXStructureSpecificData,
SDMXStructureSpecificTimeSeriesData,
SDMXCrossSectionalData,
SDMXMessageGroup,
SDMXDataFlow,
SDMXDataFlows,
SDMXRequestParams,
SDMXRequestBuilder,
SDMXREST20RequestBuilder,
SDMXREST21RequestBuilder,
SDMXDotStatRequestBuilder,
SDMXServiceProvider,
SDMXServiceProviders
)
export(
SDMX,
SDMXSchema,
SDMXHeader,
SDMXFooterMessage,
SDMXFooter,
SDMXType,
SDMXStructureType,
SDMXConcept,
SDMXConceptScheme,
SDMXConcepts,
SDMXCode,
SDMXCodelist,
SDMXCodelists,
SDMXDimension,
SDMXTimeDimension,
SDMXPrimaryMeasure,
SDMXAttribute,
SDMXComponents,
SDMXDataStructure,
SDMXDataStructures,
SDMXDataStructureDefinition,
SDMXOrganisation,
SDMXAgency,
SDMXAgencyScheme,
SDMXOrganisationSchemes,
SDMXGenericData,
SDMXCompactData,
SDMXUtilityData,
SDMXStructureSpecificData,
SDMXCrossSectionalData,
SDMXMessageGroup,
SDMXData,
SDMXDataFlow,
SDMXDataFlows,
SDMXRequestParams,
SDMXRequestBuilder,
SDMXREST20RequestBuilder,
SDMXREST21RequestBuilder,
SDMXDotStatRequestBuilder,
SDMXServiceProvider,
SDMXServiceProviders,
namespaces.SDMX,
findNamespace,
isSoapRequestEnvelope,
getSoapRequestResult,
isRegistryInterfaceEnvelope,
getRegistryInterfaceResult,
addSDMXServiceProvider,
findSDMXServiceProvider,
setSDMXServiceProviders,
getSDMXServiceProviders,
readSDMX,
saveSDMX
)
exportMethods(
getStructureType,
getNamespaces,
setDSD
)
S3method(as.data.frame, SDMXGenericData)
S3method(as.data.frame, SDMXCompactData)
S3method(as.data.frame, SDMXUtilityData)
S3method(as.data.frame, SDMXStructureSpecificData)
S3method(as.data.frame, SDMXStructureSpecificTimeSeriesData)
S3method(as.data.frame, SDMXCrossSectionalData)
S3method(as.data.frame, SDMXMessageGroup)
S3method(as.data.frame, SDMXConcepts)
S3method(as.data.frame, SDMXCodelists)
S3method(as.data.frame, SDMXDataStructures)
S3method(as.data.frame, SDMXOrganisationSchemes)
S3method(as.data.frame, SDMXComponents)
S3method(as.data.frame, SDMXDataFlows)
S3method(as.data.frame, SDMXServiceProviders) rsdmx/R/ 0000755 0001762 0000144 00000000000 13214045142 011604 5 ustar ligges users rsdmx/R/Class-SDMXData.R 0000644 0001762 0000144 00000001624 12656622474 014364 0 ustar ligges users #' @name SDMXData
#' @rdname SDMXData
#' @docType class
#' @aliases SDMXData-class
#'
#' @title Class "SDMXData"
#' @description An abstract class from which SDMX Data classes are derived
#'
#' @slot dsdRef Object of class "character" giving the DSD Reference
#' @slot dsd Object of class "SDMXDataStructureDefinition"
#'
#' @section Warning:
#' This class is not useful in itself, but all SDMX Data classes in this package
#' derive from it.
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
setClass("SDMXData",
contains = "SDMX",
representation(
dsdRef = "character_OR_NULL",
dsd = "SDMXDataStructureDefinition_OR_NULL"
),
prototype = list(),
validity = function(object){
#eventual validation rules
return(TRUE);
}
)
rsdmx/R/Class-SDMXMessageGroup.R 0000644 0001762 0000144 00000001254 12656611440 016102 0 ustar ligges users #' @name SDMXMessageGroup
#' @docType class
#' @aliases SDMXMessageGroup-class
#'
#' @title Class "SDMXMessageGroup"
#' @description A basic class to handle a SDMX-ML MessageGroup data set
#'
#' @section Warning:
#' This class is not useful in itself, but all SDMX non-abstract classes will
#' encapsulate it as slot, when parsing an SDMX-ML document.
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
setClass("SDMXMessageGroup",
contains = "SDMXData",
representation(),
prototype = list(),
validity = function(object){
#eventual validation rules
return(TRUE);
}
)
rsdmx/R/SDMXDataStructureDefinition-methods.R 0000644 0001762 0000144 00000001550 13120305212 020661 0 ustar ligges users #' @name SDMXDataStructureDefinition
#' @rdname SDMXDataStructureDefinition
#' @aliases SDMXDataStructureDefinition,SDMXDataStructureDefinition-method
#'
#' @usage
#' SDMXDataStructureDefinition(xmlObj, namespaces)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @param namespaces object of class "data.frame" given the list of namespace URIs
#' @return an object of class "SDMXDataStructureDefinition"
#'
#' @seealso \link{readSDMX}
#'
SDMXDataStructureDefinition <- function(xmlObj, namespaces){
new("SDMXDataStructureDefinition",
SDMX(xmlObj, namespaces),
organisationSchemes = SDMXOrganisationSchemes(xmlObj, namespaces),
concepts = SDMXConcepts(xmlObj, namespaces),
codelists = SDMXCodelists(xmlObj, namespaces),
datastructures = SDMXDataStructures(xmlObj, namespaces)
)
} rsdmx/R/Class-SDMX.R 0000644 0001762 0000144 00000003372 12657115554 013571 0 ustar ligges users #' @name SDMX
#' @rdname SDMX
#' @docType class
#' @aliases SDMX-class
#'
#' @title Class "SDMX"
#' @description An abstract class from which SDMX classes are derived
#'
#' @slot xmlObj Object of class "XMLInternalDocument" derived from XML package
#' @slot schema Object of class "SDMXSchema", handles the version of SDMX-ML format
#' @slot header Object of class "SDMXHeader", handles the SDMX-ML document header
#' @slot footer Object of class "SDMXFooter", handles the SDMX-ML document footer
#'
#' @section Warning:
#' This class is not useful in itself, but all SDMX classes in this package derive
#' from it.
#'
#' @note
#' Currently, the approach drafted in \link{rsdmx} package was to rely on XML
#' package, read the xml object and store it as part of the SDMX R object. Another
#' approach being investigated is to use XML handlers throughthe Simple API for XML
#' (SAX) that could avoid to load the full XML tree in the SDMX R object (xmlObj).
#' Indeed, SDMX data could be huge and causes issues of memory if the complete XML
#' tree is loaded in the R user session.
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
setClass("SDMX",
representation(
xmlObj = "XMLInternalDocument",
schema = "SDMXSchema",
header = "SDMXHeader",
footer = "SDMXFooter"
),
prototype = list(
xmlObj = NULL,
schema = new("SDMXSchema"),
header = new("SDMXHeader"),
footer = new("SDMXFooter")
),
validity = function(object){
return(TRUE);
}
)
#class unions for base data types
setClassUnion("character_OR_NULL", c("character", "NULL"))
setClassUnion("character_OR_numeric_OR_NULL", c("character", "numeric", "NULL"))
rsdmx/R/Class-SDMXStructureType.R 0000644 0001762 0000144 00000002613 13043370736 016344 0 ustar ligges users #' @name SDMXStructureType
#' @docType class
#' @aliases SDMXStructureType-class
#'
#' @title Class "SDMXStructureType"
#' @description A basic class to handle the type of a SDMX-ML Structure document
#'
#' @section Warning:
#' This class is not useful in itself, but it will be used by \link{readSDMX} to
#' deal with SDMX-ML Structure documents.
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
setClassUnion("character_OR_NULL", c("character", "NULL"))
setClass("SDMXStructureType",
contains = "SDMXType",
representation(subtype = "character_OR_NULL"),
prototype = list(),
validity = function(object){
#validation rules
if(.rsdmx.options$validate){
type <- getStructureType(object);
valid <- switch(type,
"DataflowsType" = TRUE,
"ConceptsType" = TRUE,
"CodelistsType" = TRUE,
"DataStructuresType" = TRUE,
"DataStructureDefinitionsType" = TRUE,
FALSE
);
if(valid == FALSE)
warning(paste0("Unknown SDMXStructureType '", type, "'"));
return(valid);
}
return(TRUE);
}
)
rsdmx/R/Class-SDMXREST21RequestBuilder.R 0000644 0001762 0000144 00000002372 13041347752 017304 0 ustar ligges users #' @name SDMXREST21RequestBuilder
#' @docType class
#' @aliases SDMXREST21RequestBuilder-class
#'
#' @title Class "SDMXREST21RequestBuilder"
#' @description A experimental class to handle a SDMX 2.1 service request builder
#'
#' @slot regUrl an object of class "character" giving the base Url of the SDMX service registry
#' @slot repoUrl an object of class "character" giving the base Url of the SDMX service repository
#' @slot accessKey an object of class "character" indicating the name of request parameter for which
#' an authentication or subscription user key/token has to be provided to perform requests
#' @slot compliant an object of class "logical" indicating if the web-service is compliant with the SDMX REST web-service specifications
#'
#' @section Warning:
#' This class is not useful in itself, but all SDMX non-abstract classes will
#' encapsulate it as slot, when parsing an SDMX-ML document.
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
setClass("SDMXREST21RequestBuilder",
contains = "SDMXRequestBuilder",
representation(),
prototype = list(),
validity = function(object){
#eventual validation rules
return(TRUE);
}
)
rsdmx/R/SDMXPrimaryMeasure-methods.R 0000644 0001762 0000144 00000007503 12671526706 017056 0 ustar ligges users #' @name SDMXPrimaryMeasure
#' @rdname SDMXPrimaryMeasure
#' @aliases SDMXPrimaryMeasure,SDMXPrimaryMeasure-method
#'
#' @usage
#' SDMXPrimaryMeasure(xmlObj, namespaces)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @param namespaces object of class "data.frame" given the list of namespace URIs
#' @return an object of class "SDMXPrimaryMeasure"
#'
#' @seealso \link{readSDMX}
#'
SDMXPrimaryMeasure <- function(xmlObj, namespaces){
sdmxVersion <- version.SDMXSchema(xmlDoc(xmlObj), namespaces)
VERSION.21 <- sdmxVersion == "2.1"
messageNs <- findNamespace(namespaces, "message")
strNs <- findNamespace(namespaces, "structure")
#manage SDMX 2.1 conceptIdentity and codelist LocalRepresentation
conceptRefXML <- NULL
if(VERSION.21){
conceptIdentityXML <- getNodeSet(xmlDoc(xmlObj),
"//str:ConceptIdentity",
namespaces = c(str = as.character(strNs)))
if(length(conceptIdentityXML) > 0)
conceptRefXML <- xmlChildren(conceptIdentityXML[[1]])[[1]]
}
codelistRefXML <- NULL
if(VERSION.21){
enumXML <- getNodeSet(xmlDoc(xmlObj),
"//str:Enumeration",
namespaces = c(str = as.character(strNs)))
if(length(enumXML) > 0)
codelistRefXML <- xmlChildren(enumXML[[1]])[[1]]
}
#attributes
#=========
conceptRef <- NULL
conceptVersion <- NULL
conceptAgency <- NULL
conceptSchemeRef <- NULL
conceptSchemeAgency <- NULL
codelist <- NULL
codelistVersion <- NULL
codelistAgency <- NULL
if(VERSION.21){
#concepts
if(!is.null(conceptRefXML)){
conceptRef = xmlGetAttr(conceptRefXML, "id")
conceptVersion = xmlGetAttr(conceptRefXML, "maintainableParentVersion")
conceptAgency = xmlGetAttr(conceptRefXML, "agencyID")
#TODO conceptSchemeRef?
#TODO conceptSchemeAgency
}
#codelists
if(!is.null(codelistRefXML)){
codelist <- xmlGetAttr(codelistRefXML, "id")
codelistVersion <- xmlGetAttr(codelistRefXML, "version")
codelistAgency <- xmlGetAttr(codelistRefXML, "agencyID")
}
}else{
#concepts
conceptRef = xmlGetAttr(xmlObj, "conceptRef")
conceptVersion = xmlGetAttr(xmlObj, "conceptVersion")
conceptAgency = xmlGetAttr(xmlObj, "conceptAgency")
conceptSchemeRef = xmlGetAttr(xmlObj, "conceptSchemeRef")
conceptSchemeAgency = xmlGetAttr(xmlObj, "conceptSchemeAgency")
#codelists
codelist = xmlGetAttr(xmlObj, "codelist")
codelistVersion = xmlGetAttr(xmlObj, "codelistVersion")
codelistAgency = xmlGetAttr(xmlObj, "codelistAgency")
}
if(is.null(conceptRef)) conceptRef <- as.character(NA)
if(is.null(conceptVersion)) conceptVersion <- as.character(NA)
if(is.null(conceptAgency)) conceptAgency <- as.character(NA)
if(is.null(conceptSchemeRef)) conceptSchemeRef <- as.character(NA)
if(is.null(conceptSchemeAgency)) conceptSchemeAgency <- as.character(NA)
if(is.null(codelist)) codelist <- as.character(NA)
if(is.null(codelistVersion)) codelistVersion <- as.character(NA)
if(is.null(codelistAgency)) codelistAgency <- as.character(NA)
#elements
#========
#TextFormat TODO
#instantiate the object
obj<- new("SDMXPrimaryMeasure",
#attributes
conceptRef = conceptRef,
conceptVersion = conceptVersion,
conceptAgency = conceptAgency,
conceptSchemeRef = conceptSchemeRef,
conceptSchemeAgency = conceptSchemeAgency,
codelist = codelist,
codelistVersion = codelistVersion,
codelistAgency = codelistAgency
#elements,
#TextFormat = TextFormat
)
}
rsdmx/R/rsdmx.R 0000644 0001762 0000144 00000001512 13241016317 013065 0 ustar ligges users #' @name rsdmx
#' @aliases rsdmx-package
#' @aliases rsdmx
#' @docType package
#'
#' @title Tools for Reading SDMX Data and Metadata
#' @description
#' RSDMX is a package to parse/read SDMX documents in R. It provides:
#' - a set of classes and methods to read data and metadata documents exchanged
#' through theStatistical Data and Metadata Exchange (SDMX) framework. The package
#' currently focuses on the SDMX XML standard format (SDMX-ML).
#' - an web-service interface to well-known SDMX data providers
#'
#' @details
#' \tabular{ll}{
#' Package: \tab rsdmx\cr
#' Type: \tab Package\cr
#' Version
#' : \tab 0.5-11\cr
#' Date: \tab 2018-02-14\cr
#' License: \tab GPL(>=2.0)\cr
#' LazyLoad: \tab yes\cr
#' }
#'
#'@author Emmanuel Blondel \email{emmanuel.blondel1@@gmail.com}
#'
NULL rsdmx/R/Class-SDMXREST20RequestBuilder.R 0000644 0001762 0000144 00000002372 13041347740 017300 0 ustar ligges users #' @name SDMXREST20RequestBuilder
#' @docType class
#' @aliases SDMXREST20RequestBuilder-class
#'
#' @title Class "SDMXREST20RequestBuilder"
#' @description A experimental class to handle a SDMX 2.0 service request builder
#'
#' @slot regUrl an object of class "character" giving the base Url of the SDMX service registry
#' @slot repoUrl an object of class "character" giving the base Url of the SDMX service repository
#' @slot accessKey an object of class "character" indicating the name of request parameter for which
#' an authentication or subscription user key/token has to be provided to perform requests
#' @slot compliant an object of class "logical" indicating if the web-service is compliant with the SDMX REST web-service specifications
#'
#' @section Warning:
#' This class is not useful in itself, but all SDMX non-abstract classes will
#' encapsulate it as slot, when parsing an SDMX-ML document.
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
setClass("SDMXREST20RequestBuilder",
contains = "SDMXRequestBuilder",
representation(),
prototype = list(),
validity = function(object){
#eventual validation rules
return(TRUE);
}
)
rsdmx/R/Class-SDMXPrimaryMeasure.R 0000644 0001762 0000144 00000004624 12671332034 016446 0 ustar ligges users #' @name SDMXPrimaryMeasure
#' @docType class
#' @aliases SDMXPrimaryMeasure-class
#'
#' @title Class "SDMXPrimaryMeasure
#' @description A basic class to handle a SDMX PrimaryMeasure
#'
#' @slot conceptRef Object of class "character" giving the dimension conceptRef (required)
#' @slot conceptVersion Object of class "character" giving the dimension concept version
#' @slot conceptAgency Object of class "character" giving the dimension concept agency
#' @slot conceptSchemeRef Object of class "character" giving the dimension conceptScheme ref
#' @slot conceptSchemeAgency Object of class "character" giving the dimension conceptScheme agency
#' @slot codelist Object of class "character" giving the codelist ref name
#' @slot codelistVersion Object of class "character" giving the codelist ref version
#' @slot codelistAgency Object of class "character" giving the codelist ref agency
#'
#' @section Warning:
#' This class is not useful in itself, but all SDMX non-abstract classes will
#' encapsulate it as slot, when parsing an SDMX-ML document.
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
setClass("SDMXPrimaryMeasure",
representation(
#attributes
conceptRef = "character", #required
conceptVersion = "character", #optional
conceptAgency = "character", #optional
conceptSchemeRef = "character", #optional
conceptSchemeAgency = "character", #optional
codelist = "character", #optional
codelistVersion = "character", #optional
codelistAgency = "character" #optional
#elements
#TextFormat = "SDMXTextFormat" #optional
),
prototype = list(
#attributes
conceptRef = "CONCEPT",
conceptVersion = "1.0",
conceptAgency = "ORG",
conceptSchemeRef = "CONCEPT_SCHEME",
conceptSchemeAgency = "ORG",
codelist = "CODELIST",
codelistVersion = "1.0",
codelistAgency = "ORG"
#elements
#TextFormat = new("SDMXTextFormat")
),
validity = function(object){
#eventual validation rules
if(.rsdmx.options$validate){
if(is.na(object@conceptRef)) return(FALSE)
}
return(TRUE);
}
)
rsdmx/R/SDMXServiceProviders-methods.R 0000644 0001762 0000144 00000002426 12671346632 017404 0 ustar ligges users #' @name SDMXServiceProviders
#' @rdname SDMXServiceProviders
#' @aliases SDMXServiceProviders,SDMXServiceProviders-method
#'
#' @usage
#'SDMXServiceProviders(providers)
#'
#' @param providers an object of class "list" (of \link{SDMXServiceProvider})
#' configured by default and/or at runtime in \pkg{rsdmx}
#' @return an object of class "SDMXServiceProviders"
#'
SDMXServiceProviders <- function(providers) {
new("SDMXServiceProviders", providers = providers);
}
as.data.frame.SDMXServiceProviders <- function(x, ...){
out <- as.data.frame(do.call("rbind",
lapply(slot(x, "providers"),
function(provider){
builder <- slot(provider, "builder")
c(slot(provider,"agencyId"), slot(provider, "name"),
slot(provider, "scale"), slot(provider, "country"),
class(builder), slot(builder, "compliant"))
})),
stringsAsFactors = FALSE)
colnames(out) <- c("agencyId", "name", "scale", "country",
"builder", "compliant")
return(encodeSDMXOutput(out))
}
setAs("SDMXGenericData", "data.frame",
function(from) {as.data.frame.SDMXServiceProviders(from)}); rsdmx/R/Class-SDMXCodelists.R 0000644 0001762 0000144 00000001416 12613641542 015431 0 ustar ligges users #' @name SDMXCodelists
#' @docType class
#' @aliases SDMXCodelists-class
#'
#' @title Class "SDMXCodelists"
#' @description A basic class to handle SDMX Codelists
#'
#' @slot codelists Object of class "list" giving the list of "SDMXCodelist"
#'
#' @section Warning:
#' This class is not useful in itself, but \link{SDMXDataStructureDefinition} objects
#' will encapsulate it as slot, when parsing an SDMX-ML document.
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
setClass("SDMXCodelists",
contains = "SDMX",
representation(
codelists = "list"
),
prototype = list(),
validity = function(object){
#eventual validation rules
return(TRUE);
}
) rsdmx/R/SDMXType-methods.R 0000644 0001762 0000144 00000002213 12656700572 015021 0 ustar ligges users #' @name SDMXType
#' @rdname SDMXType
#' @aliases SDMXType,SDMXType-method
#'
#' @usage
#' SDMXType(xmlObj)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @return an object of class "SDMXType"
#'
#' @note
#' At now, the following types have been implemented and successfully tested:
#' - \code{StructureType},
#' - \code{GenericDataType},
#' - \code{CompactDataType},
#' - \code{StructureSpecificDataType},
#' - \code{CrossSectionalDataType},
#' - \code{UtilityDataType},
#' - \code{MessageGroupType}
#'
#' @seealso \link{readSDMX}
#'
SDMXType <- function(xmlObj){
new("SDMXType", type = type.SDMXType(xmlObj));
}
type.SDMXType <- function(xmlObj){
child <- xmlRoot(xmlObj)
if(xmlName(child) == "RegistryInterface"){
child <- xmlChildren(child)[[2]]
if(xmlName(child) == "QueryStructureResponse") return("StructureType")
}
type <- xmlName(xmlRoot(xmlObj))
if(attr(regexpr(":", type, ignore.case = T),"match.length") > 0){
type <-strsplit(xmlName(xmlRoot(xmlObj), full=T), ":")[[1]][2]
}
res <- paste(type, "Type", sep="");
return(res)
}
rsdmx/R/Class-SDMXConcept.R 0000644 0001762 0000144 00000006135 12671331224 015073 0 ustar ligges users #' @name SDMXConcept
#' @docType class
#' @aliases SDMXConcept-class
#'
#' @title Class "SDMXConcept"
#' @description A basic class to handle a SDMX Concept
#'
#' @slot id Object of class "character" giving the ID of the concept (required)
#' @slot agencyID Object of class "character" giving the AgencyID
#' @slot version Object of class "character" giving the concept version
#' @slot uri Object of class "character" giving the concept uri
#' @slot urn Object of class "character" giving the concept urn
#' @slot isExternalReference Object of class "logical" indicating if the concept is an external reference
#' @slot coreRepresentation Object of class "character" giving the core representation
#' @slot coreRepresentationAgency Object of class "character" giving the core representation agency
#' @slot parent Object of class "character" giving the concept parent
#' @slot parentAgency Object of class "character" giving the parentAgency
#' @slot Name Object of class "list" giving the concept name (by language) - required
#' @slot Description Object of class "list" giving the concept description (by language)
#'
#' @section Warning:
#' This class is not useful in itself, but all SDMX non-abstract classes will
#' encapsulate it as slot, when parsing an SDMX-ML document (Concepts, or
#' DataStructureDefinition)
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
setClass("SDMXConcept",
representation(
#attributes
id = "character", #required
agencyID = "character", #optional
version = "character", #optional
uri = "character", #optional
urn = "character", #optional
isExternalReference = "logical", #optional
coreRepresentation = "character", #optional
coreRepresentationAgency = "character", #optional
parent = "character", #optional
parentAgency = "character", #optional
#elements
Name = "list", #at least one
Description = "list" #optional
),
prototype = list(
#attributes
id = "CONCEPT_ID",
agencyID = "AGENCY_ID",
version = "1.0",
uri = as.character(NA),
urn = as.character(NA),
isExternalReference = FALSE,
coreRepresentation = as.character(NA),
coreRepresentationAgency = as.character(NA),
parent = as.character(NA),
parentAgency = as.character(NA),
#elements
Name = list(
en = "concept name",
fr = "nom du concept"
),
Description = list(
en = "concept description",
fr = "description du concept"
)
),
validity = function(object){
#eventual validation rules
if(.rsdmx.options$validate){
if(is.na(object@id)) return(FALSE)
if(length(object@Name) == 0) return(FALSE)
}
return(TRUE);
}
) rsdmx/R/SDMX-methods.R 0000644 0001762 0000144 00000016467 12671754026 014177 0 ustar ligges users #' @name SDMX
#' @rdname SDMX
#' @aliases SDMX,SDMX-method
#'
#' @usage
#' SDMX(xmlObj, namespaces)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @param namespaces object of class "data.frame" given the list of namespace URIs
#' @return an object of class "SDMX"
#'
#' @seealso \link{readSDMX}
SDMX <- function(xmlObj, namespaces){
schema <- SDMXSchema(xmlObj, namespaces);
header <- SDMXHeader(xmlObj, namespaces);
footer <- SDMXFooter(xmlObj, namespaces);
new("SDMX",
xmlObj = xmlObj,
schema = schema,
header = header,
footer = footer);
}
#functions
namespaces.SDMX <- function(xmlObj){
nsFromXML <- xmlNamespaceDefinitions(xmlObj, addNames = FALSE,
recursive = TRUE, simplify = FALSE)
nsDefs.df <- do.call("rbind",
lapply(nsFromXML,
function(x){
out <- NULL
if(length(names(x)) > 0) out <- x$uri
return(out)
}))
row.names(nsDefs.df) <- 1:nrow(nsDefs.df)
nsDefs.df <- as.data.frame(nsDefs.df, stringsAsFactors = FALSE)
if(nrow(nsDefs.df) > 0){
colnames(nsDefs.df) <- "uri"
nsDefs.df$uri <- as.character(nsDefs.df$uri)
nsDefs.df <- unique(nsDefs.df)
nsDefs.df <- nsDefs.df[!duplicated(nsDefs.df$uri),]
nsDefs.df <- as.data.frame(nsDefs.df, stringsAsFactors = FALSE)
colnames(nsDefs.df) <- "uri"
nsDefs.df <- nsDefs.df[
regexpr("http://www.w3.org", nsDefs.df$uri,
"match.length", ignore.case = TRUE) == -1,]
nsDefs.df <- as.data.frame(nsDefs.df, stringsAsFactors = FALSE)
colnames(nsDefs.df) <- "uri"
}
return(nsDefs.df)
}
encodeSDMXOutput <- function(df){
for(col in colnames(df)){
if(class(df[,col]) == "character") Encoding(df[,col]) <- "UTF-8"
}
return(df)
}
#' @name getNamespaces
#' @docType methods
#' @aliases getNamespaces,SDMX-method
#' @title getNamespaces
#' @description Access the namespaces of the SDMX-ML object
#' @usage getNamespaces(obj)
#'
#' @param obj An object deriving from class "SDMX"
#' @return an object of class \code{data.frame} giving the id and uri for each
#' of the namespaces handled in the SDMX-ML document.
#'
#' @seealso \link{SDMX-class}
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
if (!isGeneric("getNamespaces"))
setGeneric("getNamespaces", function(obj) standardGeneric("getNamespaces"));
#' @describeIn getNamespaces
setMethod(f = "getNamespaces", signature = "SDMX", function(obj){
return(namespaces.SDMX(obj@xmlObj));
})
#others non-S4 methods
#====================
#' @name findNamespace
#' @aliases findNamespace
#' @title findNamespace
#' @description function used to find a specific namespace within the available
#' namespaces of an SDMX-ML object
#'
#' @usage
#' findNamespace(namespaces, messageType)
#'
#' @param namespaces object of class \code{data.frame} giving the namespaces URIs
#' available in a SDMX-ML object, typically obtained with \link{getNamespaces}
#' @param messageType object of class \code{character} representing a message type
#' @return an object of class "character" giving the namespace uri if found in the
#' available namespaces
#'
#' @section Warning:
#' \code{findNamespace} is a function used internally as utility function in
#' SDMX-ML object parsers.
#'
#' @seealso \link{SDMX-class} \link{getNamespaces}
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
findNamespace <- function(namespaces, messageType){
regexp <- paste(messageType, "$", sep = "")
ns <- c(ns = namespaces$uri[grep(regexp, namespaces$uri, ignore.case = TRUE)])
return(ns)
}
#' @name isSoapRequestEnvelope
#' @aliases isSoapRequestEnvelope
#' @title isSoapRequestEnvelope
#' @description function used to detect if the XML document corresponds to a SOAP
#' request response
#' @usage
#' isSoapRequestEnvelope(xmlObj, namespaces)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @param namespaces object of class "data.frame" given the list of namespace URIs
#' @return an object of class "logical"
#'
#' @section Warning:
#' \code{isSoapRequestEnvelope} is a function used internally by \link{readSDMX}
#'
#' @seealso \link{SDMX-class} \link{readSDMX}
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
isSoapRequestEnvelope <- function(xmlObj, namespaces){
return(tolower(xmlName(xmlRoot(xmlObj))) == "envelope")
}
#' @name getSoapRequestResult
#' @aliases getSoapRequestResult
#' @title getSoapRequestResult
#' @description function used to extract the SDMX-ML message from a SOAP request
#' response
#' @usage
#' getSoapRequestResult(xmlObj)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @return an object of class "XMLInternalDocument derived from XML package
#'
#' @section Warning:
#' \code{getSoapRequestResult} is a function used internally by \link{readSDMX}
#'
#' @seealso \link{SDMX-class} \link{readSDMX}
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
getSoapRequestResult <- function(xmlObj){
body <- xmlChildren(xmlRoot(xmlObj))
response <- xmlChildren(body[[1]]); rm(body);
result <- xmlChildren(response[[1]]); rm(response);
sdmxDoc <- xmlDoc(xmlChildren(result[[1]])[[1]]); rm(result);
return(sdmxDoc)
}
#' @name isRegistryInterfaceEnvelope
#' @aliases isRegistryInterfaceEnvelope
#' @title isRegistryInterfaceEnvelope
#' @description function used to detect if the XML document corresponds to a
#' registry interface query
#' @usage
#' isRegistryInterfaceEnvelope(xmlObj, nativeRoot)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @param nativeRoot object of class "logical" indicating if it is the native document
#' @return an object of class "logical"
#'
#' @section Warning:
#' \code{isRegistryInterfaceEnvelope} is a function used internally by \link{readSDMX}
#'
#' @seealso \link{SDMX-class} \link{readSDMX}
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
isRegistryInterfaceEnvelope <- function(xmlObj, nativeRoot){
root <- xmlRoot(xmlObj)
if(nativeRoot) root <- root[[1]]
return(xmlName(root) == "RegistryInterface")
}
#' @name getRegistryInterfaceResult
#' @aliases getRegistryInterfaceResult
#' @title getRegistryInterfaceResult
#' @description function used to extract the SDMX-ML message from a registry
#' interface query
#' @usage
#' getRegistryInterfaceResult(xmlObj)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @return an object of class "XMLInternalDocument derived from XML package
#'
#' @section Warning:
#' \code{getRegistryInterfaceResult} is a function used internally by \link{readSDMX}
#'
#' @seealso \link{SDMX-class} \link{readSDMX}
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
getRegistryInterfaceResult <- function(xmlObj){
sdmxDoc <- xmlDoc(xmlChildren(xmlRoot(xmlObj))[[1]])
return(sdmxDoc)
} rsdmx/R/Class-SDMXSchema.R 0000644 0001762 0000144 00000002115 12671332434 014676 0 ustar ligges users #' @name SDMXSchema
#' @docType class
#' @aliases SDMXSchema-class
#' @title Class "SDMXSchema"
#' @description A basic class to handle the version of the SDMX-ML Schema
#'
#' @slot version Object of class "character" giving the SDMX-ML schema version
#'
#' @section Warning:
#' this class is not useful in itself, but all SDMX non-abstract classes will
#' encapsulate it as slot, when parsing an SDMX-ML document.
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
setClass("SDMXSchema",
representation(
version = "character"
),
prototype = list(version = "2.0"),
validity = function(object){
#validation rules
if(.rsdmx.options$validate){
VERSION <- object@version;
valid <- switch(VERSION,
"1.0" = TRUE,
"2.0" = TRUE,
"2.1" = TRUE,
FALSE
);
if(valid == FALSE)
warning(paste0("SDMXSchema version ", VERSION," not supported by RSDMX"));
return(valid)
}
return(TRUE)
}
)
rsdmx/R/SDMXMessageGroup-methods.R 0000644 0001762 0000144 00000005112 13142702224 016465 0 ustar ligges users #' @name SDMXMessageGroup
#' @rdname SDMXMessageGroup
#' @aliases SDMXMessageGroup,SDMXMessageGroup-method
#'
#' @usage
#' SDMXMessageGroup(xmlObj, namespaces)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @param namespaces object of class "data.frame" given the list of namespace URIs
#' @return an object of class "SDMXMessageGroup"
#'
#' @seealso \link{readSDMX}
#'
SDMXMessageGroup <- function(xmlObj, namespaces){
new("SDMXMessageGroup",
SDMXData(xmlObj, namespaces)
)
}
#methods
#=======
class.SDMXMessageGroup <- function(xmlObj){
#namespace
nsDefs.df <- namespaces.SDMX(xmlObj)
#in case no ns found, try to find specific namespace
ns.df <- nsDefs.df[
regexpr("http://www.sdmx.org", nsDefs.df$uri,
"match.length", ignore.case = TRUE) == -1,]
ns.df <- as.data.frame(ns.df, stringsAsFactors = FALSE)
colnames(ns.df) <- "uri"
ns <- ns.df$uri
if(length(ns) > 1) ns <- ns[1L]
authorityNs <- nsDefs.df[nsDefs.df$uri == ns,]
authorityNs <- as.data.frame(authorityNs, stringsAsFactors = FALSE)
colnames(authorityNs) <- "uri"
if(nrow(authorityNs) == 0){
hasAuthorityNS <- FALSE
}else{
hasAuthorityNS <- TRUE
}
#business logic to inherit wrapped object class
wrappedClass <- NULL
seriesKeyXML <- NULL
if(hasAuthorityNS){
seriesKeyXML <- getNodeSet(xmlObj, "//ns:SeriesKey", c(ns = authorityNs$uri))
}else{
if(nrow(nsDefs.df) > 0){
serieNs <- nsDefs.df[regexpr("generic$", nsDefs.df$uri)>0,"uri"]
if(length(serieNs)==0) serieNs <- nsDefs.df[1,"uri"]
seriesKeyXML <- getNodeSet(xmlObj, "//ns:SeriesKey", c(ns = serieNs))
}else{
stop("Unsupported XML parser for empty target XML namespace")
}
}
if(!is.null(seriesKeyXML)){
if(length(seriesKeyXML) > 0){
wrappedClass <- "SDMXGenericData"
}else{
wrappedClass <- "SDMXCompactData"
}
}
return(wrappedClass)
}
as.data.frame.SDMXMessageGroup <- function(x, row.names=NULL, optional=FALSE,
labels = FALSE, ...){
#TODO support for other included message types
#(at now limited to SDMXGenericData for making it work with OECD)
xmlObj <- slot(x, "xmlObj")
sdmx.df <- switch(class.SDMXMessageGroup(xmlObj),
"SDMXGenericData" = as.data.frame.SDMXGenericData(x, labels = labels),
"SDMXCompactData" = as.data.frame.SDMXCompactData(x, labels = labels),
NULL
)
return(encodeSDMXOutput(sdmx.df))
}
rsdmx/R/Class-SDMXStructureSpecificData.R 0000644 0001762 0000144 00000001327 12656611456 017751 0 ustar ligges users #' @name SDMXStructureSpecificData
#' @docType class
#' @aliases SDMXStructureSpecificData-class
#'
#' @title Class "SDMXStructureSpecificData"
#' @description A basic class to handle a SDMX-ML StructureSpecificData data set
#'
#' @section Warning:
#' This class is not useful in itself, but all SDMX non-abstract classes will
#' encapsulate it as slot, when parsing an SDMX-ML document.
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
setClass("SDMXStructureSpecificData",
contains = "SDMXData",
representation(),
prototype = list(),
validity = function(object){
#eventual validation rules
return(TRUE);
}
)
rsdmx/R/Class-SDMXRequestParams.R 0000644 0001762 0000144 00000004573 13041347062 016277 0 ustar ligges users #' @name SDMXRequestParams
#' @docType class
#' @aliases SDMXRequestParams-class
#'
#' @title Class "SDMXRequestParams"
#' @description A class to handle a SDMX service request params
#'
#' @slot regUrl an object of class "character" giving the base Url of the SDMX service registry
#' @slot repoUrl an object of class "character" giving the base Url of the SDMX service repository
#' @slot accessKey an object of class "character" indicating the name of request parameter for which
#' an authentication or subscription user key/token has to be provided to perform requests
#' @slot providerId an object of class "character" giving the provider agency Id
#' @slot agencyId an object of class "character" giving an agency Id
#' @slot resource an object of class "character" giving the type of resource to be queried
#' @slot resourceId an object of class "character" giving the resource to be queried
#' @slot version an object of class "character" giving the resource version
#' @slot flowRef an object of class "character" giving the flowRef to be queried
#' @slot key an object of class "character" giving the key (SDMX url formatted) to be used for the query
#' @slot start an object of class "character" giving the start time
#' @slot end an object of class "character" giving the end time
#' @slot compliant an object of class "logical" indicating if the web-service is compliant with the SDMX REST web-service specifications
#'
#' @section Warning:
#' This class is not useful in itself, but all SDMX non-abstract classes will
#' encapsulate it as slot, when parsing an SDMX-ML document.
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
setClass("SDMXRequestParams",
representation(
regUrl = "character",
repoUrl = "character",
accessKey = "character_OR_NULL",
providerId = "character",
agencyId = "character_OR_NULL",
resource = "character",
resourceId = "character_OR_NULL",
version = "character_OR_NULL",
flowRef = "character_OR_NULL",
key = "character_OR_NULL",
start = "character_OR_numeric_OR_NULL",
end = "character_OR_numeric_OR_NULL",
compliant = "logical"
),
prototype = list(),
validity = function(object){
return(TRUE);
}
)
rsdmx/R/SDMXData-methods.R 0000644 0001762 0000144 00000010354 13043355716 014753 0 ustar ligges users #' @name SDMXData
#' @rdname SDMXData
#' @aliases SDMXData,SDMXData-method
#'
#' @usage
#' SDMXData(xmlObj, namespaces)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @param namespaces object of class "data.frame" given the list of namespace URIs
#'
#' @return an object of class "SDMXData"
#'
#' @seealso \link{readSDMX}
#'
SDMXData <- function(xmlObj, namespaces){
sdmxObj <- SDMX(xmlObj, namespaces)
dsdRef <- dsdRef.SDMXData(xmlObj, namespaces)
dsd <- NULL
if(!is.null(dsdRef)){
dsd <- NULL
}
new("SDMXData",
sdmxObj,
dsdRef = dsdRef,
dsd = dsd
)
}
#get DSD REF
#===========
dsdRef.SDMXData <- function(xmlObj, namespaces){
sdmxVersion <- version.SDMXSchema(xmlObj, namespaces)
dsXML <- xmlChildren(xmlChildren(xmlObj)[[1]])$DataSet
dsdRef <- switch(sdmxVersion,
"1.0" = NULL, #TODO
"2.0" = {
ref <- NULL
xml <- xmlChildren(dsXML)
xmlNames <- names(xml)
if("KeyFamilyRef" %in% xmlNames){
keyFamilyRef <- xml$KeyFamilyRef
ref <- xmlValue(keyFamilyRef)
}
ref
},
"2.1" = xmlGetAttr(dsXML,"structureRef")
)
return(dsdRef)
}
#ENRICH DATA WITH LABELS
#=======================
addLabels.SDMXData <- function(data, dsd){
#try to inherit datastructure components
components <- NULL
datastructures <- slot(slot(dsd,"datastructures"), "datastructures")
if(length(datastructures)>0){
ds <- datastructures[[1]]
components <- slot(ds, "Components")
components <- as.data.frame(components)
}
#function to enrich a column with its labels
enrichColumnWithLabels <- function(column, data, dsd, components){
datac <- as.data.frame(data[,column], stringsAsFactors = FALSE)
colnames(datac) <- column
#grab codelist name
clName <- NULL
if(!is.null(components)){
#try to grab codelist using concepts
clMatcher <- components$conceptRef == column
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"]
if(length(clName)>1) clName <- clName[1]
}
}else{
#no components, take the column name as codelistId
codelists <- sapply(slot(slot(dsd,"codelists"), "codelists"), slot, "id")
if(column %in% codelists){
clName <- column
}
}
if(length(clName) != 0 && !is.na(clName) && !is.null(clName)){
cl <- as.data.frame(slot(dsd, "codelists"), codelistId = clName)
datac$order <- seq(len=nrow(datac))
datac = merge(x = datac, y = cl, by.x = column, by.y = "id",
all.x = TRUE, all.y = FALSE, sort = FALSE)
datac <- datac[sort.list(datac$order),]
datac$order <- NULL
datac <- datac[,((regexpr("label", colnames(datac)) != -1) +
(colnames(datac) == column) == 1)]
colnames(datac)[regexpr("label",colnames(datac)) != -1] <- paste0(column,
"_",colnames(datac)[regexpr("label",colnames(datac)) != -1])
}
return(datac)
}
fulldata <- do.call("cbind" ,lapply(colnames(data), enrichColumnWithLabels,
data, dsd, components))
return(fulldata)
}
#' @name setDSD
#' @docType methods
#' @aliases setDSD,SDMXData-method
#' @title setDSD
#' @description set the 'dsd' slot of a \code{SDMXData} object
#' @usage setDSD(obj, dsd)
#'
#' @param obj An object deriving from class "SDMXData"
#' @param dsd An object of class "SDMXDataStructureDefinition"
#' @return the 'obj' object of class "SDMXData" enriched with the dsd
#'
#' @seealso \link{SDMXData-class}
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
if (!isGeneric("setDSD"))
setGeneric("setDSD", function(obj, dsd) standardGeneric("setDSD"));
#' @describeIn setDSD
setMethod(f = "setDSD", signature = "SDMXData", function(obj, dsd){
slot(obj, "dsd") <- dsd
return(obj)
})
rsdmx/R/SDMXConcept-methods.R 0000644 0001762 0000144 00000007054 12744363762 015507 0 ustar ligges users #' @name SDMXConcept
#' @rdname SDMXConcept
#' @aliases SDMXConcept,SDMXConcept-method
#'
#' @usage
#' SDMXConcept(xmlObj, namespaces)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @param namespaces object of class "data.frame" given the list of namespace URIs
#' @return an object of class "SDMXConcept"
#'
#' @seealso \link{readSDMX}
#'
SDMXConcept <- function(xmlObj, namespaces){
messageNs <- findNamespace(namespaces, "message")
strNs <- findNamespace(namespaces, "structure")
sdmxVersion <- version.SDMXSchema(xmlDoc(xmlObj), namespaces)
VERSION.21 <- sdmxVersion == "2.1"
refNs <- strNs
if(VERSION.21){
comNs <- findNamespace(namespaces, "common")
refNs <- comNs
}
#attributes
#=========
id = xmlGetAttr(xmlObj, "id")
if(is.null(id)) id <- as.character(NA)
agencyId = xmlGetAttr(xmlObj, "agencyID")
if(is.null(agencyId)) agencyId <- as.character(NA)
version = xmlGetAttr(xmlObj, "version")
if(is.null(version)) version <- as.character(NA)
uri = xmlGetAttr(xmlObj, "uri")
if(is.null(uri)) uri <- as.character(NA)
urn = xmlGetAttr(xmlObj, "urn")
if(is.null(urn)) urn <- as.character(NA)
isExternalReference = xmlGetAttr(xmlObj, "isExternalReference")
if(is.null(isExternalReference)){
isExternalReference <- NA
}else{
isExternalReference <- as.logical(isExternalReference)
}
coreRepresentation = xmlGetAttr(xmlObj, "coreRepresentation")
if(is.null(coreRepresentation)) coreRepresentation <- as.character(NA)
coreRepresentationAgency = xmlGetAttr(xmlObj, "coreRepresentationAgency")
if(is.null(coreRepresentationAgency)) coreRepresentationAgency <- as.character(NA)
parent = xmlGetAttr(xmlObj, "parent")
if(is.null(parent)) parent <- as.character(NA)
parentAgency = xmlGetAttr(xmlObj, "parentAgency")
if(is.null(parentAgency)) parentAgency <- as.character(NA)
#elements
#========
#name (multi-languages)
conceptNamesXML <- getNodeSet(xmlDoc(xmlObj), "//ns:Name", namespaces = refNs)
conceptNames <- NULL
if(length(conceptNamesXML) > 0){
conceptNames <- new.env()
sapply(conceptNamesXML,
function(x){
lang <- xmlGetAttr(x,"xml:lang")
if(is.null(lang)) lang <- xmlGetAttr(x,"lang")
if(is.null(lang)) lang <- "default"
conceptNames[[lang]] <- xmlValue(x)
})
conceptNames <- as.list(conceptNames)
}
#description (multi-languages)
conceptDesXML <- getNodeSet(xmlDoc(xmlObj), "//ns:Description", namespaces = refNs)
conceptDescriptions <- list()
if(length(conceptDesXML) > 0){
conceptDescriptions <- new.env()
sapply(conceptDesXML,
function(x){
lang <- xmlGetAttr(x,"xml:lang")
if(is.null(lang)) lang <- xmlGetAttr(x,"lang")
if(is.null(lang)) lang <- "default"
conceptDescriptions[[lang]] <- xmlValue(x)
})
conceptDescriptions <- as.list(conceptDescriptions)
}
#instantiate the object
obj<- new("SDMXConcept",
#attributes
id = id,
agencyID = agencyId,
version = version,
uri = uri,
urn = urn,
isExternalReference = isExternalReference,
coreRepresentation = coreRepresentation,
coreRepresentationAgency = coreRepresentationAgency,
parent = parent,
parentAgency = parentAgency,
#elements
Name = conceptNames,
Description = conceptDescriptions
)
}
rsdmx/R/SDMXCompactData-methods.R 0000644 0001762 0000144 00000012345 13142701322 016250 0 ustar ligges users #' @name SDMXCompactData
#' @rdname SDMXCompactData
#' @aliases SDMXCompactData,SDMXCompactData-method
#'
#' @usage
#' SDMXCompactData(xmlObj, namespaces)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @param namespaces object of class "data.frame" given the list of namespace URIs
#' @return an object of class "SDMXCompactData"
#'
#' @seealso \link{readSDMX}
#'
SDMXCompactData <- function(xmlObj, namespaces){
new("SDMXCompactData",
SDMXData(xmlObj, namespaces)
)
}
#methods
as.data.frame.SDMXAllCompactData <- function(x, nsExpr, labels = FALSE, ...) {
xmlObj <- x@xmlObj;
dataset <- NULL
schema <- slot(x,"schema")
sdmxVersion <- slot(schema,"version")
VERSION.21 <- sdmxVersion == "2.1"
#namespace
hasAuthorityNS <- FALSE
nsDefs.df <- getNamespaces(x)
ns <- findNamespace(nsDefs.df, nsExpr)
if(length(ns) > 1) ns <- ns[1]
authorityNamespaces <- nsDefs.df[
regexpr("http://www.sdmx.org", nsDefs.df$uri,
"match.length", ignore.case = TRUE) == -1,]
authorityNamespaces <- as.data.frame(authorityNamespaces, stringsAsFactors = FALSE)
colnames(authorityNamespaces) <- "uri"
if(nrow(authorityNamespaces) > 0){
nsIdx <- 1
hasAuthorityNS <- TRUE
if(nrow(authorityNamespaces) > 1){
authorityNs <- authorityNamespaces[nsIdx,]
authorityNs <- as.data.frame(authorityNs, stringsAsFactors = FALSE)
colnames(authorityNs) <- "uri"
}else{
authorityNs <- authorityNamespaces
}
}
if(hasAuthorityNS){
#try to get series with authority namespaces
seriesXML <- getNodeSet(xmlObj, "//ns:Series", namespaces = c(ns = authorityNs$uri))
while(nsIdx <= nrow(authorityNamespaces) && length(seriesXML) == 0){
nsIdx <- nsIdx + 1
authorityNs <- authorityNamespaces[nsIdx,]
authorityNs <- as.data.frame(authorityNs, stringsAsFactors = FALSE)
colnames(authorityNs) <- "uri"
seriesXML <- getNodeSet(xmlObj, "//ns:Series", namespaces = c(ns = authorityNs$uri))
}
if(length(seriesXML) == 0){
seriesXML <- try(getNodeSet(xmlObj, "//ns:Series", namespaces = ns), silent = TRUE)
if(class(seriesXML) == "try-error") seriesXML <- list()
}
}else{
if(length(ns) > 0){
seriesXML <- try(getNodeSet(xmlObj, "//ns:Series", namespaces = ns), silent = TRUE)
if(class(seriesXML) == "try-error") seriesXML <- list()
}else{
if(nrow(nsDefs.df) > 0){
serieNs <- nsDefs.df[1,]
serieNs <- as.data.frame(serieNs, stringsAsFactors = FALSE)
colnames(serieNs) <- "uri"
seriesXML <- getNodeSet(xmlObj, "//nt:Series", c(nt = serieNs$uri))
}else{
stop("Unsupported CompactData parser for empty target XML namespace")
}
}
}
if(length(seriesXML) == 0){
seriesXML <- getNodeSet(xmlObj, "//Series")
}
seriesNb <- length(seriesXML)
if(seriesNb == 0) return(NULL);
#function to parse a Serie
parseSerie <- function(x){
#obs attributes (which may include observations)
obsValueXML <- xmlChildren(x)
obsAttrs <- data.frame()
if(length(obsValueXML) > 0){
obsAttrs <- do.call("rbind.fill", lapply(obsValueXML, function(t){
data.frame(as.list(xmlAttrs(t)), stringsAsFactors = FALSE)
}))
}
#obs children (in case we have)
obsValues <- try(xmlToDataFrame(obsValueXML, stringsAsFactors = FALSE), silent=TRUE)
if(class(obsValues) == "try-error"){
obsValues <- NULL
}else{
obsKeyNames <- names(lapply(obsValueXML, xmlChildren)[["Key"]])
obsValues[,obsKeyNames] <- obsValues[1,obsKeyNames]
obsValues <- obsValues[-1,]
invisible(lapply(obsKeyNames, function(t) obsValues[nchar(obsValues[,t],"w")==0,t] <<- NA))
}
#key values
keydf <- as.data.frame(t(as.data.frame(xmlAttrs(x), stringAsFactors = FALSE)), stringAsFactors = FALSE)
if(nrow(obsAttrs) > 0){
keydf <- keydf[rep(row.names(keydf), nrow(obsAttrs)),]
if(class(keydf) == "data.frame") row.names(keydf) <- 1:nrow(obsAttrs)
}
#single Serie as DataFrame
if(nrow(obsAttrs) > 0){
obsContent <- obsAttrs
if(!is.null(obsValues)){
obsContent <- cbind(obsAttrs, obsValues)
}
serie <- cbind(keydf, obsContent, row.names = 1:nrow(obsAttrs))
}else{
#manage absence data
serie <- keydf
}
return(serie)
}
#converting SDMX series to a DataFrame R object
dataset <- do.call("rbind.fill",
lapply(seriesXML, function(x){serie <- parseSerie(x) }))
if(any(as.character(dataset$obsValue) == "NaN", na.rm = TRUE)){
dataset[as.character(dataset$obsValue) == "NaN",]$obsValue <- NA
}
if(!is.null(dataset)) row.names(dataset) <- 1:nrow(dataset)
#enrich with labels
if(labels){
dsd <- slot(x, "dsd")
if(!is.null(dsd)) dataset <- addLabels.SDMXData(dataset, dsd)
}
#output
return(encodeSDMXOutput(dataset))
}
as.data.frame.SDMXCompactData <- function(x, row.names=NULL, optional=FALSE,
labels = FALSE, ...){
return(as.data.frame.SDMXAllCompactData(x, "compact", labels));
}
rsdmx/R/Class-SDMXUtilityData.R 0000644 0001762 0000144 00000001245 12656611470 015741 0 ustar ligges users #' @name SDMXUtilityData
#' @docType class
#' @aliases SDMXUtilityData-class
#'
#' @title Class "SDMXUtilityData"
#' @description A basic class to handle a SDMX-ML UtilityData data set
#'
#' @section Warning:
#' This class is not useful in itself, but all SDMX non-abstract classes will
#' encapsulate it as slot, when parsing an SDMX-ML document.
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
setClass("SDMXUtilityData",
contains = "SDMXData",
representation(),
prototype = list(),
validity = function(object){
#eventual validation rules
return(TRUE);
}
)
rsdmx/R/Class-SDMXOrganisationSchemes.R 0000644 0001762 0000144 00000001612 13120314726 017436 0 ustar ligges users #' @name SDMXOrganisationSchemes
#' @docType class
#' @aliases SDMXOrganisationSchemes-class
#'
#' @title Class "SDMXOrganisationSchemes"
#' @description A basic class to handle a SDMX OrganisationSchemes
#'
#' @slot organisationSchemes Object of class "list" giving the list of \link{SDMXAgencyScheme}
#'
#' @section Warning:
#' This class is not useful in itself, but all SDMX non-abstract classes will
#' encapsulate it as slot, when parsing an SDMX-ML document
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
setClass("SDMXOrganisationSchemes",
contains = "SDMX",
representation(
organisationSchemes = "list"
),
prototype = list(
organisationSchemes = list()
),
validity = function(object){
#eventual validation rules
return(TRUE);
}
)
rsdmx/R/Class-SDMXDataStructureDefinition.R 0000644 0001762 0000144 00000003520 13120305416 020270 0 ustar ligges users #' @name SDMXDataStructureDefinition
#' @docType class
#' @aliases SDMXDataStructureDefinition-class
#'
#' @title Class "SDMXDataStructureDefinition"
#' @description A basic class to handle a SDMX DataStructureDefinition (DSD)
#' @slot organisationSchemes Object of class "SDMXOrganisationSchemes" giving the
#' list of agencies (see \link{SDMXAgencyScheme} and \link{SDMXAgency})
#' @slot concepts Object of class "SDMXConcepts" giving the list of concepts or
#' conceptSchemes (see \link{SDMXConcepts})
#' @slot codelists Object of class "SDMXCodelists" giving the list of codelists
#' (see \link{SDMXCodelists})
#' @slot datastructures Object of class "SDMXDataStructures" giving the list of
#' datastructures /key families (see \link{SDMXDataStructures})
#'
#' @section Warning:
#' This class is not useful in itself, but all SDMX non-abstract classes will
#' encapsulate it as slot, when parsing an SDMX-ML document (Concepts, or
#' DataStructureDefinition)
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
setClass("SDMXDataStructureDefinition",
contains = "SDMX",
representation(
organisationSchemes = "SDMXOrganisationSchemes",
concepts = "SDMXConcepts",
codelists = "SDMXCodelists",
datastructures = "SDMXDataStructures"
),
prototype = list(
organisationSchemes = new("SDMXOrganisationSchemes"),
concepts = new("SDMXConcepts"),
codelists = new("SDMXCodelists"),
datastructures = new("SDMXDataStructures")
),
validity = function(object){
#eventual validation rules
return(TRUE);
}
)
setClassUnion("SDMXDataStructureDefinition_OR_NULL",
c("SDMXDataStructureDefinition","NULL")) rsdmx/R/SDMXComponents-methods.R 0000644 0001762 0000144 00000014152 12671526516 016233 0 ustar ligges users #' @name SDMXComponents
#' @rdname SDMXComponents
#' @aliases SDMXComponents,SDMXComponents-method
#'
#' @usage
#' SDMXComponents(xmlObj, namespaces)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @param namespaces object of class "data.frame" given the list of namespace URIs
#' @return an object of class "SDMXComponents"
#'
#' @seealso \link{readSDMX}
#'
SDMXComponents <- function(xmlObj, namespaces){
new("SDMXComponents",
Dimensions = dimensions.SDMXComponents(xmlObj, namespaces),
TimeDimension = timedimension.SDMXComponents(xmlObj, namespaces),
PrimaryMeasure = primarymeasure.SDMXComponents(xmlObj, namespaces),
Attributes = attributes.SDMXComponents(xmlObj, namespaces)
)
}
#get list of SDMXDimension
#=========================
dimensions.SDMXComponents <- function(xmlObj, namespaces){
dimensions <- NULL
strNs <- findNamespace(namespaces, "structure")
sdmxVersion <- version.SDMXSchema(xmlDoc(xmlObj), namespaces)
VERSION.21 <- sdmxVersion == "2.1"
dimensionsXML <- NULL
if(VERSION.21){
dimensionsXML <- getNodeSet(xmlDoc(xmlObj),
"//str:DimensionList/str:Dimension",
namespaces = c(str = as.character(strNs)))
}else{
dimensionsXML <- getNodeSet(xmlDoc(xmlObj),
"//str:Dimension",
namespaces = c(str = as.character(strNs)))
}
if(!is.null(dimensionsXML)){
dimensions <- lapply(dimensionsXML, SDMXDimension, namespaces)
}
return(dimensions)
}
#get SDMXTimeDimension
#=====================
timedimension.SDMXComponents <- function(xmlObj, namespaces){
timedimension <- NULL
sdmxVersion <- version.SDMXSchema(xmlDoc(xmlObj), namespaces)
VERSION.21 <- sdmxVersion == "2.1"
strNs <- findNamespace(namespaces, "structure")
timeDimXML <- NULL
if(VERSION.21){
timeDimXML <- getNodeSet(xmlDoc(xmlObj),
"//str:DimensionList/str:TimeDimension",
namespaces = c(str = as.character(strNs)))
}else{
timeDimXML <- getNodeSet(xmlDoc(xmlObj),
"//str:TimeDimension",
namespaces = c(str = as.character(strNs)))
}
if(length(timeDimXML) > 0){
timeDimensionXML <- timeDimXML[[1]]
timedimension <- SDMXTimeDimension(timeDimensionXML, namespaces)
}
return(timedimension)
}
#get SDMXPrimaryMeasure
#======================
primarymeasure.SDMXComponents <- function(xmlObj, namespaces){
primarymeasure <- NULL
sdmxVersion <- version.SDMXSchema(xmlDoc(xmlObj), namespaces)
VERSION.21 <- sdmxVersion == "2.1"
strNs <- findNamespace(namespaces, "structure")
if(VERSION.21){
measureXML <- getNodeSet(xmlDoc(xmlObj),
"//str:MeasureList/str:PrimaryMeasure",
namespaces = c(str = as.character(strNs)))
}else{
measureXML <- getNodeSet(xmlDoc(xmlObj),
"//str:PrimaryMeasure",
namespaces = c(str = as.character(strNs)))
}
if(length(measureXML) > 0){
measureXML <- measureXML[[1]]
primarymeasure <- SDMXPrimaryMeasure(measureXML, namespaces)
}
return(primarymeasure)
}
#get list of SDMXAttribute
#=========================
attributes.SDMXComponents <- function(xmlObj, namespaces){
attributes <- NULL
sdmxVersion <- version.SDMXSchema(xmlDoc(xmlObj), namespaces)
VERSION.21 <- sdmxVersion == "2.1"
strNs <- findNamespace(namespaces, "structure")
if(VERSION.21){
attributesXML <- getNodeSet(xmlDoc(xmlObj),
"//str:AttributeList/str:Attribute",
namespaces = c(str = as.character(strNs)))
}else{
attributesXML <- getNodeSet(xmlDoc(xmlObj),
"//str:Attribute",
namespaces = c(str = as.character(strNs)))
}
if(!is.null(attributesXML)){
attributes <- lapply(attributesXML, SDMXDimension, namespaces)
}
return(attributes)
}
#methods
as.data.frame.SDMXComponents <- function(x, ...){
#dimensions
dimensions <- slot(x, "Dimensions")
dimensions.df <- as.data.frame(
do.call("rbind",
lapply(
dimensions,
function(x){
sapply(slotNames(x), function(elem){slot(x,elem)})
}
)
),stringsAsFactors = FALSE)
dimensions.df <- cbind(component = "Dimension", dimensions.df,
stringsAsFactors = FALSE)
#time dimension
timeDimension <- slot(x, "TimeDimension")
timeDimension.df <- NULL
if(!is.null(timeDimension)){
timeDimension.df <- as.data.frame(
t(sapply(slotNames(timeDimension), function(elem){slot(timeDimension,elem)})),
stringsAsFactors = FALSE
)
timeDimension.df <- cbind(component = "TimeDimension", timeDimension.df,
stringsAsFactors = FALSE)
}
#primary measure
primaryMeasure <- slot(x, "PrimaryMeasure")
primaryMeasure.df <- as.data.frame(
t(sapply(slotNames(primaryMeasure), function(elem){slot(primaryMeasure,elem)})),
stringsAsFactors = FALSE
)
primaryMeasure.df <- cbind(component = "PrimaryMeasure", primaryMeasure.df,
stringsAsFactors = FALSE)
#attributes
attributes <- slot(x, "Attributes")
attributes.df <- as.data.frame(
do.call("rbind",
lapply(
attributes,
function(x){
sapply(slotNames(x), function(elem){slot(x,elem)})
}
)
),stringsAsFactors = FALSE)
attributes.df <- cbind(component = "Attribute", attributes.df,
stringsAsFactors = FALSE)
#output
df<- do.call("rbind.fill", list(dimensions.df, timeDimension.df,
primaryMeasure.df, attributes.df))
return(encodeSDMXOutput(df))
}
setAs("SDMXComponents", "data.frame",
function(from) as.data.frame.SDMXComponents(from)); rsdmx/R/SDMXStructureSpecificTimeSeriesData-methods.R 0000644 0001762 0000144 00000001723 12744667006 022341 0 ustar ligges users #' @name SDMXStructureSpecificTimeSeriesData
#' @rdname SDMXStructureSpecificTimeSeriesData
#' @aliases SDMXStructureSpecificTimeSeriesData,SDMXStructureSpecificTimeSeriesData-method
#'
#' @usage
#' SDMXStructureSpecificTimeSeriesData(xmlObj, namespaces)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @param namespaces object of class "data.frame" given the list of namespace URIs
#' @return an object of class "SDMXStructureSpecificTimeSeriesData"
#'
#' @seealso \link{readSDMX}
#'
SDMXStructureSpecificTimeSeriesData <- function(xmlObj, namespaces){
new("SDMXStructureSpecificTimeSeriesData",
SDMXData(xmlObj, namespaces)
)
}
#methods
#=======
as.data.frame.SDMXStructureSpecificTimeSeriesData <- function(x, row.names=NULL, optional=FALSE,
labels = FALSE, ...){
return(as.data.frame.SDMXAllCompactData(x, "structurespecific", labels));
}
rsdmx/R/Class-SDMXConcepts.R 0000644 0001762 0000144 00000002431 12613630302 015244 0 ustar ligges users #' @name SDMXConcepts
#' @docType class
#' @aliases SDMXConcepts-class
#'
#' @title Class "SDMXConcepts"
#' @description A basic class to handle SDMX Concepts
#'
#' @slot concepts Object of class "list" giving the list of "SDMXConcept". This
#' slot is available to ensure backward compatibility with SDMX 1.0 in SDMX
#' 2.0 or 2.1 documents
#' @slot conceptSchemes Object of class "list" giving the list of "SDMXConceptScheme",
#' which will encapsulate the list of "SDMXConcept" (defined from SDMX 2.0)
#'
#' @section Warning:
#' This class is not useful in itself, but all SDMX non-abstract classes will
#' encapsulate it as slot, when parsing an SDMX-ML document (Concepts, or
#' DataStructureDefinition)
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
setClass("SDMXConcepts",
contains = "SDMX",
representation(
concepts = "list", #required for backward compatibility with SDMX 1.0
conceptSchemes = "list" #SDMX > 1.0
),
prototype = list(
concepts = list(),
conceptSchemes = list()
),
validity = function(object){
#eventual validation rules
return(TRUE);
}
) rsdmx/R/SDMXTimeDimension-methods.R 0000644 0001762 0000144 00000012755 12671526760 016662 0 ustar ligges users #' @name SDMXTimeDimension
#' @rdname SDMXTimeDimension
#' @aliases SDMXTimeDimension,SDMXTimeDimension-method
#'
#' @usage
#' SDMXTimeDimension(xmlObj, namespaces)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @param namespaces object of class "data.frame" given the list of namespace URIs
#' @return an object of class "SDMXTimeDimension"
#'
#' @seealso \link{readSDMX}
#'
SDMXTimeDimension <- function(xmlObj, namespaces){
sdmxVersion <- version.SDMXSchema(xmlDoc(xmlObj), namespaces)
VERSION.21 <- sdmxVersion == "2.1"
messageNs <- findNamespace(namespaces, "message")
strNs <- findNamespace(namespaces, "structure")
#manage SDMX 2.1 conceptIdentity
conceptRefXML <- NULL
if(VERSION.21){
conceptIdentityXML <- getNodeSet(xmlDoc(xmlObj),
"//str:ConceptIdentity",
namespaces = c(str = as.character(strNs)))
if(length(conceptIdentityXML) > 0)
conceptRefXML <- xmlChildren(conceptIdentityXML[[1]])[[1]]
}
codelistRefXML <- NULL
if(VERSION.21){
enumXML <- getNodeSet(xmlDoc(xmlObj),
"//str:Enumeration",
namespaces = c(str = as.character(strNs)))
if(length(enumXML) > 0)
codelistRefXML <- xmlChildren(enumXML[[1]])[[1]]
}
#attributes
#=========
conceptRef <- NULL
conceptVersion <- NULL
conceptAgency <- NULL
conceptSchemeRef <- NULL
conceptSchemeAgency <- NULL
codelist <- NULL
codelistVersion <- NULL
codelistAgency <- NULL
crossSectionalAttachDataset <- NULL
crossSectionalAttachGroup <- NULL
crossSectionalAttachSection <- NULL
crossSectionalAttachObservation <- NULL
if(VERSION.21){
#concepts
if(!is.null(conceptRefXML)){
conceptRef = xmlGetAttr(conceptRefXML, "id")
conceptVersion = xmlGetAttr(conceptRefXML, "maintainableParentVersion")
conceptAgency = xmlGetAttr(conceptRefXML, "agencyID")
#TODO conceptSchemeRef?
#TODO conceptSchemeAgency
}
#codelists
if(!is.null(codelistRefXML)){
codelist <- xmlGetAttr(codelistRefXML, "id")
codelistVersion <- xmlGetAttr(codelistRefXML, "version")
codelistAgency <- xmlGetAttr(codelistRefXML, "agencyID")
}
#crossSectionalAttach
#TODO crossSectionalAttachDataset?
#TODO crossSectionalAttachGroup?
#TODO crossSectionalAttachSection?
#TODO crossSectionalAttachObservation?
}else{
#concepts
conceptRef = xmlGetAttr(xmlObj, "conceptRef")
conceptVersion = xmlGetAttr(xmlObj, "conceptVersion")
conceptAgency = xmlGetAttr(xmlObj, "conceptAgency")
conceptSchemeRef = xmlGetAttr(xmlObj, "conceptSchemeRef")
conceptSchemeAgency = xmlGetAttr(xmlObj, "conceptSchemeAgency")
#codelists
codelist = xmlGetAttr(xmlObj, "codelist")
codelistVersion = xmlGetAttr(xmlObj, "codelistVersion")
codelistAgency = xmlGetAttr(xmlObj, "codelistAgency")
#crossSectionalAttach
crossSectionalAttachDataset = xmlGetAttr(xmlObj, "crossSectionalAttachDataset")
crossSectionalAttachGroup = xmlGetAttr(xmlObj, "crossSectionalAttachGroup")
crossSectionalAttachSection = xmlGetAttr(xmlObj, "crossSectionalAttachSection")
crossSectionalAttachObservation = xmlGetAttr(xmlObj,"crossSectionalAttachObservation")
}
if(is.null(conceptRef)) conceptRef <- as.character(NA)
if(is.null(conceptVersion)) conceptVersion <- as.character(NA)
if(is.null(conceptAgency)) conceptAgency <- as.character(NA)
if(is.null(conceptSchemeRef)) conceptSchemeRef <- as.character(NA)
if(is.null(conceptSchemeAgency)) conceptSchemeAgency <- as.character(NA)
if(is.null(codelist)) codelist <- as.character(NA)
if(is.null(codelistVersion)) codelistVersion <- as.character(NA)
if(is.null(codelistAgency)) codelistAgency <- as.character(NA)
if(is.null(crossSectionalAttachDataset)){
crossSectionalAttachDataset <- NA
}else{
crossSectionalAttachDataset <- as.logical(crossSectionalAttachDataset)
}
if(is.null(crossSectionalAttachGroup)){
crossSectionalAttachGroup <- NA
}else{
crossSectionalAttachGroup <- as.logical(crossSectionalAttachGroup)
}
if(is.null(crossSectionalAttachSection)){
crossSectionalAttachSection <- NA
}else{
crossSectionalAttachSection <- as.logical(crossSectionalAttachSection)
}
if(is.null(crossSectionalAttachObservation)){
crossSectionalAttachObservation <- NA
}else{
crossSectionalAttachObservation <- as.logical(crossSectionalAttachObservation)
}
#elements
#========
#TextFormat TODO
#instantiate the object
obj<- new("SDMXTimeDimension",
#attributes
conceptRef = conceptRef,
conceptVersion = conceptVersion,
conceptAgency = conceptAgency,
conceptSchemeRef = conceptSchemeRef,
conceptSchemeAgency = conceptSchemeAgency,
codelist = codelist,
codelistVersion = codelistVersion,
codelistAgency = codelistAgency,
crossSectionalAttachDataset = crossSectionalAttachDataset,
crossSectionalAttachGroup = crossSectionalAttachGroup,
crossSectionalAttachSection = crossSectionalAttachSection,
crossSectionalAttachObservation = crossSectionalAttachObservation
#elements,
#TextFormat = TextFormat
)
}
rsdmx/R/Class-SDMXComponents.R 0000644 0001762 0000144 00000002456 12613634014 015626 0 ustar ligges users #' @name SDMXComponents
#' @docType class
#' @aliases SDMXComponents-class
#' @title Class "SDMXComponents"
#' @description A basic class to handle SDMX Components
#'
#' @slot Dimensions Object of class "list" giving the list of dimensions (see \link{SDMXDimension})
#' @slot TimeDimension Object of class "SDMXTimeDimension"
#' @slot PrimaryMeasure Object of class "SDMXPrimaryMeasure"
#' @slot Attributes Object of class "list" giving the list of attributes (see \link{SDMXAttribute})
#'
#' @section Warning:
#' This class is not useful in itself, but all SDMX non-abstract classes will
#' encapsulate it as slot, when parsing an SDMX-ML document (DataStructures, or
#' DataStructureDefinitions)
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
setClass("SDMXComponents",
representation(
Dimensions = "list",
TimeDimension = "SDMXTimeDimension_OR_NULL",
PrimaryMeasure = "SDMXPrimaryMeasure",
Attributes = "list"
#crossSectionalMeasures = "list",
#Groups = "list
),
prototype = list(),
validity = function(object){
#eventual validation rules
return(TRUE);
}
)
setClassUnion("SDMXComponents_OR_NULL", c("SDMXComponents","NULL"))
rsdmx/R/Class-SDMXOrganisation.R 0000644 0001762 0000144 00000003103 13120301154 016112 0 ustar ligges users #' @name SDMXOrganisation
#' @docType class
#' @aliases SDMXOrganisation-class
#'
#' @title Class "SDMXOrganisation"
#' @description A basic class to handle a SDMX Concept
#'
#' @slot id Object of class "character" giving the ID of the concept (required)
#' @slot uri Object of class "character" giving the concept uri
#' @slot urn Object of class "character" giving the concept urn
#' @slot Name Object of class "list" giving the organisation name (by language) - required
#' @slot Description Object of class "list" giving the organisation description (by language)
#'
#' @section Warning:
#' This class is not useful in itself, but other classes such as \link{SDMXAgency}
#' will implement it.
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
setClass("SDMXOrganisation",
representation(
#attributes
id = "character", #required
uri = "character", #optional
urn = "character", #optional
#elements
Name = "list", #at least one
Description = "list" #optional
),
prototype = list(
#attributes
id = "ORG",
uri = as.character(NA),
urn = as.character(NA),
#elements
Name = list(
en = "Org name",
fr = "nom org"
),
Description = list(
en = "Org description",
fr = "nom org"
)
),
validity = function(object){
return(TRUE);
}
) rsdmx/R/profile.R 0000644 0001762 0000144 00000000416 12671333016 013376 0 ustar ligges users .onLoad <- function (libname, pkgname) { # nocov start
assign(".rsdmx.options", new.env(), envir= asNamespace(pkgname))
#SDMX compliance validation
.rsdmx.options$validate <- FALSE
#embedded providers
setSDMXServiceProviders()
} # nocov end
rsdmx/R/SDMXConceptScheme-methods.R 0000644 0001762 0000144 00000010265 12744363774 016635 0 ustar ligges users #' @name SDMXConceptScheme
#' @rdname SDMXConceptScheme
#' @aliases SDMXConceptScheme,SDMXConceptScheme-method
#'
#' @usage
#' SDMXConceptScheme(xmlObj, namespaces)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @param namespaces object of class "data.frame" given the list of namespace URIs
#' @return an object of class "SDMXConceptScheme"
#'
#' @seealso \link{readSDMX}
#'
SDMXConceptScheme <- function(xmlObj, namespaces){
messageNs <- findNamespace(namespaces, "message")
strNs <- findNamespace(namespaces, "structure")
sdmxVersion <- version.SDMXSchema(xmlDoc(xmlObj), namespaces)
VERSION.21 <- sdmxVersion == "2.1"
#attributes
#=========
id = xmlGetAttr(xmlObj, "id")
if(is.null(id)) id <- as.character(NA)
agencyId = xmlGetAttr(xmlObj, "agencyID")
if(is.null(agencyId)) agencyId <- as.character(NA)
version = xmlGetAttr(xmlObj, "version")
if(is.null(version)) version <- as.character(NA)
uri = xmlGetAttr(xmlObj, "uri")
if(is.null(uri)) uri <- as.character(NA)
urn = xmlGetAttr(xmlObj, "urn")
if(is.null(urn)) urn <- as.character(NA)
isExternalReference = xmlGetAttr(xmlObj, "isExternalReference")
if(is.null(isExternalReference)){
isExternalReference <- NA
}else{
isExternalReference <- as.logical(isExternalReference)
}
isFinal = xmlGetAttr(xmlObj, "isFinal")
if(is.null(isFinal)){
isFinal <- NA
}else{
isFinal <- as.logical(isFinal)
}
validFrom = xmlGetAttr(xmlObj,"validFrom")
if(is.null(validFrom)) validFrom <- as.character(NA)
validTo = xmlGetAttr(xmlObj, "validTo")
if(is.null(validTo)) validTo <- as.character(NA)
#elements
#========
#name (multi-languages)
conceptNamesXML <- NULL
if(VERSION.21){
comNs <- findNamespace(namespaces, "common")
conceptNamesXML <- getNodeSet(xmlDoc(xmlObj),
"//str:ConceptScheme/com:Name",
namespaces = c(str = as.character(strNs),
com = as.character(comNs)))
}else{
conceptNamesXML <- getNodeSet(xmlDoc(xmlObj),
"//str:ConceptScheme/str:Name",
namespaces = c(str = as.character(strNs)))
}
conceptNames <- list()
if(length(conceptNamesXML) > 0){
conceptNames <- new.env()
sapply(conceptNamesXML,
function(x){
lang <- xmlGetAttr(x,"xml:lang")
if(is.null(lang)) lang <- xmlGetAttr(x,"lang")
if(is.null(lang)) lang <- "default"
conceptNames[[lang]] <- xmlValue(x)
})
conceptNames <- as.list(conceptNames)
}
#description (multi-languages)
conceptDesXML <- getNodeSet(xmlDoc(xmlObj),
"//ns:ConceptScheme/ns:Description",
namespaces = strNs)
conceptDescriptions <- list()
if(length(conceptDesXML) > 0){
conceptDescriptions <- new.env()
sapply(conceptDesXML,
function(x){
lang <- xmlGetAttr(x,"xml:lang")
if(is.null(lang)) lang <- xmlGetAttr(x,"lang")
if(is.null(lang)) lang <- "default"
conceptDescriptions[[lang]] <- xmlValue(x)
})
conceptDescriptions <- as.list(conceptDescriptions)
}
#concepts
conceptsXML <- getNodeSet(xmlDoc(xmlObj),
"//ns:Concept",
namespaces = strNs)
concepts <- list()
if(length(conceptsXML) > 0){
concepts <- lapply(conceptsXML, SDMXConcept, namespaces)
}
#instantiate the object
obj<- new("SDMXConceptScheme",
#attributes
id = id,
agencyID = agencyId,
version = version,
uri = uri,
urn = urn,
isExternalReference = isExternalReference,
isFinal = isFinal,
validFrom = validFrom,
validTo = validTo,
#elements,
Name = conceptNames,
Description = conceptDescriptions,
Concept = concepts
)
}
rsdmx/R/Class-SDMXAgency.R 0000644 0001762 0000144 00000000672 13120303262 014675 0 ustar ligges users #' @name SDMXAgency
#' @docType class
#' @aliases SDMXAgency-class
#'
#' @title Class "SDMXAgency"
#' @description A basic class to handle a SDMX Concept
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
setClass("SDMXAgency",
contains = "SDMXOrganisation",
representation(),
prototype = list(),
validity = function(object){
return(TRUE);
}
) rsdmx/R/SDMXRequestParams-methods.R 0000644 0001762 0000144 00000004655 13041362206 016673 0 ustar ligges users #' @name SDMXRequestParams
#' @rdname SDMXRequestParams
#' @aliases SDMXRequestParams,SDMXRequestParams-method
#'
#' @usage
#' SDMXRequestParams(regUrl, repoUrl, accessKey,
#' providerId, agencyId, resource, resourceId, version,
#' flowRef, key, start, end, compliant)
#'
#' @param regUrl an object of class "character" giving the base Url of the SDMX service registry
#' @param repoUrl an object of class "character" giving the base Url of the SDMX service repository
#' @param accessKey an oject of class "character" giving the eventual authentication or subscription
#' user key (or token) to provide in order to perform the SDMX request. This key may be
#' mandatory for some service providers.
#' @param providerId an object of class "character" giving the provider agency id
#' @param agencyId an object of class "character" giving an agency id
#' @param resource an object of class "character" giving the type of resource to be queried
#' @param resourceId an object of class "character" giving the resource to be queried
#' @param version an object of class "character" giving the resource version
#' @param flowRef an object of class "character" giving the flowRef to be queried
#' @param key an object of class "character" giving the key (SDMX url formatted) to be used for the query
#' @param start an object of class "character" giving the start time
#' @param end an object of class "character" giving the end time
#' @param compliant an object of class "logical" indicating if the web-service is compliant with the SDMX REST web-service specifications
#'
#' @examples
#' #how to create a SDMXRequestParams object
#' params <- SDMXRequestParams(
#' regUrl = "", repoUrl ="", accessKey = NULL,
#' providerId = "", agencyId ="", resource = "data", resourceId = "",
#' version = "", flowRef = "", key = NULL, start = NULL, end = NULL, compliant = FALSE
#' )
#'
SDMXRequestParams <- function(regUrl, repoUrl, accessKey, providerId, agencyId, resource, resourceId, version = NULL,
flowRef, key = NULL, start = NULL, end = NULL, compliant){
new("SDMXRequestParams",
regUrl = regUrl, repoUrl = repoUrl, accessKey = accessKey, providerId = providerId,
agencyId = agencyId, resource = resource, resourceId = resourceId, version = version,
flowRef = flowRef, key = key, start = start, end = end)
}
rsdmx/R/SDMXCode-methods.R 0000644 0001762 0000144 00000004227 12744363726 014765 0 ustar ligges users #' @name SDMXCode
#' @rdname SDMXCode
#' @aliases SDMXCode,SDMXCode-method
#'
#' @usage
#' SDMXCode(xmlObj, namespaces)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @param namespaces object of class "data.frame" given the list of namespace URIs
#' @return an object of class "SDMXCode"
#'
#' @seealso \link{readSDMX}
#'
SDMXCode <- function(xmlObj, namespaces){
messageNs <- findNamespace(namespaces, "message")
strNs <- findNamespace(namespaces, "structure")
sdmxVersion <- version.SDMXSchema(xmlDoc(xmlObj), namespaces)
VERSION.21 <- sdmxVersion == "2.1"
refNs <- strNs
if(VERSION.21){
comNs <- findNamespace(namespaces, "common")
refNs <- comNs
}
#attributes
#=========
id <- NULL
if(VERSION.21){
id <- xmlGetAttr(xmlObj, "id")
}else{
id <- xmlGetAttr(xmlObj, "value")
}
if(is.null(id)) id <- as.character(NA)
urn = xmlGetAttr(xmlObj, "urn")
if(is.null(urn)) urn <- as.character(NA)
parentCode = xmlGetAttr(xmlObj, "parentCode")
if(is.null(parentCode)) parentCode <- as.character(NA)
#elements
#========
# Labels - name /description (multi-languages)
codeLabelsXML <- NULL
if(VERSION.21){
codeLabelsXML <- getNodeSet(xmlDoc(xmlObj),
"//ns:Name", namespaces = refNs)
}else{
codeLabelsXML <- getNodeSet(xmlDoc(xmlObj),
"//ns:Description", namespaces = refNs)
}
codeLabels <- list()
if(length(codeLabelsXML) > 0){
codeLabels <- new.env()
sapply(codeLabelsXML,
function(x){
lang <- xmlGetAttr(x,"xml:lang")
if(is.null(lang)) lang <- xmlGetAttr(x,"lang")
if(is.null(lang)) lang <- "default"
codeLabels[[lang]] <- xmlValue(x)
})
codeLabels <- as.list(codeLabels)
}
#instantiate the object
obj<- new("SDMXCode",
#attributes
id = id, #equivalent to "value" in SDMX 2.0
urn = urn,
parentCode = parentCode,
#elements
label = codeLabels
)
}
rsdmx/R/Class-SDMXItemScheme.R 0000644 0001762 0000144 00000001222 13120270646 015513 0 ustar ligges users #' @name SDMXItemScheme
#' @docType class
#' @aliases SDMXItemScheme-class
#'
#' @title Class "SDMXItemScheme"
#' @description A basic abstract class to handle a SDMXItemScheme
#'
#' @section Warning:
#' This class is not useful in itself, but all SDMX non-abstract "scheme" classes
#' should implement it. Added for the sake of complying with the SDMX information
#' structure model
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
setClass("SDMXItemScheme",
representation(),
prototype = list(),
validity = function(object){
return(TRUE);
}
) rsdmx/R/SDMXAgencyScheme-methods.R 0000644 0001762 0000144 00000007464 13120317420 016427 0 ustar ligges users #' @name SDMXAgencyScheme
#' @rdname SDMXAgencyScheme
#' @aliases SDMXAgencyScheme,SDMXAgencyScheme-method
#'
#' @usage
#' SDMXAgencyScheme(xmlObj, namespaces)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @param namespaces object of class "data.frame" given the list of namespace URIs
#' @return an object of class "SDMXAgencyScheme"
#'
#' @seealso \link{readSDMX}
#'
SDMXAgencyScheme <- function(xmlObj, namespaces){
messageNs <- findNamespace(namespaces, "message")
strNs <- findNamespace(namespaces, "structure")
sdmxVersion <- version.SDMXSchema(xmlDoc(xmlObj), namespaces)
VERSION.21 <- sdmxVersion == "2.1"
#attributes
#=========
id = xmlGetAttr(xmlObj, "id")
if(is.null(id)) id <- as.character(NA)
agencyId = xmlGetAttr(xmlObj, "agencyID")
if(is.null(agencyId)) agencyId <- as.character(NA)
version = xmlGetAttr(xmlObj, "version")
if(is.null(version)) version <- as.character(NA)
uri = xmlGetAttr(xmlObj, "uri")
if(is.null(uri)) uri <- as.character(NA)
urn = xmlGetAttr(xmlObj, "urn")
if(is.null(urn)) urn <- as.character(NA)
isExternalReference = xmlGetAttr(xmlObj, "isExternalReference")
if(is.null(isExternalReference)){
isExternalReference <- NA
}else{
isExternalReference <- as.logical(isExternalReference)
}
isFinal = xmlGetAttr(xmlObj, "isFinal")
if(is.null(isFinal)){
isFinal <- NA
}else{
isFinal <- as.logical(isFinal)
}
validFrom = xmlGetAttr(xmlObj,"validFrom")
if(is.null(validFrom)) validFrom <- as.character(NA)
validTo = xmlGetAttr(xmlObj, "validTo")
if(is.null(validTo)) validTo <- as.character(NA)
#elements
#========
#name (multi-languages)
comNs <- findNamespace(namespaces, "common")
agencyNamesXML <- getNodeSet(xmlDoc(xmlObj),
"//str:AgencyScheme/com:Name",
namespaces = c(str = as.character(strNs),
com = as.character(comNs)))
agencyNames <- list()
if(length(agencyNamesXML) > 0){
agencyNames <- new.env()
sapply(agencyNamesXML,
function(x){
lang <- xmlGetAttr(x,"xml:lang")
if(is.null(lang)) lang <- xmlGetAttr(x,"lang")
if(is.null(lang)) lang <- "default"
agencyNames[[lang]] <- xmlValue(x)
})
agencyNames <- as.list(agencyNames)
}
#description (multi-languages)
agencyDesXML <- getNodeSet(xmlDoc(xmlObj),
"//ns:AgencyScheme/ns:Description",
namespaces = strNs)
agencyDescriptions <- list()
if(length(agencyDesXML) > 0){
agencyDescriptions <- new.env()
sapply(agencyDesXML,
function(x){
lang <- xmlGetAttr(x,"xml:lang")
if(is.null(lang)) lang <- xmlGetAttr(x,"lang")
if(is.null(lang)) lang <- "default"
agencyDescriptions[[lang]] <- xmlValue(x)
})
agencyDescriptions <- as.list(agencyDescriptions)
}
#agencies
agenciesXML <- getNodeSet(xmlDoc(xmlObj), "//ns:Agency", namespaces = strNs)
agencies <- list()
if(length(agenciesXML) > 0){
agencies <- lapply(agenciesXML, SDMXAgency, namespaces)
}
#instantiate the object
obj<- new("SDMXAgencyScheme",
#attributes
id = id,
agencyID = agencyId,
version = version,
uri = uri,
urn = urn,
isExternalReference = isExternalReference,
isFinal = isFinal,
validFrom = validFrom,
validTo = validTo,
#elements
Name = agencyNames,
Description = agencyDescriptions,
agencies = agencies
)
}
rsdmx/R/SDMXDataStructures-methods.R 0000644 0001762 0000144 00000010325 12711102052 017035 0 ustar ligges users #' @name SDMXDataStructures
#' @rdname SDMXDataStructures
#' @aliases SDMXDataStructures,SDMXDataStructures-method
#'
#' @usage
#' SDMXDataStructures(xmlObj, namespaces)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @param namespaces object of class "data.frame" given the list of namespace URIs
#' @return an object of class "SDMXDataStructures"
#'
#' @seealso \link{readSDMX}
#'
SDMXDataStructures <- function(xmlObj, namespaces){
new("SDMXDataStructures",
SDMX(xmlObj, namespaces),
datastructures = datastructures.SDMXDataStructures(xmlObj, namespaces)
)
}
#get list of SDMXDataStructure
#=============================
datastructures.SDMXDataStructures <- function(xmlObj, namespaces){
datastructures <- NULL
sdmxVersion <- version.SDMXSchema(xmlObj, namespaces)
VERSION.21 <- sdmxVersion == "2.1"
messageNsString <- "message"
if(isRegistryInterfaceEnvelope(xmlObj, FALSE)) messageNsString <- "registry"
messageNs <- findNamespace(namespaces, messageNsString)
strNs <- findNamespace(namespaces, "structure")
dsXML <- NULL
if(VERSION.21){
dsXML <- getNodeSet(xmlObj,
"//mes:Structures/str:DataStructures/str:DataStructure",
namespaces = c(mes = as.character(messageNs),
str = as.character(strNs)))
}else{
dsXML <- getNodeSet(xmlObj,
"//mes:KeyFamilies/str:KeyFamily",
namespaces = c(mes = as.character(messageNs),
str = as.character(strNs)))
}
if(!is.null(dsXML)){
datastructures <- lapply(dsXML, SDMXDataStructure, namespaces)
}
return(datastructures)
}
#methods
as.data.frame.SDMXDataStructures <- function(x, ...){
out <- do.call("rbind.fill",
lapply(x@datastructures,
function(ds){
names <- slot(ds, "Name")
dsf.names <- NULL
if(length(names) > 0){
dsf.names <- as.data.frame(names, stringsAsFactors = FALSE)
colnames(dsf.names) <- paste0("Name.", colnames(dsf.names))
}
desc <- slot(ds, "Description")
dsf.desc <- NULL
if(length(desc) > 0){
dsf.desc <- as.data.frame(desc, stringsAsFactors = FALSE)
colnames(dsf.desc) <- paste0("Description.", colnames(dsf.desc))
}
dsf <- data.frame(
id = slot(ds, "id"),
agencyID = slot(ds, "agencyID"),
stringsAsFactors = FALSE)
if(!is.null(dsf.names)){
dsf <- cbind(dsf, dsf.names, stringsAsFactors = FALSE)
}
if(!is.null(dsf.desc)){
dsf <- cbind(dsf, dsf.desc, stringsAsFactors = FALSE)
}
dsf <- cbind(dsf,
version = slot(ds, "version"),
uri = slot(ds, "uri"),
urn = slot(ds, "urn"),
isExternalReference = slot(ds, "isExternalReference"),
isFinal = slot(ds, "isFinal"),
validFrom = slot(ds, "validFrom"),
validTo = slot(ds, "validTo"),
stringsAsFactors = FALSE
)
return(dsf)
})
)
return(encodeSDMXOutput(out))
}
setAs("SDMXDataStructures", "data.frame",
function(from) as.data.frame.SDMXDataStructures(from)); rsdmx/R/SDMXCodelist-methods.R 0000644 0001762 0000144 00000011372 13102114140 015625 0 ustar ligges users #' @name SDMXCodelist
#' @rdname SDMXCodelist
#' @aliases SDMXCodelist,SDMXCodelist-method
#'
#' @usage
#' SDMXCodelist(xmlObj, namespaces)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @param namespaces object of class "data.frame" given the list of namespace URIs
#' @return an object of class "SDMXCodelist"
#'
#' @seealso \link{readSDMX}
#'
SDMXCodelist <- function(xmlObj, namespaces){
messageNs <- findNamespace(namespaces, "message")
strNs <- findNamespace(namespaces, "structure")
sdmxVersion <- version.SDMXSchema(xmlDoc(xmlObj), namespaces)
VERSION.21 <- sdmxVersion == "2.1"
#attributes
#=========
id = xmlGetAttr(xmlObj, "id")
if(is.null(id)) id <- as.character(NA)
agencyId = xmlGetAttr(xmlObj, "agencyID")
if(is.null(agencyId)) agencyId <- as.character(NA)
version = xmlGetAttr(xmlObj, "version")
if(is.null(version)) version <- as.character(NA)
uri = xmlGetAttr(xmlObj, "uri")
if(is.null(uri)) uri <- as.character(NA)
urn = xmlGetAttr(xmlObj, "urn")
if(is.null(urn)) urn <- as.character(NA)
isExternalReference = xmlGetAttr(xmlObj, "isExternalReference")
if(is.null(isExternalReference)){
isExternalReference <- NA
}else{
isExternalReference <- as.logical(isExternalReference)
}
isFinal = xmlGetAttr(xmlObj, "isFinal")
if(is.null(isFinal)){
isFinal <- NA
}else{
isFinal <- as.logical(isFinal)
}
validFrom = xmlGetAttr(xmlObj,"validFrom")
if(is.null(validFrom)) validFrom <- as.character(NA)
validTo = xmlGetAttr(xmlObj, "validTo")
if(is.null(validTo)) validTo <- as.character(NA)
#elements
#========
#name (multi-languages)
codelistNamesXML <- NULL
if(VERSION.21){
comNs <- findNamespace(namespaces, "common")
codelistNamesXML <- getNodeSet(xmlDoc(xmlObj),
"//str:Codelist/com:Name",
namespaces = c(str = as.character(strNs),
com = as.character(comNs)))
}else{
codelistNamesXML <- getNodeSet(xmlDoc(xmlObj),
"//str:CodeList/str:Name",
namespaces = c(str = as.character(strNs)))
}
codelistNames <- list()
if(length(codelistNamesXML) > 0){
codelistNames <- new.env()
sapply(codelistNamesXML,
function(x){
lang <- xmlGetAttr(x,"xml:lang")
if(is.null(lang)) lang <- xmlGetAttr(x,"lang")
if(is.null(lang)) lang <- "default"
codelistNames[[lang]] <- xmlValue(x)
})
codelistNames <- as.list(codelistNames)
}
#description (multi-languages)
codelistDesXML <- NULL
if(VERSION.21){
comNs <- findNamespace(namespaces, "common")
codelistDesXML <- getNodeSet(xmlDoc(xmlObj),
"//str:Codelist/com:Description",
namespaces = c(str = as.character(strNs),
com = as.character(comNs)))
}else{
codelistDesXML <- getNodeSet(xmlDoc(xmlObj),
"//str:CodeList/str:Description",
namespaces = c(str = as.character(strNs)))
}
codelistDescriptions <- list()
if(length(codelistDesXML) > 0){
codelistDescriptions <- new.env()
sapply(codelistDesXML,
function(x){
lang <- xmlGetAttr(x,"xml:lang")
if(is.null(lang)) lang <- xmlGetAttr(x,"lang")
if(is.null(lang)) lang <- "default"
codelistDescriptions[[lang]] <- xmlValue(x)
})
codelistDescriptions <- as.list(codelistDescriptions)
}
#concepts
codesXML <- NULL
if(VERSION.21){
codesXML <- getNodeSet(xmlDoc(xmlObj),
"//ns:Codelist/ns:Code",
namespaces = strNs)
}else{
codesXML <- getNodeSet(xmlDoc(xmlObj),
"//ns:CodeList/ns:Code",
namespaces = strNs)
}
codes <- list()
if(length(codesXML) > 0){
codes <- lapply(codesXML, SDMXCode, namespaces)
}
#instantiate the object
obj<- new("SDMXCodelist",
#attributes
id = id,
agencyID = agencyId,
version = version,
uri = uri,
urn = urn,
isExternalReference = isExternalReference,
isFinal = isFinal,
validFrom = validFrom,
validTo = validTo,
#elements,
Name = codelistNames,
Description = codelistDescriptions,
Code = codes
)
}
rsdmx/R/Class-SDMXFooterMessage.R 0000644 0001762 0000144 00000003711 12671331616 016245 0 ustar ligges users #' @name SDMXFooterMessage
#' @docType class
#' @aliases SDMXFooterMessage-class
#' @title Class "SDMXFooterMessage"
#' @description A basic class to handle a footer message of a SDMX-ML document
#'
#' @slot code Object of class "character" giving the status code
#' @slot severity Object of class "character" giving the severity of the message
#' @slot messages Object of class "list" giving the list of messages
#'
#' @section Warning:
#' This class is not useful in itself, but all SDMX non-abstract classes will
#' encapsulate it as slot, when parsing an SDMX-ML document
#'
#' @note
#' This class is especially useful for SDMX 2.1 compliant documents. Footer
#' messages are not supported in SDMX 2.0 standard format.
#'
#' According to the SDMX 2.1 standard, the message severity takes one of the
#' following values: "Error", "Warning",Information". Given the possible typos
#' handled by data providers, rsdmx adopts a permissive strategy and does not
#' validate the object according to such controlled terms.
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
setClass("SDMXFooterMessage",
representation(
code = "character",
severity = "character",
messages = "list"
),
prototype = list(
code = "413",
severity = "Information",
messages = list("msg1", "msg2")
),
validity = function(object){
#validation rules
if(.rsdmx.options$validate){
#severity
if(!is.na(object@severity)){
#SDMX standard severity types
#Note: some data providers have typos for such messages
severityTypes <- c("Error", "Warning", "Information")
if(!(object@severity %in% severityTypes)) return(FALSE);
}
}
return(TRUE);
}
) rsdmx/R/SDMXGenericData-methods.R 0000644 0001762 0000144 00000023444 13235704553 016254 0 ustar ligges users #' @name SDMXGenericData
#' @rdname SDMXGenericData
#' @aliases SDMXGenericData,SDMXGenericData-method
#'
#' @usage
#' SDMXGenericData(xmlObj, namespaces)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @param namespaces object of class "data.frame" given the list of namespace URIs
#' @return an object of class "SDMXGenericData"
#'
#' @seealso \link{readSDMX}
#'
SDMXGenericData <- function(xmlObj, namespaces){
new("SDMXGenericData",
SDMXData(xmlObj, namespaces)
)
}
#methods
as.data.frame.SDMXGenericData <- function(x, row.names=NULL, optional=FALSE,
labels = FALSE, ...){
xmlObj <- x@xmlObj;
dataset <- NULL
schema <- slot(x,"schema")
sdmxVersion <- slot(schema,"version")
VERSION.21 <- sdmxVersion == "2.1"
#namespace
nsDefs.df <- getNamespaces(x)
ns <- findNamespace(nsDefs.df, "generic")
#series
seriesXML <- getNodeSet(xmlObj, "//ns:Series", namespaces = ns)
if(length(seriesXML) == 0){
seriesXML <- getNodeSet(xmlObj, "//Series")
}
hasSeries <- length(seriesXML) > 0
#obs
obsXML <- getNodeSet(xmlObj, "//ns:Obs", namespaces = ns)
if(length(obsXML) == 0){
obsXML <- getNodeSet(xmlObj, "//Obs")
}
hasObs <- length(obsXML) > 0
if(!hasSeries & !hasObs) return(NULL);
conceptId <- "concept"
if(VERSION.21) conceptId <- "id"
#serie keys
serieKeysNames <- NULL
if(hasSeries){
keysXML <- getNodeSet(xmlDoc(getNodeSet(xmlObj,"//ns:SeriesKey", namespaces = ns)[[1]]),
"//ns:Value", namespaces = ns)
if(length(keysXML)>0){
serieKeysNames <- unique(sapply(keysXML, function(x) xmlGetAttr(x, conceptId)))
}
}
#serie attributes
serieAttrsNames <- NULL
serieAttrsXML <- getNodeSet(xmlObj, "//ns:Series/ns:Attributes/ns:Value", namespaces = ns)
if(length(serieAttrsXML) > 0){
serieAttrsNames <- unique(sapply(serieAttrsXML, function(x){
xmlGetAttr(x, conceptId)
}))
}
#observation keys
obsKeysNames <- NULL
obsKeyXML <- getNodeSet(xmlObj,"//ns:ObsKey", namespaces = ns)
if(length(obsKeyXML)>0){
obsKeysXML <- getNodeSet(xmlDoc(obsKeyXML[[1]]), "//ns:Value", namespaces = ns)
if(length(obsKeysXML)>0){
obsKeysNames <- unique(sapply(obsKeysXML, function(x) xmlGetAttr(x, conceptId)))
}
}
#observation attributes
obsAttrsNames <- NULL
obsAttrsXML <- getNodeSet(xmlObj, "//ns:Obs/ns:Attributes/ns:Value", namespaces = ns)
if(length(obsAttrsXML) > 0){
obsAttrsNames <- unique(sapply(obsAttrsXML,function(x){
xmlGetAttr(x, conceptId)
}))
}
#output structure
serieNames <- serieKeysNames
if(!is.null(serieAttrsNames)) serieNames <- c(serieNames, serieAttrsNames)
if(!is.null(obsKeysNames)) serieNames <- c(serieNames, obsKeysNames)
serieNames <- c(serieNames, "obsTime", "obsValue")
if(!is.null(obsAttrsNames)) serieNames <- c(serieNames, obsAttrsNames)
hasTime <- FALSE
#obs parser function
parseObs <- function(obs){
obsXML <- xmlDoc(obs)
#time
timeElement <- "Time"
if(VERSION.21) timeElement <- "ObsDimension"
obsTime <- NA
obsTimeXML <- getNodeSet(obsXML,
paste("//ns:",timeElement,sep=""),
namespaces=ns)
if(length(obsTimeXML)>0){
hasTime <<- TRUE
obsTimeXML <- obsTimeXML[[1]]
if(!VERSION.21){
obsTime <- xmlValue(obsTimeXML)
} else {
obsTime <- xmlGetAttr(obsTimeXML,"value")
}
obsTime <- as.data.frame(obsTime)
}
#value
obsValue <- NA
obsValuesXML <- getNodeSet(obsXML, "//ns:ObsValue", namespaces = ns)
if(length(obsValuesXML) > 0){
obsValueXML <- obsValuesXML[[1]]
obsValue <- as.numeric(sub(",",".", xmlGetAttr(obsValueXML, "value"), fixed = TRUE))
}
obsValue <- as.data.frame(obsValue)
#Key values
#ObsKey (concept attributes/values)
obskeydf <- NULL
obsKeyValuesXML <- getNodeSet(obsXML, "//ns:ObsKey/ns:Value", namespaces = ns)
if(length(obsKeyValuesXML)>0){
obsKeyValues <- sapply(obsKeyValuesXML, function(x){
value <- xmlGetAttr(x, "value")
return(ifelse(is.null(value), as.character(NA), value))
})
obsKeyNames <- sapply(obsKeyValuesXML, function(x){
as.character(xmlGetAttr(x, conceptId))
})
obskeydf <- structure(obsKeyValues, .Names = obsKeyNames)
obskeydf <- as.data.frame(lapply(obskeydf, as.character), stringsAsFactors=FALSE)
}
#attributes
obsAttrs.df <- NULL
if(!is.null(obsAttrsNames)){
obsAttrsXML <- getNodeSet(obsXML,
"//ns:Attributes/ns:Value",
namespaces = ns)
if(length(obsAttrsXML) > 0){
obsAttrsValues <- sapply(obsAttrsXML,
function(x){
as.character(xmlGetAttr(x, "value"))
})
obsAttrsNames <- sapply(obsAttrsXML,
function(x){
as.character(xmlGetAttr(x, conceptId))
})
obsAttrs.df <- structure(obsAttrsValues, .Names = obsAttrsNames)
obsAttrs.df <- as.data.frame(lapply(obsAttrs.df, as.character), stringsAsFactors=FALSE)
if(any(obsAttrs.df == "NA")){
obsAttrs.df[obsAttrs.df == "NA"] <- NA
}
if(!is.na(obsAttrs.df) && ifelse(is.na(any(obsAttrs.df == "NULL")),FALSE,
any(obsAttrs.df == "NULL"))){
obsAttrs.df[obsAttrs.df == "NULL"] <- NA
}
}
}
#output
obsR <- obsValue
if(!is.na(obsTime)) obsR <- cbind(obsTime, obsR)
if(!is.null(obskeydf)) obsR <- cbind(obskeydf, obsR)
if(!is.null(obsAttrs.df)) obsR <- cbind(obsR, obsAttrs.df)
return(obsR)
}
#function to parse a Serie
parseSerie <- function(x){
# Single serie XMLInternalNode converted into a XMLInternalDocument
serieXML <- xmlDoc(x)
#parseobs
obssXML <- getNodeSet(serieXML, "//ns:Series/ns:Obs", namespaces = ns)
#apply obsParser
obsdf <- NULL
if(length(obssXML) > 0){
obsdf <- do.call("rbind.fill",lapply(obssXML, function(x) parseObs(x)))
}
#Key values
#SeriesKey (concept attributes/values) are duplicated according to the
#number of Time observations
serieKeyValuesXML <- getNodeSet(serieXML,
"//ns:SeriesKey/ns:Value",
namespaces = ns)
serieKeyValues <- sapply(serieKeyValuesXML, function(x){
as.character(xmlGetAttr(x, "value"))
})
serieKeyNames <- sapply(serieKeyValuesXML, function(x){
as.character(xmlGetAttr(x, conceptId))
})
seriekeydf <- structure(serieKeyValues, .Names = serieKeyNames)
seriekeydf <- as.data.frame(lapply(seriekeydf, as.character), stringsAsFactors=FALSE)
if(!is.null(obsdf)){
seriekeydf <- seriekeydf[rep(base::row.names(seriekeydf), nrow(obsdf)),]
if(class(seriekeydf) != "data.frame"){
seriekeydf <- data.frame(seriekeydf)
}
base::row.names(seriekeydf) <- 1:nrow(obsdf)
colnames(seriekeydf) <- serieKeyNames
}
#serie attributes
attrs.df <- NULL
serieAttrsXML <- getNodeSet(serieXML,
"//ns:Series/ns:Attributes/ns:Value",
namespaces = ns)
if(!is.null(serieAttrsXML)){
if(length(serieAttrsXML) > 0){
attrsValues <- sapply(serieAttrsXML, function(x){
as.character(xmlGetAttr(x, "value"))
})
attrsNames <- sapply(serieAttrsXML, function(x){
as.character(xmlGetAttr(x, conceptId))
})
attrs.df <- structure(attrsValues, .Names = attrsNames)
attrs.df <- as.data.frame(lapply(attrs.df, as.character),
stringsAsFactors=FALSE)
if(!is.null(obsdf)){
attrs.df <- attrs.df[rep(base::row.names(attrs.df), nrow(obsdf)),]
if(!is(attrs.df, "data.frame")){
attrs.df <- as.data.frame(attrs.df, stringsAsFactors = FALSE)
colnames(attrs.df) <- attrsNames
}
base::row.names(attrs.df) <- 1:nrow(obsdf)
}
}
}
#single Serie as DataFrame
serie <- seriekeydf
if(!is.null(attrs.df)) serie <- cbind(serie, attrs.df)
if(!is.null(obsdf)) serie <- cbind(serie, obsdf)
#convert factor columns
if("obsTime" %in% colnames(serie)){
serie[,"obsTime"] <- as.character(serie[,"obsTime"])
}
if(!is.null(obsAttrsNames) & !is.null(obsdf)){
for(i in 1:length(colnames(obsdf))){
serie[,colnames(obsdf)[i]] <- as.character(serie[,colnames(obsdf)[i]])
}
}
return(serie)
}
#converting SDMX series/obs to a DataFrame R object
if(hasSeries){
dataset <- do.call("rbind.fill", lapply(seriesXML, parseSerie))
}else{
dataset <- do.call("rbind.fill", lapply(obsXML, parseObs))
}
if(!hasTime) serieNames <- serieNames[-which(serieNames=="obsTime")]
dataset <- dataset[,serieNames]
dataset$obsValue <- as.numeric(dataset$obsValue)
if(any(as.character(dataset$obsValue) == "NaN", na.rm = TRUE)){
dataset[as.character(dataset$obsValue) == "NaN",]$obsValue <- NA
}
if(!is.null(dataset)) base::row.names(dataset) <- 1:nrow(dataset)
#enrich with labels
if(labels){
dsd <- slot(x, "dsd")
if(!is.null(dsd)) dataset <- addLabels.SDMXData(dataset, dsd)
}
# output
return(encodeSDMXOutput(dataset))
}
rsdmx/R/SDMXStructureType-methods.R 0000644 0001762 0000144 00000006331 13120305002 016717 0 ustar ligges users #' @name SDMXStructureType
#' @rdname SDMXStructureType
#' @aliases SDMXStructureType,SDMXStructureType-method
#'
#' @usage
#' SDMXStructureType(xmlObj, namespaces, resource)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @param namespaces object of class "data.frame" given the list of namespace URIs
#' @param resource object of class "character" giving the REST resource to be
#' queried (required to distinguish between dataflows and datastructures in
#' SDMX 2.0)
#' @return an object of class "SDMXStructureType"
#'
#' @seealso \link{readSDMX}
#'
SDMXStructureType <- function(xmlObj, namespaces, resource){
new("SDMXStructureType",
SDMXType(xmlObj),
subtype = type.SDMXStructureType(xmlObj, namespaces, resource));
}
type.SDMXStructureType <- function(xmlObj, namespaces, resource){
sdmxVersion <- version.SDMXSchema(xmlObj, namespaces)
VERSION.21 <- sdmxVersion == "2.1"
messageNsString <- "message"
if(isRegistryInterfaceEnvelope(xmlObj, FALSE)) messageNsString <- "registry"
messageNs <- findNamespace(namespaces, messageNsString)
strNs <- findNamespace(namespaces, "structure")
strType <- NULL
if(VERSION.21){
if(length(strNs)>0){
dsXML <- getNodeSet(xmlObj, "//ns:DataStructures", namespaces = strNs)
ccXML <- getNodeSet(xmlObj, "//ns:Concepts", namespaces = strNs)
clXML <- getNodeSet(xmlObj, "//ns:Codelists", namespaces = strNs)
#14/06/2017 add any of concept/codelist rule, less restrictive
#to confirm according to SDMX specs
if(length(dsXML)>0 & any(length(ccXML)>0,length(clXML)>0)){
strType <- "DataStructureDefinitionsType"
}else{
#others
structuresXML <- getNodeSet(xmlObj, "//ns:Structures", namespaces = messageNs)
strType <- paste(xmlName(xmlChildren(structuresXML[[1]])[[1]]), "Type", sep="")
}
}
}else{
if(length(messageNs)>0){
flowXML <- getNodeSet(xmlObj, "//ns:Dataflows", namespaces = messageNs)
dsXML <- getNodeSet(xmlObj, "//ns:KeyFamilies", namespaces = messageNs)
ccXML <- getNodeSet(xmlObj, "//ns:Concepts", namespaces = messageNs)
clXML <- getNodeSet(xmlObj, "//ns:CodeLists", namespaces = messageNs)
if(all(c(length(dsXML)>0, length(ccXML)>0, length(clXML)>0))){
#DSD
strType <- "DataStructureDefinitionsType"
}else{
#others
if(length(ccXML)>0) return("ConceptsType")
if(length(clXML)>0) return("CodelistsType")
if(length(flowXML)>0) return("DataflowsType")
if(length(dsXML)>0){
if(is.null(resource)){
strType <- "DataStructuresType"
}else{
strType <- switch(resource,
"dataflow" = "DataflowsType",
"datastructure" = "DataStructuresType")
}
}
}
}
}
return(strType)
}
#generics
if (!isGeneric("getStructureType"))
setGeneric("getStructureType", function(obj) standardGeneric("getStructureType"));
#methods
setMethod(f = "getStructureType", signature = "SDMXStructureType", function(obj){
return(obj@subtype)
})
rsdmx/R/SDMXDataFlows-methods.R 0000644 0001762 0000144 00000010453 12671526574 015776 0 ustar ligges users #' @name SDMXDataFlows
#' @rdname SDMXDataFlows
#' @aliases SDMXDataFlows,SDMXDataFlows-method
#'
#' @usage
#' SDMXDataFlows(xmlObj, namespaces)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @param namespaces object of class "data.frame" given the list of namespace URIs
#' @return an object of class "SDMXDataFlows"
#'
#' @seealso \link{readSDMX}
#'
SDMXDataFlows <- function(xmlObj, namespaces){
new("SDMXDataFlows",
SDMX(xmlObj, namespaces),
dataflows = dataflows.SDMXDataFlows(xmlObj, namespaces)
)
}
#get list of SDMXDataFlow
#=============================
dataflows.SDMXDataFlows <- function(xmlObj, namespaces){
dataflows <- NULL
sdmxVersion <- version.SDMXSchema(xmlObj, namespaces)
VERSION.21 <- sdmxVersion == "2.1"
messageNsString <- "message"
if(isRegistryInterfaceEnvelope(xmlObj, FALSE)) messageNsString <- "registry"
messageNs <- findNamespace(namespaces, messageNsString)
strNs <- findNamespace(namespaces, "structure")
dfXML <- NULL
if(VERSION.21){
dfXML <- getNodeSet(xmlObj,
"//mes:Structures/str:Dataflows/str:Dataflow",
namespaces = c(mes = as.character(messageNs),
str = as.character(strNs)))
}else{
dfXML <- getNodeSet(xmlObj,
"//mes:Dataflows/str:Dataflow",
namespaces = c(mes = as.character(messageNs),
str = as.character(strNs)))
if(length(dfXML) == 0){
dfXML <- getNodeSet(xmlObj,
"//mes:KeyFamilies/str:KeyFamily",
namespaces = c(mes = as.character(messageNs),
str = as.character(strNs)))
}
}
if(!is.null(dfXML)){
dataflows <- lapply(dfXML, SDMXDataFlow, namespaces)
}
return(dataflows)
}
#methods
as.data.frame.SDMXDataFlows <- function(x, ...){
out <- do.call("rbind.fill",
lapply(x@dataflows,
function(dataflow){
names <- slot(dataflow, "Name")
dataflow.names <- as.data.frame(names, stringsAsFactors = FALSE)
colnames(dataflow.names) <- paste0("Name.", colnames(dataflow.names))
desc <- slot(dataflow, "Description")
dataflow.desc <- NULL
if(length(desc) > 0){
dataflow.desc <- as.data.frame(desc, stringsAsFactors = FALSE)
colnames(dataflow.desc) <- paste0("Description.", colnames(dataflow.desc))
}
df <- data.frame(
id = slot(dataflow, "id"),
agencyID = slot(dataflow, "agencyID"),
dataflow.names,
stringsAsFactors = FALSE)
if(!is.null(dataflow.desc)){
df <- cbind(df, dataflow.desc, stringsAsFactors = FALSE)
}
df <- cbind(df,
version = slot(dataflow, "version"),
uri = slot(dataflow, "uri"),
urn = slot(dataflow, "urn"),
isExternalReference = slot(dataflow, "isExternalReference"),
isFinal = slot(dataflow, "isFinal"),
validFrom = slot(dataflow, "validFrom"),
validTo = slot(dataflow, "validTo"),
dsdRef = slot(dataflow, "dsdRef"),
stringsAsFactors = FALSE
)
return(df)
})
)
return(encodeSDMXOutput(out))
}
setAs("SDMXDataFlows", "data.frame",
function(from) as.data.frame.SDMXDataFlows(from)); rsdmx/R/Class-SDMXFooter.R 0000644 0001762 0000144 00000002372 12611300056 014726 0 ustar ligges users #' @name SDMXFooter
#' @docType class
#' @aliases SDMXFooter-class
#' @title Class "SDMXFooter"
#' @description A basic class to handle the footer of a SDMX-ML document
#'
#' @slot messages Object of class "SDMXFooterMessage" giving the list of messages
#'
#' @section Warning:
#' This class is not useful in itself, but all SDMX non-abstract classes will
#' encapsulate it as slot, when parsing an SDMX-ML document.
#'
#' @note
#' This class is especially useful for SDMX 2.1 compliant documents. Footer
#' messages are not supported in SDMX 2.0standard format. In this case, the footer
#' will return an empty message list().
#'
#' According to the SDMX 2.1 standard, the message severity takes one of the
#' following values: "Error", "Warning","Information". Given the possible typos
#' handled by data providers, rsdmx adopts a permissive strategy and does not
#' validate the object according to such controlled terms.
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
setClass("SDMXFooter",
representation(
messages = "list"
),
prototype = list(
messages = list()
),
validity = function(object){
return(TRUE);
}
) rsdmx/R/Class-SDMXCompactData.R 0000644 0001762 0000144 00000000772 12656611406 015667 0 ustar ligges users #' @name SDMXCompactData
#' @docType class
#' @aliases SDMXCompactData-class
#'
#' @title Class "SDMXCompactData"
#' @description A basic class to handle a SDMX-ML compact data set
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
setClass("SDMXCompactData",
contains = "SDMXData",
representation(),
prototype = list(),
validity = function(object){
#eventual validation rules
return(TRUE);
}
)
rsdmx/R/Class-SDMXDotStatRequestBuilder.R 0000644 0001762 0000144 00000002430 13041347770 017741 0 ustar ligges users #' @name SDMXDotStatRequestBuilder
#' @docType class
#' @aliases SDMXDotStatRequestBuilder-class
#'
#' @title Class "SDMXDotStatRequestBuilder"
#' @description A experimental class to handle a SDMX DotStat (*.Stat) service
#' request builder
#'
#' @slot regUrl an object of class "character" giving the base Url of the SDMX service registry
#' @slot repoUrl an object of class "character" giving the base Url of the SDMX service repository
#' @slot accessKey an object of class "character" indicating the name of request parameter for which
#' an authentication or subscription user key/token has to be provided to perform requests
#' @slot compliant an object of class "logical" indicating if the request builder is somehow compliant with a service specification
#'
#' @section Warning:
#' This class is not useful in itself, but all SDMX non-abstract classes will
#' encapsulate it as slot, when parsing an SDMX-ML document.
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
setClass("SDMXDotStatRequestBuilder",
contains = "SDMXRequestBuilder",
representation(),
prototype = list(),
validity = function(object){
#eventual validation rules
return(TRUE);
}
)
rsdmx/R/SDMXFooterMessage-methods.R 0000644 0001762 0000144 00000001704 12611277450 016642 0 ustar ligges users #' @name SDMXFooterMessage
#' @rdname SDMXFooterMessage
#' @aliases SDMXFooterMessage,SDMXFooterMessage-method
#'
#' @usage
#' SDMXFooterMessage(xmlObj)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @return an object of class "SDMXFooterMessage"
#'
#' @seealso \link{SDMXFooter} \link{readSDMX}
SDMXFooterMessage <- function(xmlObj){
#code
code <- xmlGetAttr(xmlObj,"code")
if(is.null(code)) code <- as.character(NA)
#severity
severity <- xmlGetAttr(xmlObj, "severity")
if(is.null(severity)) severity <- as.character(NA)
#messages
messages <- list()
messagesXML <- xmlChildren(xmlObj)
if(length(messagesXML) > 0){
messages <- unname(lapply(messagesXML, xmlValue))
}
#SDMXFooterMessage object
obj <- new("SDMXFooterMessage",
code = code,
severity = severity,
messages = messages);
return(obj);
}
rsdmx/R/SDMXFooter-methods.R 0000644 0001762 0000144 00000001611 12671526652 015341 0 ustar ligges users #' @name SDMXFooter
#' @rdname SDMXFooter
#' @aliases SDMXFooter,SDMXFooter-method
#'
#' @usage
#' SDMXFooter(xmlObj, namespaces)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @param namespaces object of class "data.frame" given the list of namespace URIs
#' @return an object of class "SDMXFooter"
#'
#' @seealso \link{readSDMX}
SDMXFooter <- function(xmlObj, namespaces){
messageList = list()
#check presence of footer
ns <- findNamespace(namespaces, "footer")
if(length(ns) > 0){
messageListXML <- getNodeSet(xmlObj,
"//footer:Message",
namespaces = c(footer = as.character(ns)))
messageList <- lapply(messageListXML, SDMXFooterMessage)
}
#SDMXFooter object
obj <- new("SDMXFooter", messages = messageList);
return(obj);
}
rsdmx/R/Class-SDMXDataStructure.R 0000644 0001762 0000144 00000006211 12671331326 016270 0 ustar ligges users #' @name SDMXDataStructure
#' @docType class
#' @aliases SDMXDataStructure-class
#'
#' @title Class "SDMXDataStructure"
#' @description A basic class to handle a SDMX DataStructure (or KeyFamily)
#'
#' @slot id Object of class "character" giving the ID (required)
#' @slot agencyID Object of class "character" giving the AgencyID
#' @slot version Object of class "character" giving the version
#' @slot uri Object of class "character" giving the uri
#' @slot urn Object of class "character" giving the urn
#' @slot isExternalReference Object of class "logical" indicating if the datastructure / keyfamily is an external reference
#' @slot isFinal Object of class "logical" indicating if the datastructure / keyfamily is final
#' @slot validFrom Object of class "character" indicating the start validity period
#' @slot validTo Object of class "character" indicating the end validity period
#' @slot Name Object of class "list" giving the codelist (by language) - required
#' @slot Description Object of class "list" giving the codelist description (by language)
#' @slot Components Object of class "SDMXComponents" (see \link{SDMXComponents})
#'
#' @section Warning:
#' This class is not useful in itself, but all SDMX non-abstract classes will
#' encapsulate it as slot, when parsing an SDMX-ML document (Concepts, or
#' DataStructureDefinition)
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
setClass("SDMXDataStructure",
representation(
#attributes
id = "character", #required
agencyID = "character", #optional
version = "character", #optional
uri = "character", #optional
urn = "character", #optional
isExternalReference = "logical", #optional
isFinal = "logical", #optional
validFrom = "character", #optional
validTo = "character", #optional
#elements
Name = "list", #at least one
Description = "list", #optional
Components = "SDMXComponents_OR_NULL" #optional
),
prototype = list(
#attributes
id = "KEYFAMILY_ID",
agencyID = "AGENCY_ID",
version = "1.0",
uri = as.character(NA),
urn = as.character(NA),
isExternalReference = FALSE,
isFinal = FALSE,
validFrom = as.character(NA),
validTo = as.character(NA),
#elements
Name = list(
en = "datastructure/keyfamily name",
fr = "nom du datastrucure/keyfamily"
),
Description = list(
en = "datastructure/keyfamily description",
fr = "description du datastructure/keyfamily"
),
Components = new("SDMXComponents")
),
validity = function(object){
#eventual validation rules
if(.rsdmx.options$validate){
if(is.na(object@id)) return(FALSE)
if(length(object@Name) == 0) return(FALSE)
}
return(TRUE);
}
) rsdmx/R/Class-SDMXRequestBuilder.R 0000644 0001762 0000144 00000005446 13041347674 016453 0 ustar ligges users #' @name SDMXRequestBuilder
#' @docType class
#' @aliases SDMXRequestBuilder-class
#'
#' @title Class "SDMXRequestBuilder"
#' @description A basic class to handle a SDMX service request builder
#'
#' @slot regUrl an object of class "character" giving the base Url of the SDMX service registry
#' @slot repoUrl an object of class "character" giving the base Url of the SDMX service repository
#' @slot accessKey an object of class "character" indicating the name of request parameter for which
#' an authentication or subscription user key/token has to be provided to perform requests
#' @slot formatter an object of class "list" giving a formatting function (for each resource) that
#' takes an object of class "SDMXRequestParams" as single argument. Such parameter allows
#' to customize eventual params (e.g. specific data provider rules)
#' @slot handler an object of class "list" that will be in charge of build a web request.
#' @slot compliant an object of class "logical" indicating if the request builder is somehow compliant with a service specification
#' @slot unsupportedResources an object of class "character" giving one or more resources not
#' supported by the Request builder for a given provider
#'
#' @section Warning:
#' This class is not useful in itself, but all SDMX non-abstract classes will
#' encapsulate it as slot, when parsing an SDMX-ML document (Concepts, or
#' DataStructureDefinition)
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
setClass("SDMXRequestBuilder",
representation(
regUrl = "character",
repoUrl = "character",
accessKey = "character_OR_NULL",
formatter = "list",
handler = "list",
compliant = "logical",
unsupportedResources = "list"
),
prototype = list(
regUrl = "http://www.myorg.org/sdmx/registry",
repoUrl = "http://www.myorg.org/sdmx/repository",
accessKey = NULL,
formatter = list(
dataflow = function(obj){return(obj)},
datastructure = function(obj){ return(obj)},
data = function(obj){return(obj)}
),
handler = list(
"dataflow" = function(obj){return(obj@regUrl)},
"datastructure" = function(obj){return(obj@regUrl)},
"data" = function(obj){return(obj@repoUrl)}
),
compliant = TRUE,
unsupportedResources = list()
),
validity = function(object){
#validation rules
if(.rsdmx.options$validate){
if(all(names(object@formatter) != names(object@handler))) return(FALSE)
}
return(TRUE);
}
)
rsdmx/R/SDMXDotStatRequestBuilder-methods.R 0000644 0001762 0000144 00000012520 13041353300 020322 0 ustar ligges users #' @name SDMXDotStatRequestBuilder
#' @rdname SDMXDotStatRequestBuilder
#' @aliases SDMXDotStatRequestBuilder,SDMXDotStatRequestBuilder-method
#'
#' @usage
#' SDMXDotStatRequestBuilder(regUrl, repoUrl, accessKey, unsupportedResources,
#' skipProviderId, forceProviderId)
#'
#' @param regUrl an object of class "character" giving the base Url of the SDMX
#' service registry
#' @param repoUrl an object of class "character" giving the base Url of the SDMX
#' service repository
#' @param accessKey an object of class "character" indicating the name of request parameter for which
#' an authentication or subscription user key/token has to be provided to perform requests
#' @param unsupportedResources an object of class "list" giving eventual unsupported
#' REST resources. Default is an empty list object
#' @param skipProviderId an object of class "logical" indicating that the provider
#' agencyIdshould be skipped. Used to control lack of strong SDMX REST compliance
#' from data providers. For now, it applies only for the "data" resource.
#' @param forceProviderId an object of class "logical" indicating if the provider
#' agencyId has to be added at the end of the request. Default value is
#' \code{FALSE}. For some providers, the \code{all} value for the provider
#' agency id is not allowed, in this case, the \code{agencyId} of the data
#' provider has to be forced in the web-request
#'
#' @examples
#' #how to create a SDMXDotStatRequestBuilder
#' requestBuilder <- SDMXDotStatRequestBuilder(
#' regUrl = "http://www.myorg/registry",
#' repoUrl = "http://www.myorg/repository")
#'
SDMXDotStatRequestBuilder <- function(regUrl, repoUrl, accessKey = NULL,
unsupportedResources = list(),
skipProviderId = FALSE, forceProviderId = FALSE){
#params formatter
formatter = list(
#dataflow
dataflow = function(obj){return(obj)},
#datastructure
datastructure = function(obj){ return(obj)},
#data
data = function(obj){return(obj)}
)
#resource handler
handler <- list(
#'dataflow' resource (path="GetKeyFamily/{resourceID}")
#------------------------------------------------------
dataflow = function(obj){
if(is.null(obj@resourceId)) obj@resourceId = "ALL"
req <- sprintf("%s/GetKeyFamily/%s/",obj@regUrl, obj@resourceId)
#require key
if(!is.null(accessKey)){
if(!is.null(obj@accessKey)){
if(length(grep("\\?",req))==0) req <- paste0(req, "?")
req <- paste(req, sprintf("%s=%s", accessKey, obj@accessKey), sep = "&")
}else{
stop("Requests to this service endpoint requires an API key")
}
}
return(req)
},
#'datastructure' resource (path="GetDataStructure/{resourceID}/{agencyID}")
#--------------------------------------------------------------------------
datastructure = function(obj){
if(is.null(obj@resourceId)) obj@resourceId = "all"
if(is.null(obj@version)) obj@version = "latest"
req <- sprintf("%s/GetDataStructure/%s",obj@regUrl, obj@resourceId)
if(forceProviderId) req <- paste(req, obj@providerId, sep = "/")
#require key
if(!is.null(accessKey)){
if(!is.null(obj@accessKey)){
if(length(grep("\\?",req))==0) req <- paste0(req, "?")
req <- paste(req, sprintf("%s=%s", accessKey, obj@accessKey), sep = "&")
}else{
stop("Requests to this service endpoint requires an API key")
}
}
return(req)
},
#'data' resource (path="GetData/{flowRef}/{key}/{agencyId}")
#----------------------------------------------------------
data = function(obj){
if(is.null(obj@flowRef)) stop("Missing flowRef value")
if(is.null(obj@key)) obj@key = "all"
req <- sprintf("%s/GetData/%s/%s", obj@repoUrl, obj@flowRef, obj@key)
if(skipProviderId){
req <- paste0(req, "/")
}else{
req <- paste(req, ifelse(forceProviderId, obj@providerId, "all"), sep = "/")
}
#DataQuery
#-> temporal extent (if any)
addParams = FALSE
if(!is.null(obj@start)){
req <- paste0(req, "?")
addParams = TRUE
req <- paste0(req, "startPeriod=", obj@start)
}
if(!is.null(obj@end)){
if(!addParams){
req <- paste0(req, "?")
}else{
req <- paste0(req, "&")
}
req <- paste0(req, "endPeriod=", obj@end)
}
#require key
if(!is.null(accessKey)){
if(!is.null(obj@accessKey)){
if(length(grep("\\?",req))==0) req <- paste0(req, "?")
req <- paste(req, sprintf("%s=%s", accessKey, obj@accessKey), sep = "&")
}else{
stop("Requests to this service endpoint requires an API key")
}
}
return(req)
}
)
new("SDMXDotStatRequestBuilder",
regUrl = regUrl,
repoUrl = repoUrl,
accessKey = accessKey,
formatter = formatter,
handler = handler,
compliant = FALSE,
unsupportedResources = unsupportedResources)
}
rsdmx/R/readSDMX.R 0000644 0001762 0000144 00000042322 13235377267 013364 0 ustar ligges users #' @name readSDMX
#' @aliases readSDMX
#' @title readSDMX
#' @description \code{readSDMX} is the main function to use to read SDMX data
#'
#' @usage readSDMX(file, isURL, isRData,
#' provider, providerId, providerKey,
#' agencyId, resource, resourceId, version,
#' flowRef, key, key.mode, start, end, dsd, validate, verbose)
#'
#' @param file path to SDMX-ML document that needs to be parsed
#' @param isURL a value of class "logical" either the path is an url, and data
#' has to be downloaded from a SDMXweb-repository. Default value is TRUE.
#' Ignored in case \code{readSDMX} is used with helpers (based on the
#' embedded list of \code{SDMXServiceProvider})
#' @param isRData a value of class "logical" either the path is local RData file
#' handling an object of class "SDMX", previously saved with \code{\link{saveSDMX}}.
#' Default value is FALSE.
#' @param provider an object of class "SDMXServiceProvider". If specified,
#' \code{file} and \code{isURL} arguments will be ignored.
#' @param providerId an object of class "character" representing a provider id.
#' It has to be match a default provider as listed in\code{getSDMXServiceProviders()}
#' @param providerKey an object of class "character" giving a key to authenticate
#' for the given provider endpoint. Some providers may require an authentication or
#' subscription key to perform SDMX requests.
#' @param agencyId an object of class "character representing an agency id, for
#' which data should be requested (from a particular service provider)
#' @param resource an object of class "character" giving the SDMX service request
#' resource to query e.g. "data". Recognized if a valid provider or provide
#' id has been specified as argument.
#' @param resourceId an object of class "character" giving a SDMX service resource
#' Id, e.g. the id of a data structure
#' @param version an object of class "character" giving a SDMX resource version,
#' e.g. the version of a dataflow.
#' @param flowRef an object of class "character" giving the SDMX flow ref id. Recognized
#' if valid provider or provide id has been specified as argument.
#' @param key an object of class "character" or "list" giving the SDMX data key/filter
#' to apply. Recognized if a valid provider or provide id has been specified as argument.
#' If \code{key.mode} is equal to \code{"R"} (default value), filter has to be an object
#' of class "list" representing the filters to apply to the dataset, otherwise the filter
#' will be a string.
#' @param key.mode an object of class "character" indicating if the \code{key} has to be provided
#' as an R object, ie a object of class "list" representing the filter(s) to apply. Default
#' value is \code{"R"}. Alternative value is \code{"SDMX"}
#' @param start an object of class "integer" or "character" giving the SDMX start time to apply.
#' Recognized if a valid provider or provide id has been specified as argument.
#' @param end an object of class "integer" or "character" giving the SDMX end time to apply.
#' Recognized if a valid provider or provide id has been specified as argument.
#' @param dsd an Object of class "logical" if an attempt to inherit the DSD should be performed.
#' Active only if \code{"readSDMX"} is used as helper method (ie if data is fetched using
#' an embedded service provider. Default is FALSE
#' @param validate an object of class "logical" indicating if a validation check has to
#' be performed on the SDMX-ML document to check its SDMX compliance when reading it.
#' Default is FALSE.
#' @param verbose an Object of class "logical" that indicates if rsdmx messages should
#' appear to user. Default is TRUE.
#'
#' @return an object of class "SDMX"
#'
#' @examples
#' # SDMX datasets
#' #--------------
#' \dontrun{
#' # Not run
#' # (local dataset examples)
#' #with SDMX 2.0
#' tmp <- system.file("extdata","Example_Eurostat_2.0.xml", package="rsdmx")
#' sdmx <- readSDMX(tmp, isURL = FALSE)
#' stats <- as.data.frame(sdmx)
#' head(stats)
#'
#' #with SDMX 2.1
#' tmpnew <- system.file("extdata","Example_Eurostat_2.1.xml", package="rsdmx")
#' sdmx <- readSDMX(tmpnew, isURL = FALSE)
#' stats <- as.data.frame(sdmx)
#' head(stats)
#' ## End(**Not run**)
#' }
#'
#' \donttest{
#' # Not run by 'R CMD check'
#' # (reliable remote datasource but with possible occasional unavailability)
#'
#' #examples using embedded providers
#' sdmx <- readSDMX(providerId = "OECD", resource = "data", flowRef = "MIG",
#' key = list("TOT", NULL, NULL), start = 2011, end = 2011)
#' stats <- as.data.frame(sdmx)
#' head(stats)
#'
#' #examples using 'file' argument
#' #using url (Eurostat REST SDMX 2.1)
#' url <- paste("http://ec.europa.eu/eurostat/SDMX/diss-web/rest/data/",
#' "cdh_e_fos/all/?startperiod=2000&endPeriod=2010",
#' sep = "")
#' sdmx <- readSDMX(url)
#' stats <- as.data.frame(sdmx)
#' head(stats)
#'
#' ## End(**Not run**)
#' }
#'
#' # SDMX DataStructureDefinition (DSD)
#' #-----------------------------------
#' \donttest{
#' # Not run by 'R CMD check'
#' # (reliable remote datasource but with possible occasional unavailability)
#'
#' #using embedded providers
#' dsd <- readSDMX(providerId = "OECD", resource = "datastructure",
#' resourceId = "WATER_ABSTRACT")
#'
#' #get codelists from DSD
#' cls <- slot(dsd, "codelists")
#' codelists <- sapply(slot(cls,"codelists"), slot, "id") #get list of codelists
#'
#' #get a codelist
#' codelist <- as.data.frame(cls, codelistId = "CL_WATER_ABSTRACT_SOURCE")
#'
#' #get concepts from DSD
#' concepts <- as.data.frame(slot(dsd, "concepts"))
#'
#' ## End(**Not run**)
#' }
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
readSDMX <- function(file = NULL, isURL = TRUE, isRData = FALSE,
provider = NULL, providerId = NULL, providerKey = NULL,
agencyId = NULL, resource = NULL, resourceId = NULL, version = NULL,
flowRef = NULL, key = NULL, key.mode = "R", start = NULL, end = NULL, dsd = FALSE,
validate = FALSE, verbose = TRUE) {
#set option for SDMX compliance validation
.rsdmx.options$validate <- validate
.rsdmx.options$followlocation <- TRUE
if(!(key.mode %in% c("R", "SDMX"))){
stop("Invalid value for key.mode argument. Accepted values are 'R', 'SDMX' ")
}
#check from arguments if request has to be performed
buildRequest <- FALSE
if(!missing(provider)){
if(class(provider) != "SDMXServiceProvider"){
stop("Provider should be an instance of 'SDMXServiceProvider'")
}else{
providerId = slot(provider, "agencyId")
}
buildRequest <- TRUE
}
if(!missing(providerId)){
provider <- findSDMXServiceProvider(providerId)
if(is.null(provider)){
stop("No provider with identifier ", providerId)
}
buildRequest <- TRUE
}
#proceed with the request build
if(buildRequest){
if(is.null(resource)) stop("SDMX service resource cannot be null")
#request handler
requestHandler <- provider@builder@handler
if((resource %in% provider@builder@unsupportedResources) ||
!(resource %in% names(requestHandler)))
stop("Unsupported SDMX service resource for this provider")
#apply SDMX key mode
if(key.mode == "R" && !missing(key) && !is.null(key)){
key <- paste(sapply(key, paste, collapse = "+"), collapse=".")
}
#request params
requestParams <- SDMXRequestParams(
regUrl = provider@builder@regUrl,
repoUrl = provider@builder@repoUrl,
accessKey = providerKey,
providerId = providerId,
agencyId = agencyId,
resource = resource,
resourceId = resourceId,
version = version,
flowRef = flowRef,
key = key,
start = start,
end = end,
compliant = provider@builder@compliant
)
#formatting requestParams
requestFormatter <- provider@builder@formatter
requestParams <- switch(resource,
"dataflow" = requestFormatter$dataflow(requestParams),
"datastructure" = requestFormatter$datastructure(requestParams),
"data" = requestFormatter$data(requestParams))
#preparing request
file <- switch(resource,
"dataflow" = requestHandler$dataflow(requestParams),
"datastructure" = requestHandler$datastructure(requestParams),
"data" = requestHandler$data(requestParams)
)
if(verbose) message(paste0("-> Fetching '", file, "'"))
}
#call readSDMX original
if(is.null(file)) stop("Empty file argument")
if(buildRequest) isURL = TRUE
if(isRData) isURL = FALSE
#load data
status <- 0
if(isURL == FALSE){
isXML <- !isRData
if(isXML){
if(!file.exists(file)) stop("File ", file, "not found\n")
content <- readChar(file, file.info(file)$size)
}
}else{
requestURL <- function(file){
rsdmxAgent <- paste("rsdmx/",as.character(packageVersion("rsdmx")),sep="")
h <- RCurl::basicHeaderGatherer()
content <- RCurl::getURL(file, httpheader = list('User-Agent' = rsdmxAgent),
ssl.verifypeer = FALSE, .encoding = "UTF-8",
encoding = "gzip", headerfunction = h$update)
return(list(response = content, header = h$value()));
}
out <- requestURL(file)
if(out$header["status"] == 301){
file <- out$header["Location"]
out <- requestURL(file)
}
if(as.numeric(out$header["status"]) >= 400) {
stop("HTTP request failed with status: ",
out$header["status"], " ", out$header["statusMessage"])
}
content <- out$response
}
status <- tryCatch({
if((attr(regexpr("", content), "match.length") == -1) &&
(attr(regexpr("", content), "match.length") == -1)){
#check the presence of a BOM
BOM <- "\ufeff"
if(attr(regexpr(BOM, content), "match.length") != - 1){
content <- gsub(BOM, "", content)
}
#check presence of XML comments
content <- gsub("", "", content)
#check presence of invalid XML entities
content <- gsub("“", """, content)
content <- gsub("”", """, content)
content <- gsub("‘", "'", content)
content <- gsub("’", "'", content)
xmlObj <- xmlTreeParse(content, useInternalNodes = TRUE)
status <- 1
}else{
stop("Invalid SDMX-ML file")
}
},error = function(err){
print(err)
status <<- 0
return(status)
})
#internal function for SDMX Structure-based document
getSDMXStructureObject <- function(xmlObj, ns, resource){
strTypeObj <- SDMXStructureType(xmlObj, ns, resource)
strType <- getStructureType(strTypeObj)
strObj <- switch(strType,
"DataflowsType" = SDMXDataFlows(xmlObj, ns),
"ConceptsType" = SDMXConcepts(xmlObj, ns),
"CodelistsType" = SDMXCodelists(xmlObj, ns),
"DataStructuresType" = SDMXDataStructures(xmlObj, ns),
"DataStructureDefinitionsType" = SDMXDataStructureDefinition(xmlObj, ns),
NULL
)
return(strObj)
}
#encapsulate in S4 object
obj <- NULL
if(status){
#namespaces
ns <- namespaces.SDMX(xmlObj)
#convenience for SDMX documents embedded in SOAP XML responses
if(isSoapRequestEnvelope(xmlObj, ns)){
xmlObj <- getSoapRequestResult(xmlObj)
}
#convenience for SDMX documents queried through a RegistryInterface
if(isRegistryInterfaceEnvelope(xmlObj, TRUE)){
xmlObj <- getRegistryInterfaceResult(xmlObj)
}
type <- SDMXType(xmlObj)@type
obj <- switch(type,
"StructureType" = getSDMXStructureObject(xmlObj, ns, resource),
"GenericDataType" = SDMXGenericData(xmlObj, ns),
"CompactDataType" = SDMXCompactData(xmlObj, ns),
"UtilityDataType" = SDMXUtilityData(xmlObj, ns),
"StructureSpecificDataType" = SDMXStructureSpecificData(xmlObj, ns),
"StructureSpecificTimeSeriesDataType" = SDMXStructureSpecificTimeSeriesData(xmlObj, ns),
"CrossSectionalDataType" = SDMXCrossSectionalData(xmlObj, ns),
"MessageGroupType" = SDMXMessageGroup(xmlObj, ns),
NULL
)
if(is.null(obj)){
if(type == "StructureType"){
strTypeObj <- SDMXStructureType(xmlObj, ns, resource)
type <- getStructureType(strTypeObj)
}
stop(paste("Unsupported SDMX Type '",type,"'",sep=""))
}else{
#handling footer messages
footer <- slot(obj, "footer")
footer.msg <- slot(footer, "messages")
if(length(footer.msg) > 0){
invisible(
lapply(footer.msg,
function(x){
code <- slot(x,"code")
severity <- slot(x,"severity")
lapply(slot(x,"messages"),
function(msg){
warning(paste(severity," (Code ",code,"): ",msg,sep=""),
call. = FALSE)
}
)
})
)
}
}
}else{
#read SDMX object from RData file (.RData, .rda, .rds)
if(isRData){
if(!file.exists(file)) stop("File ", file, "not found\n")
obj <- readRDS(file, refhook = XML::xmlDeserializeHook)
}
}
#attempt to get DSD
embeddedDSD <- FALSE
if(is(obj, "SDMXData")){
strTypeObj <- SDMXStructureType(obj@xmlObj, ns, NULL)
if(!is.null(strTypeObj@subtype)){
if(strTypeObj@subtype %in% c("CodelistsType", "DataStructureDefinitionsType")){
dsd <- TRUE
embeddedDSD <- TRUE
}
}
}
if(dsd){
dsdObj <- NULL
#in case codelist or DSD are embedded with data
if(embeddedDSD){
dsdObj <- SDMXDataStructureDefinition(obj@xmlObj, ns)
slot(obj, "dsd") <- dsdObj
}
#using helpers strategy (with a resource parameter)
if(buildRequest && resource %in% c("data","dataflow")){
if(resource == "data" && providerId %in% c("ESTAT", "ISTAT", "WBG_WITS", "UIS2")){
if(verbose) message("-> Attempt to fetch DSD ref from dataflow description")
flow <- readSDMX(providerId = providerId, providerKey = providerKey, resource = "dataflow",
resourceId = flowRef, verbose = TRUE)
dsdRef <- slot(slot(flow, "dataflows")[[1]],"dsdRef")
rm(flow)
}else{
dsdRef <- NULL
if(resource == "data"){
dsdRef <- slot(obj, "dsdRef")
}else if(resource=="dataflow"){
dsdRef <- lapply(slot(obj,"dataflows"), slot,"dsdRef")
}
if(!is.null(dsdRef)){
if(verbose) message(paste0("-> DSD ref identified in dataset = '", dsdRef, "'"))
if(verbose) message("-> Attempt to fetch & bind DSD to dataset")
}else{
dsdRef <- flowRef
if(verbose) message("-> No DSD ref associated to dataset")
if(verbose) message("-> Attempt to fetch & bind DSD to dataset using 'flowRef'")
}
}
if(resource == "data"){
dsdObj <- readSDMX(providerId = providerId, providerKey = providerKey,
resource = "datastructure", resourceId = dsdRef, verbose = verbose)
if(is.null(dsdObj)){
if(verbose) message(sprintf("-> Impossible to fetch DSD for dataset %s", flowRef))
}else{
if(verbose) message("-> DSD fetched and associated to dataset!")
slot(obj, "dsd") <- dsdObj
}
}else if(resource == "dataflow"){
dsdObj <- lapply(1:length(dsdRef), function(x){
flowDsd <- readSDMX(providerId = providerId, providerKey = providerKey,
resource = "datastructure", resourceId = dsdRef[[x]], verbose = verbose)
if(is.null(flowDsd)){
if(verbose) message(sprintf("-> Impossible to fetch DSD for dataflow %s",resourceId))
}else{
if(verbose) message("-> DSD fetched and associated to dataflow!")
slot(slot(obj,"dataflows")[[x]],"dsd") <<- flowDsd
}
})
}
}
}
return(obj);
}
rsdmx/R/Class-SDMXCrossSectionalData.R 0000644 0001762 0000144 00000001034 12656611414 017223 0 ustar ligges users #' @name SDMXCrossSectionalData
#' @docType class
#' @aliases SDMXCrossSectionalData-class
#'
#' @title Class "SDMXCrossSectionalData"
#' @description A basic class to handle a SDMX-ML cross sectional data set
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
setClass("SDMXCrossSectionalData",
contains = "SDMXData",
representation(),
prototype = list(),
validity = function(object){
#eventual validation rules
return(TRUE);
}
)
rsdmx/R/SDMXServiceProvider-methods.R 0000644 0001762 0000144 00000045700 13235421350 017207 0 ustar ligges users #' @name SDMXServiceProvider
#' @rdname SDMXServiceProvider
#' @aliases SDMXServiceProvider,SDMXServiceProvider-method
#'
#' @usage
#' SDMXServiceProvider(agencyId, name, scale, country, builder)
#'
#' @param agencyId an object of class "character" giving the a provider identifier
#' @param name an object of class "character" giving the name of the provider
#' @param scale an object of class "character" giving the scale of the datasource,
#' either "international" or "national". Default value is "international".
#' @param country an object of class "character" giving the ISO 3-alpha code of
#' the country (if scale is "national"). Default value is \code{NA}
#' @param builder an object of class "SDMXRequestBuilder" that will performs the
#' web request building for this specific provider
#' @return an object of class "SDMXServiceProvider"
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
#' @examples
#' #let's create a SDMXRESTRequestBuilder
#' #(assuming that "My Organization" implements SDMX REST web-services)
#' myBuilder <- SDMXREST20RequestBuilder(regUrl = "http://www.myorg.org/registry",
#' repoUrl = "http://www.myorg.org/repository",
#' compliant = TRUE)
#'
#' #create a SDMXServiceProvider
#' provider <- SDMXServiceProvider(agencyId = "MYORG", name = "My Organization",
#' builder = myBuilder)
#'
SDMXServiceProvider <- function(agencyId, name,
scale = "international", country = as.character(NA),
builder) {
new("SDMXServiceProvider",
agencyId = agencyId,
name = name,
scale = scale,
country = country,
builder = builder);
}
#other non-S4 methods
#====================
#' @name setSDMXServiceProviders
#' @aliases setSDMXServiceProviders
#' @title setSDMXServiceProviders
#'
#' @description function used internally by \pkg{rsdmx}, when loading the package,
#' to set the list of \link{SDMXServiceProvider} known by \pkg{rsdmx}
#' (hence known by \link{readSDMX} to query data/metadata in an easier
#' way). For internal use only (this function does not provide any
#' value for the end user, but it is here documented for transparency,
#' and to explain how the package works.)
#'
#' @usage
#' setSDMXServiceProviders()
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
#' @seealso \link{getSDMXServiceProviders} \link{addSDMXServiceProvider}
#' \link{findSDMXServiceProvider} \link{readSDMX}
#'
setSDMXServiceProviders <- function(){ # nocov start
#international data providers
#----------------------------
#ECB
ECB <- SDMXServiceProvider(
agencyId = "ECB", name = "European Central Bank",
builder = SDMXREST21RequestBuilder(
regUrl = "https://sdw-wsrest.ecb.europa.eu/service",
repoUrl = "https://sdw-wsrest.ecb.europa.eu/service",
compliant = TRUE)
)
#EUROSTAT
ESTAT <- SDMXServiceProvider(
agencyId = "ESTAT", name = "Eurostat (Statistical office of the European Union)",
builder = SDMXREST21RequestBuilder(
regUrl = "http://ec.europa.eu/eurostat/SDMX/diss-web/rest",
repoUrl = "http://ec.europa.eu/eurostat/SDMX/diss-web/rest",
compliant = TRUE)
)
ESTAT@builder@handler$dataflow = function(obj){
if(is.null(obj@resourceId)) obj@resourceId = "all"
if(is.null(obj@version)) obj@version = "latest"
req <- sprintf("%s/dataflow/ESTAT/%s/%s/",obj@regUrl, obj@resourceId, obj@version)
return(req)
}
ESTAT@builder@handler$datastructure = function(obj){
if(is.null(obj@resourceId)) obj@resourceId = "all"
if(is.null(obj@version)) obj@version = "latest"
req <- sprintf("%s/datastructure/ESTAT/%s/%s/",obj@regUrl, obj@resourceId, obj@version)
req <- paste0(req, "?references=children") #TODO to see later to have arg for this
return(req)
}
#IMF
IMF <- SDMXServiceProvider(
agencyId = "IMF", name = "International Monetary Fund",
builder = SDMXREST21RequestBuilder(
regUrl = "https://sdmxcentral.imf.org/ws/public/sdmxapi/rest",
repoUrl = "https://sdmxcentral.imf.org/ws/public/sdmxapi/rest",
compliant = TRUE)
)
#OECD
OECD <- SDMXServiceProvider(
agencyId = "OECD", name = "Organisation for Economic Cooperation and Development ",
builder = SDMXDotStatRequestBuilder(
regUrl = "http://stats.oecd.org/restsdmx/sdmx.ashx",
repoUrl = "http://stats.oecd.org/restsdmx/sdmx.ashx")
)
#UN
UNSD <- SDMXServiceProvider(
agencyId = "UNSD", "United Nations Statistics Division",
builder = SDMXREST21RequestBuilder(
regUrl = "http://data.un.org/WS/rest",
repoUrl = "http://data.un.org/WS/rest",
compliant = TRUE
)
)
#UN-FAO
FAO <- SDMXServiceProvider(
agencyId = "FAO", name = "Food and Agriculture Organization of the United Nations",
builder = SDMXREST21RequestBuilder(
regUrl = "http://data.fao.org/sdmx/registry",
repoUrl = "http://data.fao.org/sdmx/repository",
compliant = FALSE,
unsupportedResources = list("dataflow"))
)
#UN-ILO
ILO <- SDMXServiceProvider(
agencyId = "ILO", name = "International Labour Organization of the United Nations",
builder = SDMXREST21RequestBuilder(
regUrl = "http://www.ilo.org/ilostat/sdmx/ws/rest",
repoUrl = "http://www.ilo.org/ilostat/sdmx/ws/rest",
compliant = FALSE, skipProviderId = TRUE,
unsupportedResources = list("dataflow"))
)
#UIS (UNESCO)
UIS <- SDMXServiceProvider(
agencyId = "UIS", name = "UNESCO Institute of Statistics (old - http://data.uis.unesco.org)",
builder = SDMXDotStatRequestBuilder(
regUrl = "http://data.uis.unesco.org/RestSDMX/sdmx.ashx",
repoUrl = "http://data.uis.unesco.org/RestSDMX/sdmx.ashx")
)
#UIS2 (UNESCO)
UIS2 <- SDMXServiceProvider(
agencyId = "UIS2", name = "UNESCO Institute of Statistics (new - http://api.uis.unesco.org)",
builder = SDMXREST21RequestBuilder(
regUrl = "http://api.uis.unesco.org/sdmx",
repoUrl = "http://api.uis.unesco.org/sdmx",
accessKey = "subscription-key",
compliant = TRUE, skipProviderId = TRUE)
)
#WBG_WITS (World Integrated Trade Solution)
WBG_WITS <- SDMXServiceProvider(
agencyId = "WBG_WITS", name = "World Integrated Trade Solution",
builder = SDMXREST21RequestBuilder(
regUrl = "http://wits.worldbank.org/API/V1/SDMX/V21/rest",
repoUrl = "http://wits.worldbank.org/API/V1/SDMX/V21/rest",
compliant = TRUE, skipProviderId = TRUE
)
)
#national data providers
#-----------------------
#ABS {Australia}
ABS <- SDMXServiceProvider(
agencyId = "ABS", name = "Australian Bureau of Statistics",
scale = "national", country = "AUS",
builder = SDMXDotStatRequestBuilder(
regUrl = "http://stat.data.abs.gov.au/restsdmx/sdmx.ashx",
repoUrl = "http://stat.data.abs.gov.au/restsdmx/sdmx.ashx",
forceProviderId = TRUE, unsupportedResources = list("dataflow"))
)
#NBB {Belgium}
NBB <- SDMXServiceProvider(
agencyId = "NBB", name = "National Bank of Belgium",
scale = "national", country = "BEL",
builder = SDMXDotStatRequestBuilder(
regUrl = "http://stat.nbb.be/RestSDMX/sdmx.ashx",
repoUrl = "http://stat.nbb.be/RestSDMX/sdmx.ashx",
unsupportedResources = list("dataflow"))
)
#INSEE {France}
INSEE <- SDMXServiceProvider(
agencyId = "INSEE", name = "Institut national de la statistique et des \u00e9tudes \u00e9conomiques",
scale = "national", country = "FRA",
builder = SDMXREST21RequestBuilder(
regUrl = "https://bdm.insee.fr/series/sdmx",
repoUrl = "https://bdm.insee.fr/series/sdmx",
compliant = TRUE)
)
#INEGI (Mexico)
INEGI <- SDMXServiceProvider(
agencyId = "INEGI", name = "Instituto Nacional de Estad\u00edstica y Geograf\u00eda (M\u00e9jico)",
scale = "national", country = "MEX",
builder = SDMXREST21RequestBuilder(
regUrl = "http://sdmx.snieg.mx/service/Rest",
repoUrl = "http://sdmx.snieg.mx/service/Rest",
compliant = FALSE
)
)
#ISTAT (Italy)
ISTAT <- SDMXServiceProvider(
agencyId = "ISTAT", name = "Istituto nazionale di statistica (Italia)",
scale = "national", country = "ITA",
builder = SDMXREST21RequestBuilder(
regUrl = "http://sdmx.istat.it/SDMXWS/rest",
repoUrl = "http://sdmx.istat.it/SDMXWS/rest",
compliant = TRUE
)
)
#NOMIS (UK Official Labour Market statistics)
NOMIS <- SDMXServiceProvider(
agencyId = "NOMIS", name = "NOMIS - UK Official Labour Market Statistics",
scale = "national", country = "UK",
builder = SDMXRequestBuilder(
regUrl = "https://www.nomisweb.co.uk/api/v01",
repoUrl = "https://www.nomisweb.co.uk/api/v01",
compliant = FALSE,
formatter = list(
dataflow = function(obj){return(obj)},
datastructure = function(obj){return(obj)},
data = function(obj){return(obj)}
),
handler = list(
#'dataflow' resource (path="dataset/{resourceId}/def.sdmx.xml")
#-----------------------------------------------------------------------
dataflow = function(obj){
req <- sprintf("%s/dataset", obj@regUrl)
if(!is.null(obj@resourceId)) req <- paste(req, obj@resourceId, sep="/")
req <- paste(req, "def.sdmx.xml", sep="/")
return(req)
},
#'datastructure' resource (path="dataset/{resourceID}.structure.sdmx.xml")
#-----------------------------------------------------------------------
datastructure = function(obj){
req <- sprintf("%s/dataset", obj@regUrl)
if(is.null(obj@resourceId)) stop("Missing 'resourceId' value")
req <- paste(req, obj@resourceId, sep="/")
req <- paste0(req, ".structure.sdmx.xml")
return(req)
},
#'data' resource (path="dataset/{resourceID}.generic.sdmx.xml")
#----------------------------------------------------------
data = function(obj){
req <- sprintf("%s/dataset", obj@repoUrl)
if(is.null(obj@flowRef)) stop("Missing 'flowRef' value")
req <- paste(req, obj@flowRef, sep="/")
req <- paste0(req, ".compact.sdmx.xml")
return(req)
}
)
)
)
#LSD - Lithuanian Department of Statistics (Statistics Lithuania)
LSD <- SDMXServiceProvider(
agencyId = "LSD", "Statistics Lithuania",
scale = "national", country = "LTU",
builder = SDMXREST21RequestBuilder(
regUrl = "https://osp-rs.stat.gov.lt/rest_xml",
repoUrl = "https://osp-rs.stat.gov.lt/rest_xml",
compliant = TRUE, skipProviderId = TRUE
)
)
#STAT_EE - Statistics Estonia database {Estonia}
STAT_EE <- SDMXServiceProvider(
agencyId = "STAT_EE", name = "Statistics Estonia database",
scale = "national", country = "EST",
builder = SDMXDotStatRequestBuilder(
regUrl = "http://andmebaas.stat.ee/restsdmx/sdmx.ashx",
repoUrl = "http://andmebaas.stat.ee/restsdmx/sdmx.ashx",
unsupportedResources = list("dataflow")
)
)
#other data providers
#--------------------
#KNOEMA (Open data plateform)
KNOEMA <- SDMXServiceProvider(
agencyId = "KNOEMA", name = "KNOEMA knowledge plateform",
builder = SDMXRequestBuilder(
regUrl = "http://knoema.fr/api/1.0/sdmx",
repoUrl = "http://knoema.fr/api/1.0/sdmx",
formatter = list(
dataflow = function(obj){return(obj)},
datastructure = function(obj){return(obj)},
data = function(obj){return(obj)}
),
handler = list(
#'dataflow' resource (path="/")
#-----------------------------------------------------------------------
dataflow = function(obj){
return(obj@regUrl)
},
#'datastructure' resource (path="/{resourceID})
#-----------------------------------------------------------------------
datastructure = function(obj){
req <- paste(obj@regUrl, obj@resourceId, sep = "/")
return(req)
},
#'data' resource (path="getdata?dataflow={flowRef}&key={key})
#----------------------------------------------------------
data = function(obj){
if(is.null(obj@flowRef)) stop("Missing flowRef value")
if(is.null(obj@key)) obj@key = "."
#base data request
req <- sprintf("%s/getdata?dataflow=%s&key=%s", obj@repoUrl, obj@flowRef, obj@key)
#DataQuery
#-> temporal extent (if any)
if(!is.null(obj@start) | !is.null(obj@end)) {
warning("start/end parameters ignored for this SDMX API")
}
return(req)
}
),
compliant = FALSE
)
)
#WIDUKIND project - International Economics Database
WIDUKIND <- SDMXServiceProvider(
agencyId = "WIDUKIND", name = "Widukind project - International Economics Database",
builder = SDMXREST21RequestBuilder(
regUrl = "http://widukind-api.cepremap.org/api/v1/sdmx",
repoUrl = "http://widukind-api.cepremap.org/api/v1/sdmx",
compliant = FALSE, skipProviderId = TRUE
)
)
WIDUKIND@builder@handler$dataflow = function(obj){
req <- sprintf("%s/dataflow",obj@regUrl)
if(!is.null(obj@agencyId)) req = paste(req, obj@agencyId,sep="/")
if(!is.null(obj@resourceId)) req = paste(req, obj@resourceId,sep="/")
return(req)
}
WIDUKIND@builder@handler$datastructure = function(obj){
req <- sprintf("%s/datastructure",obj@regUrl)
if(!is.null(obj@agencyId)){
req <- paste(req,obj@agencyId,sep="/")
}else{
req <- paste(req, "all",sep="/") #not supported by service
}
if(!is.null(obj@resourceId)) req <- paste(req, obj@resourceId, sep="/")
req <- paste0(req, "?references=children") #TODO to see later to have arg for this
return(req)
}
WIDUKIND@builder@handler$data = function(obj){
if(is.null(obj@flowRef)) stop("Missing flowRef value")
if(is.null(obj@agencyId)) obj@agencyId = "all"
if(is.null(obj@key)) obj@key = "all"
req <- sprintf("%s/%s/data/%s/%s",obj@repoUrl, obj@agencyId, obj@flowRef, obj@key)
#DataQuery
#-> temporal extent (if any)
addParams = FALSE
if(!is.null(obj@start)){
req <- paste0(req, "?")
addParams = TRUE
req <- paste0(req, "startPeriod=", obj@start)
}
if(!is.null(obj@end)){
if(!addParams){
req <- paste0(req, "?")
}else{
req <- paste0(req, "&")
}
req <- paste0(req, "endPeriod=", obj@end)
}
return(req)
}
listOfProviders <- list(
#international
ECB, ESTAT, IMF, OECD, UNSD, FAO, ILO, UIS, UIS2, WBG_WITS,
#national
ABS, NBB, INSEE, INEGI, ISTAT, NOMIS, LSD, STAT_EE,
#others
KNOEMA, WIDUKIND
)
.rsdmx.options$providers <- new("SDMXServiceProviders", providers = listOfProviders)
} # nocov end
#' @name addSDMXServiceProvider
#' @aliases addSDMXServiceProvider
#' @title addSDMXServiceProvider
#' @description function that allows configuring a new \link{SDMXServiceProvider}
#' as part of the list of providers known by \pkg{rsdmx}, hence by
#' \link{readSDMX}
#'
#' @usage
#' addSDMXServiceProvider(provider)
#'
#' @param provider an object of class "SDMXServiceProvider"
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
#' @examples
#' #create a provider
#' myBuilder <- SDMXREST20RequestBuilder(regUrl = "http://www.myorg.org/registry",
#' repoUrl = "http://www.myorg.org/repository",
#' compliant = TRUE)
#' myProvider <- SDMXServiceProvider(
#' agencyId = "MYORG", name = "My Organization",
#' builder = myBuilder
#' )
#'
#' #add it
#' addSDMXServiceProvider(myProvider)
#'
#' #check out the list of existing provider (only list the agency Ids)
#' sapply(slot(getSDMXServiceProviders(), "providers"), function(x){slot(x, "agencyId")})
#'
#' @seealso \link{getSDMXServiceProviders} \link{findSDMXServiceProvider}
#' \link{readSDMX}
#'
addSDMXServiceProvider <- function(provider){
.rsdmx.options$providers <- new("SDMXServiceProviders",
providers = c(slot(.rsdmx.options$providers, "providers"), provider)
)
}
#' @name getSDMXServiceProviders
#' @aliases getSDMXServiceProviders
#' @title getSDMXServiceProviders
#' @description function used to get the list of \link{SDMXServiceProvider} known
#' by \pkg{rsdmx} (hence known by \link{readSDMX} to query data or
#' metadata in an easier way). This function can be easily used to
#' interrogate the list of known providers, and eventually consider
#' adding one at runtime with \link{addSDMXServiceProvider}
#' @usage
#' getSDMXServiceProviders()
#'
#' @return an object of class "list" (of \link{SDMXServiceProvider})
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
#' @seealso \link{addSDMXServiceProvider} \link{findSDMXServiceProvider}
#' \link{readSDMX}
#'
getSDMXServiceProviders <- function(){
out <- .rsdmx.options$providers
return(out)
}
#' @name findSDMXServiceProvider
#' @aliases findSDMXServiceProvider
#' @title findSDMXServiceProvider
#'
#' @description function that allows searching by provider id in the list of
#' known \link{SDMXServiceProvider}. This function can be used for
#' interrogating the list of default providers known by \pkg{rsdmx},
#' and is used internally by \link{readSDMX}
#' @usage
#' findSDMXServiceProvider(agencyId)
#'
#' @param agencyId an object of class "character" representing a provider
#' identifier
#' @return an object of class "SDMXServiceProvider" (or NULL if no matching)
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
#' @examples
#' #find OECD provider
#' oecd.provider <- findSDMXServiceProvider("OECD")
#'
#' @seealso \link{getSDMXServiceProviders} \link{addSDMXServiceProvider}
#' \link{readSDMX}
#'
findSDMXServiceProvider <- function(agencyId){
if(is.null(agencyId)) return(NULL)
res <- unlist(lapply(slot(getSDMXServiceProviders(),"providers"),
function(x) {if(x@agencyId == agencyId){return(x)}}))
if(!is.null(res) && length(res) > 0) res <- res[[1]]
return(res)
}
rsdmx/R/Class-SDMXGenericData.R 0000644 0001762 0000144 00000001243 12656611430 015644 0 ustar ligges users #' @name SDMXGenericData
#' @docType class
#' @aliases SDMXGenericData-class
#'
#' @title Class "SDMXGenericData"
#' @description A basic class to handle a SDMX-ML Generic data set
#'
#' @section Warning:
#' This class is not useful in itself, but all SDMX non-abstract classes will
#' encapsulate it as slot, when parsing an SDMX-ML document.
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
setClass("SDMXGenericData",
contains = "SDMXData",
representation(),
prototype = list(),
validity = function(object){
#eventual validation rules
return(TRUE);
}
)
rsdmx/R/SDMXDataStructure-methods.R 0000644 0001762 0000144 00000011210 12744364036 016666 0 ustar ligges users #' @name SDMXDataStructure
#' @rdname SDMXDataStructure
#' @aliases SDMXDataStructure,SDMXDataStructure-method
#'
#' @usage
#' SDMXDataStructure(xmlObj, namespaces)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @param namespaces object of class "data.frame" given the list of namespace URIs
#' @return an object of class "SDMXDataStructure"
#'
#' @seealso \link{readSDMX}
#'
SDMXDataStructure <- function(xmlObj, namespaces){
sdmxVersion <- version.SDMXSchema(xmlDoc(xmlObj), namespaces)
VERSION.21 <- sdmxVersion == "2.1"
messageNs <- findNamespace(namespaces, "message")
strNs <- findNamespace(namespaces, "structure")
#attributes
#=========
id = xmlGetAttr(xmlObj, "id")
if(is.null(id)) id <- as.character(NA)
agencyId = xmlGetAttr(xmlObj, "agencyID")
if(is.null(agencyId)) agencyId <- as.character(NA)
version = xmlGetAttr(xmlObj, "version")
if(is.null(version)) version <- as.character(NA)
uri = xmlGetAttr(xmlObj, "uri")
if(is.null(uri)) uri <- as.character(NA)
urn = xmlGetAttr(xmlObj, "urn")
if(is.null(urn)) urn <- as.character(NA)
isExternalReference = xmlGetAttr(xmlObj, "isExternalReference")
if(is.null(isExternalReference)){
isExternalReference <- NA
}else{
isExternalReference <- as.logical(isExternalReference)
}
isFinal = xmlGetAttr(xmlObj, "isFinal")
if(is.null(isFinal)){
isFinal <- NA
}else{
isFinal <- as.logical(isFinal)
}
validFrom = xmlGetAttr(xmlObj,"validFrom")
if(is.null(validFrom)) validFrom <- as.character(NA)
validTo = xmlGetAttr(xmlObj, "validTo")
if(is.null(validTo)) validTo <- as.character(NA)
#elements
#========
#name (multi-languages)
dsNamesXML <- NULL
if(VERSION.21){
comNs <- findNamespace(namespaces, "common")
dsNamesXML <- getNodeSet(xmlDoc(xmlObj),
"//str:DataStructure/com:Name",
namespaces = c(str = as.character(strNs),
com = as.character(comNs)))
}else{
dsNamesXML <- getNodeSet(xmlDoc(xmlObj),
"//str:KeyFamily/str:Name",
namespaces = c(str = as.character(strNs)))
}
dsNames <- list()
if(length(dsNamesXML) > 0){
dsNames <- new.env()
sapply(dsNamesXML,
function(x){
lang <- xmlGetAttr(x,"xml:lang")
if(is.null(lang)) lang <- xmlGetAttr(x,"lang")
if(is.null(lang)) lang <- "default"
dsNames[[lang]] <- xmlValue(x)
})
dsNames <- as.list(dsNames)
}
#description (multi-languages)
dsDesXML <- NULL
if(VERSION.21){
comNs <- findNamespace(namespaces, "common")
dsDesXML <- getNodeSet(xmlDoc(xmlObj),
"//str:DataStructure/com:Description",
namespaces = c(str = as.character(strNs),
com = as.character(comNs)))
}else{
dsDesXML <- getNodeSet(xmlDoc(xmlObj),
"//str:KeyFamily/str:Description",
namespaces = c(str = as.character(strNs)))
}
dsDescriptions <- list()
if(length(dsDesXML) > 0){
dsDescriptions <- new.env()
sapply(dsDesXML,
function(x){
lang <- xmlGetAttr(x,"xml:lang")
if(is.null(lang)) lang <- xmlGetAttr(x,"lang")
if(is.null(lang)) lang <- "default"
dsDescriptions[[lang]] <- xmlValue(x)
})
dsDescriptions <- as.list(dsDescriptions)
}
#Components
compXML <- NULL
if(VERSION.21){
compXML <- getNodeSet(xmlDoc(xmlObj),
"//str:DataStructureComponents",
namespaces = c(str = as.character(strNs)))
}else{
compXML <- getNodeSet(xmlDoc(xmlObj),
"//str:Components",
namespaces = c(str = as.character(strNs)))
}
components <- NULL
if(length(compXML) > 0) components <- SDMXComponents(xmlObj, namespaces)
#instantiate the object
obj<- new("SDMXDataStructure",
#attributes
id = id,
agencyID = agencyId,
version = version,
uri = uri,
urn = urn,
isExternalReference = isExternalReference,
isFinal = isFinal,
validFrom = validFrom,
validTo = validTo,
#elements,
Name = dsNames,
Description = dsDescriptions,
Components = components
)
}
rsdmx/R/SDMXSchema-methods.R 0000644 0001762 0000144 00000001607 12671526720 015304 0 ustar ligges users #' @name SDMXSchema
#' @rdname SDMXSchema
#' @aliases SDMXSchema,SDMXSchema-method
#'
#' @usage
#' SDMXSchema(xmlObj, namespaces)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @param namespaces object of class "data.frame" given the list of namespace URIs
#' @return an object of class "SDMXSchema"
#'
#' @seealso \link{readSDMX}
#'
SDMXSchema <- function(xmlObj, namespaces) {
new("SDMXSchema", version = version.SDMXSchema(xmlObj, namespaces));
}
#default functions
version.SDMXSchema <- function(xmlObj, namespaces){
schemaVersion <- NULL
for(i in 1:nrow(namespaces)){
parsed <- strsplit(namespaces$uri[i],"/")[[1]];
if(tolower(parsed[3]) == "www.sdmx.org"){
schemaVersion <- gsub("_",".",substr(parsed[substr(parsed,0,1)=="v"],2,nchar(parsed,"w")));
break;
}
}
return(schemaVersion);
}
rsdmx/R/Class-SDMXOrganisationScheme.R 0000644 0001762 0000144 00000001453 13120300264 017246 0 ustar ligges users #' @name SDMXOrganisationScheme
#' @docType class
#' @aliases SDMXOrganisationScheme-class
#'
#' @title Class "SDMXOrganisationScheme"
#' @description A basic abstract class to handle a SDMXOrganisationScheme
#'
#' @section Information:
#' This class is implemented in both SDMX 2.0 and 2.1. In the latter, it is
#' extended by other specific classes such as AgencyScheme, DataConsumerScheme,
#' DataProviderScheme and OrganisationUnitScheme. \pkg{rsdmx} covers the support
#' in SDMX 2.1
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
setClass("SDMXOrganisationScheme",
contains = "SDMXItemScheme",
representation(),
prototype = list(),
validity = function(object){
return(TRUE);
}
) rsdmx/R/SDMXUtilityData-methods.R 0000644 0001762 0000144 00000001373 12671526772 016350 0 ustar ligges users #' @name SDMXUtilityData
#' @rdname SDMXUtilityData
#' @aliases SDMXUtilityData,SDMXUtilityData-method
#'
#' @usage
#' SDMXUtilityData(xmlObj, namespaces)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @param namespaces object of class "data.frame" given the list of namespace URIs
#' @return an object of class "SDMXUtilityData"
#'
#' @seealso \link{readSDMX}
#'
SDMXUtilityData <- function(xmlObj, namespaces){
new("SDMXUtilityData",
SDMXData(xmlObj, namespaces)
)
}
#methods
#=======
as.data.frame.SDMXUtilityData <- function(x, row.names=NULL, optional=FALSE,
labels = FALSE, ...){
return(as.data.frame.SDMXCompactData(x, labels))
}
rsdmx/R/SDMXStructureSpecificData-methods.R 0000644 0001762 0000144 00000001571 12671526740 020346 0 ustar ligges users #' @name SDMXStructureSpecificData
#' @rdname SDMXStructureSpecificData
#' @aliases SDMXStructureSpecificData,SDMXStructureSpecificData-method
#'
#' @usage
#' SDMXStructureSpecificData(xmlObj, namespaces)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @param namespaces object of class "data.frame" given the list of namespace URIs
#' @return an object of class "SDMXStructureSpecificData"
#'
#' @seealso \link{readSDMX}
#'
SDMXStructureSpecificData <- function(xmlObj, namespaces){
new("SDMXStructureSpecificData",
SDMXData(xmlObj, namespaces)
)
}
#methods
#=======
as.data.frame.SDMXStructureSpecificData <- function(x, row.names=NULL, optional=FALSE,
labels = FALSE, ...){
return(as.data.frame.SDMXAllCompactData(x, "structurespecific", labels));
}
rsdmx/R/Class-SDMXConceptScheme.R 0000644 0001762 0000144 00000006136 12671331254 016224 0 ustar ligges users #' @name SDMXConceptScheme
#' @docType class
#' @aliases SDMXConceptScheme-class
#'
#' @title Class "SDMXConceptScheme"
#' @description A basic class to handle a SDMX Concept scheme
#'
#' @slot id Object of class "character" giving the ID of the concept scheme (required)
#' @slot agencyID Object of class "character" giving the AgencyID
#' @slot version Object of class "character" giving the version
#' @slot uri Object of class "character" giving the concept uri
#' @slot urn Object of class "character" giving the concept urn
#' @slot isExternalReference Object of class "logical" indicating if the concept scheme is an external reference
#' @slot isFinal Object of class "logical" indicating if the concept scheme is final
#' @slot validFrom Object of class "character" indicating the start validity period
#' @slot validTo Object of class "character" indicating the end validity period
#' @slot Name Object of class "list" giving the concept scheme name (by language) - required
#' @slot Description Object of class "list" giving the concept scheme description (by language)
#' @slot Concept Object of class "list" giving the list of "SDMXConcept" objects (see \link{SDMXConcept})
#'
#' @section Warning:
#' This class is not useful in itself, but all SDMX non-abstract classes will
#' encapsulate it as slot, when parsing an SDMX-ML document (Concepts, or
#' DataStructureDefinition)
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
setClass("SDMXConceptScheme",
representation(
#attributes
id = "character", #required
agencyID = "character", #optional
version = "character", #optional
uri = "character", #optional
urn = "character", #optional
isExternalReference = "logical", #optional
isFinal = "logical", #optional
validFrom = "character", #optional
validTo = "character", #optional
#elements
Name = "list", #at least one
Description = "list", #optional
Concept = "list" #optional
),
prototype = list(
#attributes
id = "CONCEPTSCHEME_ID",
agencyID = "AGENCY_ID",
version = "1.0",
uri = as.character(NA),
urn = as.character(NA),
isExternalReference = FALSE,
isFinal = FALSE,
validFrom = as.character(NA),
validTo = as.character(NA),
#elements
Name = list(
en = "concept name",
fr = "nom du concept"
),
Description = list(
en = "concept description",
fr = "description du concept"
),
Concept = list()
),
validity = function(object){
#validation rules
if(.rsdmx.options$validate){
if(is.na(object@id)) return(FALSE)
if(length(object@Name) == 0) return(FALSE)
}
return(TRUE);
}
) rsdmx/R/Class-SDMXCodelist.R 0000644 0001762 0000144 00000006015 12671331154 015245 0 ustar ligges users #' @name SDMXCodelist
#' @docType class
#' @aliases SDMXCodelist-class
#'
#' @title Class "SDMXCodelist"
#' @description A basic class to handle a SDMX Codelist
#'
#' @slot id Object of class "character" giving the ID of the codelist (required)
#' @slot agencyID Object of class "character" giving the AgencyID
#' @slot version Object of class "character" giving the version
#' @slot uri Object of class "character" giving the codelist uri
#' @slot urn Object of class "character" giving the codelist urn
#' @slot isExternalReference Object of class "logical" indicating if the codelist is an external reference
#' @slot isFinal Object of class "logical" indicating if the codelist is final
#' @slot validFrom Object of class "character" indicating the start validity period
#' @slot validTo Object of class "character" indicating the end validity period
#' @slot Name Object of class "list" giving the codelist (by language) - required
#' @slot Description Object of class "list" giving the codelist description (by language)
#' @slot Code Object of class "list" giving the list of "SDMXCode" objects included in the codelist (see \link{SDMXCode})
#'
#' @section Warning:
#' This class is not useful in itself, but all SDMX non-abstract classes will
#' encapsulate it as slot, when parsing an SDMX-ML document (Codelists, or DataStructureDefinition)
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
setClass("SDMXCodelist",
representation(
#attributes
id = "character", #required
agencyID = "character", #optional
version = "character", #optional
uri = "character", #optional
urn = "character", #optional
isExternalReference = "logical", #optional
isFinal = "logical", #optional
validFrom = "character", #optional
validTo = "character", #optional
#elements
Name = "list", #at least one
Description = "list", #optional
Code = "list" #optional
),
prototype = list(
#attributes
id = "CODELIST_ID",
agencyID = "AGENCY_ID",
version = "1.0",
uri = as.character(NA),
urn = as.character(NA),
isExternalReference = FALSE,
isFinal = FALSE,
validFrom = as.character(NA),
validTo = as.character(NA),
#elements
Name = list(
en = "concept name",
fr = "nom du concept"
),
Description = list(
en = "concept description",
fr = "description du concept"
),
Code = list()
),
validity = function(object){
#eventual validation rules
if(.rsdmx.options$validate){
if(is.na(object@id)) return(FALSE)
if(length(object@Name) == 0) return(FALSE)
}
return(TRUE);
}
) rsdmx/R/Class-SDMXServiceProviders.R 0000644 0001762 0000144 00000001544 12613640174 017000 0 ustar ligges users #' @name SDMXServiceProviders
#' @docType class
#' @aliases SDMXServiceProviders-class
#'
#' @title Class "SDMXServiceProviders"
#' @description A class to wrap a list of SDMX service providers
#'
#' @slot providers an object of class "list" (of \link{SDMXServiceProvider})
#' configured by default and/or at runtime in \pkg{rsdmx}
#'
#' @section Warning:
#' this class is not useful in itself, but all SDMX non-abstract classes will
#' encapsulate it as slot, when parsing an SDMX-ML document.
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
setClass("SDMXServiceProviders",
representation(
providers = "list"
),
prototype = list(
providers = list()
),
validity = function(object){
return(TRUE);
}
)
rsdmx/R/Class-SDMXDataStructures.R 0000644 0001762 0000144 00000001623 12613633064 016455 0 ustar ligges users #' @name SDMXDataStructures
#' @docType class
#' @aliases SDMXDataStructures-class
#'
#' @title Class "SDMXDataStructures"
#' @description A basic class to handle a SDMX DataStructures (or KeyFamilies)
#'
#' @slot datastructures Object of class "list" giving the list of DataStructures,
#' (see \link{SDMXDataStructure})
#'
#' @section Warning:
#' This class is not useful in itself, but all SDMX non-abstract classes will
#' encapsulate it as slot, when parsing an SDMX-ML document (Concepts, or
#' DataStructureDefinition)
#'
#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
#'
setClass("SDMXDataStructures",
contains = "SDMX",
representation(
datastructures = "list"
),
prototype = list(),
validity = function(object){
#eventual validation rules
return(TRUE);
}
)
rsdmx/R/SDMXConcepts-methods.R 0000644 0001762 0000144 00000007760 12744362122 015663 0 ustar ligges users #' @name SDMXConcepts
#' @rdname SDMXConcepts
#' @aliases SDMXConcepts,SDMXConcepts-method
#'
#' @usage
#' SDMXConcepts(xmlObj, namespaces)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @param namespaces object of class "data.frame" given the list of namespace URIs
#' @return an object of class "SDMXConcepts"
#'
#' @seealso \link{readSDMX}
#'
SDMXConcepts <- function(xmlObj, namespaces){
new("SDMXConcepts",
SDMX(xmlObj, namespaces),
concepts = concepts.SDMXConcepts(xmlObj, namespaces),
conceptSchemes = conceptSchemes.SDMXConcepts(xmlObj, namespaces)
)
}
#get list of SDMXConcept (backward compatibility with SDMX 1.0)
#=======================
concepts.SDMXConcepts <- function(xmlObj, namespaces){
concepts <- NULL
messageNsString <- "message"
if(isRegistryInterfaceEnvelope(xmlObj, FALSE)) messageNsString <- "registry"
messageNs <- findNamespace(namespaces, messageNsString)
strNs <- findNamespace(namespaces, "structure")
sdmxVersion <- version.SDMXSchema(xmlObj, namespaces)
VERSION.21 <- sdmxVersion == "2.1"
conceptsXML <- NULL
if(VERSION.21){
conceptsXML <- getNodeSet(xmlObj,
"//mes:Structures/str:Concepts/str:Concept",
namespaces = c(mes = as.character(messageNs),
str = as.character(strNs)))
}else{
conceptsXML <- getNodeSet(xmlObj,
"//mes:Concepts/str:Concept",
namespaces = c(mes = as.character(messageNs),
str = as.character(strNs)))
}
if(!is.null(conceptsXML)){
concepts <- lapply(conceptsXML, SDMXConcept, namespaces)
}
return(concepts)
}
#get list of SDMXConceptScheme (from SDMX 2.0)
#=============================
conceptSchemes.SDMXConcepts <- function(xmlObj, namespaces){
conceptSchemes <- NULL
strNs <- findNamespace(namespaces, "structure")
conceptSchemesXML <- getNodeSet(xmlObj,
"//ns:ConceptScheme",
namespaces = strNs)
conceptSchemes <- lapply(conceptSchemesXML, SDMXConceptScheme, namespaces)
return(conceptSchemes)
}
#as.data.frame
#=============
as.data.frame.SDMXConcepts <- function(x, ...,
conceptSchemeId = NULL,
ignore.empty.slots = TRUE){
xmlObj <- x@xmlObj;
concepts <- NULL
conceptsList <- NULL
if(length(x@concepts) > 0){
conceptsList <- x@concepts
}else if(length(x@conceptSchemes) > 0){
if(is.null(conceptSchemeId) & length(x@conceptSchemes) > 0){
warning("Using first conceptScheme referenced in SDMXConcepts object: \n
Specify 'conceptSchemeId' argument for a specific conceptScheme")
conceptScheme <- x@conceptSchemes[[1]]
}else{
conceptScheme <- NULL
for(i in 1:length(x@conceptSchemes)){
cs <- x@conceptSchemes[[i]]
if(cs@id == conceptSchemeId) conceptScheme <- cs
}
}
conceptsList <- conceptScheme@Concept
}
if(!is.null(conceptsList)){
concepts <- do.call("rbind.fill",
lapply(conceptsList, function(concept){
as.data.frame(sapply(slotNames(concept), function(x){
obj <- slot(concept,x)
if(all(is.na(obj))){
obj <- switch(class(obj),
"character" = NA,
"logical" = NA,
"list" = structure(as.list(rep(NA,2)),
.Names = names(conceptsList[[1]]@Name))
)
}
return(obj)
}))
})
)
}
if(ignore.empty.slots){
concepts <- concepts[,colSums(is.na(concepts))