Skip to content

Commit 7d64a5c

Browse files
committed
Merge pull request #87 from kevinushey/master
Merging pull request #87 by Kevin with fixes to sugar table
2 parents 1d6620e + d68aa72 commit 7d64a5c

File tree

10 files changed

+265
-14
lines changed

10 files changed

+265
-14
lines changed

ChangeLog

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,8 @@
1+
2013-12-20 Kevin Ushey <kevinushey@gmail.com>
2+
3+
* inst/include/Rcpp/RObject.h: Add missing *this return for
4+
RObject_impl::operator=
5+
16
2013-12-20 Dirk Eddelbuettel <edd@debian.org>
27

38
* inst/include/Rcpp/RObject.h: Applied fix by Kevin Ushey (#88)

inst/NEWS.Rd

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,11 @@
1414
functions were incorrectly expanding to the no-degree-of-freedoms
1515
variant.
1616
\item Unit tests for \code{pnt} were added.
17+
\item The sugar table function did not handle NAs and NaNs properly
18+
for numeric vectors. Fixed and tests added.
19+
\item The internal coercion mechanism mapping numerics to strings has
20+
been updated to better match \R (specifically with \code{Inf}, \code{-Inf},
21+
and \code{NaN}.)
1722
\item Applied two bug fixes to Vector \code{sort()} and \code{RObject}
1823
definition spotted and correct by Kevin Ushey
1924
}

