Add in warning when DataFrame created will have incorrect rows.

With this commit, if after a push_back the row count of the DataFrame would
be invalid, a warning is generated. The type is then not coerced to a
DataFrame, but left as a list.

In future, this could instead `stop()`.

Author: waltersom

inst/include/Rcpp/DataFrame.h

@@ -86,25 +86,25 @@ namespace Rcpp{
 	template <typename T>
         void push_back( const T& object){
             Parent::push_back(object);
-            set__(Parent::get__());
+            set_type_after_push();
         }
 
         template <typename T>
         void push_back( const T& object, const std::string& name ){
             Parent::push_back(object, name);
-            set__(Parent::get__());
+            set_type_after_push();
         }
 
         template <typename T>
         void push_front( const T& object){
             Parent::push_front(object);
-            set__(Parent::get__());
+            set_type_after_push();
         }
 
         template <typename T>
         void push_front( const T& object, const std::string& name){
             Parent::push_front(object, name);
-            set__(Parent::get__());
+            set_type_after_push();
         }
 
         // Offer multiple variants to accomodate both old interface here and signatures in other classes
@@ -130,6 +130,30 @@ namespace Rcpp{
             }
         }
 
+        void set_type_after_push(){
+            int max_rows = 0;
+            bool invalid_column_size = false;
+            SEXP data = Parent::get__();
+            List::iterator it;
+            // Get the maximum number of rows
+            for (it = Parent::begin(); it != Parent::end(); ++it) {
+                if (Rf_xlength(*it) > max_rows) {
+                    max_rows = Rf_xlength(*it);
+                }
+            }
+            for (it = Parent::begin(); it != Parent::end(); ++it) {
+                if (Rf_xlength(*it) > 1 && max_rows % Rf_xlength(*it) != 0) {
+                    // We have a column that is not an integer fraction of the largest
+                    invalid_column_size = true;
+                }
+            }
+            if (invalid_column_size) {
+                warning("Column sizes are not equal in DataFrame::push_back, object degrading to List\n");
+            } else {
+                set__(Parent::get__());
+            }
+        }
+
         static DataFrame_Impl from_list( Parent obj ){
             bool use_default_strings_as_factors = true ;
             bool strings_as_factors = true ;

inst/tinytest/cpp/DataFrame.cpp

@@ -157,3 +157,27 @@ DataFrame DataFrame_PushBackDataFrame(){
   return df1;
 }
 
+// [[Rcpp::export]]
+DataFrame DataFrame_PushWrongSize(){
+  NumericVector u(2);
+  NumericVector v(3);
+
+  DataFrame df1 = DataFrame::create(_["u"] = u);
+  df1.push_back(v);
+  return df1;
+}
+
+// [[Rcpp::export]]
+DataFrame DataFrame_PushReplicateLength(){
+  NumericVector u(2);
+  NumericVector v(4);
+  NumericVector x(1);
+
+  u[0] = 1;
+  x[0] = 2;
+
+  DataFrame df1 = DataFrame::create(_["u"] = u);
+  df1.push_back(v);
+  df1.push_back(x);
+  return df1;
+}

inst/tinytest/test_dataframe.R

@@ -101,3 +101,12 @@ expect_equal( DataFrame_PushFrontDataFrame(), df )
 df <- data.frame( u = c(0, 0), v = c(0, 0), w = c(0, 0), x = c(0, 0) )
 expect_true( is.data.frame( DataFrame_PushBackDataFrame() ) )
 expect_equal( DataFrame_PushBackDataFrame(), df )
+
+#    test.DataFrame.PushWrongSize <- function(){
+df <- data.frame( u = c(0, 0), v = c(0, 0), w = c(0, 0), x = c(0, 0) )
+expect_warning( DataFrame_PushWrongSize() )
+
+#    test.DataFrame.PushReplicateLength <- function(){
+df <- data.frame( u = c(1, 0), v = c(0, 0, 0, 0), x = c(2) )
+expect_true( is.data.frame( DataFrame_PushReplicateLength() ) )
+expect_equal( DataFrame_PushReplicateLength(), df )