Merge branch 'ListOf'

Author: kevinushey

inst/include/Rcpp/Vector.h

@@ -65,6 +65,7 @@ namespace Rcpp{
 #include <Rcpp/vector/LazyVector.h>
 #include <Rcpp/vector/swap.h>
 
+#include <Rcpp/vector/ChildVector.h>
 #include <Rcpp/vector/ListOf.h>
 
 #endif

inst/include/Rcpp/traits/traits.h

@@ -49,7 +49,6 @@ struct int2type { enum { value = I }; };
 #include <Rcpp/traits/has_na.h>
 #include <Rcpp/traits/storage_type.h>
 #include <Rcpp/traits/r_sexptype_traits.h>
-#include <Rcpp/traits/storage_type.h>
 #include <Rcpp/traits/r_type_traits.h>
 #include <Rcpp/traits/un_pointer.h>
 #include <Rcpp/traits/is_pointer.h>

inst/include/Rcpp/vector/ChildVector.h

@@ -0,0 +1,77 @@
+// ChildVector.h: Rcpp R/C++ interface class library -- vector children of lists
+//
+// Copyright (C) 2014 Dirk Eddelbuettel, Romain Francois and Kevin Ushey
+//
+// This file is part of Rcpp.
+//
+// Rcpp is free software: you can redistribute it and/or modify it
+// under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 2 of the License, or
+// (at your option) any later version.
+//
+// Rcpp is distributed in the hope that it will be useful, but
+// WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
+
+#ifndef Rcpp__Vector__ChildVector__h
+#define Rcpp__Vector__ChildVector__h
+
+namespace Rcpp {
+
+template <typename T>
+class ChildVector : public T {
+
+    public:
+
+    ChildVector(SEXP data_, SEXP parent_, int i_):
+        T(data_),
+        parent(parent_),
+        i(i_) {}
+
+    ChildVector(const ChildVector& other):
+        T(other),
+        parent(other.parent),
+        i(other.i) {}
+
+    inline ChildVector& operator=(const ChildVector& other) {
+        if (this != &other) {
+            this->set__(other);
+            if (parent != NULL && !Rf_isNull(parent)) {
+                SET_VECTOR_ELT(parent, i, other);
+            }
+        }
+        return *this;
+    }
+
+    inline ChildVector& operator=(const T& other) {
+        this->set__(other);
+        if (parent != NULL && !Rf_isNull(parent)) {
+            SET_VECTOR_ELT(parent, i, other);
+        }
+        return *this;
+    }
+
+    template <typename U>
+    inline ChildVector& operator=(const U& other) {
+        Shield<SEXP> wrapped( wrap(other) );
+        T vec = as<T>(wrapped);
+        this->set__(vec);
+        if (parent != NULL && !Rf_isNull(parent)) {
+            SET_VECTOR_ELT(parent, i, vec);
+        }
+        return *this;
+    }
+
+    private:
+        SEXP parent;
+        int i;
+};
+
+} // namespace Rcpp
+
+#endif
+

inst/include/Rcpp/vector/ListOf.h

@@ -52,20 +52,20 @@ class ListOf {
 
     // subsetting operators
 
-    T operator[](int i) {
-      return list[i];
+    ChildVector<T> operator[](int i) {
+        return ChildVector<T>(list[i], list, i);
     }
 
-    const T operator[](int i) const {
-      return list[i];
+    const ChildVector<T> operator[](int i) const {
+        return ChildVector<T>(list[i], list, i);
     }
 
-    T operator[](const std::string& str) {
-        return list[str];
+    ChildVector<T> operator[](const std::string& str) {
+        return ChildVector<T>(list[str], list, list.findName(str));
     }
 
-    const T operator[](const std::string& str) const {
-        return list[str];
+    const ChildVector<T> operator[](const std::string& str) const {
+        return ChildVector<T>(list[str], list, list.findName(str));
     }
 
     // iteration operators pass down to list
@@ -90,45 +90,16 @@ class ListOf {
         return list.size() ;
     }
 
-    class ListOfProxy {
-
-    public:
-        ListOfProxy(List& list_): list(list_) {};
-
-        List::Proxy operator[](int i) {
-            return List::Proxy(list, i);
-        }
-
-        List::Proxy operator[](const char* str) {
-            std::vector<std::string> names = as< std::vector<std::string> >(list.attr("names"));
-            for (int i=0; i < list.size(); ++i) {
-                if (names[i] == str) {
-                    return List::Proxy(list, i);
-                }
-            }
-            std::stringstream ss;
-            ss << "No name '" << str << "' in the names of the list supplied";
-            stop(ss.str());
-            return List::Proxy(list, -1);
-        }
-
-    private:
-        ListOfProxy() {};
-
-        List& list;
-    };
-
-    friend class ListOfProxy;
-
-    // lhs access
-    friend ListOfProxy lhs(ListOf& x) {
-        return ListOfProxy(x.list);
+    inline List get() const {
+        return list;
     }
 
     // conversion operators
     operator SEXP() const { return wrap(list); }
     operator List() const { return list; }
 
+private:
+
     List list;
 
 }; // ListOf<T>
@@ -147,12 +118,12 @@ class Sapply;
 
 template <typename T, typename Function>
 List lapply(const ListOf<T>& t, Function fun) {
-    return lapply(t.list, fun);
+    return lapply(t.get(), fun);
 }
 
 template <typename T, typename Function>
 T sapply(const ListOf<T>& t, Function fun) {
-    return sapply(t.list, fun);
+    return sapply(t.get(), fun);
 }
 
 } // Rcpp

inst/include/Rcpp/vector/Vector.h

@@ -511,6 +511,21 @@ class Vector :
         return false ;
     }
 
+    int findName(const std::string& name) const {
+        SEXP names = RCPP_GET_NAMES(Storage::get__());
+        if (Rf_isNull(names)) stop("'names' attribute is null");
+        int n = Rf_length(names);
+        for (int i=0; i < n; ++i) {
+            if (strcmp(name.c_str(), CHAR(STRING_ELT(names, i))) == 0) {
+                return i;
+            }
+        }
+        std::stringstream ss;
+        ss << "no name '" << name << "' found";
+        stop(ss.str());
+        return -1;
+    }
+
 
 protected:
     inline int* dims() const {

inst/unitTests/cpp/ListOf.cpp

@@ -25,14 +25,14 @@ NumericVector test_sapply_sum(NVList x) {
 
 // [[Rcpp::export]]
 NVList test_assign(NVList x, NumericVector y, CharacterVector z) {
-    lhs(x)[1] = y;
-    lhs(x)[2] = 1;
+    x[1] = y;
+    x[2] = 1;
     return x;
 }
 
 // [[Rcpp::export]]
 NVList test_assign_names(NVList x) {
-    lhs(x)["a"] = x["b"];
+    x["a"] = x["b"];
     return x;
 }
 
@@ -55,7 +55,7 @@ NumericVector test_mult(NVList x) {
 typedef ListOf<CharacterVector> CVList;
 // [[Rcpp::export]]
 CVList test_char(CVList x) {
-    lhs(x)[0] = "apple";
+    x[0] = "apple";
     return x;
 }
 
@@ -82,3 +82,9 @@ NVList test_binary_ops(NVList x) {
         x[0] <= x[1]
     );
 }
+
+// [[Rcpp::export]]
+int test_sub_calls(NVList x) {
+    int sz = x[0].size() + x[1].size() + x[2].size();
+    return sz;
+}

inst/unitTests/runit.ListOf.R

@@ -18,48 +18,53 @@
 .runThisTest <- Sys.getenv("RunAllRcppTests") == "yes"
 
 if (.runThisTest) {
-    
+
     .setUp <- Rcpp:::unitTestSetup("ListOf.cpp")
-    
+
     x <- list( c(1, 5), c(2, 6), c(3, 7) )
-    
-    test.identity <- function() {
+
+    test.ListOf.identity <- function() {
         checkIdentical(
             test_identity(setNames(x, c('a', 'b', 'c'))),
             setNames(x, c('a', 'b', 'c'))
         )
     }
-    
-    test.lapply.sum <- function() {
+
+    test.ListOf.lapply.sum <- function() {
         x <- list( c(1, 5), c(2, 6), c(3, 7) )
         checkIdentical( test_lapply_sum(x), lapply(x, sum) )
     }
-    
-    test.sapply.sum <- function() {
+
+    test.ListOf.sapply.sum <- function() {
         x <- list( c(1, 5), c(2, 6), c(3, 7) )
         checkIdentical( test_sapply_sum(x), sapply(x, sum) )
     }
-    
-    test.assign <- function() {
+
+    test.ListOf.assign <- function() {
+        x <- list( c(1, 5), c(2, 6), c(3, 7) )
         test_assign(x, 100, "apple")
         checkIdentical( x[[2]], 100 )
     }
-    
-    test.assign.names <- function() {
+
+    test.ListOf.assign.names <- function() {
         x <- setNames(list(1, 2, 3), c('a', 'b', 'c'))
         test_assign_names(x)
         checkIdentical( x[["a"]], x[["b"]] )
     }
-    
-    test.arith <- function() {
+
+    test.ListOf.arith <- function() {
         checkIdentical(test_add(list(1, 2, 3)), 6)
         checkIdentical(test_add_subtract(list(1, 2, 3)), 0)
         checkIdentical(test_mult( list(1, 2, 3) ), 6)
         checkIdentical(test_char( list("banana") ), list("apple"))
     }
-    
-    test.assign.names <- function() {
+
+    test.ListOf.assign.names <- function() {
         checkException(test_assign_names(list(alpha=1, beta=2, gamma=3)))
     }
-    
+
+    test.ListOf.sub.calls <- function() {
+        checkEquals(test_sub_calls( list(1, 2, 3) ), 3)
+    }
+
 }