Rcpp Version 1.0.9
external_pointer.r
Go to the documentation of this file.
1 #!/usr/bin/env r
2 #
3 # Copyright (C) 2009 - 2010 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 require(Rcpp)
21 require(inline)
22 
23 
24 ## NOTE: This is the old way to compile Rcpp code inline.
25 ## The code here has left as a historical artifact and tribute to the old way.
26 ## Please use the code under the "new" inline compilation section.
27 
28 funx_old <- cxxfunction(signature(), '
29  /* creating a pointer to a vector<int> */
30  std::vector<int>* v = new std::vector<int> ;
31  v->push_back( 1 ) ;
32  v->push_back( 2 ) ;
33 
34  /* wrap the pointer as an external pointer */
35  /* this automatically protected the external pointer from R garbage
36  collection until p goes out of scope. */
37  Rcpp::XPtr< std::vector<int> > p(v) ;
38 
39  /* return it back to R, since p goes out of scope after the return
40  the external pointer is no more protected by p, but it gets
41  protected by being on the R side */
42  return( p ) ;
43 ', plugin = "Rcpp" )
44 xp <- funx_old()
45 stopifnot( identical( typeof( xp ), "externalptr" ) )
46 
47 # passing the pointer back to C++
48 funx_old <- cxxfunction(signature(x = "externalptr" ), '
49  /* wrapping x as smart external pointer */
50  /* The SEXP based constructor does not protect the SEXP from
51  garbage collection automatically, it is already protected
52  because it comes from the R side, however if you want to keep
53  the Rcpp::XPtr object on the C(++) side
54  and return something else to R, you need to protect the external
55  pointer, by using the protect member function */
56  Rcpp::XPtr< std::vector<int> > p(x) ;
57 
58  /* just return the front of the vector as a SEXP */
59  return( Rcpp::wrap( p->front() ) ) ;
60 ', plugin = "Rcpp" )
61 front <- funx_old(xp)
62 stopifnot( identical( front, 1L ) )
63 
64 
65 ## NOTE: Within this section, the new way to compile Rcpp code inline has been
66 ## written. Please use the code next as a template for your own project.
67 
68 ## Use of the cppFunction() gives the ability to immediately compile embedded
69 ## C++ directly within R without having to worry about header specification or
70 ## Rcpp attributes.
71 
72 cppFunction('
73 Rcpp::XPtr< std::vector<int> > funx(){
74  /* creating a pointer to a vector<int> */
75  std::vector<int>* v = new std::vector<int> ;
76  v->push_back( 1 ) ;
77  v->push_back( 2 ) ;
78 
79  /* wrap the pointer as an external pointer */
80  /* this automatically protected the external pointer from R garbage
81  * collection until p goes out of scope.
82  */
83  Rcpp::XPtr< std::vector<int> > p(v) ;
84 
85  /* return it back to R, since p goes out of scope after the return
86  * the external pointer is no more protected by p, but it gets
87  * protected by being on the R side
88  */
89  return( p ) ;
90 }')
91 
92 xp <- funx()
93 stopifnot( identical( typeof( xp ), "externalptr" ) )
94 
95 # passing the pointer back to C++
96 cppFunction('
97 SEXP funx_pt(Rcpp::XPtr< std::vector<int> > p){
98  /* Wrapping x as smart external pointer */
99 
100  /* The SEXP based constructor does not protect the SEXP from
101  * garbage collection automatically, it is already protected
102  * because it comes from the R side, however if you want to keep
103  * the Rcpp::XPtr object on the C(++) side
104  * and return something else to R, you need to protect the external
105  * pointer, by using the protect member function
106  */
107 
108  /* Just return the front of the vector as a SEXP */
109  return Rcpp::wrap(p->front());
110 }')
111 front <- funx_pt(xp)
112 stopifnot( identical( front, 1L ) )
113