<< Rcomplex. fix #187

ChangeLog

@@ -1,3 +1,7 @@
+2015-11-11  Qiang Kou <qkou@umail.iu.edu>
+
+        * include/Rcpp/complex.h: operator<< for Rcomplex
+
 2015-11-08  Daniel C. Dillon  <dcdillon@gmail.com>
 
         * inst/include/Rcpp/Nullable.h: No longer prevent assignment of

inst/include/Rcpp/complex.h

@@ -65,4 +65,8 @@ inline bool operator==( const Rcomplex& a, const Rcomplex& b){
     return a.r == b.r && a.i == b.i ;
 }
 
+inline std::ostream & operator<<(std::ostream &os, const Rcomplex& cplx ){
+    return os << cplx.r << "+" << cplx.i << "i" ;
+}
+
 #endif

inst/unitTests/cpp/misc.cpp

@@ -107,6 +107,28 @@ void test_rcout(std::string tfile, std::string teststring) {
     testfile.close();
 }
 
+// [[Rcpp::export]]
+void test_rcout_rcomplex(std::string tfile, SEXP rc) {
+    Rcomplex rx = Rcpp::as<Rcomplex>(rc);
+    // define and open testfile
+    std::ofstream testfile(tfile.c_str());
+
+    // save output buffer of the Rcout stream
+    std::streambuf* Rcout_buffer = Rcout.rdbuf();
+
+    // redirect ouput into testfile
+    Rcout.rdbuf( testfile.rdbuf() );
+
+    // write a test string to the file
+    Rcout << rx << std::endl;
+
+    // restore old output buffer
+    Rcout.rdbuf(Rcout_buffer);
+
+    // close testfile
+    testfile.close();
+}
+
 // [[Rcpp::export]]
 LogicalVector na_proxy() {
     CharacterVector s("foo");

inst/unitTests/runit.misc.R

@@ -118,6 +118,23 @@ if (.runThisTest) {
         checkEquals( readLines(rcppfile), readLines(rfile), msg="Rcout output")    
     }
 
+    test.rcout.complex <- function(){
+
+        rcppfile <- tempfile()
+        rfile <- tempfile()
+
+        z <- complex(real=sample(1:10, 1), imaginary=sample(1:10, 1))
+
+        ## write to test_rcpp.txt from Rcpp
+        test_rcout_rcomplex(rcppfile,  z )
+
+        ## write to test_r.txt from R
+        cat( z, file=rfile, sep='\n' )
+
+        ## compare whether the two files have the same data
+        checkEquals( readLines(rcppfile), readLines(rfile), msg="Rcout Rcomplex")    
+    }
+
     test.na_proxy <- function(){
         checkEquals( 
             na_proxy(),