2626#ifndef Rcpp__sugar__sample_h
2727#define Rcpp__sugar__sample_h
2828
29- #if defined(WIN32) || defined(__WIN32) || defined(__WIN32__)
30- #include < malloc.h>
31- #else
32- #include < alloca.h>
33- #endif
34-
35- // In order to mirror the behavior of `base::sample`
36- // as closely as possible, this file contains adaptations
29+ #include < vector>
30+
31+ // In order to mirror the behavior of `base::sample`
32+ // as closely as possible, this file contains adaptations
3733// of several functions in R/src/main/random.c:
3834//
3935// * do_sample - general logic as well as the empirical sampling routine.
4339// * walker_ProbSampleReplace, ProbSampleReplace, and ProbSampleNoReplace -
4440// algorithms for sampling according to a supplied probability vector.
4541//
46- // For each of the sampling routines, two signatures are provided:
42+ // For each of the sampling routines, two signatures are provided:
4743//
48- // * A version that returns an integer vector, which can be used to
49- // generate 0-based indices (one_based = false) or 1-based indices
50- // (one_based = true) -- where the latter corresponds to the
51- // bahavior of `base::sample.int`.
44+ // * A version that returns an integer vector, which can be used to
45+ // generate 0-based indices (one_based = false) or 1-based indices
46+ // (one_based = true) -- where the latter corresponds to the
47+ // bahavior of `base::sample.int`.
5248//
5349// * A version which takes an input Vector<> (rather than an integer 'n'),
5450// and samples its elements -- this corresponds to `base::sample`.
@@ -150,26 +146,19 @@ inline Vector<RTYPE> SampleReplace(Vector<REALSXP>& p, int k, const Vector<RTYPE
150146
151147// Adapted from `walker_ProbSampleReplace`
152148// Index version
153- #define SMALL 10000
154149inline Vector<INTSXP> WalkerSample (const Vector<REALSXP>& p, int n, int nans, bool one_based)
155150{
156151 Vector<INTSXP> a = no_init (n), ans = no_init (nans);
157- double *q, rU;
158152 int i, j, k;
159- int *HL, *H, *L;
153+ std::vector<double > q (n);
154+ double rU;
160155
161- int adj = one_based ? 1 : 0 ;
156+ std::vector<int > HL (n);
157+ std::vector<int >::iterator H, L;
162158
163- if (n <= SMALL) {
164- R_CheckStack2 (n * (sizeof (int ) + sizeof (double )));
165- HL = static_cast <int *>(::alloca (n * sizeof (int )));
166- q = static_cast <double *>(::alloca (n * sizeof (double )));
167- } else {
168- HL = static_cast <int *>(Calloc (n, int ));
169- q = static_cast <double *>(Calloc (n, double ));
170- }
159+ int adj = one_based ? 1 : 0 ;
171160
172- H = HL - 1 ; L = HL + n;
161+ H = HL. begin () - 1 ; L = HL. begin () + n;
173162 for (i = 0 ; i < n; i++) {
174163 q[i] = p[i] * n;
175164 if (q[i] < 1.0 ) {
@@ -179,7 +168,7 @@ inline Vector<INTSXP> WalkerSample(const Vector<REALSXP>& p, int n, int nans, bo
179168 }
180169 }
181170
182- if (H >= HL && L < HL + n) {
171+ if (H >= HL. begin () && L < HL. begin () + n) {
183172 for (k = 0 ; k < n - 1 ; k++) {
184173 i = HL[k];
185174 j = *L;
@@ -188,7 +177,7 @@ inline Vector<INTSXP> WalkerSample(const Vector<REALSXP>& p, int n, int nans, bo
188177
189178 L += (q[j] < 1.0 );
190179
191- if (L >= HL + n) {
180+ if (L >= HL. begin () + n) {
192181 break ;
193182 }
194183 }
@@ -204,11 +193,6 @@ inline Vector<INTSXP> WalkerSample(const Vector<REALSXP>& p, int n, int nans, bo
204193 ans[i] = (rU < q[k]) ? k + adj : a[k] + adj;
205194 }
206195
207- if (n > SMALL) {
208- Free (HL);
209- Free (q);
210- }
211-
212196 return ans;
213197}
214198
@@ -221,20 +205,14 @@ inline Vector<RTYPE> WalkerSample(const Vector<REALSXP>& p, int nans, const Vect
221205 Vector<INTSXP> a = no_init (n);
222206 Vector<RTYPE> ans = no_init (nans);
223207
224- double *q, rU;
225208 int i, j, k;
226- int *HL, *H, *L;
227-
228- if (n <= SMALL) {
229- R_CheckStack2 (n * (sizeof (int ) + sizeof (double )));
230- HL = static_cast <int *>(::alloca (n * sizeof (int )));
231- q = static_cast <double *>(::alloca (n * sizeof (double )));
232- } else {
233- HL = static_cast <int *>(Calloc (n, int ));
234- q = static_cast <double *>(Calloc (n, double ));
235- }
209+ std::vector<double > q (n);
210+ double rU;
211+
212+ std::vector<int > HL (n);
213+ std::vector<int >::iterator H, L;
236214
237- H = HL - 1 ; L = HL + n;
215+ H = HL. begin () - 1 ; L = HL. begin () + n;
238216 for (i = 0 ; i < n; i++) {
239217 q[i] = p[i] * n;
240218 if (q[i] < 1.0 ) {
@@ -244,7 +222,7 @@ inline Vector<RTYPE> WalkerSample(const Vector<REALSXP>& p, int nans, const Vect
244222 }
245223 }
246224
247- if (H >= HL && L < HL + n) {
225+ if (H >= HL. begin () && L < HL. begin () + n) {
248226 for (k = 0 ; k < n - 1 ; k++) {
249227 i = HL[k];
250228 j = *L;
@@ -253,7 +231,7 @@ inline Vector<RTYPE> WalkerSample(const Vector<REALSXP>& p, int nans, const Vect
253231
254232 L += (q[j] < 1.0 );
255233
256- if (L >= HL + n) {
234+ if (L >= HL. begin () + n) {
257235 break ;
258236 }
259237 }
@@ -269,14 +247,8 @@ inline Vector<RTYPE> WalkerSample(const Vector<REALSXP>& p, int nans, const Vect
269247 ans[i] = (rU < q[k]) ? ref[k] : ref[a[k]];
270248 }
271249
272- if (n > SMALL) {
273- Free (HL);
274- Free (q);
275- }
276-
277250 return ans;
278251}
279- #undef SMALL
280252
281253// Adapted from `ProbSampleNoReplace`
282254// Index version
@@ -425,7 +397,7 @@ typedef Nullable< Vector<REALSXP> > probs_t;
425397} // sugar
426398
427399// Adapted from `do_sample`
428- inline Vector<INTSXP>
400+ inline Vector<INTSXP>
429401sample (int n, int size, bool replace = false , sugar::probs_t probs = R_NilValue, bool one_based = true )
430402{
431403 if (probs.isNotNull ()) {
@@ -461,7 +433,7 @@ sample(int n, int size, bool replace = false, sugar::probs_t probs = R_NilValue,
461433}
462434
463435template <int RTYPE>
464- inline Vector<RTYPE>
436+ inline Vector<RTYPE>
465437sample (const Vector<RTYPE>& x, int size, bool replace = false , sugar::probs_t probs = R_NilValue)
466438{
467439 int n = x.size ();
0 commit comments