[Rcpp-commits] r3323 - in pkg/int64: . R inst/include/int64 src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Nov 12 10:25:35 CET 2011
Author: romain
Date: 2011-11-12 10:25:35 +0100 (Sat, 12 Nov 2011)
New Revision: 3323
Modified:
pkg/int64/NAMESPACE
pkg/int64/R/int64.R
pkg/int64/inst/include/int64/LongVector.h
pkg/int64/inst/include/int64/as_character.h
pkg/int64/inst/include/int64/routines.h
pkg/int64/src/int64.cpp
pkg/int64/src/int64_init.c
Log:
starting to add some NA specific behaviour
Modified: pkg/int64/NAMESPACE
===================================================================
--- pkg/int64/NAMESPACE 2011-11-12 01:39:56 UTC (rev 3322)
+++ pkg/int64/NAMESPACE 2011-11-12 09:25:35 UTC (rev 3323)
@@ -8,7 +8,7 @@
show, length, "[", Arith, Compare, Summary, Math, Math2,
as.character, format, names, "names<-",
- as.data.frame, binary, unique, sort
+ as.data.frame, binary, unique, sort, is.na
)
export(
int64, uint64, as.int64, as.uint64, numeric_limits
Modified: pkg/int64/R/int64.R
===================================================================
--- pkg/int64/R/int64.R 2011-11-12 01:39:56 UTC (rev 3322)
+++ pkg/int64/R/int64.R 2011-11-12 09:25:35 UTC (rev 3323)
@@ -101,9 +101,15 @@
setMethod( "show", "uint64", show_int64)
as.int64 <- function(x){
+ if( is.character(x) ){
+ x[ ! grepl("^[-][0-9]+$", x) ] <- NA
+ }
new( "int64", .Call(int64_as_int64, x) )
}
as.uint64 <- function(x){
+ if( is.character(x) ){
+ x[ ! grepl("^[-][0-9]+$", x) ] <- NA
+ }
new( "uint64", .Call(int64_as_uint64, x) )
}
@@ -277,4 +283,9 @@
} )
-
+setMethod( "is.na", "int64", function(x){
+ .Call( int64_isna, x, FALSE )
+})
+setMethod( "is.na", "uint64", function(x){
+ .Call( int64_isna, x, TRUE )
+})
Modified: pkg/int64/inst/include/int64/LongVector.h
===================================================================
--- pkg/int64/inst/include/int64/LongVector.h 2011-11-12 01:39:56 UTC (rev 3322)
+++ pkg/int64/inst/include/int64/LongVector.h 2011-11-12 09:25:35 UTC (rev 3323)
@@ -34,6 +34,12 @@
SEXP data ;
public:
+ static LONG min ;
+ static LONG max ;
+ static LONG na ;
+ static int na_hb ;
+ static int na_lb ;
+
LongVector(SEXP x) : data(x) {
if( Rf_inherits( x, internal::get_class<LONG>().c_str() ) ){
data = x ;
@@ -48,10 +54,16 @@
LONG tmp ;
int* p_i_x = INTEGER(x) ;
for( int i=0; i<n; i++){
- tmp = (LONG) p_i_x[i] ;
- hb = internal::get_high_bits<LONG>(tmp) ;
- lb = internal::get_low_bits<LONG>(tmp) ;
- SET_VECTOR_ELT( y, i, int64::internal::int2(hb,lb) ) ;
+ if( p_i_x[i] == NA_INTEGER){
+ SET_VECTOR_ELT( y, i, int64::internal::int2(
+ na_hb, na_lb
+ ) ) ;
+ } else {
+ tmp = (LONG) p_i_x[i] ;
+ hb = internal::get_high_bits<LONG>(tmp) ;
+ lb = internal::get_low_bits<LONG>(tmp) ;
+ SET_VECTOR_ELT( y, i, int64::internal::int2(hb,lb) ) ;
+ }
}
UNPROTECT(1) ; // y
data = y ;
@@ -66,10 +78,16 @@
LONG tmp ;
int* p_i_x = INTEGER(x) ;
for( int i=0; i<n; i++){
- tmp = (LONG) p_i_x[i] ;
- hb = internal::get_high_bits<LONG>(tmp) ;
- lb = internal::get_low_bits<LONG>(tmp) ;
- SET_VECTOR_ELT( y, i, int64::internal::int2(hb,lb) ) ;
+ if( p_i_x[i] == NA_INTEGER){
+ SET_VECTOR_ELT( y, i, int64::internal::int2(
+ na_hb, na_lb
+ ) ) ;
+ } else {
+ tmp = (LONG) p_i_x[i] ;
+ hb = internal::get_high_bits<LONG>(tmp) ;
+ lb = internal::get_low_bits<LONG>(tmp) ;
+ SET_VECTOR_ELT( y, i, int64::internal::int2(hb,lb) ) ;
+ }
}
UNPROTECT(1) ; // y
data = y ;
@@ -84,10 +102,16 @@
LONG tmp ;
double* p_d_x = REAL(x) ;
for( int i=0; i<n; i++){
- tmp = (LONG) p_d_x[i] ;
- hb = internal::get_high_bits<LONG>(tmp) ;
- lb = internal::get_low_bits<LONG>(tmp) ;
- SET_VECTOR_ELT( y, i, int64::internal::int2(hb,lb) ) ;
+ if( R_IsNA(p_d_x[i]) ){
+ SET_VECTOR_ELT( y, i, int64::internal::int2(
+ na_hb, na_lb
+ ) ) ;
+ } else {
+ tmp = (LONG) p_d_x[i] ;
+ hb = internal::get_high_bits<LONG>(tmp) ;
+ lb = internal::get_low_bits<LONG>(tmp) ;
+ SET_VECTOR_ELT( y, i, int64::internal::int2(hb,lb) ) ;
+ }
}
UNPROTECT(1) ; // y
data = y ;
@@ -101,10 +125,16 @@
int hb, lb ;
LONG tmp ;
for( int i=0; i<n; i++){
- tmp = internal::read_string<LONG>( CHAR(STRING_ELT(x,i)) ) ;
- hb = internal::get_high_bits<LONG>(tmp) ;
- lb = internal::get_low_bits<LONG>(tmp) ;
- SET_VECTOR_ELT( y, i, int64::internal::int2(hb,lb) ) ;
+ if( !strcmp("NA", CHAR(STRING_ELT(x,i)) ) ){
+ SET_VECTOR_ELT( y, i, int64::internal::int2(
+ na_hb, na_lb
+ ) ) ;
+ } else{
+ tmp = internal::read_string<LONG>( CHAR(STRING_ELT(x,i)) ) ;
+ hb = internal::get_high_bits<LONG>(tmp) ;
+ lb = internal::get_low_bits<LONG>(tmp) ;
+ SET_VECTOR_ELT( y, i, int64::internal::int2(hb,lb) ) ;
+ }
}
UNPROTECT(1) ; // y
data = y ;
@@ -186,6 +216,19 @@
}
return LongVector<LONG>( n, x.begin(), x.end() ) ;
}
+
+ SEXP is_na(){
+ int n = size() ;
+ SEXP res = PROTECT( Rf_allocVector(LGLSXP,n)) ;
+ int* p ;
+ int* p_res = INTEGER(res) ;
+ for( int i=0; i<n; i++){
+ p = INTEGER(VECTOR_ELT(data, i)) ;
+ p_res[i] = p[0] == na_hb && p[1] == na_lb ;
+ }
+ UNPROTECT(1) ; // res
+ return res;
+ }
} ;
Modified: pkg/int64/inst/include/int64/as_character.h
===================================================================
--- pkg/int64/inst/include/int64/as_character.h 2011-11-12 01:39:56 UTC (rev 3322)
+++ pkg/int64/inst/include/int64/as_character.h 2011-11-12 09:25:35 UTC (rev 3323)
@@ -33,8 +33,14 @@
int n = data.size() ;
SEXP res = PROTECT( Rf_allocVector( STRSXP, n) ) ;
std::ostringstream stream ;
- for( int i=0; i<n; i++){
- stream << data.get(i) ;
+ LONG tmp ;
+ for( int i=0; i<n; i++){
+ tmp = data.get(i) ;
+ if( tmp == int64::LongVector<LONG>::na ){
+ stream << "NA" ;
+ } else {
+ stream << data.get(i) ;
+ }
SET_STRING_ELT( res, i, Rf_mkChar(stream.str().c_str()) ) ;
stream.str("") ;
}
Modified: pkg/int64/inst/include/int64/routines.h
===================================================================
--- pkg/int64/inst/include/int64/routines.h 2011-11-12 01:39:56 UTC (rev 3322)
+++ pkg/int64/inst/include/int64/routines.h 2011-11-12 09:25:35 UTC (rev 3323)
@@ -49,6 +49,7 @@
CALLFUN_3(int64_sort) ;
CALLFUN_3(int64_math) ;
CALLFUN_3(int64_signif) ;
+CALLFUN_2(int64_isna) ;
#ifdef __cplusplus
}
Modified: pkg/int64/src/int64.cpp
===================================================================
--- pkg/int64/src/int64.cpp 2011-11-12 01:39:56 UTC (rev 3322)
+++ pkg/int64/src/int64.cpp 2011-11-12 09:25:35 UTC (rev 3323)
@@ -22,8 +22,22 @@
#include <limits>
namespace int64{
+
+ template<> int64_t LongVector<int64_t>::min = std::numeric_limits<int64_t>::min() + 1;
+ template<> int64_t LongVector<int64_t>::max = std::numeric_limits<int64_t>::max() ;
+ template<> int64_t LongVector<int64_t>::na = std::numeric_limits<int64_t>::min() ;
+ template<> int LongVector<int64_t>::na_hb = int64::internal::get_high_bits<int64_t>( int64::LongVector<int64_t>::na ) ;
+ template<> int LongVector<int64_t>::na_lb = int64::internal::get_low_bits<int64_t>( int64::LongVector<int64_t>::na ) ;
+
+ template<> uint64_t LongVector<uint64_t>::min = 0 ;
+ template<> uint64_t LongVector<uint64_t>::max = std::numeric_limits<uint64_t>::max() - 1 ;
+ template<> uint64_t LongVector<uint64_t>::na = std::numeric_limits<uint64_t>::max() ;
+ template<> int LongVector<uint64_t>::na_hb = int64::internal::get_high_bits<uint64_t>( int64::LongVector<uint64_t>::na ) ;
+ template<> int LongVector<uint64_t>::na_lb = int64::internal::get_low_bits<uint64_t>( int64::LongVector<uint64_t>::na ) ;
+
namespace internal{
+
/* tool to make an int vector with two ints */
SEXP int2( int x, int y ){
SEXP res = PROTECT( Rf_allocVector(INTSXP, 2) ) ;
@@ -128,7 +142,7 @@
extern "C" SEXP int64_limits( SEXP type_ ){
const char* type = CHAR(STRING_ELT(type_, 0) ) ;
- if( !strcmp( type, "integer" ) ){
+ if( !strcmp( type, "integer" ) ){
SEXP res = PROTECT( Rf_allocVector(INTSXP, 2 ) ) ;
INTEGER(res)[0] = std::numeric_limits<int>::min() + 1 ;
INTEGER(res)[1] = std::numeric_limits<int>::max() ;
@@ -136,13 +150,13 @@
return res ;
} else if( ! strcmp( type, "int64" ) ){
return int64::internal::new_long_2<int64_t>(
- std::numeric_limits<int64_t>::min(),
- std::numeric_limits<int64_t>::max()
+ int64::LongVector<int64_t>::min ,
+ int64::LongVector<int64_t>::max
) ;
} else if( !strcmp( type, "uint64" ) ){
return int64::internal::new_long_2<uint64_t>(
- std::numeric_limits<uint64_t>::min(),
- std::numeric_limits<uint64_t>::max()
+ int64::LongVector<uint64_t>::min,
+ int64::LongVector<uint64_t>::max
) ;
}
@@ -193,6 +207,15 @@
}
}
UNPROTECT(1) ;
- return res ;
+ return res ;
}
+
+extern "C" SEXP int64_isna( SEXP x_, SEXP unsign ){
+ bool is_unsigned = INTEGER(unsign)[0] ;
+ if( is_unsigned ){
+ return int64::LongVector<uint64_t>( x_ ).is_na() ;
+ } else {
+ return int64::LongVector<int64_t>( x_ ).is_na() ;
+ }
+}
Modified: pkg/int64/src/int64_init.c
===================================================================
--- pkg/int64/src/int64_init.c 2011-11-12 01:39:56 UTC (rev 3322)
+++ pkg/int64/src/int64_init.c 2011-11-12 09:25:35 UTC (rev 3323)
@@ -43,6 +43,7 @@
CALLDEF(int64_sort,3),
CALLDEF(int64_math,3),
CALLDEF(int64_signif,3),
+ CALLDEF(int64_isna,2),
{NULL, NULL, 0}
};
More information about the Rcpp-commits
mailing list