Add interop code and tests

Author: JohnMount

DESCRIPTION

@@ -31,6 +31,7 @@ Suggests:
     DBI,
     RSQLite,
     knitr,
-    RUnit
+    RUnit,
+    yaml
 VignetteBuilder: knitr
 ByteCompile: true

NAMESPACE

@@ -37,7 +37,9 @@ export(build_pivot_control)
 export(build_pivot_control_q)
 export(build_unpivot_control)
 export(check_cols_form_unique_keys)
+export(convert_cdata_spec_to_yaml)
 export(convert_records)
+export(convert_yaml_to_cdata_spec)
 export(draw_frame)
 export(get_transform_details)
 export(layout_by)
@@ -62,6 +64,7 @@ export(rowrecs_to_blocks_spec)
 export(rows_are_uniquely_keyed)
 export(run_cdata_tests)
 export(unpivot_to_blocks)
+importFrom(methods,is)
 importFrom(methods,setGeneric)
 importFrom(rqdatatable,ex_data_table)
 importFrom(stats,as.formula)

R/cdata_yaml.R

@@ -1,4 +1,7 @@
 
+#' @importFrom methods is
+NULL
+
 convert_yaml_to_data_frame <- function(obj) {
   n <- length(obj)
   if (n<1) {
@@ -18,6 +21,15 @@ convert_yaml_to_data_frame <- function(obj) {
   return(d)
 }
 
+convert_data_frame_to_yaml <- function(d) {
+  lst = list()
+  for(n in colnames(d)) {
+    lst[[n]] <- d[[n]]
+  }
+  return(lst)
+}
+
+
 convert_yaml_to_record_spec <- function(obj) {
   record_keys <- NULL
   control_table_keys <- NULL
@@ -33,6 +45,7 @@ convert_yaml_to_record_spec <- function(obj) {
               'control_table' = control_table))
 }
 
+
 #' Read a cdata record transform from a simple object (such as is imported from YAML).
 #'
 #' @param obj object to convert
@@ -52,11 +65,11 @@ convert_yaml_to_cdata_spec <- function(obj) {
   # TODO: work on check/strict options
   if ((!is.null(blocks_in)) && (!is.null(blocks_out))) {
     # TODO: work on recordKeys point
-    return(cdata::layout_specification(incoming_shape = blocks_in$control_table,
-                                       outgoing_shape = blocks_out$control_table,
-                                       recordKeys = blocks_in$record_keys,
-                                       incoming_controlTableKeys = blocks_in$control_table_keys,
-                                       outgoing_controlTableKeys = blocks_out$control_table_keys))
+    return(layout_specification(incoming_shape = blocks_in$control_table,
+                                outgoing_shape = blocks_out$control_table,
+                                recordKeys = blocks_in$record_keys,
+                                incoming_controlTableKeys = blocks_in$control_table_keys,
+                                outgoing_controlTableKeys = blocks_out$control_table_keys))
   }
   if (!is.null(blocks_in)) {
     return(blocks_to_rowrecs_spec(controlTable = blocks_in$control_table,
@@ -71,4 +84,41 @@ convert_yaml_to_cdata_spec <- function(obj) {
   return(NULL)
 }
 
-# TODO: cdata to yaml
+
+#' Convert a layout_specification, blocks_to_rowrecs_spec, or rowrecs_to_blocks_spec to a simple object.
+#'
+#' @param spec a layout_specification, blocks_to_rowrecs_spec, or rowrecs_to_blocks_spec
+#' @return a simple object suitable for YAML serialization
+#'
+#' @export
+#'
+convert_cdata_spec_to_yaml <- function(spec) {
+  if(is(spec, "blocks_to_rowrecs_spec")) {
+    return(list(
+      blocks_in = list(
+        record_keys = spec$recordKeys,
+        control_table_keys = spec$controlTableKeys,
+        control_table = spec$controlTable
+      )
+    ))
+  }
+  if(is(spec, "rowrecs_to_blocks_spec")) {
+    return(list(
+      blocks_out = list(
+        record_keys = spec$recordKeys,
+        control_table_keys = spec$controlTableKeys,
+        control_table = spec$controlTable
+      )
+    ))
+  }
+  if(is(spec, "cdata_general_transform_spec")) {
+    blocks_in = convert_cdata_spec_to_yaml(spec$blocks_to_rowrecs_spec)
+    blocks_out = convert_cdata_spec_to_yaml(spec$rowrecs_to_blocks_spec)
+    return(list(
+      blocks_in = blocks_in$blocks_in,
+      blocks_out = blocks_out$blocks_out
+    ))
+  }
+  stop(paste("unexpected class: ", paste(class(spec), collapse = ', ')))
+}
+

inst/unit_tests/test_encode.R

@@ -0,0 +1,107 @@
+
+
+test_encode <- function() {
+  d = data.frame(x = 1:3,
+                 y = c('a', 'b', 'c'),
+                 stringsAsFactors = FALSE)
+
+  d_simple <- cdata:::convert_data_frame_to_yaml(d)
+  d_back1 <- cdata:::convert_yaml_to_data_frame(d_simple)
+  RUnit::checkEquals(d, d_back1)
+
+  row_keys <- c('id', 'Species')
+
+  block_record <- wrapr::qchar_frame(
+    "Part" , "Measure", "Value"      |
+    "Petal", "Length" , Petal.Length |
+    "Petal", "Width"  , Petal.Width  |
+    "Sepal", "Length" , Sepal.Length |
+    "Sepal", "Width"  , Sepal.Width  )
+  block_keys <- c('Part', 'Measure')
+
+  brtrrs <- blocks_to_rowrecs_spec(controlTable = block_record,
+                                  recordKeys = row_keys,
+                                  controlTableKeys = block_keys)
+  rrtbrs <- rowrecs_to_blocks_spec(controlTable = block_record,
+                                  recordKeys = row_keys,
+                                  controlTableKeys = block_keys)
+
+  incoming_shape <- qchar_frame(
+    "row",  "col1", "col2", "col3" |
+      "row1",   v11,     v12,  v13   |
+      "row2",   v21,     v22,  v23   |
+      "row3",   v31,     v32,  v33   )
+
+
+  outgoing_shape <- qchar_frame(
+    "column", "row1", "row2", "row3" |
+      "col1",      v11,  v21  ,  v31   |
+      "col2",      v12,  v22  ,  v32   |
+      "col3",      v13,  v23  ,  v33   )
+
+  brtbrts <- layout_specification(
+    incoming_shape = incoming_shape,
+    outgoing_shape = outgoing_shape,
+    recordKeys = 'record_id')
+
+  brtrrs_simple <- convert_cdata_spec_to_yaml(brtrrs)
+  brtrrs_back <- convert_yaml_to_cdata_spec(brtrrs_simple)
+  RUnit::checkEquals(format(brtrrs), format(brtrrs_back))
+
+  rrtbrs_simple <- convert_cdata_spec_to_yaml(rrtbrs)
+  rrtbrs_back <- convert_yaml_to_cdata_spec(rrtbrs_simple)
+  RUnit::checkEquals(format(rrtbrs), format(rrtbrs_back))
+
+  brtbrts_simple <- convert_cdata_spec_to_yaml(brtbrts)
+  brtbrts_back <- convert_yaml_to_cdata_spec(brtbrts_simple)
+  RUnit::checkEquals(format(brtbrts), format(brtbrts_back))
+
+  if(requireNamespace('yaml', quietly = TRUE)) {
+    brtrrs_yaml <- yaml::as.yaml(brtrrs_simple)
+    brtrrs_back_y <- convert_yaml_to_cdata_spec(yaml::read_yaml(text = brtrrs_yaml))
+    RUnit::checkEquals(format(brtrrs), format(brtrrs_back_y))
+
+    rrtbrs_yaml <- yaml::as.yaml(rrtbrs_simple)
+    rrtbrs_back_y <- convert_yaml_to_cdata_spec(yaml::read_yaml(text = rrtbrs_yaml))
+    RUnit::checkEquals(format(rrtbrs), format(rrtbrs_back_y))
+
+    brtbrts_yaml <- yaml::as.yaml(brtbrts_simple)
+    brtbrts_back_y <- convert_yaml_to_cdata_spec(yaml::read_yaml(text = brtbrts_yaml))
+    RUnit::checkEquals(format(brtbrts), format(brtbrts_back_y))
+  }
+
+  invisible(NULL)
+}
+
+test_read_from_data_algebra <- function() {
+  text = '
+type: data_algebra.cdata_impl.RecordMap
+blocks_out:
+  type: data_algebra.cdata.RecordSpecification
+  record_keys:
+  - id
+  - Species
+  control_table_keys:
+  - Part
+  - Measure
+  control_table:
+    Part:
+    - Petal
+    - Petal
+    - Sepal
+    - Sepal
+    Measure:
+    - Length
+    - Width
+    - Length
+    - Width
+    Value:
+    - Petal.Length
+    - Petal.Width
+    - Sepal.Length
+    - Sepal.Width
+'
+  xform = convert_yaml_to_cdata_spec(yaml::read_yaml(text = text))
+  RUnit::checkTrue(is(xform, "rowrecs_to_blocks_spec"))
+}
+