Mercurial > hg > octave-lyh
annotate src/DLD-FUNCTIONS/rand.cc @ 9647:54f45f883a53
optimize & extend randperm
author | Jaroslav Hajek <highegg@gmail.com> |
---|---|
date | Wed, 16 Sep 2009 13:41:49 +0200 |
parents | 610bf90fce2a |
children | 09da0bd91412 |
rev | line source |
---|---|
2928 | 1 /* |
2 | |
7017 | 3 Copyright (C) 1996, 1997, 1998, 1999, 2000, 2002, 2003, 2005, 2006, |
8920 | 4 2007, 2008, 2009 John W. Eaton |
9647
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
5 Copyright (C) 2009 VZLU Prague |
2928 | 6 |
7 This file is part of Octave. | |
8 | |
9 Octave is free software; you can redistribute it and/or modify it | |
10 under the terms of the GNU General Public License as published by the | |
7016 | 11 Free Software Foundation; either version 3 of the License, or (at your |
12 option) any later version. | |
2928 | 13 |
14 Octave is distributed in the hope that it will be useful, but WITHOUT | |
15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
17 for more details. | |
18 | |
19 You should have received a copy of the GNU General Public License | |
7016 | 20 along with Octave; see the file COPYING. If not, see |
21 <http://www.gnu.org/licenses/>. | |
2928 | 22 |
23 */ | |
24 | |
25 #ifdef HAVE_CONFIG_H | |
26 #include <config.h> | |
27 #endif | |
28 | |
29 #include <ctime> | |
30 | |
31 #include <string> | |
32 | |
33 #include "f77-fcn.h" | |
34 #include "lo-mappers.h" | |
4307 | 35 #include "oct-rand.h" |
4153 | 36 #include "quit.h" |
2928 | 37 |
38 #include "defun-dld.h" | |
39 #include "error.h" | |
40 #include "gripes.h" | |
41 #include "oct-obj.h" | |
42 #include "unwind-prot.h" | |
43 #include "utils.h" | |
9647
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
44 #include "ov-re-mat.h" |
2928 | 45 |
6437 | 46 /* |
47 %!shared __random_statistical_tests__ | |
48 %! % Flag whether the statistical tests should be run in "make check" or not | |
49 %! __random_statistical_tests__ = 0; | |
50 */ | |
51 | |
4307 | 52 static octave_value |
5730 | 53 do_rand (const octave_value_list& args, int nargin, const char *fcn, |
54 bool additional_arg = false) | |
2928 | 55 { |
4307 | 56 octave_value retval; |
5730 | 57 NDArray a; |
58 int idx = 0; | |
59 dim_vector dims; | |
2928 | 60 |
5730 | 61 if (additional_arg) |
62 { | |
63 if (nargin == 0) | |
64 { | |
65 error ("%s: expecting at least one argument", fcn); | |
66 goto done; | |
67 } | |
68 else if (args(0).is_string()) | |
69 additional_arg = false; | |
70 else | |
71 { | |
72 a = args(0).array_value (); | |
73 if (error_state) | |
74 { | |
75 error ("%s: expecting scalar or matrix arguments", fcn); | |
76 goto done; | |
77 } | |
78 idx++; | |
79 nargin--; | |
80 } | |
81 } | |
2928 | 82 |
4543 | 83 switch (nargin) |
2928 | 84 { |
4543 | 85 case 0: |
86 { | |
5730 | 87 if (additional_arg) |
88 dims = a.dims (); | |
89 else | |
90 { | |
91 dims.resize (2); | |
4543 | 92 |
5730 | 93 dims(0) = 1; |
94 dims(1) = 1; | |
95 } | |
4543 | 96 goto gen_matrix; |
97 } | |
98 break; | |
2928 | 99 |
4543 | 100 case 1: |
101 { | |
5730 | 102 octave_value tmp = args(idx); |
4543 | 103 |
104 if (tmp.is_string ()) | |
105 { | |
106 std::string s_arg = tmp.string_value (); | |
2928 | 107 |
4543 | 108 if (s_arg == "dist") |
109 { | |
110 retval = octave_rand::distribution (); | |
111 } | |
5730 | 112 else if (s_arg == "seed") |
4543 | 113 { |
114 retval = octave_rand::seed (); | |
115 } | |
5730 | 116 else if (s_arg == "state" || s_arg == "twister") |
117 { | |
7533
ff52243af934
save state separately for each MT random number generator
John W. Eaton <jwe@octave.org>
parents:
7421
diff
changeset
|
118 retval = octave_rand::state (fcn); |
5730 | 119 } |
4543 | 120 else if (s_arg == "uniform") |
121 { | |
122 octave_rand::uniform_distribution (); | |
123 } | |
124 else if (s_arg == "normal") | |
125 { | |
126 octave_rand::normal_distribution (); | |
127 } | |
5730 | 128 else if (s_arg == "exponential") |
129 { | |
130 octave_rand::exponential_distribution (); | |
131 } | |
132 else if (s_arg == "poisson") | |
133 { | |
134 octave_rand::poisson_distribution (); | |
135 } | |
136 else if (s_arg == "gamma") | |
137 { | |
138 octave_rand::gamma_distribution (); | |
139 } | |
4543 | 140 else |
4664 | 141 error ("%s: unrecognized string argument", fcn); |
4543 | 142 } |
143 else if (tmp.is_scalar_type ()) | |
144 { | |
145 double dval = tmp.double_value (); | |
2928 | 146 |
4543 | 147 if (xisnan (dval)) |
148 { | |
4664 | 149 error ("%s: NaN is invalid a matrix dimension", fcn); |
4543 | 150 } |
151 else | |
152 { | |
153 dims.resize (2); | |
154 | |
5275 | 155 dims(0) = NINTbig (tmp.double_value ()); |
156 dims(1) = NINTbig (tmp.double_value ()); | |
2928 | 157 |
4543 | 158 if (! error_state) |
159 goto gen_matrix; | |
160 } | |
161 } | |
162 else if (tmp.is_range ()) | |
163 { | |
164 Range r = tmp.range_value (); | |
165 | |
166 if (r.all_elements_are_ints ()) | |
167 { | |
5275 | 168 octave_idx_type n = r.nelem (); |
4543 | 169 |
170 dims.resize (n); | |
171 | |
5275 | 172 octave_idx_type base = NINTbig (r.base ()); |
173 octave_idx_type incr = NINTbig (r.inc ()); | |
174 octave_idx_type lim = NINTbig (r.limit ()); | |
2928 | 175 |
4543 | 176 if (base < 0 || lim < 0) |
4664 | 177 error ("%s: all dimensions must be nonnegative", fcn); |
4543 | 178 else |
179 { | |
5275 | 180 for (octave_idx_type i = 0; i < n; i++) |
4543 | 181 { |
182 dims(i) = base; | |
183 base += incr; | |
184 } | |
2928 | 185 |
4543 | 186 goto gen_matrix; |
187 } | |
188 } | |
189 else | |
4664 | 190 error ("%s: expecting all elements of range to be integers", |
191 fcn); | |
4543 | 192 } |
193 else if (tmp.is_matrix_type ()) | |
194 { | |
195 Array<int> iv = tmp.int_vector_value (true); | |
196 | |
197 if (! error_state) | |
198 { | |
5275 | 199 octave_idx_type len = iv.length (); |
2928 | 200 |
4543 | 201 dims.resize (len); |
202 | |
5275 | 203 for (octave_idx_type i = 0; i < len; i++) |
4543 | 204 { |
5275 | 205 octave_idx_type elt = iv(i); |
4543 | 206 |
207 if (elt < 0) | |
208 { | |
4664 | 209 error ("%s: all dimensions must be nonnegative", fcn); |
4543 | 210 goto done; |
211 } | |
212 | |
213 dims(i) = iv(i); | |
214 } | |
2928 | 215 |
4543 | 216 goto gen_matrix; |
217 } | |
218 else | |
4664 | 219 error ("%s: expecting integer vector", fcn); |
4543 | 220 } |
221 else | |
222 { | |
223 gripe_wrong_type_arg ("rand", tmp); | |
224 return retval; | |
225 } | |
226 } | |
227 break; | |
228 | |
229 default: | |
230 { | |
5730 | 231 octave_value tmp = args(idx); |
4543 | 232 |
233 if (nargin == 2 && tmp.is_string ()) | |
234 { | |
5164 | 235 std::string ts = tmp.string_value (); |
236 | |
5730 | 237 if (ts == "seed") |
4543 | 238 { |
5782 | 239 if (args(idx+1).is_real_scalar ()) |
240 { | |
241 double d = args(idx+1).double_value (); | |
2928 | 242 |
5782 | 243 if (! error_state) |
244 octave_rand::seed (d); | |
245 } | |
246 else | |
247 error ("%s: seed must be a real scalar", fcn); | |
4543 | 248 } |
5730 | 249 else if (ts == "state" || ts == "twister") |
250 { | |
251 ColumnVector s = | |
252 ColumnVector (args(idx+1).vector_value(false, true)); | |
253 | |
254 if (! error_state) | |
7533
ff52243af934
save state separately for each MT random number generator
John W. Eaton <jwe@octave.org>
parents:
7421
diff
changeset
|
255 octave_rand::state (s, fcn); |
5730 | 256 } |
4543 | 257 else |
4664 | 258 error ("%s: unrecognized string argument", fcn); |
4543 | 259 } |
260 else | |
261 { | |
262 dims.resize (nargin); | |
263 | |
264 for (int i = 0; i < nargin; i++) | |
265 { | |
5760 | 266 dims(i) = args(idx+i).int_value (); |
4543 | 267 |
268 if (error_state) | |
269 { | |
4664 | 270 error ("%s: expecting integer arguments", fcn); |
4543 | 271 goto done; |
272 } | |
273 } | |
274 | |
275 goto gen_matrix; | |
276 } | |
277 } | |
278 break; | |
2928 | 279 } |
280 | |
4543 | 281 done: |
2928 | 282 |
283 return retval; | |
284 | |
285 gen_matrix: | |
286 | |
5355 | 287 dims.chop_trailing_singletons (); |
288 | |
5730 | 289 if (additional_arg) |
290 { | |
291 if (a.length() == 1) | |
292 return octave_rand::nd_array (dims, a(0)); | |
293 else | |
294 { | |
295 if (a.dims() != dims) | |
296 { | |
297 error ("%s: mismatch in argument size", fcn); | |
298 return retval; | |
299 } | |
300 octave_idx_type len = a.length (); | |
301 NDArray m (dims); | |
302 double *v = m.fortran_vec (); | |
303 for (octave_idx_type i = 0; i < len; i++) | |
304 v[i] = octave_rand::scalar (a(i)); | |
305 return m; | |
306 } | |
307 } | |
308 else | |
309 return octave_rand::nd_array (dims); | |
2928 | 310 } |
311 | |
4665 | 312 DEFUN_DLD (rand, args, , |
3369 | 313 "-*- texinfo -*-\n\ |
314 @deftypefn {Loadable Function} {} rand (@var{x})\n\ | |
315 @deftypefnx {Loadable Function} {} rand (@var{n}, @var{m})\n\ | |
5730 | 316 @deftypefnx {Loadable Function} {} rand (\"state\", @var{x})\n\ |
317 @deftypefnx {Loadable Function} {} rand (\"seed\", @var{x})\n\ | |
3369 | 318 Return a matrix with random elements uniformly distributed on the\n\ |
319 interval (0, 1). The arguments are handled the same as the arguments\n\ | |
5730 | 320 for @code{eye}.\n\ |
321 \n\ | |
322 You can query the state of the random number generator using the\n\ | |
3369 | 323 form\n\ |
2928 | 324 \n\ |
3369 | 325 @example\n\ |
5730 | 326 v = rand (\"state\")\n\ |
327 @end example\n\ | |
328 \n\ | |
9064
7c02ec148a3c
Check grammar on all .cc files
Rik <rdrider0-list@yahoo.com>
parents:
9041
diff
changeset
|
329 This returns a column vector @var{v} of length 625. Later, you can\n\ |
5730 | 330 restore the random number generator to the state @var{v}\n\ |
331 using the form\n\ | |
332 \n\ | |
333 @example\n\ | |
334 rand (\"state\", v)\n\ | |
3369 | 335 @end example\n\ |
336 \n\ | |
337 @noindent\n\ | |
5730 | 338 You may also initialize the state vector from an arbitrary vector of\n\ |
339 length <= 625 for @var{v}. This new state will be a hash based on the\n\ | |
5798 | 340 value of @var{v}, not @var{v} itself.\n\ |
5730 | 341 \n\ |
342 By default, the generator is initialized from @code{/dev/urandom} if it is\n\ | |
343 available, otherwise from cpu time, wall clock time and the current\n\ | |
344 fraction of a second.\n\ | |
345 \n\ | |
8325
b93ac0586e4b
spelling corrections
Brian Gough<bjg@network-theory.co.uk>
parents:
7780
diff
changeset
|
346 To compute the pseudo-random sequence, @code{rand} uses the Mersenne\n\ |
8498
5837f2a73a51
[docs] 2^19937-1 => @math{2^{19937}-1}
Brian Gough <bjg@gnu.org>
parents:
8497
diff
changeset
|
347 Twister with a period of @math{2^{19937}-1} (See M. Matsumoto and T. Nishimura,\n\ |
8482
ab51abf62698
[docs] ``Mersenne Twister: A 623-dimensionally equidistributed uniform pseudorandom number generator'' => @cite{Mersenne Twister: A 623-dimensionally equidistributed uniform pseudorandom number generator}
Brian Gough <bjg@gnu.org>
parents:
8325
diff
changeset
|
348 @cite{Mersenne Twister: A 623-dimensionally equidistributed uniform pseudorandom number generator}, ACM Trans. on\n\ |
7001 | 349 Modeling and Computer Simulation Vol. 8, No. 1, January pp.3-30 1998,\n\ |
7171 | 350 @url{http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/emt.html}).\n\ |
6547 | 351 Do @strong{not} use for cryptography without securely hashing\n\ |
352 several returned values together, otherwise the generator state\n\ | |
353 can be learned after reading 624 consecutive values.\n\ | |
5730 | 354 \n\ |
7096 | 355 Older versions of Octave used a different random number generator.\n\ |
356 The new generator is used by default\n\ | |
5730 | 357 as it is significantly faster than the old generator, and produces\n\ |
9041
853f96e8008f
Cleanup documentation file matrix.texi
Rik <rdrider0-list@yahoo.com>
parents:
8920
diff
changeset
|
358 random numbers with a significantly longer cycle time. However, in\n\ |
5798 | 359 some circumstances it might be desirable to obtain the same random\n\ |
9041
853f96e8008f
Cleanup documentation file matrix.texi
Rik <rdrider0-list@yahoo.com>
parents:
8920
diff
changeset
|
360 sequences as used by the old generators. To do this the keyword\n\ |
5730 | 361 \"seed\" is used to specify that the old generators should be use,\n\ |
362 as in\n\ | |
2928 | 363 \n\ |
3369 | 364 @example\n\ |
5730 | 365 rand (\"seed\", val)\n\ |
3369 | 366 @end example\n\ |
367 \n\ | |
9064
7c02ec148a3c
Check grammar on all .cc files
Rik <rdrider0-list@yahoo.com>
parents:
9041
diff
changeset
|
368 which sets the seed of the generator to @var{val}. The seed of the\n\ |
5730 | 369 generator can be queried with\n\ |
370 \n\ | |
371 @example\n\ | |
372 s = rand (\"seed\")\n\ | |
373 @end example\n\ | |
374 \n\ | |
375 However, it should be noted that querying the seed will not cause\n\ | |
376 @code{rand} to use the old generators, only setting the seed will.\n\ | |
377 To cause @code{rand} to once again use the new generators, the\n\ | |
378 keyword \"state\" should be used to reset the state of the @code{rand}.\n\ | |
5798 | 379 @seealso{randn, rande, randg, randp}\n\ |
3369 | 380 @end deftypefn") |
2928 | 381 { |
4307 | 382 octave_value retval; |
2928 | 383 |
384 int nargin = args.length (); | |
385 | |
4543 | 386 retval = do_rand (args, nargin, "rand"); |
2928 | 387 |
388 return retval; | |
389 } | |
390 | |
8871 | 391 // FIXME -- The old generator (selected when "seed" is set) will not |
392 // work properly if compiled to use 64-bit integers. | |
393 | |
5730 | 394 /* |
395 %!test # 'state' can be a scalar | |
396 %! rand('state',12); x = rand(1,4); | |
397 %! rand('state',12); y = rand(1,4); | |
398 %! assert(x,y); | |
399 %!test # 'state' can be a vector | |
400 %! rand('state',[12,13]); x=rand(1,4); | |
401 %! rand('state',[12;13]); y=rand(1,4); | |
402 %! assert(x,y); | |
403 %!test # querying 'state' doesn't disturb sequence | |
404 %! rand('state',12); rand(1,2); x=rand(1,2); | |
405 %! rand('state',12); rand(1,2); | |
406 %! s=rand('state'); y=rand(1,2); | |
407 %! assert(x,y); | |
408 %! rand('state',s); z=rand(1,2); | |
409 %! assert(x,z); | |
410 %!test # 'seed' must be a scalar | |
411 %! rand('seed',12); x = rand(1,4); | |
412 %! rand('seed',12); y = rand(1,4); | |
413 %! assert(x,y); | |
414 %!error(rand('seed',[12,13])) | |
415 %!test # querying 'seed' returns a value which can be used later | |
416 %! s=rand('seed'); x=rand(1,2); | |
417 %! rand('seed',s); y=rand(1,2); | |
418 %! assert(x,y); | |
419 %!test # querying 'seed' doesn't disturb sequence | |
420 %! rand('seed',12); rand(1,2); x=rand(1,2); | |
421 %! rand('seed',12); rand(1,2); | |
422 %! s=rand('seed'); y=rand(1,2); | |
423 %! assert(x,y); | |
424 %! rand('seed',s); z=rand(1,2); | |
425 %! assert(x,z); | |
426 */ | |
427 | |
428 /* | |
429 %!test | |
6437 | 430 %! % Test fixed state |
431 %! rand("state",1); | |
6443 | 432 %! assert (rand(1,6), [0.1343642441124013 0.8474337369372327 0.763774618976614 0.2550690257394218 0.495435087091941 0.4494910647887382],1e-6); |
6437 | 433 %!test |
6443 | 434 %! % Test fixed seed |
6437 | 435 %! rand("seed",1); |
6443 | 436 %! assert (rand(1,6), [0.8668024251237512 0.9126510815694928 0.09366085007786751 0.1664607301354408 0.7408077004365623 0.7615650338120759],1e-6); |
5730 | 437 %!test |
6437 | 438 %! if (__random_statistical_tests__) |
439 %! % statistical tests may fail occasionally. | |
440 %! rand("state",12); | |
441 %! x = rand(100000,1); | |
442 %! assert(max(x)<1.); %*** Please report this!!! *** | |
443 %! assert(min(x)>0.); %*** Please report this!!! *** | |
444 %! assert(mean(x),0.5,0.0024); | |
445 %! assert(var(x),1/48,0.0632); | |
446 %! assert(skewness(x),0,0.012); | |
447 %! assert(kurtosis(x),-6/5,0.0094); | |
448 %! endif | |
449 %!test | |
450 %! if (__random_statistical_tests__) | |
451 %! % statistical tests may fail occasionally. | |
452 %! rand("seed",12); | |
453 %! x = rand(100000,1); | |
454 %! assert(max(x)<1.); %*** Please report this!!! *** | |
455 %! assert(min(x)>0.); %*** Please report this!!! *** | |
456 %! assert(mean(x),0.5,0.0024); | |
457 %! assert(var(x),1/48,0.0632); | |
458 %! assert(skewness(x),0,0.012); | |
459 %! assert(kurtosis(x),-6/5,0.0094); | |
460 %! endif | |
5730 | 461 */ |
462 | |
463 | |
4307 | 464 static std::string current_distribution = octave_rand::distribution (); |
465 | |
2928 | 466 static void |
467 reset_rand_generator (void *) | |
468 { | |
4307 | 469 octave_rand::distribution (current_distribution); |
2928 | 470 } |
471 | |
4665 | 472 DEFUN_DLD (randn, args, , |
3369 | 473 "-*- texinfo -*-\n\ |
474 @deftypefn {Loadable Function} {} randn (@var{x})\n\ | |
475 @deftypefnx {Loadable Function} {} randn (@var{n}, @var{m})\n\ | |
5730 | 476 @deftypefnx {Loadable Function} {} randn (\"state\", @var{x})\n\ |
477 @deftypefnx {Loadable Function} {} randn (\"seed\", @var{x})\n\ | |
7780
08125419efcb
Extend explanation of randn's return value
Thomas Weber <thomas.weber.mail@gmail.com>
parents:
7533
diff
changeset
|
478 Return a matrix with normally distributed pseudo-random\n\ |
9041
853f96e8008f
Cleanup documentation file matrix.texi
Rik <rdrider0-list@yahoo.com>
parents:
8920
diff
changeset
|
479 elements having zero mean and variance one. The arguments are\n\ |
7780
08125419efcb
Extend explanation of randn's return value
Thomas Weber <thomas.weber.mail@gmail.com>
parents:
7533
diff
changeset
|
480 handled the same as the arguments for @code{rand}.\n\ |
3369 | 481 \n\ |
8497
63d2f6508dde
[docs] Ziggurat technique => ``Ziggurat technique''
Brian Gough <bjg@gnu.org>
parents:
8483
diff
changeset
|
482 By default, @code{randn} uses the Marsaglia and Tsang ``Ziggurat technique'' to\n\ |
9041
853f96e8008f
Cleanup documentation file matrix.texi
Rik <rdrider0-list@yahoo.com>
parents:
8920
diff
changeset
|
483 transform from a uniform to a normal distribution. (G. Marsaglia and\n\ |
8483
b8069cab1ce3
[docs] 'Ziggurat method for generating random variables' => @cite{Ziggurat method for generating random variables}
Brian Gough <bjg@gnu.org>
parents:
8482
diff
changeset
|
484 W.W. Tsang, @cite{Ziggurat method for generating random variables},\n\ |
5730 | 485 J. Statistical Software, vol 5, 2000,\n\ |
486 @url{http://www.jstatsoft.org/v05/i08/})\n\ | |
2928 | 487 \n\ |
6547 | 488 @seealso{rand, rande, randg, randp}\n\ |
3369 | 489 @end deftypefn") |
2928 | 490 { |
4307 | 491 octave_value retval; |
2928 | 492 |
493 int nargin = args.length (); | |
494 | |
9377
610bf90fce2a
update unwind_protect usage everywhere
Jaroslav Hajek <highegg@gmail.com>
parents:
9064
diff
changeset
|
495 unwind_protect::frame_id_t uwp_frame = unwind_protect::begin_frame (); |
2928 | 496 |
4543 | 497 // This relies on the fact that elements are popped from the unwind |
498 // stack in the reverse of the order they are pushed | |
499 // (i.e. current_distribution will be reset before calling | |
500 // reset_rand_generator()). | |
2928 | 501 |
4543 | 502 unwind_protect::add (reset_rand_generator, 0); |
9377
610bf90fce2a
update unwind_protect usage everywhere
Jaroslav Hajek <highegg@gmail.com>
parents:
9064
diff
changeset
|
503 unwind_protect::protect_var (current_distribution); |
2928 | 504 |
4543 | 505 current_distribution = "normal"; |
2928 | 506 |
4543 | 507 octave_rand::distribution (current_distribution); |
2928 | 508 |
4543 | 509 retval = do_rand (args, nargin, "randn"); |
2928 | 510 |
9377
610bf90fce2a
update unwind_protect usage everywhere
Jaroslav Hajek <highegg@gmail.com>
parents:
9064
diff
changeset
|
511 unwind_protect::run_frame (uwp_frame); |
2928 | 512 |
513 return retval; | |
514 } | |
515 | |
516 /* | |
5730 | 517 %!test |
6437 | 518 %! % Test fixed state |
519 %! randn("state",1); | |
6443 | 520 %! assert (randn(1,6), [-2.666521678978671 -0.7381719971724564 1.507903992673601 0.6019427189162239 -0.450661261143348 -0.7054431351574116],1e-6); |
6437 | 521 %!test |
6443 | 522 %! % Test fixed seed |
6437 | 523 %! randn("seed",1); |
6443 | 524 %! assert (randn(1,6), [-1.039402365684509 -1.25938892364502 0.1968704611063004 0.3874166905879974 -0.5976632833480835 -0.6615074276924133],1e-6); |
5730 | 525 %!test |
6437 | 526 %! if (__random_statistical_tests__) |
527 %! % statistical tests may fail occasionally. | |
528 %! randn("state",12); | |
529 %! x = randn(100000,1); | |
530 %! assert(mean(x),0,0.01); | |
531 %! assert(var(x),1,0.02); | |
532 %! assert(skewness(x),0,0.02); | |
533 %! assert(kurtosis(x),0,0.04); | |
534 %! endif | |
535 %!test | |
536 %! if (__random_statistical_tests__) | |
537 %! % statistical tests may fail occasionally. | |
538 %! randn("seed",12); | |
539 %! x = randn(100000,1); | |
540 %! assert(mean(x),0,0.01); | |
541 %! assert(var(x),1,0.02); | |
542 %! assert(skewness(x),0,0.02); | |
543 %! assert(kurtosis(x),0,0.04); | |
544 %! endif | |
5730 | 545 */ |
546 | |
547 DEFUN_DLD (rande, args, , | |
548 "-*- texinfo -*-\n\ | |
549 @deftypefn {Loadable Function} {} rande (@var{x})\n\ | |
550 @deftypefnx {Loadable Function} {} rande (@var{n}, @var{m})\n\ | |
551 @deftypefnx {Loadable Function} {} rande (\"state\", @var{x})\n\ | |
552 @deftypefnx {Loadable Function} {} rande (\"seed\", @var{x})\n\ | |
9041
853f96e8008f
Cleanup documentation file matrix.texi
Rik <rdrider0-list@yahoo.com>
parents:
8920
diff
changeset
|
553 Return a matrix with exponentially distributed random elements. The\n\ |
5730 | 554 arguments are handled the same as the arguments for @code{rand}.\n\ |
555 \n\ | |
8497
63d2f6508dde
[docs] Ziggurat technique => ``Ziggurat technique''
Brian Gough <bjg@gnu.org>
parents:
8483
diff
changeset
|
556 By default, @code{randn} uses the Marsaglia and Tsang ``Ziggurat technique'' to\n\ |
9041
853f96e8008f
Cleanup documentation file matrix.texi
Rik <rdrider0-list@yahoo.com>
parents:
8920
diff
changeset
|
557 transform from a uniform to a exponential distribution. (G. Marsaglia and\n\ |
8483
b8069cab1ce3
[docs] 'Ziggurat method for generating random variables' => @cite{Ziggurat method for generating random variables}
Brian Gough <bjg@gnu.org>
parents:
8482
diff
changeset
|
558 W.W. Tsang, @cite{Ziggurat method for generating random variables},\n\ |
5730 | 559 J. Statistical Software, vol 5, 2000,\n\ |
560 @url{http://www.jstatsoft.org/v05/i08/})\n\ | |
6547 | 561 @seealso{rand, randn, randg, randp}\n\ |
5730 | 562 @end deftypefn") |
563 { | |
564 octave_value retval; | |
565 | |
566 int nargin = args.length (); | |
567 | |
9377
610bf90fce2a
update unwind_protect usage everywhere
Jaroslav Hajek <highegg@gmail.com>
parents:
9064
diff
changeset
|
568 unwind_protect::frame_id_t uwp_frame = unwind_protect::begin_frame (); |
5730 | 569 |
570 // This relies on the fact that elements are popped from the unwind | |
571 // stack in the reverse of the order they are pushed | |
572 // (i.e. current_distribution will be reset before calling | |
573 // reset_rand_generator()). | |
574 | |
575 unwind_protect::add (reset_rand_generator, 0); | |
9377
610bf90fce2a
update unwind_protect usage everywhere
Jaroslav Hajek <highegg@gmail.com>
parents:
9064
diff
changeset
|
576 unwind_protect::protect_var (current_distribution); |
5730 | 577 |
578 current_distribution = "exponential"; | |
579 | |
580 octave_rand::distribution (current_distribution); | |
581 | |
582 retval = do_rand (args, nargin, "rande"); | |
583 | |
9377
610bf90fce2a
update unwind_protect usage everywhere
Jaroslav Hajek <highegg@gmail.com>
parents:
9064
diff
changeset
|
584 unwind_protect::run_frame (uwp_frame); |
5730 | 585 |
586 return retval; | |
587 } | |
588 | |
589 /* | |
590 %!test | |
6437 | 591 %! % Test fixed state |
592 %! rande("state",1); | |
6443 | 593 %! assert (rande(1,6), [3.602973885835625 0.1386190677555021 0.6743112889616958 0.4512830847258422 0.7255744741233175 0.3415969205292291],1e-6); |
6437 | 594 %!test |
6443 | 595 %! % Test fixed seed |
6437 | 596 %! rande("seed",1); |
6443 | 597 %! assert (rande(1,6), [0.06492075175653866 1.717980206012726 0.4816154008731246 0.5231300676241517 0.103910739364359 1.668931916356087],1e-6); |
5730 | 598 %!test |
6437 | 599 %! if (__random_statistical_tests__) |
600 %! % statistical tests may fail occasionally | |
601 %! rande("state",1); | |
602 %! x = rande(100000,1); | |
603 %! assert(min(x)>0); % *** Please report this!!! *** | |
604 %! assert(mean(x),1,0.01); | |
605 %! assert(var(x),1,0.03); | |
606 %! assert(skewness(x),2,0.06); | |
607 %! assert(kurtosis(x),6,0.7); | |
608 %! endif | |
609 %!test | |
610 %! if (__random_statistical_tests__) | |
611 %! % statistical tests may fail occasionally | |
612 %! rande("seed",1); | |
613 %! x = rande(100000,1); | |
614 %! assert(min(x)>0); % *** Please report this!!! *** | |
615 %! assert(mean(x),1,0.01); | |
616 %! assert(var(x),1,0.03); | |
617 %! assert(skewness(x),2,0.06); | |
618 %! assert(kurtosis(x),6,0.7); | |
619 %! endif | |
5730 | 620 */ |
621 | |
622 DEFUN_DLD (randg, args, , | |
623 "-*- texinfo -*-\n\ | |
624 @deftypefn {Loadable Function} {} randg (@var{a}, @var{x})\n\ | |
625 @deftypefnx {Loadable Function} {} randg (@var{a}, @var{n}, @var{m})\n\ | |
626 @deftypefnx {Loadable Function} {} randg (\"state\", @var{x})\n\ | |
627 @deftypefnx {Loadable Function} {} randg (\"seed\", @var{x})\n\ | |
628 Return a matrix with @code{gamma(@var{a},1)} distributed random elements.\n\ | |
629 The arguments are handled the same as the arguments for @code{rand},\n\ | |
630 except for the argument @var{a}.\n\ | |
631 \n\ | |
632 This can be used to generate many distributions:\n\ | |
633 \n\ | |
634 @table @asis\n\ | |
6547 | 635 @item @code{gamma (a, b)} for @code{a > -1}, @code{b > 0}\n\ |
5730 | 636 @example\n\ |
6547 | 637 r = b * randg (a)\n\ |
5730 | 638 @end example\n\ |
6547 | 639 @item @code{beta (a, b)} for @code{a > -1}, @code{b > -1}\n\ |
5730 | 640 @example\n\ |
9064
7c02ec148a3c
Check grammar on all .cc files
Rik <rdrider0-list@yahoo.com>
parents:
9041
diff
changeset
|
641 @group\n\ |
6547 | 642 r1 = randg (a, 1)\n\ |
643 r = r1 / (r1 + randg (b, 1))\n\ | |
9064
7c02ec148a3c
Check grammar on all .cc files
Rik <rdrider0-list@yahoo.com>
parents:
9041
diff
changeset
|
644 @end group\n\ |
5730 | 645 @end example\n\ |
6547 | 646 @item @code{Erlang (a, n)}\n\ |
5730 | 647 @example\n\ |
6547 | 648 r = a * randg (n)\n\ |
5730 | 649 @end example\n\ |
6547 | 650 @item @code{chisq (df)} for @code{df > 0}\n\ |
5730 | 651 @example\n\ |
6547 | 652 r = 2 * randg (df / 2)\n\ |
5730 | 653 @end example\n\ |
654 @item @code{t(df)} for @code{0 < df < inf} (use randn if df is infinite)\n\ | |
655 @example\n\ | |
6547 | 656 r = randn () / sqrt (2 * randg (df / 2) / df)\n\ |
5730 | 657 @end example\n\ |
6547 | 658 @item @code{F (n1, n2)} for @code{0 < n1}, @code{0 < n2}\n\ |
5730 | 659 @example\n\ |
7096 | 660 @group\n\ |
661 ## r1 equals 1 if n1 is infinite\n\ | |
662 r1 = 2 * randg (n1 / 2) / n1\n\ | |
663 ## r2 equals 1 if n2 is infinite\n\ | |
664 r2 = 2 * randg (n2 / 2) / n2\n\ | |
5730 | 665 r = r1 / r2\n\n\ |
7096 | 666 @end group\n\ |
5730 | 667 @end example\n\ |
668 @item negative @code{binomial (n, p)} for @code{n > 0}, @code{0 < p <= 1}\n\ | |
669 @example\n\ | |
6547 | 670 r = randp ((1 - p) / p * randg (n))\n\ |
5730 | 671 @end example\n\ |
6547 | 672 @item non-central @code{chisq (df, L)}, for @code{df >= 0} and @code{L > 0}\n\ |
5730 | 673 (use chisq if @code{L = 0})\n\ |
674 @example\n\ | |
9064
7c02ec148a3c
Check grammar on all .cc files
Rik <rdrider0-list@yahoo.com>
parents:
9041
diff
changeset
|
675 @group\n\ |
6547 | 676 r = randp (L / 2)\n\ |
677 r(r > 0) = 2 * randg (r(r > 0))\n\ | |
678 r(df > 0) += 2 * randg (df(df > 0)/2)\n\ | |
9064
7c02ec148a3c
Check grammar on all .cc files
Rik <rdrider0-list@yahoo.com>
parents:
9041
diff
changeset
|
679 @end group\n\ |
5730 | 680 @end example\n\ |
9041
853f96e8008f
Cleanup documentation file matrix.texi
Rik <rdrider0-list@yahoo.com>
parents:
8920
diff
changeset
|
681 @item @code{Dirichlet (a1, @dots{} ak)}\n\ |
5730 | 682 @example\n\ |
9064
7c02ec148a3c
Check grammar on all .cc files
Rik <rdrider0-list@yahoo.com>
parents:
9041
diff
changeset
|
683 @group\n\ |
9041
853f96e8008f
Cleanup documentation file matrix.texi
Rik <rdrider0-list@yahoo.com>
parents:
8920
diff
changeset
|
684 r = (randg (a1), @dots{}, randg (ak))\n\ |
6547 | 685 r = r / sum (r)\n\ |
9064
7c02ec148a3c
Check grammar on all .cc files
Rik <rdrider0-list@yahoo.com>
parents:
9041
diff
changeset
|
686 @end group\n\ |
5730 | 687 @end example\n\ |
688 @end table\n\ | |
6547 | 689 @seealso{rand, randn, rande, randp}\n\ |
5730 | 690 @end deftypefn") |
691 { | |
692 octave_value retval; | |
693 | |
694 int nargin = args.length (); | |
695 | |
696 if (nargin < 1) | |
697 error ("randg: insufficient arguments"); | |
698 else | |
699 { | |
9377
610bf90fce2a
update unwind_protect usage everywhere
Jaroslav Hajek <highegg@gmail.com>
parents:
9064
diff
changeset
|
700 unwind_protect::frame_id_t uwp_frame = unwind_protect::begin_frame (); |
5730 | 701 |
702 // This relies on the fact that elements are popped from the unwind | |
703 // stack in the reverse of the order they are pushed | |
704 // (i.e. current_distribution will be reset before calling | |
705 // reset_rand_generator()). | |
706 | |
707 unwind_protect::add (reset_rand_generator, 0); | |
9377
610bf90fce2a
update unwind_protect usage everywhere
Jaroslav Hajek <highegg@gmail.com>
parents:
9064
diff
changeset
|
708 unwind_protect::protect_var (current_distribution); |
5730 | 709 |
710 current_distribution = "gamma"; | |
711 | |
712 octave_rand::distribution (current_distribution); | |
713 | |
714 retval = do_rand (args, nargin, "randg", true); | |
715 | |
9377
610bf90fce2a
update unwind_protect usage everywhere
Jaroslav Hajek <highegg@gmail.com>
parents:
9064
diff
changeset
|
716 unwind_protect::run_frame (uwp_frame); |
5730 | 717 } |
718 | |
719 return retval; | |
720 } | |
721 | |
722 /* | |
723 %!test | |
6437 | 724 %! randg("state",12) |
725 %!assert(randg([-inf,-1,0,inf,nan]),[nan,nan,nan,nan,nan]) % *** Please report | |
726 | |
727 | |
728 %!test | |
729 %! % Test fixed state | |
730 %! randg("state",1); | |
6443 | 731 %! assert (randg(0.1,1,6), [0.0103951513331241 8.335671459898252e-05 0.00138691397249762 0.000587308416993855 0.495590518784736 2.3921917414795e-12],1e-6); |
6437 | 732 %!test |
733 %! % Test fixed state | |
734 %! randg("state",1); | |
6443 | 735 %! assert (randg(0.95,1,6), [3.099382433255327 0.3974529788871218 0.644367450750855 1.143261091802246 1.964111762696822 0.04011915547957939],1e-6); |
6437 | 736 %!test |
737 %! % Test fixed state | |
738 %! randg("state",1); | |
6443 | 739 %! assert (randg(1,1,6), [0.2273389379645993 1.288822625058359 0.2406335209340746 1.218869553370733 1.024649860162554 0.09631230343599533],1e-6); |
6437 | 740 %!test |
741 %! % Test fixed state | |
742 %! randg("state",1); | |
6443 | 743 %! assert (randg(10,1,6), [3.520369644331133 15.15369864472106 8.332112081991205 8.406211067432674 11.81193475187611 10.88792728177059],1e-5); |
6437 | 744 %!test |
745 %! % Test fixed state | |
746 %! randg("state",1); | |
6443 | 747 %! assert (randg(100,1,6), [75.34570255262264 115.4911985594699 95.23493031356388 95.48926019250911 106.2397448229803 103.4813150404118],1e-4); |
6437 | 748 %!test |
749 %! % Test fixed seed | |
750 %! randg("seed",1); | |
6443 | 751 %! assert (randg(0.1,1,6), [0.07144210487604141 0.460641473531723 0.4749028384685516 0.06823389977216721 0.000293838675133884 1.802567535340305e-12],1e-6); |
6437 | 752 %!test |
753 %! % Test fixed seed | |
754 %! randg("seed",1); | |
6443 | 755 %! assert (randg(0.95,1,6), [1.664905071258545 1.879976987838745 1.905677795410156 0.9948706030845642 0.5606933236122131 0.0766092911362648],1e-6); |
6437 | 756 %!test |
757 %! % Test fixed seed | |
758 %! randg("seed",1); | |
6443 | 759 %! assert (randg(1,1,6), [0.03512085229158401 0.6488978862762451 0.8114678859710693 0.1666885763406754 1.60791552066803 1.90356981754303],1e-6); |
6437 | 760 %!test |
761 %! % Test fixed seed | |
762 %! randg("seed",1); | |
6443 | 763 %! assert (randg(10,1,6), [6.566435813903809 10.11648464202881 10.73162078857422 7.747178077697754 6.278522491455078 6.240195751190186],1e-5); |
6437 | 764 %!test |
765 %! % Test fixed seed | |
766 %! randg("seed",1); | |
6443 | 767 %! assert (randg(100,1,6), [89.40208435058594 101.4734725952148 103.4020004272461 93.62763214111328 88.33104705810547 88.1871337890625],1e-4); |
6437 | 768 %!test |
769 %! if (__random_statistical_tests__) | |
770 %! % statistical tests may fail occasionally. | |
771 %! randg("state",12) | |
772 %! a=0.1; x = randg(a,100000,1); | |
773 %! assert(mean(x), a, 0.01); | |
774 %! assert(var(x), a, 0.01); | |
775 %! assert(skewness(x),2/sqrt(a), 1.); | |
776 %! assert(kurtosis(x),6/a, 50.); | |
777 %! endif | |
778 %!test | |
779 %! if (__random_statistical_tests__) | |
780 %! % statistical tests may fail occasionally. | |
781 %! randg("state",12) | |
782 %! a=0.95; x = randg(a,100000,1); | |
783 %! assert(mean(x), a, 0.01); | |
784 %! assert(var(x), a, 0.04); | |
785 %! assert(skewness(x),2/sqrt(a), 0.2); | |
786 %! assert(kurtosis(x),6/a, 2.); | |
787 %! endif | |
788 %!test | |
789 %! if (__random_statistical_tests__) | |
790 %! % statistical tests may fail occasionally. | |
791 %! randg("state",12) | |
792 %! a=1; x = randg(a,100000,1); | |
793 %! assert(mean(x),a, 0.01); | |
794 %! assert(var(x),a, 0.04); | |
795 %! assert(skewness(x),2/sqrt(a), 0.2); | |
796 %! assert(kurtosis(x),6/a, 2.); | |
797 %! endif | |
798 %!test | |
799 %! if (__random_statistical_tests__) | |
800 %! % statistical tests may fail occasionally. | |
801 %! randg("state",12) | |
802 %! a=10; x = randg(a,100000,1); | |
803 %! assert(mean(x), a, 0.1); | |
804 %! assert(var(x), a, 0.5); | |
805 %! assert(skewness(x),2/sqrt(a), 0.1); | |
806 %! assert(kurtosis(x),6/a, 0.5); | |
807 %! endif | |
808 %!test | |
809 %! if (__random_statistical_tests__) | |
810 %! % statistical tests may fail occasionally. | |
811 %! randg("state",12) | |
812 %! a=100; x = randg(a,100000,1); | |
813 %! assert(mean(x), a, 0.2); | |
814 %! assert(var(x), a, 2.); | |
815 %! assert(skewness(x),2/sqrt(a), 0.05); | |
816 %! assert(kurtosis(x),6/a, 0.2); | |
817 %! endif | |
818 %!test | |
819 %! randg("seed",12) | |
5730 | 820 %!assert(randg([-inf,-1,0,inf,nan]),[nan,nan,nan,nan,nan]) % *** Please report |
821 %!test | |
6437 | 822 %! if (__random_statistical_tests__) |
823 %! % statistical tests may fail occasionally. | |
824 %! randg("seed",12) | |
825 %! a=0.1; x = randg(a,100000,1); | |
826 %! assert(mean(x), a, 0.01); | |
827 %! assert(var(x), a, 0.01); | |
828 %! assert(skewness(x),2/sqrt(a), 1.); | |
829 %! assert(kurtosis(x),6/a, 50.); | |
830 %! endif | |
5730 | 831 %!test |
6437 | 832 %! if (__random_statistical_tests__) |
833 %! % statistical tests may fail occasionally. | |
834 %! randg("seed",12) | |
835 %! a=0.95; x = randg(a,100000,1); | |
836 %! assert(mean(x), a, 0.01); | |
837 %! assert(var(x), a, 0.04); | |
838 %! assert(skewness(x),2/sqrt(a), 0.2); | |
839 %! assert(kurtosis(x),6/a, 2.); | |
840 %! endif | |
5730 | 841 %!test |
6437 | 842 %! if (__random_statistical_tests__) |
843 %! % statistical tests may fail occasionally. | |
844 %! randg("seed",12) | |
845 %! a=1; x = randg(a,100000,1); | |
846 %! assert(mean(x),a, 0.01); | |
847 %! assert(var(x),a, 0.04); | |
848 %! assert(skewness(x),2/sqrt(a), 0.2); | |
849 %! assert(kurtosis(x),6/a, 2.); | |
850 %! endif | |
5730 | 851 %!test |
6437 | 852 %! if (__random_statistical_tests__) |
853 %! % statistical tests may fail occasionally. | |
854 %! randg("seed",12) | |
855 %! a=10; x = randg(a,100000,1); | |
856 %! assert(mean(x), a, 0.1); | |
857 %! assert(var(x), a, 0.5); | |
858 %! assert(skewness(x),2/sqrt(a), 0.1); | |
859 %! assert(kurtosis(x),6/a, 0.5); | |
860 %! endif | |
5730 | 861 %!test |
6437 | 862 %! if (__random_statistical_tests__) |
863 %! % statistical tests may fail occasionally. | |
864 %! randg("seed",12) | |
865 %! a=100; x = randg(a,100000,1); | |
866 %! assert(mean(x), a, 0.2); | |
867 %! assert(var(x), a, 2.); | |
868 %! assert(skewness(x),2/sqrt(a), 0.05); | |
869 %! assert(kurtosis(x),6/a, 0.2); | |
870 %! endif | |
5730 | 871 */ |
872 | |
873 | |
874 DEFUN_DLD (randp, args, , | |
875 "-*- texinfo -*-\n\ | |
876 @deftypefn {Loadable Function} {} randp (@var{l}, @var{x})\n\ | |
877 @deftypefnx {Loadable Function} {} randp (@var{l}, @var{n}, @var{m})\n\ | |
878 @deftypefnx {Loadable Function} {} randp (\"state\", @var{x})\n\ | |
879 @deftypefnx {Loadable Function} {} randp (\"seed\", @var{x})\n\ | |
9064
7c02ec148a3c
Check grammar on all .cc files
Rik <rdrider0-list@yahoo.com>
parents:
9041
diff
changeset
|
880 Return a matrix with Poisson distributed random elements with mean value parameter given by the first argument, @var{l}. The arguments\n\ |
5730 | 881 are handled the same as the arguments for @code{rand}, except for the\n\ |
882 argument @var{l}.\n\ | |
883 \n\ | |
884 Five different algorithms are used depending on the range of @var{l}\n\ | |
885 and whether or not @var{l} is a scalar or a matrix.\n\ | |
886 \n\ | |
887 @table @asis\n\ | |
888 @item For scalar @var{l} <= 12, use direct method.\n\ | |
889 Press, et al., 'Numerical Recipes in C', Cambridge University Press, 1992.\n\ | |
890 @item For scalar @var{l} > 12, use rejection method.[1]\n\ | |
891 Press, et al., 'Numerical Recipes in C', Cambridge University Press, 1992.\n\ | |
892 @item For matrix @var{l} <= 10, use inversion method.[2]\n\ | |
893 Stadlober E., et al., WinRand source code, available via FTP.\n\ | |
894 @item For matrix @var{l} > 10, use patchwork rejection method.\n\ | |
895 Stadlober E., et al., WinRand source code, available via FTP, or\n\ | |
896 H. Zechner, 'Efficient sampling from continuous and discrete\n\ | |
8325
b93ac0586e4b
spelling corrections
Brian Gough<bjg@network-theory.co.uk>
parents:
7780
diff
changeset
|
897 unimodal distributions', Doctoral Dissertation, 156pp., Technical\n\ |
5730 | 898 University Graz, Austria, 1994.\n\ |
899 @item For @var{l} > 1e8, use normal approximation.\n\ | |
900 L. Montanet, et al., 'Review of Particle Properties', Physical Review\n\ | |
901 D 50 p1284, 1994\n\ | |
902 @end table\n\ | |
6547 | 903 @seealso{rand, randn, rande, randg}\n\ |
5730 | 904 @end deftypefn") |
905 { | |
906 octave_value retval; | |
907 | |
908 int nargin = args.length (); | |
909 | |
910 if (nargin < 1) | |
911 error ("randp: insufficient arguments"); | |
912 else | |
913 { | |
9377
610bf90fce2a
update unwind_protect usage everywhere
Jaroslav Hajek <highegg@gmail.com>
parents:
9064
diff
changeset
|
914 unwind_protect::frame_id_t uwp_frame = unwind_protect::begin_frame (); |
5730 | 915 |
916 // This relies on the fact that elements are popped from the unwind | |
917 // stack in the reverse of the order they are pushed | |
918 // (i.e. current_distribution will be reset before calling | |
919 // reset_rand_generator()). | |
920 | |
921 unwind_protect::add (reset_rand_generator, 0); | |
9377
610bf90fce2a
update unwind_protect usage everywhere
Jaroslav Hajek <highegg@gmail.com>
parents:
9064
diff
changeset
|
922 unwind_protect::protect_var (current_distribution); |
5730 | 923 |
924 current_distribution = "poisson"; | |
925 | |
926 octave_rand::distribution (current_distribution); | |
927 | |
928 retval = do_rand (args, nargin, "randp", true); | |
929 | |
9377
610bf90fce2a
update unwind_protect usage everywhere
Jaroslav Hajek <highegg@gmail.com>
parents:
9064
diff
changeset
|
930 unwind_protect::run_frame (uwp_frame); |
5730 | 931 } |
932 | |
933 return retval; | |
934 } | |
935 | |
936 /* | |
937 %!test | |
6437 | 938 %! randp("state",12) |
939 %!assert(randp([-inf,-1,0,inf,nan]),[nan,nan,0,nan,nan]); % *** Please report | |
940 %!test | |
941 %! % Test fixed state | |
942 %! randp("state",1); | |
943 %! assert(randp(5,1,6),[5 5 3 7 7 3]) | |
944 %!test | |
945 %! % Test fixed state | |
946 %! randp("state",1); | |
947 %! assert(randp(15,1,6),[13 15 8 18 18 15]) | |
948 %!test | |
949 %! % Test fixed state | |
950 %! randp("state",1); | |
7421 | 951 %! assert(randp(1e9,1,6),[999915677 999976657 1000047684 1000019035 999985749 999977692],-1e-6) |
6437 | 952 %!test |
953 %! % Test fixed state | |
954 %! randp("seed",1); | |
6449 | 955 %! %%assert(randp(5,1,6),[8 2 3 6 6 8]) |
956 %! assert(randp(5,1,5),[8 2 3 6 6]) | |
6437 | 957 %!test |
958 %! % Test fixed state | |
959 %! randp("seed",1); | |
960 %! assert(randp(15,1,6),[15 16 12 10 10 12]) | |
961 %!test | |
962 %! % Test fixed state | |
963 %! randp("seed",1); | |
7421 | 964 %! assert(randp(1e9,1,6),[1000006208 1000012224 999981120 999963520 999963072 999981440],-1e-6) |
6437 | 965 %!test |
966 %! if (__random_statistical_tests__) | |
967 %! % statistical tests may fail occasionally. | |
968 %! randp("state",12) | |
969 %! for a=[5, 15, 1e9; 0.03, 0.03, -5e-3; 0.03, 0.03, 0.03] | |
970 %! x = randp(a(1),100000,1); | |
971 %! assert(min(x)>=0); % *** Please report this!!! *** | |
972 %! assert(mean(x),a(1),a(2)); | |
973 %! assert(var(x),a(1),0.02*a(1)); | |
974 %! assert(skewness(x),1/sqrt(a(1)),a(3)); | |
975 %! assert(kurtosis(x),1/a(1),3*a(3)); | |
976 %! endfor | |
977 %! endif | |
978 %!test | |
979 %! if (__random_statistical_tests__) | |
980 %! % statistical tests may fail occasionally. | |
981 %! randp("state",12) | |
982 %! for a=[5, 15, 1e9; 0.03, 0.03, -5e-3; 0.03, 0.03, 0.03] | |
983 %! x = randp(a(1)*ones(100000,1),100000,1); | |
984 %! assert(min(x)>=0); % *** Please report this!!! *** | |
985 %! assert(mean(x),a(1),a(2)); | |
986 %! assert(var(x),a(1),0.02*a(1)); | |
987 %! assert(skewness(x),1/sqrt(a(1)),a(3)); | |
988 %! assert(kurtosis(x),1/a(1),3*a(3)); | |
989 %! endfor | |
990 %! endif | |
991 %!test | |
992 %! randp("seed",12) | |
5730 | 993 %!assert(randp([-inf,-1,0,inf,nan]),[nan,nan,0,nan,nan]); % *** Please report |
994 %!test | |
6449 | 995 %! if (__random_statistical_tests__) |
996 %! % statistical tests may fail occasionally. | |
997 %! randp("seed",12) | |
998 %! for a=[5, 15, 1e9; 0.03, 0.03, -5e-3; 0.03, 0.03, 0.03] | |
999 %! x = randp(a(1),100000,1); | |
1000 %! assert(min(x)>=0); % *** Please report this!!! *** | |
1001 %! assert(mean(x),a(1),a(2)); | |
1002 %! assert(var(x),a(1),0.02*a(1)); | |
1003 %! assert(skewness(x),1/sqrt(a(1)),a(3)); | |
1004 %! assert(kurtosis(x),1/a(1),3*a(3)); | |
1005 %! endfor | |
1006 %! endif | |
5730 | 1007 %!test |
6449 | 1008 %! if (__random_statistical_tests__) |
1009 %! % statistical tests may fail occasionally. | |
1010 %! randp("seed",12) | |
1011 %! for a=[5, 15, 1e9; 0.03, 0.03, -5e-3; 0.03, 0.03, 0.03] | |
1012 %! x = randp(a(1)*ones(100000,1),100000,1); | |
1013 %! assert(min(x)>=0); % *** Please report this!!! *** | |
1014 %! assert(mean(x),a(1),a(2)); | |
1015 %! assert(var(x),a(1),0.02*a(1)); | |
1016 %! assert(skewness(x),1/sqrt(a(1)),a(3)); | |
1017 %! assert(kurtosis(x),1/a(1),3*a(3)); | |
1018 %! endfor | |
1019 %! endif | |
5730 | 1020 */ |
1021 | |
9647
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1022 DEFUN_DLD (randperm, args, , |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1023 "-*- texinfo -*-\n\ |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1024 @deftypefn {Loadable Function} {} randperm (@var{n})\n\ |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1025 @deftypefnx {Loadable Function} {} randperm (@var{n}, @var{m})\n\ |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1026 Return a row vector containing a random permutation of @code{1:@var{n}}.\n\ |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1027 If @var{m} is supplied, return @var{m} permutations,\n\ |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1028 one in each row of a NxM matrix. The complexity is O(M*N) in both time and\n\ |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1029 memory. The randomization is performed using rand().\n\ |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1030 All permutations are equally likely.\n\ |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1031 @seealso{perms}\n\ |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1032 @end deftypefn") |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1033 { |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1034 int nargin = args.length (); |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1035 octave_value retval; |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1036 |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1037 if (nargin == 1 || nargin == 2) |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1038 { |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1039 octave_idx_type n, m; |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1040 |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1041 if (nargin == 2) |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1042 m = args(1).idx_type_value (true); |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1043 else |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1044 m = 1; |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1045 |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1046 n = args(0).idx_type_value (true); |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1047 |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1048 if (m < 0 || n < 0) |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1049 error ("randperm: m and n must be non-negative"); |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1050 |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1051 if (! error_state) |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1052 { |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1053 // Generate random numbers. |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1054 NDArray r = octave_rand::nd_array (dim_vector (m, n)); |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1055 |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1056 // Create transposed to allow faster access. |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1057 Array<octave_idx_type> idx (dim_vector (n, m)); |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1058 |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1059 double *rvec = r.fortran_vec (); |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1060 |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1061 octave_idx_type *ivec = idx.fortran_vec (); |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1062 |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1063 // Perform the Knuth shuffle. |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1064 for (octave_idx_type j = 0; j < m; j++) |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1065 { |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1066 for (octave_idx_type i = 0; i < n; i++) |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1067 ivec[i] = i; |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1068 |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1069 for (octave_idx_type i = 0; i < n; i++) |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1070 { |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1071 octave_idx_type k = i + floor (rvec[i] * (n - i)); |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1072 std::swap (ivec[i], ivec[k]); |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1073 } |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1074 |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1075 ivec += n; |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1076 rvec += n; |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1077 } |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1078 |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1079 // Transpose. |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1080 idx = idx.transpose (); |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1081 |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1082 // Re-fetch the pointers. |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1083 ivec = idx.fortran_vec (); |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1084 rvec = r.fortran_vec (); |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1085 |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1086 // Convert to doubles, reusing r. |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1087 for (octave_idx_type i = 0, l = m*n; i < l; i++) |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1088 rvec[i] = ivec[i] + 1; |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1089 |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1090 // Now create an array object with a cached idx_vector. |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1091 retval = new octave_matrix (r, idx_vector (idx)); |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1092 } |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1093 } |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1094 else |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1095 print_usage (); |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1096 |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1097 return retval; |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1098 } |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1099 |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1100 /* |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1101 %!assert(sort(randperm(20)),1:20) |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1102 %!assert(sort(randperm(20,50),2),repmat(1:20,50,1)) |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1103 */ |
54f45f883a53
optimize & extend randperm
Jaroslav Hajek <highegg@gmail.com>
parents:
9377
diff
changeset
|
1104 |
5730 | 1105 /* |
2928 | 1106 ;;; Local Variables: *** |
1107 ;;; mode: C++ *** | |
1108 ;;; End: *** | |
1109 */ |