[Rcpp-commits] r3279 - in pkg/int64: . R inst/include/int64 man src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Nov 4 12:46:57 CET 2011
Author: romain
Date: 2011-11-04 12:46:57 +0100 (Fri, 04 Nov 2011)
New Revision: 3279
Modified:
pkg/int64/NAMESPACE
pkg/int64/R/int64.R
pkg/int64/inst/include/int64/math.h
pkg/int64/inst/include/int64/routines.h
pkg/int64/man/int64-class.Rd
pkg/int64/man/uint64-class.Rd
pkg/int64/src/int64.cpp
pkg/int64/src/int64_init.c
Log:
implementing Math2 (round and signif)
Modified: pkg/int64/NAMESPACE
===================================================================
--- pkg/int64/NAMESPACE 2011-11-04 05:02:11 UTC (rev 3278)
+++ pkg/int64/NAMESPACE 2011-11-04 11:46:57 UTC (rev 3279)
@@ -5,7 +5,7 @@
exportClasses( "int64", "uint64", "binary" )
exportMethods(
- show, length, "[", Arith, Compare, Summary, Math,
+ show, length, "[", Arith, Compare, Summary, Math, Math2,
as.character, format,
as.data.frame, binary, unique, sort
Modified: pkg/int64/R/int64.R
===================================================================
--- pkg/int64/R/int64.R 2011-11-04 05:02:11 UTC (rev 3278)
+++ pkg/int64/R/int64.R 2011-11-04 11:46:57 UTC (rev 3279)
@@ -205,11 +205,41 @@
.Call( int64_sort, x, TRUE, decreasing )
} )
-setGeneric( "Math" )
setMethod( "Math", "int64", function(x){
- .Call( int64_math, .Generic, x, FALSE )
+ .External( int64_math, .Generic, x, FALSE)
} )
setMethod( "Math", "uint64", function(x){
- .Call( int64_math, .Generic, x, TRUE )
+ .External( int64_math, .Generic, x, TRUE )
} )
+# implementation of signif using string maniplation
+int64_Math2 <- function( type = "int64", .Generic, x, digits ){
+ if( .Generic == "round" ) x else{
+ if( any(digits<0 ) ) stop("digits must be positive")
+
+ # signif
+ s <- as.character( x )
+ len <- nchar( s )
+ signs <- ! grepl( "^-", s )
+ s <- sub( "^-", "", s )
+
+ # recycling
+ digits <- as.integer( rep( digits, length = length( s ) ) )
+ digits[ digits == 0L ] <- 1L
+
+ res <- .Call( int64_signif, s, digits, len )
+ res <- sprintf( "%s%s", ifelse(signs, "", "-"), res )
+
+ if( type == "int64" ) as.int64(res) else as.uint64(res)
+ }
+}
+
+setMethod( "Math2", "int64", function(x, digits = 6L){
+ int64_Math2( "int64", .Generic, x, digits )
+} )
+setMethod( "Math2", "uint64", function(x, digits = 6L){
+ int64_Math2( "uint64", .Generic, x, digits )
+} )
+
+
+
Modified: pkg/int64/inst/include/int64/math.h
===================================================================
--- pkg/int64/inst/include/int64/math.h 2011-11-04 05:02:11 UTC (rev 3278)
+++ pkg/int64/inst/include/int64/math.h 2011-11-04 11:46:57 UTC (rev 3279)
@@ -23,7 +23,7 @@
namespace int64{
namespace internal{
-
+
template <typename LONG>
SEXP abs( SEXP x ){
int64::LongVector<LONG> data(x) ;
@@ -59,9 +59,13 @@
return abs<LONG>(x) ;
} else if( !strcmp(op, "sign") ) {
return sign<LONG>(x) ;
+ } else if( !strcmp( op, "trunc" ) ){
+ return x ;
+ } else if( !strcmp( op, "floor" ) ){
+ return x ;
}
- Rf_error( "operator not implemented" );
+ Rf_error( "generic not implemented" );
return R_NilValue ;
}
Modified: pkg/int64/inst/include/int64/routines.h
===================================================================
--- pkg/int64/inst/include/int64/routines.h 2011-11-04 05:02:11 UTC (rev 3278)
+++ pkg/int64/inst/include/int64/routines.h 2011-11-04 11:46:57 UTC (rev 3279)
@@ -48,6 +48,7 @@
CALLFUN_3(int64_sort) ;
CALLFUN_3(int64_math) ;
+CALLFUN_3(int64_signif) ;
#ifdef __cplusplus
}
Modified: pkg/int64/man/int64-class.Rd
===================================================================
--- pkg/int64/man/int64-class.Rd 2011-11-04 05:02:11 UTC (rev 3278)
+++ pkg/int64/man/int64-class.Rd 2011-11-04 11:46:57 UTC (rev 3279)
@@ -4,6 +4,7 @@
\alias{int64-class}
\alias{[,int64-method}
\alias{Math,int64-method}
+\alias{Math2,int64-method}
\alias{[<-,int64-method}
\alias{Arith,ANY,int64-method}
\alias{Arith,int64,ANY-method}
@@ -53,6 +54,7 @@
\item{length}{\code{signature(x = "int64")}: ... }
\item{Summary}{\code{signature(x = "int64")}: ... }
\item{Math}{\code{signature(x = "int64")}: ... }
+ \item{Math2}{\code{signature(x = "int64")}: ... }
}
}
\author{
Modified: pkg/int64/man/uint64-class.Rd
===================================================================
--- pkg/int64/man/uint64-class.Rd 2011-11-04 05:02:11 UTC (rev 3278)
+++ pkg/int64/man/uint64-class.Rd 2011-11-04 11:46:57 UTC (rev 3279)
@@ -3,6 +3,7 @@
\docType{class}
\alias{uint64-class}
\alias{Math,uint64-method}
+\alias{Math2,uint64-method}
\alias{[,uint64-method}
\alias{[<-,uint64-method}
\alias{Arith,ANY,uint64-method}
@@ -53,6 +54,7 @@
\item{length}{\code{signature(x = "uint64")}: ... }
\item{Summary}{\code{signature(x = "uint64")}: ... }
\item{Math}{\code{signature(x = "uint64")}: ... }
+ \item{Math2}{\code{signature(x = "uint64")}: ... }
}
}
\author{
Modified: pkg/int64/src/int64.cpp
===================================================================
--- pkg/int64/src/int64.cpp 2011-11-04 05:02:11 UTC (rev 3278)
+++ pkg/int64/src/int64.cpp 2011-11-04 11:46:57 UTC (rev 3279)
@@ -170,6 +170,30 @@
return int64::internal::math<uint64_t>( op, x ) ;
} else {
return int64::internal::math<int64_t>( op, x ) ;
+ }
+}
+
+extern "C" SEXP int64_signif( SEXP s_, SEXP digits_, SEXP len_){
+ std::string s ;
+ int n = Rf_length(s_) ;
+ int* digits = INTEGER(digits_) ;
+ int* len = INTEGER(len_) ;
+ int tmp = 0 ;
+
+ SEXP res = PROTECT( Rf_allocVector( STRSXP, n ) ) ;
+ for( int i=0; i<n; i++){
+ if( digits[i] > len[i] ){
+ SET_STRING_ELT( res, i, STRING_ELT( s_, i ) ) ;
+ } else {
+ s = CHAR(STRING_ELT(s_, i ));
+ tmp = len[i] - digits[i] ;
+ for( int j=tmp; j<len[i]; j++){
+ s[j] = '0' ;
+ }
+ SET_STRING_ELT( res, i, Rf_mkChar(s.c_str()) ) ;
+ }
}
-
+ UNPROTECT(1) ;
+ return res ;
}
+
Modified: pkg/int64/src/int64_init.c
===================================================================
--- pkg/int64/src/int64_init.c 2011-11-04 05:02:11 UTC (rev 3278)
+++ pkg/int64/src/int64_init.c 2011-11-04 11:46:57 UTC (rev 3279)
@@ -41,7 +41,7 @@
CALLDEF(int64_limits,1),
CALLDEF(int64_sort,3),
- CALLDEF(int64_math,3),
+ CALLDEF(int64_signif,3),
{NULL, NULL, 0}
};
More information about the Rcpp-commits
mailing list