rsdmx/ 0000755 0001762 0000144 00000000000 12654245164 011420 5 ustar ligges users rsdmx/inst/ 0000755 0001762 0000144 00000000000 12654151640 012370 5 ustar ligges users rsdmx/inst/doc/ 0000755 0001762 0000144 00000000000 12654151640 013135 5 ustar ligges users rsdmx/inst/doc/quickstart.Rmd 0000644 0001762 0000144 00000017034 12654151640 016000 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](http://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}
devtools::install_github("opensdmx/rsdmx")
```
## Load rsdmx
To load rsdmx in R, do the following:
```{r}
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}
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}
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, message = FALSE}
sdmx <- readSDMX(agencyId = "OECD", resource = "data", flowRef = "MIG",
key = list("TOT", NULL, NULL), start = 2010, end = 2011)
df <- as.data.frame(sdmx)
head(df)
```
### 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}
#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)
### Concepts
Read concept schemes from [FAO data portal](http://data.fao.org/sdmx/index.html)
```{r, warning=FALSE}
csUrl <- "http://data.fao.org/sdmx/registry/conceptscheme/FAO/ALL/LATEST/?detail=full&references=none&version=2.1"
csobj <- readSDMX(csUrl)
csdf <- as.data.frame(csobj)
```
### Codelists
Read codelists from [FAO data portal](http://data.fao.org/sdmx/index.html)
```{r}
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}
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}
#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}
#get concepts from DSD
concepts <- as.data.frame(slot(dsd, "concepts"))
```
rsdmx/inst/doc/quickstart.R 0000644 0001762 0000144 00000004664 12654151640 015464 0 ustar ligges users ## ---- eval=FALSE---------------------------------------------------------
# devtools::install_github("opensdmx/rsdmx")
## ------------------------------------------------------------------------
library(rsdmx)
## ------------------------------------------------------------------------
myUrl <- "http://stats.oecd.org/restsdmx/sdmx.ashx/GetData/MIG/TOT../OECD?startTime=2000&endTime=2011"
dataset <- readSDMX(myUrl)
stats <- as.data.frame(dataset)
## ------------------------------------------------------------------------
providers <- getSDMXServiceProviders();
as.data.frame(providers)
## ---- message = FALSE----------------------------------------------------
sdmx <- readSDMX(agencyId = "OECD", resource = "data", flowRef = "MIG",
key = list("TOT", NULL, NULL), start = 2010, end = 2011)
df <- as.data.frame(sdmx)
head(df)
## ------------------------------------------------------------------------
#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)
## ---- warning=FALSE------------------------------------------------------
csUrl <- "http://data.fao.org/sdmx/registry/conceptscheme/FAO/ALL/LATEST/?detail=full&references=none&version=2.1"
csobj <- readSDMX(csUrl)
csdf <- as.data.frame(csobj)
## ------------------------------------------------------------------------
clUrl <- "http://data.fao.org/sdmx/registry/codelist/FAO/CL_FAO_MAJOR_AREA/0.1"
clobj <- readSDMX(clUrl)
cldf <- as.data.frame(clobj)
## ------------------------------------------------------------------------
dsdUrl <- "http://stats.oecd.org/restsdmx/sdmx.ashx/GetDataStructure/TABLE1"
dsd <- readSDMX(dsdUrl)
## ------------------------------------------------------------------------
#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")
## ------------------------------------------------------------------------
#get concepts from DSD
concepts <- as.data.frame(slot(dsd, "concepts"))
rsdmx/inst/doc/quickstart.html 0000644 0001762 0000144 00000057375 12654151640 016236 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)
## agencyId name
## 1 ECB European Central Bank
## 2 ESTAT Eurostat (Statistical office of the European Union)
## 3 OECD Organisation for Economic Cooperation and Development
## 4 FAO Food and Agriculture Organization of the United Nations
## 5 ILO International Labour Organization of the United Nations
## 6 UIS UNESCO Institute of Statistics
## 7 ABS Australian Bureau of Statistics
## 8 NBB National Bank of Belgium
## 9 INSEE Institut national de la statistique et des études économiques
## scale country
## 1 international <NA>
## 2 international <NA>
## 3 international <NA>
## 4 international <NA>
## 5 international <NA>
## 6 international <NA>
## 7 national AUS
## 8 national BEL
## 9 national FRA
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(agencyId = "OECD", resource = "data", flowRef = "MIG",
key = list("TOT", NULL, NULL), start = 2010, end = 2011)
df <- as.data.frame(sdmx)
head(df)
## CO2 VAR GEN COU attrs.df obsTime obsValue OBS_STATUS
## 1 TOT B11 WMN AUS P1Y 2010 107740 <NA>
## 2 TOT B11 WMN AUS P1Y 2011 108865 <NA>
## 3 TOT B11 TOT AUS P1Y 2010 206714 <NA>
## 4 TOT B11 TOT AUS P1Y 2011 210704 <NA>
## 5 TOT B12 TOT AUS P1Y 2010 29307 <NA>
## 6 TOT B12 TOT AUS P1Y 2011 31204 <NA>
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)
Concepts
Read concept schemes from FAO data portal
csUrl <- "http://data.fao.org/sdmx/registry/conceptscheme/FAO/ALL/LATEST/?detail=full&references=none&version=2.1"
csobj <- readSDMX(csUrl)
csdf <- as.data.frame(csobj)
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"))
rsdmx/tests/ 0000755 0001762 0000144 00000000000 12654150565 012562 5 ustar ligges users rsdmx/tests/testthat/ 0000755 0001762 0000144 00000000000 12654150565 014422 5 ustar ligges users rsdmx/tests/testthat/test_MessageGroup.R 0000644 0001762 0000144 00000001630 12654150565 020205 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)
ds <- SDMXMessageGroup(xmlObj)
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)
ds <- SDMXMessageGroup(xmlObj)
expect_is(ds, "SDMXMessageGroup")
df <- as.data.frame(ds)
expect_is(df, "data.frame")
})
rsdmx/tests/testthat/test_Header.R 0000644 0001762 0000144 00000003217 12654150565 016777 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)
obj = SDMXHeader(xmlObj)
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)
obj = SDMXHeader(xmlObj)
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 00000001113 12654150565 016502 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)
expect_true(isSoapRequestEnvelope(xmlObj))
xmlObj <- getSoapRequestResult(xmlObj)
expect_false(isSoapRequestEnvelope(xmlObj))
ds <- SDMXCompactData(xmlObj)
expect_is(ds, "SDMXCompactData")
}) rsdmx/tests/testthat/test_Type.R 0000644 0001762 0000144 00000002114 12654150565 016523 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 00000004132 12654150565 020561 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)
ds <- SDMXDataStructures(xmlObj)
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)
ds <- SDMXDataStructures(xmlObj)
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 00000002240 12654150565 022405 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)
dsd <- SDMXDataStructureDefinition(xmlObj)
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)
dsd <- SDMXDataStructureDefinition(xmlObj)
expect_is(dsd, "SDMXDataStructureDefinition")
expect_is(dsd@concepts, "SDMXConcepts")
expect_is(dsd@codelists, "SDMXCodelists")
expect_is(dsd@datastructures, "SDMXDataStructures")
})
rsdmx/tests/testthat/test_Namespaces.R 0000644 0001762 0000144 00000002001 12654150565 017654 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(c("id","uri"), colnames(namespaces))
expect_equal(12L, 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_DataFlows.R 0000644 0001762 0000144 00000002346 12654150565 017475 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)
flow <- SDMXDataFlows(xmlObj)
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")
})
rsdmx/tests/testthat/test_CompactData.R 0000644 0001762 0000144 00000001337 12654150565 017770 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)
ds <- SDMXCompactData(xmlObj)
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 00000002734 12654150565 017050 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)
obj = SDMXFooter(xmlObj)
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)
obj = SDMXFooter(xmlObj)
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 00000016351 12654150565 020160 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")
#international data providers
#ECB
#---
#-> dataflow
test_that("ECB - dataflow",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(agencyId = "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(agencyId = "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(agencyId = "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(agencyId = "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(agencyId = "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(agencyId = "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")
}
})
#OECD
#----
#-> dataflow
test_that("OECD - dataflow",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(agencyId = "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(agencyId = "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(agencyId = "OECD", resource = "data",
flowRef = "MIG", key = list("TOT", NULL, NULL), start = 2011, end = 2011)
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXMessageGroup")
}
})
#FAO (UN-FAO)
#------------
#-> datastructure
test_that("FAO - datastructure",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(agencyId = "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(agencyId = "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(agencyId = "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(agencyId = "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)
#------------
#-> datastructure
test_that("UIS - datastructure",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(agencyId = "UIS", resource = "datastructure", resourceId = "all")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataStructureDefinition")
}
})
#-> data
test_that("UIS - data",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(agencyId = "UIS", resource = "data",
flowRef = "EDULIT_DS", key = list("OFST_1_CP", NULL),
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(agencyId = "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(agencyId = "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(agencyId = "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(agencyId = "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(agencyId = "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(agencyId = "INSEE", resource = "datastructure", resourceId = "IPI-2010-A21")
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXDataStructureDefinition")
}
})
#-> data
test_that("INSEE - data",{
testthat::skip_on_travis()
testthat::skip_on_cran()
sdmx <- readSDMX(agencyId = "INSEE", resource = "data",
flowRef = "IPI-2010-A21", key = "all", key.mode = "SDMX",
start = 2010, end = 2015)
if(!is.null(sdmx)){
expect_is(sdmx, "SDMXStructureSpecificData")
}
})
rsdmx/tests/testthat/test_GenericData.R 0000644 0001762 0000144 00000005251 12654150565 017755 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)
ds <- SDMXGenericData(xmlObj)
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)
ds <- SDMXGenericData(xmlObj)
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)
ds <- SDMXGenericData(xmlObj)
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_ServiceProvider.R 0000644 0001762 0000144 00000005012 12654150565 020715 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",
handler = function(baseUrl, agencyId, resource, resourceId, version,
flowRef, key, start, end, compliant){
return(paste(baseUrl, agencyId, resource, flowRef, key, start, end, sep="/"))
},
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")
expect_equal(length(providers@providers), 9L)
expect_equal(sapply(providers@providers, function(x){slot(x,"agencyId")}),
c("ECB", "ESTAT", "OECD", "FAO", "ILO", "UIS",
"ABS", "NBB", "INSEE"))
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",
handler = function(baseUrl, agencyId, resource, resourceId, version,
flowRef, key, start, end, compliant){
return(paste(baseUrl, agencyId, resource, flowRef, key, start, end, sep="/"))
},
compliant = TRUE)
provider <- SDMXServiceProvider(
agencyId = "MYORG", name = "My Organization",
builder = requestBuilder
)
addSDMXServiceProvider(provider)
providers <- getSDMXServiceProviders()
expect_equal(length(providers@providers), 10L)
expect_equal(sapply(providers@providers, function(x){slot(x,"agencyId")}),
c("ECB", "ESTAT", "OECD", "FAO", "ILO", "UIS",
"ABS", "NBB", "INSEE", "MYORG"))
#find a provider
oecd <- findSDMXServiceProvider("OECD")
expect_is(oecd, "SDMXServiceProvider")
expect_equal(oecd@agencyId, "OECD")
})
rsdmx/tests/testthat/test_Codelists.R 0000644 0001762 0000144 00000001650 12654150565 017537 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)
codelists <- SDMXCodelists(xmlObj)
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)
codelists <- SDMXCodelists(xmlObj)
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 00000004704 12654150565 016475 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")
})
rsdmx/tests/testthat/test_Concepts.R 0000644 0001762 0000144 00000002751 12654150565 017367 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)
concepts <- SDMXConcepts(xmlObj)
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)
concepts <- SDMXConcepts(xmlObj)
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)
concepts <- SDMXConcepts(xmlObj)
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 00000002136 12654150565 017006 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)
test_that("version.SDMXSchema - 2.0",{
schema1 = version.SDMXSchema(xmlObj1)
expect_equal(schema1, "2.0")
})
test_that("version.SDMXSchema - 2.1",{
schema2 = version.SDMXSchema(xmlObj2)
expect_equal(schema2, "2.1")
})
test_that("SDMXSchema - 2.0",{
obj1 = SDMXSchema(xmlObj1)
expect_is(obj1, "SDMXSchema")
})
test_that("SDMXSchema - 2.1",{
obj2 = SDMXSchema(xmlObj2)
expect_is(obj2, "SDMXSchema")
})
test_that("getVersion - 2.0",{
obj1 = SDMXSchema(xmlObj1)
expect_equal(obj1@version, "2.0")
})
test_that("getVersion - 2.1",{
obj2 = SDMXSchema(xmlObj2)
expect_equal(obj2@version, "2.1")
})
rsdmx/tests/testthat/test_RequestBuilder.R 0000644 0001762 0000144 00000004455 12654150565 020553 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("SDMXRequestBuilder",{
request <- SDMXRequestBuilder(
regUrl = "http://www.myorg.org/registry",
repoUrl = "http://www.myorg.org/repository",
handler = function(regUrl, repoUrl, agencyId, resource, resourceId, version,
flowRef, key, start, end, compliant){
return(paste(repoUrl, agencyId, resource, flowRef, key, start, end, sep="/"))
},
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@handler, "function")
expect_equal(request@compliant, TRUE)
webRequest <- request@handler(regUrl = "http://www.myorg.org/registry", repoUrl = "http://www.myorg.org/repository",
agencyId = "MYORG", resource = "data", flowRef = "FLOW", resourceId = NULL,
key = "KEY", start = 2000, end = 2010, compliant = TRUE)
expect_equal(webRequest, "http://www.myorg.org/repository/MYORG/data/FLOW/KEY/2000/2010")
})
test_that("SDMXRESTRequestBuilder",{
request <- SDMXRESTRequestBuilder(regUrl = "http://www.myorg.org/registry",
repoUrl = "http://www.myorg.org/repository",
compliant = TRUE)
expect_is(request, "SDMXRESTRequestBuilder")
expect_equal(request@regUrl, "http://www.myorg.org/registry")
expect_equal(request@repoUrl, "http://www.myorg.org/repository")
expect_is(request@handler, "function")
expect_equal(request@compliant, TRUE)
webRequest <- request@handler(regUrl = "http://www.myorg.org/registry", repoUrl = "http://www.myorg.org/repository",
agencyId = "MYORG", resource = "data", flowRef = "FLOW", resourceId = NULL,
key = "KEY", start = 2000, end = 2010, compliant = TRUE)
expect_equal(webRequest, "http://www.myorg.org/repository/data/FLOW/KEY/all?startPeriod=2000&endPeriod=2010")
})
rsdmx/tests/testthat/test_CrossSectionalData.R 0000644 0001762 0000144 00000001102 12654150565 021323 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)
ds <- SDMXCrossSectionalData(xmlObj)
expect_is(ds, "SDMXCrossSectionalData")
df <- as.data.frame(ds)
expect_is(df, "data.frame")
}) rsdmx/tests/testthat/test_StructureSpecificData.R 0000644 0001762 0000144 00000001223 12654150565 022042 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)
ds <- SDMXStructureSpecificData(xmlObj)
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 12654150565 014432 0 ustar ligges users library(testthat)
test_check("rsdmx") rsdmx/NAMESPACE 0000644 0001762 0000144 00000004247 12654150565 012646 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,
SDMXGenericData,
SDMXCompactData,
SDMXUtilityData,
SDMXStructureSpecificData,
SDMXCrossSectionalData,
SDMXMessageGroup,
SDMXConcept,
SDMXConceptScheme,
SDMXConcepts,
SDMXCode,
SDMXCodelist,
SDMXCodelists,
SDMXDimension,
SDMXTimeDimension,
SDMXPrimaryMeasure,
SDMXAttribute,
SDMXComponents,
SDMXDataStructure,
SDMXDataStructures,
SDMXDataStructureDefinition,
SDMXDataFlow,
SDMXDataFlows,
SDMXRequestBuilder,
SDMXRESTRequestBuilder,
SDMXServiceProvider,
SDMXServiceProviders
)
export(
SDMX,
SDMXSchema,
SDMXHeader,
SDMXFooterMessage,
SDMXFooter,
SDMXType,
SDMXStructureType,
SDMXGenericData,
SDMXCompactData,
SDMXUtilityData,
SDMXStructureSpecificData,
SDMXCrossSectionalData,
SDMXMessageGroup,
SDMXConcept,
SDMXConceptScheme,
SDMXConcepts,
SDMXCode,
SDMXCodelist,
SDMXCodelists,
SDMXDimension,
SDMXTimeDimension,
SDMXPrimaryMeasure,
SDMXAttribute,
SDMXComponents,
SDMXDataStructure,
SDMXDataStructures,
SDMXDataStructureDefinition,
SDMXDataFlow,
SDMXDataFlows,
SDMXRequestBuilder,
SDMXRESTRequestBuilder,
SDMXServiceProvider,
SDMXServiceProviders,
findNamespace,
isSoapRequestEnvelope,
getSoapRequestResult,
addSDMXServiceProvider,
findSDMXServiceProvider,
setSDMXServiceProviders,
getSDMXServiceProviders,
readSDMX
)
exportMethods(
getStructureType,
getNamespaces
)
S3method(as.data.frame, SDMXGenericData)
S3method(as.data.frame, SDMXCompactData)
S3method(as.data.frame, SDMXUtilityData)
S3method(as.data.frame, SDMXStructureSpecificData)
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, SDMXDataFlows)
S3method(as.data.frame, SDMXServiceProviders) rsdmx/R/ 0000755 0001762 0000144 00000000000 12654150565 011621 5 ustar ligges users rsdmx/R/Class-SDMXMessageGroup.R 0000644 0001762 0000144 00000001250 12654150565 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 = "SDMX",
representation(),
prototype = list(),
validity = function(object){
#eventual validation rules
return(TRUE);
}
)
rsdmx/R/SDMXDataStructureDefinition-methods.R 0000644 0001762 0000144 00000001202 12654150565 020677 0 ustar ligges users #' @name SDMXDataStructureDefinition
#' @rdname SDMXDataStructureDefinition
#' @aliases SDMXDataStructureDefinition,SDMXDataStructureDefinition-method
#'
#' @usage
#' SDMXDataStructureDefinition(xmlObj)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @return an object of class "SDMXDataStructureDefinition"
#'
#' @seealso \link{readSDMX}
#'
SDMXDataStructureDefinition <- function(xmlObj){
new("SDMXDataStructureDefinition",
SDMX(xmlObj),
concepts = SDMXConcepts(xmlObj),
codelists = SDMXCodelists(xmlObj),
datastructures = SDMXDataStructures(xmlObj)
)
} rsdmx/R/Class-SDMX.R 0000644 0001762 0000144 00000003111 12654150565 013556 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);
}
)
rsdmx/R/Class-SDMXStructureType.R 0000644 0001762 0000144 00000002253 12654150565 016347 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}
#'
setClass("SDMXStructureType",
contains = "SDMXType",
representation(subtype = "character"),
prototype = list(),
validity = function(object){
type <- getStructureType(object);
valid <- switch(type,
"DataflowsType" = TRUE,
"ConceptsType" = TRUE,
"CodelistsType" = TRUE,
"DataStructuresType" = TRUE,
"DataStructureDefinitionsType" = TRUE,
FALSE
);
if(valid == FALSE)
warning(paste("Unknown SDMXStructureType '", type, "'", sep=""));
return(valid);
}
)
rsdmx/R/SDMXPrimaryMeasure-methods.R 0000644 0001762 0000144 00000007374 12654150565 017061 0 ustar ligges users #' @name SDMXPrimaryMeasure
#' @rdname SDMXPrimaryMeasure
#' @aliases SDMXPrimaryMeasure,SDMXPrimaryMeasure-method
#'
#' @usage
#' SDMXPrimaryMeasure(xmlObj)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @return an object of class "SDMXPrimaryMeasure"
#'
#' @seealso \link{readSDMX}
#'
SDMXPrimaryMeasure <- function(xmlObj){
sdmxVersion <- version.SDMXSchema(xmlDoc(xmlObj))
VERSION.21 <- sdmxVersion == "2.1"
namespaces <- namespaces.SDMX(xmlDoc(xmlObj))
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 00000001511 12654150565 013077 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-1\cr
#' Date: \tab 2016-01-19\cr
#' License: \tab GPL(>=2.0)\cr
#' LazyLoad: \tab yes\cr
#' }
#'
#'@author Emmanuel Blondel \email{emmanuel.blondel1@@gmail.com}
#'
NULL rsdmx/R/Class-SDMXPrimaryMeasure.R 0000644 0001762 0000144 00000004517 12654150565 016457 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(is.na(object@conceptRef)) return(FALSE)
return(TRUE);
}
)
rsdmx/R/SDMXServiceProviders-methods.R 0000644 0001762 0000144 00000002055 12654150565 017401 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){
c(slot(provider,"agencyId"), slot(provider, "name"),
slot(provider, "scale"), slot(provider, "country"))
})),
stringsAsFactors = FALSE)
colnames(out) <- c("agencyId", "name", "scale", "country")
return(out)
}
setAs("SDMXGenericData", "data.frame",
function(from) {as.data.frame.SDMXServiceProviders(from)}); rsdmx/R/Class-SDMXCodelists.R 0000644 0001762 0000144 00000001416 12654150565 015436 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 00000001702 12654150565 015022 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){
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 00000006001 12654150565 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){
#validation rules
if(is.na(object@id)) return(FALSE)
if(length(object@Name) == 0) return(FALSE)
return(TRUE);
}
) rsdmx/R/SDMX-methods.R 0000644 0001762 0000144 00000011527 12654150565 014166 0 ustar ligges users #' @name SDMX
#' @rdname SDMX
#' @aliases SDMX,SDMX-method
#'
#' @usage
#' SDMX(xmlObj)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @return an object of class "SDMX"
#'
#' @seealso \link{readSDMX}
SDMX <- function(xmlObj){
schema <- SDMXSchema(xmlObj);
header <- SDMXHeader(xmlObj);
footer <- SDMXFooter(xmlObj);
new("SDMX",
xmlObj = xmlObj,
schema = schema,
header = header,
footer = footer);
}
#functions
namespaces.SDMX <- function(xmlObj){
nsFromXML <- xmlNamespaceDefinitions(xmlObj, recursive = TRUE, simplify = FALSE)
nsDefs.df <- do.call("rbind",
lapply(nsFromXML,
function(x){
c(x$id, x$uri)
}))
row.names(nsDefs.df) <- 1:nrow(nsDefs.df)
nsDefs.df <-as.data.frame(nsDefs.df, stringAsFactors = FALSE)
if(nrow(nsDefs.df) > 0){
colnames(nsDefs.df) <- c("id","uri")
nsDefs.df$id <- as.character(nsDefs.df$id)
nsDefs.df$uri <- as.character(nsDefs.df$uri)
}
nsDefs.df <- unique(nsDefs.df)
nsDefs.df <- nsDefs.df[!duplicated(nsDefs.df$uri),]
return(nsDefs.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 id and uri of
#' namespaces 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)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @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 <- namespaces.SDMX(xmlObj)
ns <- c(ns = namespaces$uri[grep("soap", namespaces$uri)])
return(length(ns) > 0)
}
#' @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)
}
rsdmx/R/Class-SDMXSchema.R 0000644 0001762 0000144 00000001750 12654150565 014706 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){
VERSION <- object@version;
valid <- switch(VERSION,
"1.0" = TRUE,
"2.0" = TRUE,
"2.1" = TRUE,
FALSE
);
if(valid == FALSE)
warning(paste("SDMXSchema version ", VERSION," not supported by RSDMX",
sep=""));
return(valid);
}
)
rsdmx/R/SDMXMessageGroup-methods.R 0000644 0001762 0000144 00000004332 12654150565 016504 0 ustar ligges users #' @name SDMXMessageGroup
#' @rdname SDMXMessageGroup
#' @aliases SDMXMessageGroup,SDMXMessageGroup-method
#'
#' @usage
#' SDMXMessageGroup(xmlObj)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @return an object of class "SDMXMessageGroup"
#'
#' @seealso \link{readSDMX}
#'
SDMXMessageGroup <- function(xmlObj){
new("SDMXMessageGroup",
SDMX(xmlObj)
)
}
#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
& regexpr("http://www.w3.org", nsDefs.df$uri,
"match.length", ignore.case = TRUE) == -1,]
ns <- ns.df$uri
if(length(ns) > 1) ns <- ns[1L]
authorityNs <- nsDefs.df[nsDefs.df$uri == ns,]
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){
seriesKeyXML <- getNodeSet(xmlObj, "//ns:SeriesKey", c(ns = nsDefs.df[1,"uri"]))
}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, ...){
#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),
"SDMXCompactData" = as.data.frame.SDMXCompactData(x),
NULL
)
return(sdmx.df)
}
setAs("SDMXMessageGroup", "data.frame",
function(from) as.data.frame.SDMXMessageGroup(from));
rsdmx/R/Class-SDMXStructureSpecificData.R 0000644 0001762 0000144 00000001323 12654150565 017742 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 = "SDMX",
representation(),
prototype = list(),
validity = function(object){
#eventual validation rules
return(TRUE);
}
)
rsdmx/R/SDMXConcept-methods.R 0000644 0001762 0000144 00000006373 12654150565 015505 0 ustar ligges users #' @name SDMXConcept
#' @rdname SDMXConcept
#' @aliases SDMXConcept,SDMXConcept-method
#'
#' @usage
#' SDMXConcept(xmlObj)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @return an object of class "SDMXConcept"
#'
#' @seealso \link{readSDMX}
#'
SDMXConcept <- function(xmlObj){
sdmxVersion <- version.SDMXSchema(xmlDoc(xmlObj))
VERSION.21 <- sdmxVersion == "2.1"
namespaces <- namespaces.SDMX(xmlDoc(xmlObj))
messageNs <- findNamespace(namespaces, "message")
strNs <- findNamespace(namespaces, "structure")
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")
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")
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 00000010102 12654150565 016253 0 ustar ligges users #' @name SDMXCompactData
#' @rdname SDMXCompactData
#' @aliases SDMXCompactData,SDMXCompactData-method
#'
#' @usage
#' SDMXCompactData(xmlObj)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @return an object of class "SDMXCompactData"
#'
#' @seealso \link{readSDMX}
#'
SDMXCompactData <- function(xmlObj){
new("SDMXCompactData",
SDMX(xmlObj)
)
}
#methods
as.data.frame.SDMXAllCompactData <- function(x, nsExpr, ...) {
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)
authorityNs <- nsDefs.df[
regexpr("http://www.sdmx.org", nsDefs.df$uri,
"match.length", ignore.case = TRUE) == -1
& regexpr("http://www.w3.org", nsDefs.df$uri,
"match.length", ignore.case = TRUE) == -1,]
if(nrow(authorityNs) > 0){
hasAuthorityNS <- TRUE
if(nrow(authorityNs) > 1){
warning("More than one target dataset namespace found!")
authorityNs <- authorityNs[1L,]
}
}
if(hasAuthorityNS){
seriesXML <- getNodeSet(xmlObj, "//ns:Series", namespaces = c(ns = authorityNs$uri))
if(length(seriesXML) == 0){
seriesXML <- getNodeSet(xmlObj, "//ns:Series", namespaces = ns)
}
}else{
if(length(ns) > 0){
seriesXML <- getNodeSet(xmlObj, "//ns:Series", namespaces = ns)
}else{
if(nrow(nsDefs.df) > 0){
serieNs <- nsDefs.df[1,]
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)
# output
return(dataset)
}
as.data.frame.SDMXCompactData <- function(x, ...){
return(as.data.frame.SDMXAllCompactData(x, "compact"));
}
setAs("SDMXCompactData", "data.frame",
function(from) as.data.frame.SDMXCompactData(from));
rsdmx/R/Class-SDMXUtilityData.R 0000644 0001762 0000144 00000001241 12654150565 015736 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 = "SDMX",
representation(),
prototype = list(),
validity = function(object){
#eventual validation rules
return(TRUE);
}
)
rsdmx/R/Class-SDMXDataStructureDefinition.R 0000644 0001762 0000144 00000002704 12654150565 020311 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 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(
concepts = "SDMXConcepts",
codelists = "SDMXCodelists",
datastructures = "SDMXDataStructures"
),
prototype = list(
concepts = new("SDMXConcepts"),
codelists = new("SDMXCodelists"),
datastructures = new("SDMXDataStructures")
),
validity = function(object){
#eventual validation rules
return(TRUE);
}
) rsdmx/R/SDMXComponents-methods.R 0000644 0001762 0000144 00000010126 12654150565 016226 0 ustar ligges users #' @name SDMXComponents
#' @rdname SDMXComponents
#' @aliases SDMXComponents,SDMXComponents-method
#'
#' @usage
#' SDMXComponents(xmlObj)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @return an object of class "SDMXComponents"
#'
#' @seealso \link{readSDMX}
#'
SDMXComponents <- function(xmlObj){
new("SDMXComponents",
Dimensions = dimensions.SDMXComponents(xmlObj),
TimeDimension = timedimension.SDMXComponents(xmlObj),
PrimaryMeasure = primarymeasure.SDMXComponents(xmlObj),
Attributes = attributes.SDMXComponents(xmlObj)
)
}
#get list of SDMXDimension
#=========================
dimensions.SDMXComponents <- function(xmlObj){
dimensions <- NULL
sdmxVersion <- version.SDMXSchema(xmlDoc(xmlObj))
VERSION.21 <- sdmxVersion == "2.1"
namespaces <- namespaces.SDMX(xmlDoc(xmlObj))
strNs <- findNamespace(namespaces, "structure")
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, function(x){ SDMXDimension(x)})
}
return(dimensions)
}
#get SDMXTimeDimension
#=====================
timedimension.SDMXComponents <- function(xmlObj){
timedimension <- NULL
sdmxVersion <- version.SDMXSchema(xmlDoc(xmlObj))
VERSION.21 <- sdmxVersion == "2.1"
namespaces <- namespaces.SDMX(xmlDoc(xmlObj))
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)
}
return(timedimension)
}
#get SDMXPrimaryMeasure
#======================
primarymeasure.SDMXComponents <- function(xmlObj){
primarymeasure <- NULL
sdmxVersion <- version.SDMXSchema(xmlDoc(xmlObj))
VERSION.21 <- sdmxVersion == "2.1"
namespaces <- namespaces.SDMX(xmlDoc(xmlObj))
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)
}
return(primarymeasure)
}
#get list of SDMXAttribute
#=========================
attributes.SDMXComponents <- function(xmlObj){
attributes <- NULL
sdmxVersion <- version.SDMXSchema(xmlDoc(xmlObj))
VERSION.21 <- sdmxVersion == "2.1"
namespaces <- namespaces.SDMX(xmlDoc(xmlObj))
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, function(x){ SDMXDimension(x)})
}
return(attributes)
} rsdmx/R/Class-SDMXConcepts.R 0000644 0001762 0000144 00000002431 12654150565 015261 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 00000012646 12654150565 016656 0 ustar ligges users #' @name SDMXTimeDimension
#' @rdname SDMXTimeDimension
#' @aliases SDMXTimeDimension,SDMXTimeDimension-method
#'
#' @usage
#' SDMXTimeDimension(xmlObj)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @return an object of class "SDMXTimeDimension"
#'
#' @seealso \link{readSDMX}
#'
SDMXTimeDimension <- function(xmlObj){
sdmxVersion <- version.SDMXSchema(xmlDoc(xmlObj))
VERSION.21 <- sdmxVersion == "2.1"
namespaces <- namespaces.SDMX(xmlDoc(xmlObj))
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 12654150565 015637 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/profile.R 0000644 0001762 0000144 00000000250 12654150565 013401 0 ustar ligges users .onLoad <- function (libname, pkgname) { # nocov start
assign(".rsdmx.options", new.env(), envir= asNamespace(pkgname))
setSDMXServiceProviders()
} # nocov end
rsdmx/R/SDMXConceptScheme-methods.R 0000644 0001762 0000144 00000007621 12654150565 016627 0 ustar ligges users #' @name SDMXConceptScheme
#' @rdname SDMXConceptScheme
#' @aliases SDMXConceptScheme,SDMXConceptScheme-method
#'
#' @usage
#' SDMXConceptScheme(xmlObj)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @return an object of class "SDMXConceptScheme"
#'
#' @seealso \link{readSDMX}
#'
SDMXConceptScheme <- function(xmlObj){
sdmxVersion <- version.SDMXSchema(xmlDoc(xmlObj))
VERSION.21 <- sdmxVersion == "2.1"
namespaces <- namespaces.SDMX(xmlDoc(xmlObj))
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)
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 <- NULL
if(length(conceptNamesXML) > 0){
conceptNames <- new.env()
sapply(conceptNamesXML,
function(x){
lang <- xmlGetAttr(x,"xml:lang")
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")
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, function(x){ SDMXConcept(x)})
}
#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/SDMXCode-methods.R 0000644 0001762 0000144 00000004017 12654150565 014755 0 ustar ligges users #' @name SDMXCode
#' @rdname SDMXCode
#' @aliases SDMXCode,SDMXCode-method
#'
#' @usage
#' SDMXCode(xmlObj)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @return an object of class "SDMXCode"
#'
#' @seealso \link{readSDMX}
#'
SDMXCode <- function(xmlObj){
sdmxVersion <- version.SDMXSchema(xmlDoc(xmlObj))
VERSION.21 <- sdmxVersion == "2.1"
namespaces <- namespaces.SDMX(xmlDoc(xmlObj))
messageNs <- findNamespace(namespaces, "message")
strNs <- findNamespace(namespaces, "structure")
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 <- "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/SDMXDataStructures-methods.R 0000644 0001762 0000144 00000007400 12654150565 017057 0 ustar ligges users #' @name SDMXDataStructures
#' @rdname SDMXDataStructures
#' @aliases SDMXDataStructures,SDMXDataStructures-method
#'
#' @usage
#' SDMXDataStructures(xmlObj)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @return an object of class "SDMXDataStructures"
#'
#' @seealso \link{readSDMX}
#'
SDMXDataStructures <- function(xmlObj){
new("SDMXDataStructures",
SDMX(xmlObj),
datastructures = datastructures.SDMXDataStructures(xmlObj)
)
}
#get list of SDMXDataStructure
#=============================
datastructures.SDMXDataStructures <- function(xmlObj){
datastructures <- NULL
sdmxVersion <- version.SDMXSchema(xmlObj)
VERSION.21 <- sdmxVersion == "2.1"
namespaces <- namespaces.SDMX(xmlObj)
messageNs <- findNamespace(namespaces, "message")
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, function(x){ SDMXDataStructure(x)})
}
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 <- 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"),
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(out)
}
setAs("SDMXDataStructures", "data.frame",
function(from) as.data.frame.SDMXDataStructures(from)); rsdmx/R/SDMXCodelist-methods.R 0000644 0001762 0000144 00000010730 12654150565 015650 0 ustar ligges users #' @name SDMXCodelist
#' @rdname SDMXCodelist
#' @aliases SDMXCodelist,SDMXCodelist-method
#'
#' @usage
#' SDMXCodelist(xmlObj)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @return an object of class "SDMXCodelist"
#'
#' @seealso \link{readSDMX}
#'
SDMXCodelist <- function(xmlObj){
sdmxVersion <- version.SDMXSchema(xmlDoc(xmlObj))
VERSION.21 <- sdmxVersion == "2.1"
namespaces <- namespaces.SDMX(xmlDoc(xmlObj))
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)
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 <- NULL
if(length(codelistNamesXML) > 0){
codelistNames <- new.env()
sapply(codelistNamesXML,
function(x){
lang <- xmlGetAttr(x,"xml:lang")
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")
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, function(x){ SDMXCode(x)})
}
#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 00000003460 12654150565 016251 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){
# deactivated standard compliance (convenience because of data providers' typos)
#if(!is.na(object@severity)){
# severityTypes <- c("Error", "Warning", "Information")
# if(!(object@severity %in% severityTypes)) return(FALSE);
#}
return(TRUE);
}
) rsdmx/R/SDMXGenericData-methods.R 0000644 0001762 0000144 00000017304 12654150565 016254 0 ustar ligges users #' @name SDMXGenericData
#' @rdname SDMXGenericData
#' @aliases SDMXGenericData,SDMXGenericData-method
#'
#' @usage
#' SDMXGenericData(xmlObj)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @return an object of class "SDMXGenericData"
#'
#' @seealso \link{readSDMX}
#'
SDMXGenericData <- function(xmlObj){
new("SDMXGenericData",
SDMX(xmlObj)
)
}
#methods
as.data.frame.SDMXGenericData <- function(x, ...){
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")
}
seriesNb <- length(seriesXML)
if(seriesNb == 0) return(NULL);
conceptId <- "concept"
if(VERSION.21) conceptId <- "id"
#serie keys
keysXML <- getNodeSet(xmlDoc(getNodeSet(xmlObj,
"//ns:SeriesKey",
namespaces = ns)[[1]]),
"//ns:Value",
namespaces = ns)
keysNames <- 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)
}))
}
#serie 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 <- c(keysNames, "Time", "ObsValue")
if(!is.null(obsAttrsNames)) serieNames <- c(serieNames, obsAttrsNames)
if(!is.null(serieAttrsNames)) serieNames <- c(serieNames, serieAttrsNames)
#obs parser function
parseObs <- function(obs){
obsXML <- xmlDoc(obs)
#time
timeElement <- "Time"
if(VERSION.21) timeElement <- "ObsDimension"
obsTimeXML <- getNodeSet(obsXML,
paste("//ns:",timeElement,sep=""),
namespaces=ns)[[1]]
obsTime <- NA
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(xmlGetAttr(obsValueXML, "value"))
}
obsValue <- as.data.frame(obsValue)
#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) && any(obsAttrs.df == "NULL")){
obsAttrs.df[obsAttrs.df == "NULL"] <- NA
}
}
}
#output
obsR <- cbind(obsTime, obsValue)
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
keyValuesXML <- getNodeSet(serieXML,
"//ns:SeriesKey/ns:Value",
namespaces = ns)
keyValues <- sapply(keyValuesXML, function(x){
as.character(xmlGetAttr(x, "value"))
})
keyNames <- sapply(keyValuesXML, function(x){
as.character(xmlGetAttr(x, conceptId))
})
keydf <- structure(keyValues, .Names = keyNames)
keydf <- as.data.frame(lapply(keydf, as.character), stringsAsFactors=FALSE)
if(!is.null(obsdf)){
keydf <- keydf[rep(row.names(keydf), nrow(obsdf)),]
if(class(keydf) == "data.frame"){
row.names(keydf) <- 1:nrow(obsdf)
colnames(keydf) <- keyNames
}
}
#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(row.names(attrs.df), nrow(obsdf)),]
if(is(attrs.df, "data.frame")){
row.names(attrs.df) <- 1:nrow(obsdf)
colnames(attrs.df) <- attrsNames
}
}
}
}
#single Serie as DataFrame
serie <- keydf
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 to a DataFrame R object
dataset <- do.call("rbind.fill", lapply(seriesXML, function(x){
serie <- parseSerie(x)
}))
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)) row.names(dataset) <- 1:nrow(dataset)
# output
return(dataset)
}
setAs("SDMXGenericData", "data.frame",
function(from) as.data.frame.SDMXGenericData(from));
rsdmx/R/SDMXStructureType-methods.R 0000644 0001762 0000144 00000005250 12654150565 016745 0 ustar ligges users #' @name SDMXStructureType
#' @rdname SDMXStructureType
#' @aliases SDMXStructureType,SDMXStructureType-method
#'
#' @usage
#' SDMXStructureType(xmlObj, resource)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @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, resource){
new("SDMXStructureType",
SDMXType(xmlObj),
subtype = type.SDMXStructureType(xmlObj, resource));
}
type.SDMXStructureType <- function(xmlObj, resource){
sdmxVersion <- version.SDMXSchema(xmlObj)
VERSION.21 <- sdmxVersion == "2.1"
namespaces <- namespaces.SDMX(xmlObj)
messageNs <- findNamespace(namespaces, "message")
strNs <- findNamespace(namespaces, "structure")
if(VERSION.21){
flowXML <- getNodeSet(xmlObj, "//ns:DataFlows", namespaces = strNs)
dsXML <- getNodeSet(xmlObj, "//ns:DataStructures", namespaces = strNs)
ccXML <- getNodeSet(xmlObj, "//ns:Concepts", namespaces = strNs)
clXML <- getNodeSet(xmlObj, "//ns:Codelists", namespaces = strNs)
if(all(c(length(dsXML)>0,length(ccXML)>0,length(clXML)>0))){
return("DataStructureDefinitionsType")
}else{
#others
structuresXML <- getNodeSet(xmlObj, "//ns:Structures", namespaces = messageNs)
strType <- paste(xmlName(xmlChildren(structuresXML[[1]])[[1]]), "Type", sep="")
return(strType)
}
}else{
#TODO flowXML
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
return("DataStructureDefinitionsType")
}else{
#others
if(length(ccXML)>0) return("ConceptsType")
if(length(clXML)>0) return("CodelistsType")
if(length(dsXML)>0){
strType <- switch(resource,
"dataflow" = "DataflowsType",
"datastructure" = "DataStructuresType",
NULL = "DataStructuresType")
return(strType)
}
}
}
return(NULL)
}
#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 00000007435 12654150565 015776 0 ustar ligges users #' @name SDMXDataFlows
#' @rdname SDMXDataFlows
#' @aliases SDMXDataFlows,SDMXDataFlows-method
#'
#' @usage
#' SDMXDataFlows(xmlObj)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @return an object of class "SDMXDataFlows"
#'
#' @seealso \link{readSDMX}
#'
SDMXDataFlows <- function(xmlObj){
new("SDMXDataFlows",
SDMX(xmlObj),
dataflows = dataflows.SDMXDataFlows(xmlObj)
)
}
#get list of SDMXDataFlow
#=============================
dataflows.SDMXDataFlows <- function(xmlObj){
dataflows <- NULL
sdmxVersion <- version.SDMXSchema(xmlObj)
VERSION.21 <- sdmxVersion == "2.1"
namespaces <- namespaces.SDMX(xmlObj)
messageNs <- findNamespace(namespaces, "message")
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:KeyFamilies/str:KeyFamily",
namespaces = c(mes = as.character(messageNs),
str = as.character(strNs)))
}
if(!is.null(dfXML)){
dataflows <- lapply(dfXML, function(x){ SDMXDataFlow(x)})
}
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(datflow.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(out)
}
setAs("SDMXDataFlows", "data.frame",
function(from) as.data.frame.SDMXDataFlows(from)); rsdmx/R/Class-SDMXFooter.R 0000644 0001762 0000144 00000002372 12654150565 014745 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 00000000766 12654150565 015674 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 = "SDMX",
representation(),
prototype = list(),
validity = function(object){
#eventual validation rules
return(TRUE);
}
)
rsdmx/R/SDMXFooterMessage-methods.R 0000644 0001762 0000144 00000001704 12654150565 016646 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 00000001504 12654150565 015337 0 ustar ligges users #' @name SDMXFooter
#' @rdname SDMXFooter
#' @aliases SDMXFooter,SDMXFooter-method
#'
#' @usage
#' SDMXFooter(xmlObj)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @return an object of class "SDMXFooter"
#'
#' @seealso \link{readSDMX}
SDMXFooter <- function(xmlObj){
messageList = list()
#check presence of footer
nsDefs.df <- namespaces.SDMX(xmlObj)
ns <- findNamespace(nsDefs.df, "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 00000006066 12654150565 016305 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(is.na(object@id)) return(FALSE)
if(length(object@Name) == 0) return(FALSE)
return(TRUE);
}
) rsdmx/R/Class-SDMXRequestBuilder.R 0000644 0001762 0000144 00000002760 12654150565 016447 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 handler an object of class "function" 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
#'
#' @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",
handler = "function",
compliant = "logical"
),
prototype = list(
regUrl = "http://www.myorg.org/sdmx/registry",
repoUrl = "http://www.myorg.org/sdmx/repository",
handler = function(regUrl, repUrl, agencyId){
paste(regUrl, agencyId,sep="/")
},
compliant = TRUE
),
validity = function(object){
return(TRUE);
}
)
rsdmx/R/readSDMX.R 0000644 0001762 0000144 00000026121 12654150565 013355 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,
#' provider, agencyId, resource, resourceId, version,
#' flowRef, key, key.mode, start, end)
#'
#' @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 provider an object of class "SDMXServiceProvider". If specified,
#' \code{file} and \code{isURL} arguments will be ignored.
#' @param agencyId an object of class "character" representing a provider id.
#' It has to be match a default provider as listed in\code{getSDMXServiceProviders()}
#' @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.
#'
#' @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(agencyId = "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/..PC.FOS1.BE/?startperiod=2011&endPeriod=2011",
#' sep = "")
#' sdmx <- readSDMX(url)
#' stats <- as.data.frame(sdmx)
#' head(stats)
#'
#' ## End(**Not run**)
#' }
#'
#' # SDMX Concepts / ConceptSchemes
#' #-------------------------------
#' \donttest{
#' # Not run by 'R CMD check'
#' # (reliable remote datasource but with possible occasional unavailability)
#' csUrl <- paste("http://data.fao.org/sdmx/registry/conceptscheme",
#' "/FAO/ALL/LATEST/?detail=full&references=none&version=2.1",
#' sep = "")
#' csobj <- readSDMX(csUrl)
#' csdf <- as.data.frame(csobj)
#' head(csdf)
#' ## End(**Not run**)
#' }
#'
#' # SDMX Codelists
#' #---------------
#' \donttest{
#' # Not run by 'R CMD check'
#' # (reliable remote datasource but with possible occasional unavailability)
#' clUrl <- "http://data.fao.org/sdmx/registry/codelist/FAO/CL_FAO_MAJOR_AREA/0.1"
#' clobj <- readSDMX(clUrl)
#' cldf <- as.data.frame(clobj)
#' head(cldf)
#' ## 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(agencyId = "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,
provider = NULL, agencyId = NULL, resource = NULL, resourceId = NULL, version = NULL,
flowRef = NULL, key = NULL, key.mode = "R", start = NULL, end = NULL) {
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(!is.null(provider)){
if(class(provider) != "SDMXServiceProvider"){
stop("Provider should be an instance of 'SDMXServiceProvider'")
}
buildRequest <- TRUE
}
if(!is.null(agencyId)){
provider <- findSDMXServiceProvider(agencyId)
if(is.null(provider)){
stop("No provider with identifier ", agencyId)
}
buildRequest <- TRUE
}
#proceed with the request build
if(buildRequest){
if(key.mode == "R" && !missing(key) && !is.null(key)){
key <- paste(sapply(key, paste, collapse = "+"), collapse=".")
}
if(is.null(resource)) stop("SDMX service resource cannot be null")
file <- provider@builder@handler(
regUrl = provider@builder@regUrl,
repoUrl = provider@builder@repoUrl,
agencyId = provider@agencyId,
resource = resource,
resourceId = resourceId,
version = version,
flowRef = flowRef,
key = key,
start = start,
end = end,
compliant = provider@builder@compliant)
message(file)
}
#call readSDMX original
if(is.null(file)) stop("Empty file argument")
if(buildRequest) isURL = TRUE
#load data
status <- 0
if(isURL == FALSE){
if(!file.exists(file))
stop("File ", file, "not found\n")
xmlObj <- xmlTreeParse(file, useInternalNodes = TRUE)
status <- 1
}else{
rsdmxAgent <- paste("rsdmx/",as.character(packageVersion("rsdmx")),sep="")
content <- getURL(file, httpheader = list('User-Agent' = rsdmxAgent),
ssl.verifypeer = FALSE, .encoding = "UTF-8")
status <- tryCatch({
if(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)
}
xmlObj <- xmlTreeParse(content, useInternalNodes = TRUE)
status <- 1
}else{
stop("The SDMX web-request failed. Please retry")
}
},error = function(err){
print(err)
status <<- 0
return(status)
})
}
#internal function for SDMX Structure-based document
getSDMXStructureObject <- function(xmlObj, resource){
strTypeObj <- SDMXStructureType(xmlObj, resource)
strType <- getStructureType(strTypeObj)
strObj <- switch(strType,
"DataflowsType" = SDMXDataFlows(xmlObj),
"ConceptsType" = SDMXConcepts(xmlObj),
"CodelistsType" = SDMXCodelists(xmlObj),
"DataStructuresType" = SDMXDataStructures(xmlObj),
"DataStructureDefinitionsType" = SDMXDataStructureDefinition(xmlObj),
NULL
)
return(strObj)
}
#encapsulate in S4 object
obj <- NULL
if(status){
#convenience for SDMX documents embedded in SOAP XML responses
if(isSoapRequestEnvelope(xmlObj)){
xmlObj <- getSoapRequestResult(xmlObj)
}
type <- SDMXType(xmlObj)@type
obj <- switch(type,
"StructureType" = getSDMXStructureObject(xmlObj, resource),
"GenericDataType" = SDMXGenericData(xmlObj),
"CompactDataType" = SDMXCompactData(xmlObj),
"UtilityDataType" = SDMXUtilityData(xmlObj),
"StructureSpecificDataType" = SDMXStructureSpecificData(xmlObj),
"CrossSectionalDataType" = SDMXCrossSectionalData(xmlObj),
"MessageGroupType" = SDMXMessageGroup(xmlObj),
NULL
)
if(is.null(obj)){
if(type == "StructureType"){
strTypeObj <- SDMXStructureType(xmlObj, 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)
}
)
})
)
}
}
}
return(obj);
}
rsdmx/R/Class-SDMXCrossSectionalData.R 0000644 0001762 0000144 00000001030 12654150565 017222 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 = "SDMX",
representation(),
prototype = list(),
validity = function(object){
#eventual validation rules
return(TRUE);
}
)
rsdmx/R/SDMXServiceProvider-methods.R 0000644 0001762 0000144 00000024232 12654150565 017217 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 <- SDMXRESTRequestBuilder(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
listOfProviders <- list(
#international data providers
#----------------------------
#ECB
SDMXServiceProvider(
agencyId = "ECB", name = "European Central Bank",
builder = SDMXRESTRequestBuilder(
regUrl = "https://sdw-wsrest.ecb.europa.eu/service",
repoUrl = "https://sdw-wsrest.ecb.europa.eu/service",
compliant = TRUE)
),
#EUROSTAT
SDMXServiceProvider(
agencyId = "ESTAT", name = "Eurostat (Statistical office of the European Union)",
builder = SDMXRESTRequestBuilder(
regUrl = "http://ec.europa.eu/eurostat/SDMX/diss-web/rest",
repoUrl = "http://ec.europa.eu/eurostat/SDMX/diss-web/rest",
compliant = TRUE)
),
#OECD
SDMXServiceProvider(
agencyId = "OECD", name = "Organisation for Economic Cooperation and Development ",
builder = SDMXRESTRequestBuilder(
regUrl = "http://stats.oecd.org/restsdmx/sdmx.ashx",
repoUrl = "http://stats.oecd.org/restsdmx/sdmx.ashx",
compliant = FALSE)
),
#UN-FAO
SDMXServiceProvider(
agencyId = "FAO", name = "Food and Agriculture Organization of the United Nations",
builder = SDMXRESTRequestBuilder(
regUrl = "http://data.fao.org/sdmx/registry",
repoUrl = "http://data.fao.org/sdmx/repository",
compliant = TRUE,
unsupportedResources = list("dataflow"))
),
#UN-ILO
SDMXServiceProvider(
agencyId = "ILO", name = "International Labour Organization of the United Nations",
builder = SDMXRESTRequestBuilder(
regUrl = "http://www.ilo.org/ilostat/sdmx/ws/rest",
repoUrl = "http://www.ilo.org/ilostat/sdmx/ws/rest",
compliant = TRUE, skipAgencyId = TRUE,
unsupportedResources = list("dataflow"))
),
#UIS (UNESCO)
SDMXServiceProvider(
agencyId = "UIS", name = "UNESCO Institute of Statistics",
builder = SDMXRESTRequestBuilder(
regUrl = "http://data.uis.unesco.org/RestSDMX/sdmx.ashx",
repoUrl = "http://data.uis.unesco.org/RestSDMX/sdmx.ashx",
compliant = TRUE,
unsupportedResources = list("dataflow"))
),
#national data providers
#-----------------------
#ABS {Australia}
SDMXServiceProvider(
agencyId = "ABS", name = "Australian Bureau of Statistics",
scale = "national", country = "AUS",
builder = SDMXRESTRequestBuilder(
regUrl = "http://stat.abs.gov.au/restsdmx/sdmx.ashx",
repoUrl = "http://stat.abs.gov.au/restsdmx/sdmx.ashx",
compliant = FALSE, forceAgencyId = TRUE,
unsupportedResources = list("dataflow"))
),
#NBB {Belgium}
SDMXServiceProvider(
agencyId = "NBB", name = "National Bank of Belgium",
scale = "national", country = "BEL",
builder = SDMXRESTRequestBuilder(
regUrl = "http://stat.nbb.be/RestSDMX/sdmx.ashx",
repoUrl = "http://stat.nbb.be/RestSDMX/sdmx.ashx",
compliant = FALSE,
unsupportedResources = list("dataflow"))
),
#INSEE {France}
SDMXServiceProvider(
agencyId = "INSEE", name = "Institut national de la statistique et des \u00e9tudes \u00e9conomiques",
scale = "national", country = "FRA",
builder = SDMXRESTRequestBuilder(
regUrl = "http://www.bdm.insee.fr/series/sdmx",
repoUrl = "http://www.bdm.insee.fr/series/sdmx",
compliant = TRUE)
)
)
.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 <- SDMXRESTRequestBuilder(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){
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 00000001237 12654150565 015654 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 = "SDMX",
representation(),
prototype = list(),
validity = function(object){
#eventual validation rules
return(TRUE);
}
)
rsdmx/R/SDMXDataStructure-methods.R 0000644 0001762 0000144 00000010525 12654150565 016676 0 ustar ligges users #' @name SDMXDataStructure
#' @rdname SDMXDataStructure
#' @aliases SDMXDataStructure,SDMXDataStructure-method
#'
#' @usage
#' SDMXDataStructure(xmlObj)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @return an object of class "SDMXDataStructure"
#'
#' @seealso \link{readSDMX}
#'
SDMXDataStructure <- function(xmlObj){
sdmxVersion <- version.SDMXSchema(xmlDoc(xmlObj))
VERSION.21 <- sdmxVersion == "2.1"
namespaces <- namespaces.SDMX(xmlDoc(xmlObj))
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 <- NULL
if(length(dsNamesXML) > 0){
dsNames <- new.env()
sapply(dsNamesXML,
function(x){
lang <- xmlGetAttr(x,"xml:lang")
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")
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)
#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 00000001614 12654150565 015303 0 ustar ligges users #' @name SDMXSchema
#' @rdname SDMXSchema
#' @aliases SDMXSchema,SDMXSchema-method
#'
#' @usage
#' SDMXSchema(xmlObj)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @return an object of class "SDMXSchema"
#'
#' @seealso \link{readSDMX}
#'
SDMXSchema <- function(xmlObj) {
new("SDMXSchema", version = version.SDMXSchema(xmlObj));
}
#default functions
version.SDMXSchema <- function(xmlObj){
nsDefs.df <- namespaces.SDMX(xmlObj)
ns.df <- nsDefs.df[
regexpr("http://www.sdmx.org", nsDefs.df$uri,
"match.length", ignore.case = TRUE) == 1
& regexpr("http://www.w3.org", nsDefs.df$uri,
"match.length", ignore.case = TRUE) == -1,]
parsed <- strsplit(ns.df[1,]$uri,"/")[[1]];
schemaVersion <- gsub("_",".",substr(parsed[substr(parsed,0,1)=="v"],2,nchar(parsed,"w")));
return(schemaVersion);
}
rsdmx/R/SDMXUtilityData-methods.R 0000644 0001762 0000144 00000001202 12654150565 016331 0 ustar ligges users #' @name SDMXUtilityData
#' @rdname SDMXUtilityData
#' @aliases SDMXUtilityData,SDMXUtilityData-method
#'
#' @usage
#' SDMXUtilityData(xmlObj)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @return an object of class "SDMXUtilityData"
#'
#' @seealso \link{readSDMX}
#'
SDMXUtilityData <- function(xmlObj){
new("SDMXUtilityData",
SDMX(xmlObj)
)
}
#methods
#=======
as.data.frame.SDMXUtilityData <- function(x, ...){
return(as.data.frame.SDMXCompactData(x))
}
setAs("SDMXUtilityData", "data.frame",
function(from) as.data.frame.SDMXUtilityData(from));
rsdmx/R/SDMXStructureSpecificData-methods.R 0000644 0001762 0000144 00000001412 12654150565 020337 0 ustar ligges users #' @name SDMXStructureSpecificData
#' @rdname SDMXStructureSpecificData
#' @aliases SDMXStructureSpecificData,SDMXStructureSpecificData-method
#'
#' @usage
#' SDMXStructureSpecificData(xmlObj)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @return an object of class "SDMXStructureSpecificData"
#'
#' @seealso \link{readSDMX}
#'
SDMXStructureSpecificData <- function(xmlObj){
new("SDMXStructureSpecificData",
SDMX(xmlObj)
)
}
#methods
#=======
as.data.frame.SDMXStructureSpecificData <- function(x, ...){
return(as.data.frame.SDMXAllCompactData(x, "structurespecific"));
}
setAs("SDMXStructureSpecificData", "data.frame",
function(from) as.data.frame.SDMXStructureSpecificData(from));
rsdmx/R/Class-SDMXConceptScheme.R 0000644 0001762 0000144 00000006013 12654150565 016223 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(is.na(object@id)) return(FALSE)
if(length(object@Name) == 0) return(FALSE)
return(TRUE);
}
) rsdmx/R/Class-SDMXCodelist.R 0000644 0001762 0000144 00000005705 12654150565 015260 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(is.na(object@id)) return(FALSE)
if(length(object@Name) == 0) return(FALSE)
return(TRUE);
}
) rsdmx/R/Class-SDMXServiceProviders.R 0000644 0001762 0000144 00000001544 12654150565 017005 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 12654150565 016462 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 00000007422 12654150565 015664 0 ustar ligges users #' @name SDMXConcepts
#' @rdname SDMXConcepts
#' @aliases SDMXConcepts,SDMXConcepts-method
#'
#' @usage
#' SDMXConcepts(xmlObj)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @return an object of class "SDMXConcepts"
#'
#' @seealso \link{readSDMX}
#'
SDMXConcepts <- function(xmlObj){
new("SDMXConcepts",
SDMX(xmlObj),
concepts = concepts.SDMXConcepts(xmlObj),
conceptSchemes = conceptSchemes.SDMXConcepts(xmlObj)
)
}
#get list of SDMXConcept (backward compatibility with SDMX 1.0)
#=======================
concepts.SDMXConcepts <- function(xmlObj){
concepts <- NULL
sdmxVersion <- version.SDMXSchema(xmlObj)
VERSION.21 <- sdmxVersion == "2.1"
namespaces <- namespaces.SDMX(xmlObj)
messageNs <- findNamespace(namespaces, "message")
strNs <- findNamespace(namespaces, "structure")
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, function(x){ SDMXConcept(x)})
}
return(concepts)
}
#get list of SDMXConceptScheme (from SDMX 2.0)
#=============================
conceptSchemes.SDMXConcepts <- function(xmlObj){
conceptSchemes <- NULL
namespaces <- namespaces.SDMX(xmlObj)
strNs <- findNamespace(namespaces, "structure")
conceptSchemesXML <- getNodeSet(xmlObj,
"//ns:ConceptScheme",
namespaces = strNs)
conceptSchemes <- lapply(conceptSchemesXML, function(x){ SDMXConceptScheme(x)})
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))