#84 support for dataset enrichment with labels

opensdmx · Feb 10, 2016 · d0c9917 · d0c9917
1 parent 09b2c4c
commit d0c9917
Show file tree

Hide file tree

Showing 9 changed files with 76 additions and 14 deletions.
diff --git a/R/SDMXCodelists-methods.R b/R/SDMXCodelists-methods.R
@@ -85,7 +85,7 @@ as.data.frame.SDMXCodelists <- function(x, ...,
                           as.data.frame(sapply(slotNames(code), function(x){
                             obj <- slot(code,x)
                             return(obj)
-                          }))
+                          }), stringsAsFactors = FALSE)
                         })
     )
   }

diff --git a/R/SDMXCompactData-methods.R b/R/SDMXCompactData-methods.R
@@ -17,7 +17,7 @@ SDMXCompactData <- function(xmlObj){
 }
 
 #methods
-as.data.frame.SDMXAllCompactData <- function(x, nsExpr, ...) {
+as.data.frame.SDMXAllCompactData <- function(x, nsExpr, labels = FALSE, ...) {
   xmlObj <- x@xmlObj;
   dataset <- NULL
 
@@ -122,13 +122,20 @@ as.data.frame.SDMXAllCompactData <- function(x, nsExpr, ...) {
   }
   if(!is.null(dataset)) row.names(dataset) <- 1:nrow(dataset)
 
-  # output
+  #enrich with labels
+  if(labels){
+    message("we are going to enrich the data.frame")
+    dsd <- slot(x, "dsd")
+    if(!is.null(dsd)) dataset <- addLabels.SDMXData(dataset, dsd)
+  }
+
+  #output
   return(dataset)
 }
 
 
-as.data.frame.SDMXCompactData <- function(x, ...){
-  return(as.data.frame.SDMXAllCompactData(x, "compact"));
+as.data.frame.SDMXCompactData <- function(x, labels = FALSE, ...){
+  return(as.data.frame.SDMXAllCompactData(x, "compact", labels));
 }
 
 setAs("SDMXCompactData", "data.frame",

diff --git a/R/SDMXCrossSectionalData-methods.R b/R/SDMXCrossSectionalData-methods.R
@@ -19,7 +19,7 @@ SDMXCrossSectionalData <- function(xmlObj){
 #methods
 #=======
 
-as.data.frame.SDMXCrossSectionalData <- function(x, ...){
+as.data.frame.SDMXCrossSectionalData <- function(x, labels = FALSE, ...){
 
   xmlObj <- x@xmlObj;
   dataset <- NULL
@@ -140,6 +140,13 @@ as.data.frame.SDMXCrossSectionalData <- function(x, ...){
   }
   if(!is.null(dataset)) row.names(dataset) <- 1:nrow(dataset)
 
+  #enrich with labels
+  if(labels){
+    message("we are going to enrich the data.frame")
+    dsd <- slot(x, "dsd")
+    if(!is.null(dsd)) dataset <- addLabels.SDMXData(dataset, dsd)
+  }
+
   # output
   return(dataset)
 }

diff --git a/R/SDMXData-methods.R b/R/SDMXData-methods.R
@@ -50,6 +50,39 @@ dsdRef.SDMXData <- function(xmlObj){
   return(dsdRef)
 }
 
+#ENRICH DATA WITH LABELS
+#=======================
+addLabels.SDMXData <- function(data, dsd){
+
+  ds <- slot(slot(dsd,"datastructures"), "datastructures")[[1]]
+  components <- slot(ds, "Components")
+  components <- as.data.frame(components)
+
+  #function to enrich a column with its labels
+  enrichColumnWithLabels <- function(column, dsd, components){
+
+    datac <- as.data.frame(data[,column], stringsAsFactors = FALSE)
+    colnames(datac) <- column
+    clName <- components[components$conceptRef == column, "codelist"]
+    if(length(clName) != 0 && !is.na(clName) && !is.null(clName)){
+      cl <- as.data.frame(slot(sdmx.dsd, "codelists"), codelistId = clName)
+      datac = merge(x = datac, y = cl, by.x = column, by.y = "id",
+                    all.x = TRUE, all.y = FALSE)
+      datac <- datac[,((regexpr("label", colnames(datac)) != -1) + 
+                         (colnames(datac) == column) == 1)]
+      colnames(datac)[regexpr("label",colnames(datac)) != -1] <- paste0(column,
+      "_",colnames(datac)[regexpr("label",colnames(datac)) != -1])
+    }
+
+    return(datac)
+
+  }
+
+  fulldata <- do.call("cbind" ,lapply(columns, enrichColumnWithLabels,
+                                      dsd, components))
+  return(fulldata)
+}
+
 
 #' @name setDSD
 #' @docType methods

diff --git a/R/SDMXGenericData-methods.R b/R/SDMXGenericData-methods.R
@@ -17,7 +17,7 @@ SDMXGenericData <- function(xmlObj){
 }
 
 #methods
-as.data.frame.SDMXGenericData <- function(x, ...){
+as.data.frame.SDMXGenericData <- function(x, labels = FALSE, ...){
   xmlObj <- x@xmlObj;
   dataset <- NULL
 
@@ -236,6 +236,12 @@ as.data.frame.SDMXGenericData <- function(x, ...){
   }
   if(!is.null(dataset)) row.names(dataset) <- 1:nrow(dataset)
 
+  #enrich with labels
+  if(labels){
+    dsd <- slot(x, "dsd")
+    if(!is.null(dsd)) dataset <- addLabels.SDMXData(dataset, dsd)
+  }
+
   # output
   return(dataset)
 }

diff --git a/R/SDMXMessageGroup-methods.R b/R/SDMXMessageGroup-methods.R
@@ -60,13 +60,13 @@ class.SDMXMessageGroup <- function(xmlObj){
 
 }
 
-as.data.frame.SDMXMessageGroup <- function(x, ...){
+as.data.frame.SDMXMessageGroup <- function(x, labels = FALSE, ...){
   #TODO support for other included message types
   #(at now limited to SDMXGenericData for making it work with OECD)
   xmlObj <- slot(x, "xmlObj")
   sdmx.df <- switch(class.SDMXMessageGroup(xmlObj),
-                    "SDMXGenericData" = as.data.frame.SDMXGenericData(x),
-                    "SDMXCompactData" = as.data.frame.SDMXCompactData(x),
+                    "SDMXGenericData" = as.data.frame.SDMXGenericData(x, labels),
+                    "SDMXCompactData" = as.data.frame.SDMXCompactData(x, labels),
                     NULL
              )
   return(sdmx.df)

diff --git a/R/SDMXStructureSpecificData-methods.R b/R/SDMXStructureSpecificData-methods.R
@@ -19,8 +19,8 @@ SDMXStructureSpecificData <- function(xmlObj){
 #methods
 #=======
 
-as.data.frame.SDMXStructureSpecificData <- function(x, ...){
-  return(as.data.frame.SDMXAllCompactData(x, "structurespecific"));
+as.data.frame.SDMXStructureSpecificData <- function(x, labels = FALSE, ...){
+  return(as.data.frame.SDMXAllCompactData(x, "structurespecific", labels));
 }
 
 setAs("SDMXStructureSpecificData", "data.frame",

diff --git a/R/SDMXUtilityData-methods.R b/R/SDMXUtilityData-methods.R
@@ -19,8 +19,8 @@ SDMXUtilityData <- function(xmlObj){
 #methods
 #=======
 
-as.data.frame.SDMXUtilityData <- function(x, ...){
-  return(as.data.frame.SDMXCompactData(x))
+as.data.frame.SDMXUtilityData <- function(x,labels = FALSE, ...){
+  return(as.data.frame.SDMXCompactData(x, labels))
 }
 
 setAs("SDMXUtilityData", "data.frame",

diff --git a/tests/testthat/test_Data.R b/tests/testthat/test_Data.R
@@ -38,3 +38,12 @@ test_that("DSD is properly fetched by readSDMX when there is no dsdRef (using fl
   expect_false(is.null(slot(data,"dsd")))
   expect_is(slot(data,"dsd"), "SDMXDataStructureDefinition")
 })
+
+test_that("Dataset is correctly enriched with labels using the DSD",{
+  sdmx.data <- readSDMX(agencyId = "UIS", resource = "data",
+                        flowRef = "EDULIT_DS", key = list("OFST_1_CP", NULL),
+                        start = "2000", end = "2015", dsd = TRUE)
+  data <- as.data.frame(sdmx.data)
+  data.enriched <- as.data.frame(sdmx.data, labels = TRUE)
+  expect_true(ncol(data.enriched) > ncol(data))
+})