Rcpp Version 1.0.9
random.h
Go to the documentation of this file.
1 // -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*-
2 //
3 // random.h: Rcpp R/C++ interface class library --
4 //
5 // Copyright (C) 2010 - 2016 Douglas Bates, Dirk Eddelbuettel and Romain Francois
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__stats__random_random_h
23 #define Rcpp__stats__random_random_h
24 
25 namespace Rcpp{
26 
27 template <typename T>
28 class Generator {
29 public:
30  typedef T r_generator ;
31 };
32 
33 }
41 #include <Rcpp/stats/random/rf.h>
42 #include <Rcpp/stats/random/rt.h>
45 #include <Rcpp/stats/random/rexp.h>
55 
56 namespace Rcpp{
57 
58 inline NumericVector rnorm( int n, double mean, double sd){
59  if (ISNAN(mean) || !R_FINITE(sd) || sd < 0.){
60  // TODO: R also throws a warning in that case, should we ?
61  return NumericVector( n, R_NaN ) ;
62  } else if (sd == 0. || !R_FINITE(mean)){
63  return NumericVector( n, mean ) ;
64  } else {
65  bool sd1 = sd == 1.0 ;
66  bool mean0 = mean == 0.0 ;
67  if( sd1 && mean0 ){
69  } else if( sd1 ){
71  } else if( mean0 ){
73  } else {
74  // general case
75  return NumericVector( n, stats::NormGenerator( mean, sd ) );
76  }
77  }
78 }
79 
80 inline NumericVector rnorm( int n, double mean /*, double sd [=1.0] */ ){
81  if (ISNAN(mean) ){
82  // TODO: R also throws a warning in that case, should we ?
83  return NumericVector( n, R_NaN ) ;
84  } else if ( !R_FINITE(mean)){
85  return NumericVector( n, mean ) ;
86  } else {
87  bool mean0 = mean == 0.0 ;
88  if( mean0 ){
90  } else {
92  }
93  }
94 }
95 
96 inline NumericVector rnorm( int n /*, double mean [=0.0], double sd [=1.0] */ ){
97  return NumericVector( n, stats::NormGenerator() ) ;
98 }
99 
100 inline NumericVector rbeta( int n, double a, double b ){
101  return NumericVector( n, stats::BetaGenerator(a, b ) ) ;
102 }
103 
104 inline NumericVector rbinom( int n, double nin, double pp ){
105  return NumericVector( n, stats::BinomGenerator(nin, pp) ) ;
106 }
107 
108 inline NumericVector rcauchy( int n, double location, double scale ){
109  if (ISNAN(location) || !R_FINITE(scale) || scale < 0)
110  return NumericVector( n, R_NaN ) ;
111 
112  if (scale == 0. || !R_FINITE(location))
113  return NumericVector( n, location ) ;
114 
115  return NumericVector( n, stats::CauchyGenerator( location, scale ) ) ;
116 }
117 
118 inline NumericVector rcauchy( int n, double location /* , double scale [=1.0] */ ){
119  if (ISNAN(location))
120  return NumericVector( n, R_NaN ) ;
121 
122  if (!R_FINITE(location))
123  return NumericVector( n, location ) ;
124 
125  return NumericVector( n, stats::CauchyGenerator_1( location ) ) ;
126 }
127 
128 inline NumericVector rcauchy( int n /*, double location [=0.0] , double scale [=1.0] */ ){
129  return NumericVector( n, stats::CauchyGenerator_0() ) ;
130 }
131 
132 inline NumericVector rchisq( int n, double df ){
133  if (!R_FINITE(df) || df < 0.0) return NumericVector(n, R_NaN) ;
134  return NumericVector( n, stats::ChisqGenerator( df ) ) ;
135 }
136 
137 inline NumericVector rexp( int n, double rate ){
138  double scale = 1.0 / rate ;
139  if (!R_FINITE(scale) || scale <= 0.0) {
140  if(scale == 0.) return NumericVector( n, 0.0 ) ;
141  /* else */
142  return NumericVector( n, R_NaN ) ;
143  }
144  return NumericVector( n, stats::ExpGenerator( scale ) ) ;
145 }
146 
147 inline NumericVector rexp( int n /* , rate = 1 */ ){
149 }
150 
151 inline NumericVector rf( int n, double n1, double n2 ){
152  if (ISNAN(n1) || ISNAN(n2) || n1 <= 0. || n2 <= 0.)
153  return NumericVector( n, R_NaN ) ;
154  if( R_FINITE( n1 ) && R_FINITE( n2 ) ){
155  return NumericVector( n, stats::FGenerator_Finite_Finite( n1, n2 ) ) ;
156  } else if( ! R_FINITE( n1 ) && ! R_FINITE( n2 ) ){
157  return NumericVector( n, 1.0 ) ;
158  } else if( ! R_FINITE( n1 ) ) {
160  } else {
162  }
163 }
164 
165 inline NumericVector rgamma( int n, double a, double scale ){
166  if (!R_FINITE(a) || !R_FINITE(scale) || a < 0.0 || scale <= 0.0) {
167  if(scale == 0.) return NumericVector( n, 0.) ;
168  return NumericVector( n, R_NaN ) ;
169  }
170  if( a == 0. ) return NumericVector(n, 0. ) ;
171  return NumericVector( n, stats::GammaGenerator(a, scale) ) ;
172 }
173 
174 inline NumericVector rgamma( int n, double a /* scale = 1.0 */ ){
175  if (!R_FINITE(a) || a < 0.0 ) {
176  return NumericVector( n, R_NaN ) ;
177  }
178  if( a == 0. ) return NumericVector(n, 0. ) ;
179  /* TODO: check if we can take advantage of the scale = 1 special case */
180  return NumericVector( n, stats::GammaGenerator(a, 1.0) ) ;
181 }
182 
183 inline NumericVector rgeom( int n, double p ){
184  if (!R_FINITE(p) || p <= 0 || p > 1)
185  return NumericVector( n, R_NaN );
186  return NumericVector( n, stats::GeomGenerator( p ) ) ;
187 }
188 
189 inline NumericVector rhyper( int n, double nn1, double nn2, double kk ){
190  return NumericVector( n, stats::HyperGenerator( nn1, nn2, kk ) ) ;
191 }
192 
193 inline NumericVector rlnorm( int n, double meanlog, double sdlog ){
194  if (ISNAN(meanlog) || !R_FINITE(sdlog) || sdlog < 0.){
195  // TODO: R also throws a warning in that case, should we ?
196  return NumericVector( n, R_NaN ) ;
197  } else if (sdlog == 0. || !R_FINITE(meanlog)){
198  return NumericVector( n, ::exp( meanlog ) ) ;
199  } else {
200  return NumericVector( n, stats::LNormGenerator( meanlog, sdlog ) );
201  }
202 }
203 
204 inline NumericVector rlnorm( int n, double meanlog /*, double sdlog = 1.0 */){
205  if (ISNAN(meanlog) ){
206  // TODO: R also throws a warning in that case, should we ?
207  return NumericVector( n, R_NaN ) ;
208  } else if ( !R_FINITE(meanlog)){
209  return NumericVector( n, ::exp( meanlog ) ) ;
210  } else {
211  return NumericVector( n, stats::LNormGenerator_1( meanlog ) );
212  }
213 }
214 
215 inline NumericVector rlnorm( int n /*, double meanlog [=0.], double sdlog = 1.0 */){
216  return NumericVector( n, stats::LNormGenerator_0( ) );
217 }
218 
219 inline NumericVector rlogis( int n, double location, double scale ){
220  if (ISNAN(location) || !R_FINITE(scale))
221  return NumericVector( n, R_NaN ) ;
222 
223  if (scale == 0. || !R_FINITE(location))
224  return NumericVector( n, location );
225 
226  return NumericVector( n, stats::LogisGenerator( location, scale ) ) ;
227 }
228 
229 inline NumericVector rlogis( int n, double location /*, double scale =1.0 */ ){
230  if (ISNAN(location) )
231  return NumericVector( n, R_NaN ) ;
232 
233  if (!R_FINITE(location))
234  return NumericVector( n, location );
235 
236  return NumericVector( n, stats::LogisGenerator_1( location ) ) ;
237 }
238 
239 inline NumericVector rlogis( int n /*, double location [=0.0], double scale =1.0 */ ){
240  return NumericVector( n, stats::LogisGenerator_0() ) ;
241 }
242 
243 inline NumericVector rnbinom( int n, double siz, double prob ){
244  if(!R_FINITE(siz) || !R_FINITE(prob) || siz <= 0 || prob <= 0 || prob > 1)
245  /* prob = 1 is ok, PR#1218 */
246  return NumericVector( n, R_NaN ) ;
247 
248  return NumericVector( n, stats::NBinomGenerator( siz, prob ) ) ;
249 }
250 
251 inline NumericVector rnbinom_mu( int n, double siz, double mu ){
252  if(!R_FINITE(siz) || !R_FINITE(mu) || siz <= 0 || mu < 0)
253  return NumericVector( n, R_NaN ) ;
254 
255  return NumericVector( n, stats::NBinomGenerator_Mu( siz, mu ) ) ;
256 }
257 
258 inline NumericVector rnchisq( int n, double df, double lambda ){
259  if (!R_FINITE(df) || !R_FINITE(lambda) || df < 0. || lambda < 0.)
260  return NumericVector(n, R_NaN) ;
261  if( lambda == 0.0 ){
262  // using the central generator, see rchisq.h
263  return NumericVector( n, stats::ChisqGenerator( df ) ) ;
264  }
265  return NumericVector( n, stats::NChisqGenerator( df, lambda ) ) ;
266 }
267 
268 inline NumericVector rnchisq( int n, double df /*, double lambda = 0.0 */ ){
269  if (!R_FINITE(df) || df < 0. )
270  return NumericVector(n, R_NaN) ;
271  return NumericVector( n, stats::ChisqGenerator( df ) ) ;
272 }
273 
274 inline NumericVector rpois( int n, double mu ){
275  return NumericVector( n, stats::PoissonGenerator(mu) ) ;
276 }
277 
278 inline NumericVector rsignrank( int n, double nn ){
279  return NumericVector( n, stats::SignRankGenerator(nn) ) ;
280 }
281 
282 inline NumericVector rt( int n, double df ){
283  // special case
284  if (ISNAN(df) || df <= 0.0)
285  return NumericVector( n, R_NaN ) ;
286 
287  // just generating a N(0,1)
288  if(!R_FINITE(df))
290 
291  // general case
292  return NumericVector( n, stats::TGenerator( df ) ) ;
293 }
294 
295 inline NumericVector runif( int n, double min, double max ){
296  if (!R_FINITE(min) || !R_FINITE(max) || max < min) return NumericVector( n, R_NaN ) ;
297  if( min == max ) return NumericVector( n, min ) ;
298  return NumericVector( n, stats::UnifGenerator( min, max ) ) ;
299 }
300 
301 inline NumericVector runif( int n, double min /*, double max = 1.0 */ ){
302  if (!R_FINITE(min) || 1.0 < min) return NumericVector( n, R_NaN ) ;
303  if( min == 1.0 ) return NumericVector( n, 1.0 ) ;
304  return NumericVector( n, stats::UnifGenerator( min, 1.0 ) ) ;
305 }
306 
307 inline NumericVector runif( int n /*, double min = 0.0, double max = 1.0 */ ){
309 }
310 
311 inline NumericVector rweibull( int n, double shape, double scale ){
312  if (!R_FINITE(shape) || !R_FINITE(scale) || shape <= 0. || scale <= 0.) {
313  if(scale == 0.) return NumericVector(n, 0.);
314  /* else */
315  return NumericVector(n, R_NaN);
316  }
317  return NumericVector( n, stats::WeibullGenerator( shape, scale ) ) ;
318 }
319 
320 inline NumericVector rweibull( int n, double shape /* scale = 1 */ ){
321  if (!R_FINITE(shape) || shape <= 0. ) {
322  return NumericVector(n, R_NaN);
323  }
324  return NumericVector( n, stats::WeibullGenerator__scale1( shape ) ) ;
325 }
326 
327 inline NumericVector rwilcox( int n, double mm, double nn ){
328  return NumericVector( n, stats::WilcoxGenerator(mm, nn) ) ;
329 }
330 }
331 
332 #endif
double df(double x, double df1, double df2, int lg)
Definition: Rmath.h:84
void exp(InputIterator begin, InputIterator end, OutputIterator out)
Definition: algorithm.h:474
Rcpp API.
Definition: algo.h:28
Vector< REALSXP > NumericVector
Definition: instantiation.h:30
NumericVector rexp(int n, double rate)
Definition: random.h:137
NumericVector rnbinom(int n, double siz, double prob)
Definition: random.h:243
NumericVector rsignrank(int n, double nn)
Definition: random.h:278
NumericVector rf(int n, double n1, double n2)
Definition: random.h:151
NumericVector rchisq(int n, double df)
Definition: random.h:132
NumericVector rnchisq(int n, double df, double lambda)
Definition: random.h:258
NumericVector runif(int n, double min, double max)
Definition: random.h:295
sugar::Sd< REALSXP, NA, T > sd(const VectorBase< REALSXP, NA, T > &t)
Definition: sd.h:46
NumericVector rcauchy(int n, double location, double scale)
Definition: random.h:108
NumericVector rbinom(int n, double nin, double pp)
Definition: random.h:104
sugar::Mean< REALSXP, NA, T > mean(const VectorBase< REALSXP, NA, T > &t)
Definition: mean.h:140
NumericVector rgeom(int n, double p)
Definition: random.h:183
NumericVector rnorm(int n, double mean, double sd)
Definition: random.h:58
NumericVector rpois(int n, double mu)
Definition: random.h:274
NumericVector rbeta(int n, double a, double b)
Definition: random.h:100
NumericVector rlogis(int n, double location, double scale)
Definition: random.h:219
sugar::Max< RTYPE, NA, T > max(const VectorBase< RTYPE, NA, T > &x)
Definition: max.h:82
NumericVector rlnorm(int n, double meanlog, double sdlog)
Definition: random.h:193
NumericVector rnbinom_mu(int n, double siz, double mu)
Definition: random.h:251
NumericVector rgamma(int n, double a, double scale)
Definition: random.h:165
NumericVector rweibull(int n, double shape, double scale)
Definition: random.h:311
NumericVector rwilcox(int n, double mm, double nn)
Definition: random.h:327
NumericVector rt(int n, double df)
Definition: random.h:282
NumericVector rhyper(int n, double nn1, double nn2, double kk)
Definition: random.h:189
sugar::Min< RTYPE, NA, T > min(const VectorBase< RTYPE, NA, T > &x)
Definition: min.h:82