Add support for tagged missing values in reader

Author: hadley

src/DfReader.cpp

@@ -6,6 +6,29 @@
 using namespace Rcpp;
 #include "readstat.h"
 #include "haven_types.h"
+#include "tagged_na.h"
+
+// Wrappers around readstat_*_value that convert missing values to appropriate
+// R sentinel values -----------------------------------------------------------
+
+double haven_double_value(readstat_value_t value) {
+  if (readstat_value_is_missing(value)) {
+    return make_tagged_na(readstat_value_tag(value));
+  } else {
+    return readstat_double_value(value);
+  }
+}
+
+double haven_float_value(readstat_value_t value) {
+  if (readstat_value_is_missing(value)) {
+    return make_tagged_na(readstat_value_tag(value));
+  } else {
+    return readstat_float_value(value);
+  }
+}
+
+
+// LabelSet -------------------------------------------------------------------
 
 class LabelSet {
   std::vector<std::string> labels_;
@@ -97,6 +120,8 @@ class LabelSet {
   }
 };
 
+// DfReader ------------------------------------------------------------------
+
 class DfReader {
   FileType type_;
   int nrows_, ncols_;
@@ -218,19 +243,10 @@ class DfReader {
       }
     } else if (value.type == READSTAT_TYPE_FLOAT) {
       NumericVector col = output_[var_index];
-      if (readstat_value_is_missing(value)) {
-        col[obs_index] = NA_REAL;
-      } else {
-        col[obs_index] = adjustDatetimeToR(type_, var_type, readstat_float_value(value));
-      }
+      col[obs_index] = adjustDatetimeToR(type_, var_type, haven_float_value(value));
     } else if (value.type == READSTAT_TYPE_DOUBLE) {
       NumericVector col = output_[var_index];
-      if (readstat_value_is_missing(value)) {
-        col[obs_index] = NA_REAL;
-      } else {
-        double val = readstat_double_value(value);
-        col[obs_index] = std::isnan(val) ? NA_REAL : adjustDatetimeToR(type_, var_type, val);
-      }
+      col[obs_index] = adjustDatetimeToR(type_, var_type, haven_double_value(value));
     }
 
     return 0;
@@ -258,7 +274,7 @@ class DfReader {
       label_set.add(readstat_int32_value(value), label_s, is_missing);
       break;
     case READSTAT_TYPE_DOUBLE:
-      label_set.add(readstat_double_value(value), label_s, is_missing);
+      label_set.add(haven_double_value(value), label_s, is_missing);
       break;
     default:
       Rf_warning("Unsupported label type: %s", value.type);

src/haven_types.h

@@ -2,6 +2,7 @@
 #define __HAVEN_TYPES__
 
 #include <Rcpp.h>
+#include <cmath>
 
 enum FileType {
   HAVEN_SPSS,
@@ -94,6 +95,9 @@ inline int daysOffset(FileType type) {
 }
 
 inline double adjustDatetimeToR(FileType file, VarType var, double value) {
+  if (std::isnan(value))
+    return value;
+
   double offset = daysOffset(file);
 
   switch(var) {
@@ -111,6 +115,9 @@ inline double adjustDatetimeToR(FileType file, VarType var, double value) {
 }
 
 inline double adjustDatetimeFromR(FileType file, SEXP col, double value) {
+  if (std::isnan(value))
+    return value;
+
   double offset = daysOffset(file);
 
   switch(numType(col)) {

src/tagged_na.c

@@ -31,7 +31,7 @@ const int TAG_BYTE = 3;
 const int TAG_BYTE = 4;
 #endif
 
-inline double make_tagged_na(char x) {
+double make_tagged_na(char x) {
   ieee_double y;
 
   y.value = NA_REAL;
@@ -40,7 +40,7 @@ inline double make_tagged_na(char x) {
   return y.value;
 }
 
-inline char tagged_na_value(double x) {
+char tagged_na_value(double x) {
   ieee_double y;
   y.value = x;
 

src/tagged_na.h

@@ -0,0 +1,15 @@
+#ifndef __TAGGED_NA__
+#define __TAGGED_NA__
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+double make_tagged_na(char x);
+char tagged_na_value(double x);
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif

tests/testthat/tagged-na.sas7bcat

@@ -30,3 +30,11 @@ test_that("date times are converted into corresponding R types", {
   expect_equal(df$VAR5[1], hms::hms(52932))
 
 })
+
+test_that("tagged missings are read correctly", {
+  x <- read_sas(test_path("tagged-na.sas7bdat"), test_path("tagged-na.sas7bcat"))$x
+  expect_equal(na_tag(x), c(rep(NA, 5), "A", "H", "Z"))
+
+  labels <- attr(x, "labels")
+  expect_equal(na_tag(labels), c("A", "Z"))
+})