[Rcpp-commits] r1832 - in pkg/Rcpp: . inst/include/Rcpp/sugar/matrix inst/include/Rcpp/vector inst/unitTests

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Jul 8 11:34:28 CEST 2010


Author: romain
Date: 2010-07-08 11:34:28 +0200 (Thu, 08 Jul 2010)
New Revision: 1832

Added:
   pkg/Rcpp/inst/include/Rcpp/sugar/matrix/diag.h
Modified:
   pkg/Rcpp/TODO
   pkg/Rcpp/inst/include/Rcpp/sugar/matrix/matrix_functions.h
   pkg/Rcpp/inst/include/Rcpp/vector/Matrix.h
   pkg/Rcpp/inst/include/Rcpp/vector/MatrixBase.h
   pkg/Rcpp/inst/include/Rcpp/vector/Vector.h
   pkg/Rcpp/inst/unitTests/runit.sugar.R
Log:
diag function to extract diagonal of a matrix

Modified: pkg/Rcpp/TODO
===================================================================
--- pkg/Rcpp/TODO	2010-07-08 09:10:32 UTC (rev 1831)
+++ pkg/Rcpp/TODO	2010-07-08 09:34:28 UTC (rev 1832)
@@ -70,8 +70,6 @@
     	has to evaluate x[i] + y[i] as many times as the length
     	of z. perhaps a better implementation would be to 
     	first force the evaluation of x + y.
-
-    o	primitive should be allowed in ifelse, on the lhs, rhs or both
     
 Testing
 

Added: pkg/Rcpp/inst/include/Rcpp/sugar/matrix/diag.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/sugar/matrix/diag.h	                        (rev 0)
+++ pkg/Rcpp/inst/include/Rcpp/sugar/matrix/diag.h	2010-07-08 09:34:28 UTC (rev 1832)
@@ -0,0 +1,61 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// diag.h: Rcpp R/C++ interface class library -- diag
+//
+// Copyright (C) 2010 Dirk Eddelbuettel and Romain Francois
+//
+// 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__sugar__diag_h
+#define Rcpp__sugar__diag_h
+
+namespace Rcpp{
+namespace sugar{
+	
+template <int RTYPE, bool NA, typename T>
+class Matrix_Diag : public Rcpp::VectorBase< RTYPE ,NA, Matrix_Diag<RTYPE,NA,T> > {
+public:
+	typedef typename Rcpp::MatrixBase<RTYPE,NA,T> MAT_TYPE ;
+	typedef typename Rcpp::traits::storage_type<RTYPE>::type STORAGE ;
+	
+	Matrix_Diag( const MAT_TYPE& object_ ) : object(object_), n(0) {
+		int nr = object.nrow() ;
+		int nc = object.ncol() ;
+		n = (nc < nr ) ? nc : nr ;
+	}
+	
+	inline STORAGE operator[]( int i ) const {
+		return object( i, i ) ;
+	}
+	inline int size() const { return n; }
+	         
+private:
+	const MAT_TYPE& object ;
+	int n ;
+} ;
+	
+} // sugar
+
+template <int RTYPE,bool NA, typename T>
+inline sugar::Matrix_Diag<RTYPE,NA,T> diag( 
+	const MatrixBase<RTYPE,NA,T>& t 
+	){
+	return sugar::Matrix_Diag<RTYPE,NA,T>( t ) ;
+}
+
+} // Rcpp
+#endif
+

Modified: pkg/Rcpp/inst/include/Rcpp/sugar/matrix/matrix_functions.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/sugar/matrix/matrix_functions.h	2010-07-08 09:10:32 UTC (rev 1831)
+++ pkg/Rcpp/inst/include/Rcpp/sugar/matrix/matrix_functions.h	2010-07-08 09:34:28 UTC (rev 1832)
@@ -28,5 +28,6 @@
 #include <Rcpp/sugar/matrix/col.h>
 #include <Rcpp/sugar/matrix/lower_tri.h>
 #include <Rcpp/sugar/matrix/upper_tri.h>
+#include <Rcpp/sugar/matrix/diag.h>
 
 #endif

