Rcpp Version 0.12.12
RObject.r
Go to the documentation of this file.
1 #!/usr/bin/env r
2 #
3 # Copyright (C) 2009 - 2010 Dirk Eddelbuettel and Romain Francois
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 ## NB This file is mostly historic and predates the unit tests.
21 ## Yet it still provides useful examples -- but the unitTests/
22 ## for vastly larger coverage
23 
24 suppressMessages(library(Rcpp))
25 suppressMessages(library(inline))
26 
27 cat("===Doubles\n")
28 foo <- '
29  double d = Rcpp::as<double>(x);
30  std::cout << "Returning twice the value of " << d << " : ";
31  return(Rcpp::wrap( 2*d ) );
32  '
33 funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
34 cat(funx(x=2.123), "\n")
35 cat(funx(x=2), "\n")
36 ##funx(x='2') ## throws as expected
37 ##funx(x=2:3) ## throws as expected
38 
39 
40 cat("\n===Int\n")
41 foo <- '
42  int i = Rcpp::as<int>(x);
43  std::cout << "Returning twice the value of " << i << " : ";
44  return(Rcpp::wrap( 2*i ) );
45  '
46 funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
47 cat(funx(x=2), "\n")
48 cat(funx(x=2.2), "\n")
49 funx <- cfunction(signature(x="raw"), foo, Rcpp=TRUE, verbose=FALSE)
50 cat(funx(x=as.raw(2)), "\n")
51 
52 cat("\n===String\n")
53 foo <- '
54  std::string s = Rcpp::as<std::string>(x);
55  std::cout << "Returning twice the value of " << s << " : ";
56  return(Rcpp::wrap( s+s ) );
57  '
58 funx <- cfunction(signature(x="character"), foo, Rcpp=TRUE, verbose=FALSE)
59 cat(funx(x="abc"), "\n")
60 
61 cat("\n===Raw (bytes)\n")
62 foo <- '
63  Rbyte i = Rcpp::as<Rbyte>(x) ;
64  std::cout << "Returning twice the value of " << (int)i << " : ";
65  return(Rcpp::wrap( (Rbyte)(2*i) ) );
66  '
67 funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
68 cat( funx(x=2), "\n")
69 funx <- cfunction(signature(x="integer"), foo, Rcpp=TRUE, verbose=FALSE)
70 cat( funx(x=2L), "\n")
71 funx <- cfunction(signature(x="raw"), foo, Rcpp=TRUE, verbose=FALSE)
72 cat( funx(x=as.raw(2)), "\n")
73 
74 cat("\n=== logical \n")
75 foo <- '
76 bool b = Rcpp::as<bool>(x);
77 std::cout << "flip " << ( b ? "TRUE" : "FALSE" ) << " : ";
78 return(Rcpp::wrap( !b ));
79 '
80 funx <- cfunction(signature(x="logical"), foo, Rcpp=TRUE, verbose=FALSE)
81 cat( res <- funx(x=TRUE) , "\n") ; stopifnot( !res )
82 cat( res <- funx(x=FALSE), "\n" ) ; stopifnot( res)
83 funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
84 cat( res <- funx(x=2) , "\n") ; stopifnot( !res )
85 cat( res <- funx(x=0.0), "\n") ; stopifnot( res)
86 funx <- cfunction(signature(x="integer"), foo, Rcpp=TRUE, verbose=FALSE)
87 cat( res <- funx(x=2L), "\n") ; stopifnot( !res )
88 cat( res <- funx(x=0L), "\n") ; stopifnot( res)
89 funx <- cfunction(signature(x="raw"), foo, Rcpp=TRUE, verbose=FALSE)
90 cat( res <- funx(x=as.raw(2)), "\n") ; stopifnot( !res )
91 cat( res <- funx(x=as.raw(0)), "\n") ; stopifnot( res)
92 
93 ### vectors
94 
95 cat("\n===Int Vector via wrap\n")
96 foo <- '
97  std::vector<int> iv = Rcpp::as< std::vector<int> >(x) ;
98  std::cout << "Returning twice the value of vector : ";
99  for (size_t i=0; i<iv.size(); i++) {
100  iv[i] = 2*iv[i];
101  }
102  return(Rcpp::wrap(iv));
103  '
104 funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
105 print(funx(x=2:5))
106 funx <- cfunction(signature(x="integer"), foo, Rcpp=TRUE, verbose=FALSE)
107 print(funx(x=2:5))
108 funx <- cfunction(signature(x="raw"), foo, Rcpp=TRUE, verbose=FALSE)
109 print(funx(x=as.raw(2:5)))
110 
111 cat("\n===Int Vector\n")
112 foo <- '
113  std::vector<int> iv = Rcpp::as< std::vector<int> >(x) ;
114  std::cout << "Returning twice the value of vector : ";
115  for (size_t i=0; i<iv.size(); i++) {
116  iv[i] = 2*iv[i];
117  }
118  return(Rcpp::wrap( iv ) );
119  '
120 funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
121 print(funx(x=2:5+.1))
122 funx <- cfunction(signature(x="integer"), foo, Rcpp=TRUE, verbose=FALSE)
123 print(funx(x=2:5))
124 funx <- cfunction(signature(x="raw"), foo, Rcpp=TRUE, verbose=FALSE)
125 print(funx(x=as.raw(2:5)))
126 
127 
128 cat("\n===Double Vector\n")
129 foo <- '
130  std::vector<double> iv = Rcpp::as< std::vector<double> >(x) ;
131  std::cout << "Returning twice the value of vector : ";
132  for (size_t i=0; i<iv.size(); i++) {
133  iv[i] = 2*iv[i];
134  }
135  return(Rcpp::wrap( iv ));
136  '
137 funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
138 print(funx(x=0.1+2:5))
139 funx <- cfunction(signature(x="integer"), foo, Rcpp=TRUE, verbose=FALSE)
140 print(funx(x=2:5))
141 funx <- cfunction(signature(x="raw"), foo, Rcpp=TRUE, verbose=FALSE)
142 print(funx(x=as.raw(2:5)))
143 
144 cat("\n===Raw Vector\n")
145 foo <- '
146  std::vector<Rbyte> iv = Rcpp::as< std::vector<Rbyte> >(x) ;
147  std::cout << "Returning twice the value of vector : ";
148  for (size_t i=0; i<iv.size(); i++) {
149  iv[i] = 2*iv[i];
150  }
151  return(Rcpp::wrap( iv ));
152  '
153 funx <- cfunction(signature(x="raw"), foo, Rcpp=TRUE, verbose=FALSE)
154 print(funx(x=as.raw(0:9)))
155 funx <- cfunction(signature(x="integer"), foo, Rcpp=TRUE, verbose=FALSE)
156 print(funx(x=0:9))
157 funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
158 print(funx(x=0:9+.1))
159 
160 cat("\n=== vector<bool>\n")
161 foo <- '
162 std::vector<bool> bv = Rcpp::as< std::vector<bool> >(x) ;
163 std::cout << "Flip the value of vector : ";
164 for (size_t i=0; i<bv.size(); i++) {
165  bv[i].flip() ;
166 }
167 return(Rcpp::wrap( bv ));
168 '
169 funx <- cfunction(signature(x="logical"), foo, Rcpp=TRUE, verbose=FALSE)
170 print(funx(x=c(TRUE,FALSE)))
171 funx <- cfunction(signature(x="raw"), foo, Rcpp=TRUE, verbose=FALSE)
172 print(funx(x=as.raw(0:9)))
173 funx <- cfunction(signature(x="integer"), foo, Rcpp=TRUE, verbose=FALSE)
174 print(funx(x=0:9))
175 funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
176 print(funx(x=as.numeric(0:9)))
177 
178 
179 cat("\n===String Vector\n")
180 foo <- '
181  std::vector<std::string> iv = Rcpp::as< std::vector<std::string> >(x);
182  std::cout << "Returning twice the value of vector : ";
183  for (size_t i=0; i<iv.size(); i++) {
184  iv[i] = iv[i] + iv[i];
185  }
186  return(Rcpp::wrap( iv ));
187  '
188 funx <- cfunction(signature(x="character"), foo, Rcpp=TRUE, verbose=FALSE)
189 print(funx(x=c("foo", "bar")))
190 
191 ### using std::set
192 cat("\n=== set<int>\n")
193 foo <- '
194 std::set<int> iv ;
195 iv.insert( 0 ) ;
196 iv.insert( 1 ) ;
197 iv.insert( 0 ) ;
198 return Rcpp::wrap( iv );'
199 funx <- cfunction(signature(), foo, Rcpp=TRUE, verbose=FALSE, includes = "#include <set>" )
200 print(res <- funx())
201 stopifnot( identical( res, 0:1 ) )
202 
203 cat("\n=== set<double>\n")
204 foo <- '
205 std::set<double> ds;
206 ds.insert( 0.0 );
207 ds.insert( 1.0 );
208 ds.insert( 0.0 );
209 return(Rcpp::wrap( ds )); '
210 funx <- cfunction(signature(), foo, Rcpp=TRUE, verbose=FALSE, includes = "#include <set>")
211 print( res <- funx() )
212 stopifnot( identical( res, as.numeric(0:1)))
213 
214 cat("\n=== set<raw>\n")
215 foo <- '
216 std::set<Rbyte> bs ;
217 bs.insert( (Rbyte)0 ) ;
218 bs.insert( (Rbyte)1 ) ;
219 bs.insert( (Rbyte)0 ) ;
220 return(Rcpp::wrap( bs )); '
221 funx <- cfunction(signature(), foo, Rcpp=TRUE, verbose=FALSE, includes = "#include <set>")
222 print( res <- funx() )
223 stopifnot( identical( res, as.raw(0:1)))
224 
225 cat("\n=== set<string> \n")
226 foo <- '
227 std::set<std::string> ss ;
228 ss.insert( "foo" ) ;
229 ss.insert( "bar" ) ;
230 ss.insert( "foo" ) ;
231 return(Rcpp::wrap( ss )); '
232 funx <- cfunction(signature(), foo, Rcpp=TRUE, verbose=FALSE, include = "#include <set>" )
233 print( res <- funx() )
234 stopifnot( identical( res, c("bar","foo")) )
235 
236 
237 #========= attributes
238 
239 funx <- cfunction(
240  signature(x="data.frame"), '
241 std::vector<std::string> iv = Rcpp::RObject(x).attributeNames();
242 return(Rcpp::wrap( iv ));
243 ', Rcpp=TRUE, verbose=FALSE)
244 res <- funx( iris )
245 stopifnot( all( c("names", "row.names", "class" ) %in% res ) )
246 
247 funx <- cfunction(signature(x="data.frame"), '
248 bool has_class = Rcpp::RObject(x).hasAttribute( "class" ) ;
249 return Rcpp::wrap( has_class ) ;
250 ', Rcpp=TRUE, verbose=FALSE)
251 res <- funx( iris )
252 stopifnot( res )
253 
254 funx <- cfunction(signature(x="data.frame"), '
255 return Rcpp::RObject(x).attr( "row.names" ) ;
256 ', Rcpp=TRUE, verbose=FALSE)
257 res <- funx( iris )
258 stopifnot( identical(res, 1:150) )
259 
260 #============ NULL
261 funx <- cfunction(signature(x="ANY"), '
262 bool is_null = Rcpp::RObject(x).isNULL() ;
263 return Rcpp::wrap( is_null ) ;
264 ', Rcpp=TRUE, verbose=FALSE)
265 res <- funx( iris )
266 stopifnot( !res )
267 res <- funx( NULL )
268 stopifnot( res )
269 
270 
271