inst/include/Rcpp/RObject.h

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -47,7 +47,8 @@ namespace Rcpp{
4747
* Assignement operator. Set this SEXP to the given SEXP
4848
*/
4949
RObject_Impl& operator=( SEXP other ){
50-
Storage::set__(other) ;
50+
Storage::set__(other) ;
51+
return *this;
5152
}
5253

5354
void update(SEXP){}

inst/include/Rcpp/internal/r_coerce.h

Lines changed: 11 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@
33
//
44
// r_coerce.h: Rcpp R/C++ interface class library -- coercion
55
//
6-
// Copyright (C) 2010 - 2012 Dirk Eddelbuettel and Romain Francois
6+
// Copyright (C) 2010 - 2013 Dirk Eddelbuettel, Romain Francois, and Kevin Ushey
77
//
88
// This file is part of Rcpp.
99
//
@@ -236,9 +236,11 @@ inline const char* coerce_to_string<REALSXP>(double x){
236236
// we are no longer allowed to use this:
237237
// char* tmp = const_cast<char*>( Rf_EncodeReal(x, w, d, e, '.') );
238238
// so approximate it poorly as
239+
239240
static char tmp[128];
240241
snprintf(tmp, 127, "%f", x);
241-
return dropTrailing0(tmp, '.');
242+
if (strcmp( dropTrailing0(tmp, '.'), "-0") == 0) return "0";
243+
else return dropTrailing0(tmp, '.');
242244
}
243245
#define NB 1000
244246
template <>
@@ -268,8 +270,13 @@ inline SEXP r_coerce<CPLXSXP,STRSXP>(Rcomplex from) {
268270
return Rcpp::traits::is_na<CPLXSXP>(from) ? NA_STRING : Rf_mkChar( coerce_to_string<CPLXSXP>( from ) ) ;
269271
}
270272
template <>
271-
inline SEXP r_coerce<REALSXP,STRSXP>(double from){
272-
return Rcpp::traits::is_na<REALSXP>(from) ? NA_STRING :Rf_mkChar( coerce_to_string<REALSXP>( from ) ) ;
273+
inline SEXP r_coerce<REALSXP,STRSXP>(double from){
274+
275+
// handle some special values explicitly
276+
if (R_IsNaN(from)) return Rf_mkChar("NaN");
277+
else if (from == R_PosInf) return Rf_mkChar("Inf");
278+
else if (from == R_NegInf) return Rf_mkChar("-Inf");
279+
else return Rcpp::traits::is_na<REALSXP>(from) ? NA_STRING :Rf_mkChar( coerce_to_string<REALSXP>( from ) ) ;
273280
}
274281
template <>
275282
inline SEXP r_coerce<INTSXP ,STRSXP>(int from){

inst/include/Rcpp/platform/compiler.h

Lines changed: 9 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22
//
33
// compiler.h: Rcpp R/C++ interface class library -- check compiler
44
//
5-
// Copyright (C) 2012 - 2013 Dirk Eddelbuettel and Romain Francois
5+
// Copyright (C) 2012 - 2013 Dirk Eddelbuettel, Romain Francois, and Kevin Ushey
66
//
77
// This file is part of Rcpp.
88
//
@@ -144,31 +144,39 @@
144144
#ifdef HAS_CXX0X_FLAG
145145
#if defined(HAS_CXX0X_UNORDERED_MAP)
146146
#include <unordered_map>
147+
#define RCPP_USING_UNORDERED_MAP
147148
#define RCPP_UNORDERED_MAP std::unordered_map
148149
#else
149150
#include <map>
151+
#define RCPP_USING_MAP
150152
#define RCPP_UNORDERED_MAP std::map
151153
#endif
152154
#if defined(HAS_CXX0X_UNORDERED_SET)
153155
#include <unordered_set>
156+
#define RCPP_USING_UNORDERED_SET
154157
#define RCPP_UNORDERED_SET std::unordered_set
155158
#else
156159
#include <set>
160+
#define RCPP_USING_SET
157161
#define RCPP_UNORDERED_SET std::set
158162
#endif
159163
#else
160164
#if defined(HAS_TR1_UNORDERED_MAP)
161165
#include <tr1/unordered_map>
166+
#define RCPP_USING_TR1_UNORDERED_MAP
162167
#define RCPP_UNORDERED_MAP std::tr1::unordered_map
163168
#else
164169
#include <map>
170+
#define RCPP_USING_MAP
165171
#define RCPP_UNORDERED_MAP std::map
166172
#endif
167173
#if defined(HAS_TR1_UNORDERED_SET)
168174
#include <tr1/unordered_set>
175+
#define RCPP_USING_TR1_UNORDERED_SET
169176
#define RCPP_UNORDERED_SET std::tr1::unordered_set
170177
#else
171178
#include <set>
179+
#define RCPP_USING_SET
172180
#define RCPP_UNORDERED_SET std::set
173181
#endif
174182
#endif

inst/include/Rcpp/sugar/functions/table.h

Lines changed: 39 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22
//
33
// table.h: Rcpp R/C++ interface class library -- table match
44
//
5-
// Copyright (C) 2012 Dirk Eddelbuettel and Romain Francois
5+
// Copyright (C) 2012 - 2013 Dirk Eddelbuettel, Romain Francois, and Kevin Ushey
66
//
77
// This file is part of Rcpp.
88
//
@@ -21,22 +21,23 @@
2121

2222
#ifndef Rcpp__sugar__table_h
2323
#define Rcpp__sugar__table_h
24+
25+
#include <Rcpp/sugar/tools/mapcompare.h>
2426

2527
namespace Rcpp{
2628
namespace sugar{
2729

2830
template <typename HASH, typename STORAGE>
2931
class CountInserter {
3032
public:
31-
CountInserter( HASH& hash_ ) : hash(hash_), index(0) {}
33+
CountInserter( HASH& hash_ ) : hash(hash_) {}
3234

3335
inline void operator()( STORAGE value ){
3436
hash[value]++ ;
3537
}
3638

3739
private:
3840
HASH& hash ;
39-
int index;
4041
} ;
4142

4243
template <typename HASH, int RTYPE>
@@ -56,6 +57,36 @@ class Grabber{
5657
int index ;
5758
} ;
5859

60+
// we define a different Table class depending on whether we are using
61+
// std::map or not
62+
#ifdef RCPP_USING_MAP
63+
64+
template <int RTYPE, typename TABLE_T>
65+
class Table {
66+
public:
67+
typedef typename Rcpp::traits::storage_type<RTYPE>::type STORAGE ;
68+
69+
Table( const TABLE_T& table ): hash() {
70+
std::for_each( table.begin(), table.end(), Inserter(hash) ) ;
71+
}
72+
73+
inline operator IntegerVector() const {
74+
int n = hash.size() ;
75+
IntegerVector result = no_init(n) ;
76+
CharacterVector names = no_init(n) ;
77+
std::for_each( hash.begin(), hash.end(), Grabber<HASH, RTYPE>(result, names) ) ;
78+
result.names() = names ;
79+
return result ;
80+
}
81+
82+
private:
83+
typedef RCPP_UNORDERED_MAP<STORAGE, int, MapCompare<STORAGE> >HASH ;
84+
typedef CountInserter<HASH,STORAGE> Inserter ;
85+
HASH hash ;
86+
};
87+
88+
#else
89+
5990
template <int RTYPE, typename TABLE_T>
6091
class Table {
6192
public:
@@ -82,12 +113,14 @@ class Table {
82113
private:
83114
typedef RCPP_UNORDERED_MAP<STORAGE, int> HASH ;
84115
typedef CountInserter<HASH,STORAGE> Inserter ;
85-
86-
typedef std::map<STORAGE, int, typename Rcpp::traits::comparator_type<RTYPE>::type > SORTED_MAP ;
87-
88116
HASH hash ;
117+
118+
typedef std::map<STORAGE, int, MapCompare<STORAGE> > SORTED_MAP ;
89119
SORTED_MAP map ;
120+
90121
};
122+
123+
#endif // USING_RCPP_MAP
91124

92125
} // sugar
93126

Lines changed: 93 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,93 @@
1+
// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
2+
//
3+
// mapcompare.h: Rcpp R/C++ interface class library -- comparator for table
4+
//
5+
// Copyright (C) 2012 - 2013 Dirk Eddelbuettel, Romain Francois, and Kevin Ushey
6+
//
7+
// This file is part of Rcpp.
8+
//
9+
// Rcpp is free software: you can redistribute it and/or modify it
10+
// under the terms of the GNU General Public License as published by
11+
// the Free Software Foundation, either version 2 of the License, or
12+
// (at your option) any later version.
13+
//
14+
// Rcpp is distributed in the hope that it will be useful, but
15+
// WITHOUT ANY WARRANTY; without even the implied warranty of
16+
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17+
// GNU General Public License for more details.
18+
//
19+
// You should have received a copy of the GNU General Public License
20+
// along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
21+
22+
#ifndef Rcpp__sugar__tools__mapcompare_h
23+
#define Rcpp__sugar__tools__mapcompare_h
24+
25+
namespace Rcpp {
26+
namespace sugar {
27+
28+
static unsigned long const R_UNSIGNED_LONG_NA_REAL = *(unsigned long*)(&NA_REAL);
29+
static unsigned long const R_UNSIGNED_LONG_NAN_REAL = *(unsigned long*)(&R_NaN);
30+
31+
inline bool Rcpp_IsNA(double x) {
32+
return *reinterpret_cast<unsigned long*>(&x) == R_UNSIGNED_LONG_NA_REAL;
33+
}
34+
35+
inline bool Rcpp_IsNaN(double x) {
36+
return *reinterpret_cast<unsigned long*>(&x) == R_UNSIGNED_LONG_NAN_REAL;
37+
}
38+
39+
inline int StrCmp(SEXP x, SEXP y) {
40+
if (x == NA_STRING) return (y == NA_STRING ? 0 : 1);
41+
if (y == NA_STRING) return -1;
42+
if (x == y) return 0; // same string in cache
43+
return strcmp(CHAR(x), CHAR(y));
44+
}
45+
46+
template <typename T>
47+
struct MapCompare {
48+
inline bool operator()(T left, T right) const {
49+
return left < right;
50+
}
51+
};
52+
53+
template <>
54+
struct MapCompare<int> {
55+
inline bool operator()(int left, int right) const {
56+
if (left == NA_INTEGER) return false;
57+
if (right == NA_INTEGER) return true;
58+
return left < right;
59+
}
60+
};
61+
62+
template <>
63+
struct MapCompare<double> {
64+
inline bool operator()(double left, double right) const {
65+
66+
bool leftNaN = (left != left);
67+
bool rightNaN = (right != right);
68+
69+
// this branch inspired by data.table: see
70+
// https://github.com/arunsrinivasan/datatable/commit/1a3e476d3f746e18261662f484d2afa84ac7a146#commitcomment-4885242
71+
if (Rcpp_IsNaN(right) and Rcpp_IsNA(left)) return true;
72+
73+
if (leftNaN != rightNaN) {
74+
return leftNaN < rightNaN;
75+
} else {
76+
return left < right;
77+
}
78+
79+
}
80+
81+
};
82+
83+
template <>
84+
struct MapCompare<SEXP> {
85+
inline bool operator()(SEXP left, SEXP right) const {
86+
return StrCmp(left, right) < 0;
87+
}
88+
};
89+
90+
}
91+
}
92+
93+
#endif

inst/unitTests/cpp/table.cpp

Lines changed: 37 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,37 @@
1+
// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
2+
//
3+
// table.cpp: Rcpp R/C++ interface class library -- table<> unit tests
4+
//
5+
// Copyright (C) 2013 Dirk Eddelbuettel, Romain Francois, and Kevin Ushey
6+
//
7+
// This file is part of Rcpp.
8+
//
9+
// Rcpp is free software: you can redistribute it and/or modify it
10+
// under the terms of the GNU General Public License as published by
11+
// the Free Software Foundation, either version 2 of the License, or
12+
// (at your option) any later version.
13+
//
14+
// Rcpp is distributed in the hope that it will be useful, but
15+
// WITHOUT ANY WARRANTY; without even the implied warranty of
16+
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17+
// GNU General Public License for more details.
18+
//
19+
// You should have received a copy of the GNU General Public License
20+
// along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
21+
22+
#include <Rcpp.h>
23+
using namespace Rcpp ;
24+
25+
// [[Rcpp::export]]
26+
IntegerVector RcppTable(SEXP x) {
27+
switch (TYPEOF(x)) {
28+
case INTSXP: return table(as<IntegerVector>(x));
29+
case REALSXP: return table(as<NumericVector>(x));
30+
case STRSXP: return table(as<CharacterVector>(x));
31+
case LGLSXP: return table(as<LogicalVector>(x));
32+
default: {
33+
stop("untested SEXP type");
34+
return R_NilValue;
35+
}
36+
}
37+
}

inst/unitTests/runit.table.R

Lines changed: 48 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,48 @@
1+
#!/usr/bin/r -t
2+
#
3+
# Copyright (C) 2013 Dirk Eddelbuettel, Romain Francois, and Kevin Ushey
4+
#
5+
# This file is part of Rcpp.
6+
#
7+
# Rcpp is free software: you can redistribute it and/or modify it
8+
# under the terms of the GNU General Public License as published by
9+
# the Free Software Foundation, either version 2 of the License, or
10+
# (at your option) any later version.
11+
#
12+
# Rcpp is distributed in the hope that it will be useful, but
13+
# WITHOUT ANY WARRANTY; without even the implied warranty of
14+
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15+
# GNU General Public License for more details.
16+
#
17+
# You should have received a copy of the GNU General Public License
18+
# along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
19+
20+
.runThisTest <- Sys.getenv("RunAllRcppTests") == "yes"
21+
22+
if (.runThisTest) {
23+
24+
.setUp <- Rcpp:::unit_test_setup("table.cpp")
25+
26+
table_ <- function(x) c(base::table(x, useNA="ifany"))
27+
28+
test.table.numeric <- function() {
29+
x <- c(1, 2, 1, 1, NA, NaN, -Inf, Inf)
30+
checkEquals( RcppTable(x), table_(x), "table matches R: numeric case")
31+
}
32+
33+
test.table.integer <- function() {
34+
x <- c(-1L, 1L, NA_integer_, NA_integer_, 100L, 1L)
35+
checkEquals( RcppTable(x), table_(x), "table matches R: integer case")
36+
}
37+
38+
test.table.logical <- function() {
39+
x <- c(TRUE, TRUE, FALSE, NA)
40+
checkEquals( RcppTable(x), table_(x), "table matches R: logical case")
41+
}
42+
43+
test.table.character <- function() {
44+
x <- c("a", "a", "b", "a", NA, NA)
45+
checkEquals( RcppTable(x), table_(x), "table matches R: character case")
46+
}
47+
48+
}

0 commit comments

Comments
 (0)