Modified: pkg/Rcpp/inst/include/Rcpp/vector/Matrix.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/vector/Matrix.h	2010-07-08 09:10:32 UTC (rev 1831)
+++ pkg/Rcpp/inst/include/Rcpp/vector/Matrix.h	2010-07-08 09:34:28 UTC (rev 1832)
@@ -113,6 +113,13 @@
     	return static_cast< Vector<RTYPE>* >( this )->operator()( i, j ) ;
     }
     
+    inline Proxy operator[]( int i ) const {
+    	return static_cast< const Vector<RTYPE>* >( this )->operator[]( i ) ;
+    }
+    inline Proxy operator()( int i, int j ) const {
+    	return static_cast< const Vector<RTYPE>* >( this )->operator()( i, j ) ;
+    }
+    
 private:
 	virtual void update(){
 		RCPP_DEBUG_1( "%s::update", DEMANGLE(Matrix) ) ;

Modified: pkg/Rcpp/inst/include/Rcpp/vector/MatrixBase.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/vector/MatrixBase.h	2010-07-08 09:10:32 UTC (rev 1831)
+++ pkg/Rcpp/inst/include/Rcpp/vector/MatrixBase.h	2010-07-08 09:34:28 UTC (rev 1832)
@@ -41,7 +41,7 @@
 		return static_cast<const MATRIX*>(this)->operator[](i) ;
 	}
 	
-	inline stored_type operator()( int i, int j) throw(not_a_matrix) {
+	inline stored_type operator()( int i, int j) const throw(not_a_matrix) {
 		return static_cast<const MATRIX*>(this)->operator()(i, j) ;
 	}
 	

Modified: pkg/Rcpp/inst/include/Rcpp/vector/Vector.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/vector/Vector.h	2010-07-08 09:10:32 UTC (rev 1831)
+++ pkg/Rcpp/inst/include/Rcpp/vector/Vector.h	2010-07-08 09:34:28 UTC (rev 1832)
@@ -271,9 +271,18 @@
 	inline Proxy operator()( const size_t& i) throw(index_out_of_bounds){
 		return cache.ref( offset(i) ) ;
 	}
+	// TODO: should it be const_Proxy
+	inline Proxy operator()( const size_t& i) const throw(index_out_of_bounds){
+		return cache.ref( offset(i) ) ;
+	}
 	inline Proxy operator()( const size_t& i, const size_t& j) throw(not_a_matrix,index_out_of_bounds){
 		return cache.ref( offset(i,j) ) ;
 	}
+	// TODO: should it be const_Proxy
+	inline Proxy operator()( const size_t& i, const size_t& j) const throw(not_a_matrix,index_out_of_bounds){
+		return cache.ref( offset(i,j) ) ;
+	}
+	
 	inline NameProxy operator[]( const std::string& name ){
 		return NameProxy( *this, name ) ;
 	}

Modified: pkg/Rcpp/inst/unitTests/runit.sugar.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.sugar.R	2010-07-08 09:10:32 UTC (rev 1831)
+++ pkg/Rcpp/inst/unitTests/runit.sugar.R	2010-07-08 09:34:28 UTC (rev 1832)
@@ -538,6 +538,13 @@
 						_["neg"] = tail( xx, -5 )
 					) ;
 				'
+			), 
+			"runit_matrix_diag" = list( 
+				signature( x = "matrix" ), 
+				'
+					NumericMatrix xx(x) ;
+					return wrap( diag( xx ) ) ;
+				'
 			)
 			
 		)
@@ -1027,16 +1034,22 @@
 
 
 			
-test.sugar.outer <- function( ){
+test.sugar.matrix.outer <- function( ){
 	fx <- .rcpp.sugar$runit_outer
 	x <- 1:2
 	y <- 1:5
 	checkEquals( fx(x,y) , outer(x,y,"+") )
 }
 
-test.sugar.row <- function( ){
+test.sugar.matrix.row <- function( ){
 	fx <- .rcpp.sugar$runit_row
 	m <- matrix( 1:16, nc = 4 )
 	checkEquals( fx(m), list( row = row(m), col = col(m) ) ) 
 }
 
+test.sugar.matrix.diag <- function( ){
+	fx <- .rcpp.sugar$runit_matrix_diag
+	m <- matrix( 1:16, nc = 4 )
+	checkEquals( fx(m), diag(m) ) 
+}
+



More information about the Rcpp-commits mailing list