Coverage Report

Created: 2025-07-18 07:05

/src/igraph/src/random/random.c
Line
Count
Source (jump to first uncovered line)
1
/*
2
   IGraph library.
3
   Copyright (C) 2005-2012  Gabor Csardi <csardi.gabor@gmail.com>
4
   334 Harvard street, Cambridge, MA 02139 USA
5
6
   This program is free software; you can redistribute it and/or modify
7
   it under the terms of the GNU General Public License as published by
8
   the Free Software Foundation; either version 2 of the License, or
9
   (at your option) any later version.
10
11
   This program is distributed in the hope that it will be useful,
12
   but WITHOUT ANY WARRANTY; without even the implied warranty of
13
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14
   GNU General Public License for more details.
15
16
   You should have received a copy of the GNU General Public License
17
   along with this program; if not, write to the Free Software
18
   Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
19
   02110-1301 USA
20
21
*/
22
23
24
#include "igraph_random.h"
25
26
#include "igraph_nongraph.h"
27
#include "igraph_error.h"
28
#include "igraph_types.h"
29
#include "igraph_vector.h"
30
31
#include "core/interruption.h"
32
#include "math/safe_intop.h"
33
#include "random/random_internal.h"
34
35
#include "config.h" /* IGRAPH_THREAD_LOCAL, HAVE___UINT128_T, HAVE__UMUL128 */
36
37
#if defined(HAVE__UMUL128) || defined(HAVE___UMULH)
38
#include <intrin.h> /* _umul128() or __umulh() are defined in intrin.h */
39
#endif
40
41
#include <assert.h>
42
#include <math.h>
43
#include <float.h> /* DBL_MANT_DIG */
44
#include <stdbool.h>
45
46
/**
47
 * \section about_rngs
48
 *
49
 * <section id="about-random-numbers-in-igraph">
50
 * <title>About random numbers in igraph</title>
51
 *
52
 * <para>
53
 * Some algorithms in igraph, such as sampling from random graph models,
54
 * require random number generators (RNGs). igraph includes a flexible
55
 * RNG framework that allows hooking up arbitrary random number generators,
56
 * and comes with several ready-to-use generators. This framework is used
57
 * in igraph's high-level interfaces to integrate with the host language's
58
 * own RNG.
59
 * </para>
60
 * </section>
61
 *
62
 */
63
64
/**
65
 * \section rng_use_cases
66
 *
67
 * <section id="random-use-cases"><title>Use cases</title>
68
 *
69
 * <section id="random-normal-use"><title>Normal (default) use</title>
70
 * <para>
71
 * If the user does not use any of the RNG functions explicitly, but calls
72
 * some of the randomized igraph functions, then a default RNG is set
73
 * up the first time an igraph function needs random numbers. The
74
 * seed of this RNG is the output of the <code>time(0)</code> function
75
 * call, using the <code>time</code> function from the standard C
76
 * library. This ensures that igraph creates a different random graph,
77
 * each time the C program is called.
78
 * </para>
79
 *
80
 * <para>
81
 * The created default generator is stored internally and can be
82
 * queried with the \ref igraph_rng_default() function.
83
 * </para>
84
 * </section>
85
 *
86
 * <section id="random-reproducible-simulations"><title>Reproducible simulations</title>
87
 * <para>
88
 * If reproducible results are needed, then the user should set the
89
 * seed of the default random number generator explicitly, using the
90
 * \ref igraph_rng_seed() function on the default generator, \ref
91
 * igraph_rng_default(). When setting the seed to the same number,
92
 * igraph generates exactly the same random graph (or series of random
93
 * graphs).
94
 * </para>
95
 * </section>
96
 *
97
 * <section id="random-changing-default-generator"><title>Changing the default generator</title>
98
 * <para>
99
 * By default igraph uses the \ref igraph_rng_default() random number
100
 * generator. This can be changed any time by calling \ref
101
 * igraph_rng_set_default(), with an already initialized random number
102
 * generator. Note that the old (replaced) generator is not
103
 * destroyed, so no memory is deallocated.
104
 * </para>
105
 * </section>
106
 *
107
 * <section id="random-using-multiple-generators"><title>Using multiple generators</title>
108
 * <para>
109
 * igraph also provides functions to set up multiple random number
110
 * generators, using the \ref igraph_rng_init() function, and then
111
 * generating random numbers from them, e.g. with \ref igraph_rng_get_integer()
112
 * and/or \ref igraph_rng_get_unif() calls.
113
 * </para>
114
 *
115
 * <para>
116
 * Note that initializing a new random number generator is
117
 * independent of the generator that the igraph functions themselves
118
 * use. If you want to replace that, then please use \ref
119
 * igraph_rng_set_default().
120
 * </para>
121
 * </section>
122
 *
123
 * <section id="random-example"><title>Example</title>
124
 * <para>
125
 * \example examples/simple/random_seed.c
126
 * </para>
127
 * </section>
128
 *
129
 * </section>
130
 */
131
132
/* ------------------------------------ */
133
134
/**
135
 * \var igraph_i_rng_default
136
 * The default igraph random number generator
137
 *
138
 * This generator is used by all builtin igraph functions that need to
139
 * generate random numbers; e.g. all random graph generators.
140
 *
141
 * You can use \ref igraph_i_rng_default with \ref igraph_rng_seed()
142
 * to set its seed.
143
 *
144
 * You can change the default generator using the \ref
145
 * igraph_rng_set_default() function.
146
 */
147
148
extern igraph_rng_t igraph_i_rng_default; /* defined in rng_pcg32.c */
149
IGRAPH_THREAD_LOCAL igraph_rng_t *igraph_i_rng_default_ptr = &igraph_i_rng_default;
150
151
/**
152
 * \function igraph_rng_set_default
153
 * \brief Set the default igraph random number generator.
154
 *
155
 * This function updates the default RNG used by igraph to be the one
156
 * pointed to by \p rng, and returns a pointer to the previous default
157
 * RNG. Future calls to \ref igraph_rng_default() will return the same
158
 * pointer as \p rng. The RNG pointed to by \p rng must not be destroyed
159
 * for as long as it is used as the default.
160
 *
161
 * \param rng The random number generator to use as default from now
162
 *    on. Calling \ref igraph_rng_destroy() on it, while it is still
163
 *    being used as the default will result in crashes and/or
164
 *    unpredictable results.
165
 * \return Pointer the previous default RNG.
166
 *
167
 * Time complexity: O(1).
168
 */
169
170
0
igraph_rng_t *igraph_rng_set_default(igraph_rng_t *rng) {
171
0
    igraph_rng_t *old_rng = igraph_i_rng_default_ptr;
172
0
    igraph_i_rng_default_ptr = rng;
173
0
    return old_rng;
174
0
}
175
176
177
/* ------------------------------------ */
178
179
/**
180
 * \function igraph_rng_default
181
 * \brief Query the default random number generator.
182
 *
183
 * \return A pointer to the default random number generator.
184
 *
185
 * \sa \ref igraph_rng_set_default()
186
 */
187
188
124k
igraph_rng_t *igraph_rng_default(void) {
189
124k
    return igraph_i_rng_default_ptr;
190
124k
}
191
192
/* ------------------------------------ */
193
194
static igraph_uint_t igraph_i_rng_get_random_bits(igraph_rng_t *rng, uint8_t bits);
195
static uint64_t igraph_i_rng_get_random_bits_uint64(igraph_rng_t *rng, uint8_t bits);
196
197
static igraph_uint_t igraph_i_rng_get_uint(igraph_rng_t *rng);
198
static igraph_uint_t igraph_i_rng_get_uint_bounded(igraph_rng_t *rng, igraph_uint_t range);
199
200
static uint32_t igraph_i_rng_get_uint32(igraph_rng_t *rng);
201
static uint32_t igraph_i_rng_get_uint32_bounded(igraph_rng_t *rng, uint32_t range);
202
203
#if IGRAPH_INTEGER_SIZE == 64
204
static uint64_t igraph_i_rng_get_uint64(igraph_rng_t *rng);
205
static uint64_t igraph_i_rng_get_uint64_bounded(igraph_rng_t *rng, uint64_t range);
206
#endif
207
208
static double igraph_i_norm_rand(igraph_rng_t *rng);
209
static double igraph_i_exp_rand(igraph_rng_t *rng);
210
static double igraph_i_rbinom(igraph_rng_t *rng, igraph_integer_t n, double pp);
211
static double igraph_i_rexp(igraph_rng_t *rng, double rate);
212
static double igraph_i_rgamma(igraph_rng_t *rng, double shape, double scale);
213
static double igraph_i_rpois(igraph_rng_t *rng, double rate);
214
215
/**
216
 * \function igraph_rng_init
217
 * \brief Initializes a random number generator.
218
 *
219
 * This function allocates memory for a random number generator, with
220
 * the given type, and sets its seed to the default.
221
 *
222
 * \param rng Pointer to an uninitialized RNG.
223
 * \param type The type of the RNG, such as \ref igraph_rngtype_mt19937,
224
 * \ref igraph_rngtype_glibc2, \ref igraph_rngtype_pcg32 or
225
 * \ref igraph_rngtype_pcg64.
226
 * \return Error code.
227
 */
228
229
0
igraph_error_t igraph_rng_init(igraph_rng_t *rng, const igraph_rng_type_t *type) {
230
0
    rng->type = type;
231
0
    IGRAPH_CHECK(rng->type->init(&rng->state));
232
0
    return IGRAPH_SUCCESS;
233
0
}
234
235
/**
236
 * \function igraph_rng_destroy
237
 * \brief Deallocates memory associated with a random number generator.
238
 *
239
 * \param rng The RNG to destroy. Do not destroy an RNG that is used
240
 *    as the default igraph RNG.
241
 *
242
 * Time complexity: O(1).
243
 */
244
245
0
void igraph_rng_destroy(igraph_rng_t *rng) {
246
0
    rng->type->destroy(rng->state);
247
0
}
248
249
/**
250
 * \function igraph_rng_seed
251
 * \brief Seeds a random number generator.
252
 *
253
 * \param rng The RNG.
254
 * \param seed The new seed.
255
 * \return Error code.
256
 *
257
 * Time complexity: usually O(1), but may depend on the type of the
258
 * RNG.
259
 */
260
0
igraph_error_t igraph_rng_seed(igraph_rng_t *rng, igraph_uint_t seed) {
261
0
    const igraph_rng_type_t *type = rng->type;
262
0
    IGRAPH_CHECK(type->seed(rng->state, seed));
263
0
    rng->is_seeded = true;
264
0
    return IGRAPH_SUCCESS;
265
0
}
266
267
/**
268
 * \function igraph_rng_bits
269
 * \brief The number of random bits that a random number generator can produces in a single round.
270
 *
271
 * \param rng The RNG.
272
 * \return The number of random bits that can be generated in a single round
273
 *         with the RNG.
274
 *
275
 * Time complexity: O(1).
276
 */
277
124k
igraph_integer_t igraph_rng_bits(const igraph_rng_t* rng) {
278
124k
    return rng->type->bits;
279
124k
}
280
281
/**
282
 * \function igraph_rng_max
283
 * \brief The maximum possible integer for a random number generator.
284
 *
285
 * Note that this number is only for informational purposes; it returns the
286
 * maximum possible integer that can be generated with the RNG with a single
287
 * call to its internals. It is derived directly from the number of random
288
 * \em bits that the RNG can generate in a single round. When this is smaller
289
 * than what would be needed by other RNG functions like \ref igraph_rng_get_integer(),
290
 * igraph will call the RNG multiple times to generate more random bits.
291
 *
292
 * \param rng The RNG.
293
 * \return The largest possible integer that can be generated in a single round
294
 *         with the RNG.
295
 *
296
 * Time complexity: O(1).
297
 */
298
299
0
igraph_uint_t igraph_rng_max(const igraph_rng_t *rng) {
300
0
    const igraph_rng_type_t *type = rng->type;
301
0
#if IGRAPH_INTEGER_SIZE == 64
302
0
    return (type->bits >= 64) ? 0xFFFFFFFFFFFFFFFFULL : ((1ULL << type->bits) - 1);
303
#else
304
    return (type->bits >= 32) ? 0xFFFFFFFFUL : ((1ULL << type->bits) - 1);
305
#endif
306
0
}
307
308
/**
309
 * \function igraph_rng_name
310
 * \brief The type of a random number generator.
311
 *
312
 * \param rng The RNG.
313
 * \return The name of the type of the generator. Do not deallocate or
314
 *         change the returned string.
315
 *
316
 * Time complexity: O(1).
317
 */
318
319
0
const char *igraph_rng_name(const igraph_rng_t *rng) {
320
0
    const igraph_rng_type_t *type = rng->type;
321
0
    return type->name;
322
0
}
323
324
/**
325
 * Generates a given number of random bits, possibly invoking the underlying
326
 * RNG multiple times if needed, and returns the result in an \c igraph_uint_t .
327
 *
328
 * \param rng The RNG.
329
 * \param bits The number of random bits needed. Must be smaller than or equal
330
 *        to the size of the \c igraph_uint_t data type. Passing a value larger
331
 *        than the size of \c igraph_uint_t will throw away random bits except
332
 *        the last few that are needed to fill an \c igraph_uint_t .
333
 * \return The random bits, packed into the low bits of an \c igraph_uint_t .
334
 *         The upper, unused bits of \c igraph_uint_t will be set to zero.
335
 */
336
83.7k
static igraph_uint_t igraph_i_rng_get_random_bits(igraph_rng_t *rng, uint8_t bits) {
337
83.7k
    const igraph_rng_type_t *type = rng->type;
338
83.7k
    igraph_integer_t rng_bitwidth = igraph_rng_bits(rng);
339
83.7k
    igraph_uint_t result;
340
341
83.7k
    if (rng_bitwidth >= bits) {
342
        /* keep the high bits as RNGs sometimes tend to have lower entropy in
343
         * low bits than in high bits */
344
83.7k
        result = type->get(rng->state) >> (rng_bitwidth - bits);
345
83.7k
    } else {
346
0
        result = 0;
347
0
        do {
348
0
            result = (result << rng_bitwidth) + type->get(rng->state);
349
0
            bits -= rng_bitwidth;
350
0
        } while (bits > rng_bitwidth);
351
352
        /* and now the last piece */
353
0
        result = (result << bits) + (type->get(rng->state) >> (rng_bitwidth - bits));
354
0
    }
355
356
83.7k
    return result;
357
83.7k
}
358
359
/**
360
 * Generates a given number of random bits, possibly invoking the underlying
361
 * RNG multiple times if needed, and returns the result in an \c uint64_t .
362
 *
363
 * Prefer \c igraph_i_rng_get_random_bits() if you know that you need at most
364
 * 32 bits due to the type of the return value. This function might perform
365
 * worse on 32-bit platforms because the result is always 64 bits.
366
 *
367
 * \param rng The RNG.
368
 * \param bits The number of random bits needed. Must be smaller than or equal
369
 *        to the size of the \c uint64_t data type. Passing a value larger
370
 *        than the size of \c uint64_t will throw away random bits except
371
 *        the last few that are needed to fill an \c uint64_t .
372
 * \return The random bits, packed into the low bits of an \c uint64_t .
373
 *         The upper, unused bits of \c uint64_t will be set to zero.
374
 */
375
0
static uint64_t igraph_i_rng_get_random_bits_uint64(igraph_rng_t *rng, uint8_t bits) {
376
0
    const igraph_rng_type_t *type = rng->type;
377
0
    igraph_integer_t rng_bitwidth = igraph_rng_bits(rng);
378
0
    uint64_t result;
379
380
0
    if (rng_bitwidth >= bits) {
381
        /* keep the high bits as RNGs sometimes tend to have lower entropy in
382
         * low bits than in high bits */
383
0
        result = type->get(rng->state) >> (rng_bitwidth - bits);
384
0
    } else {
385
0
        result = 0;
386
0
        do {
387
0
            result = (result << rng_bitwidth) + type->get(rng->state);
388
0
            bits -= rng_bitwidth;
389
0
        } while (bits > rng_bitwidth);
390
391
        /* and now the last piece */
392
0
        result = (result << bits) + (type->get(rng->state) >> (rng_bitwidth - bits));
393
0
    }
394
395
0
    return result;
396
0
}
397
398
/**
399
 * Generates a random integer in the full range of the \c igraph_uint_t
400
 * data type.
401
 *
402
 * \param rng The RNG.
403
 * \return The random integer.
404
 */
405
0
static igraph_uint_t igraph_i_rng_get_uint(igraph_rng_t *rng) {
406
0
    return igraph_i_rng_get_random_bits(rng, sizeof(igraph_uint_t) * 8);
407
0
}
408
409
/**
410
 * Generates a random integer in the full range of the \c uint32_t
411
 * data type.
412
 *
413
 * \param rng The RNG.
414
 * \return The random integer.
415
 */
416
83.7k
static uint32_t igraph_i_rng_get_uint32(igraph_rng_t *rng) {
417
83.7k
    return igraph_i_rng_get_random_bits(rng, 32);
418
83.7k
}
419
420
/**
421
 * Generates a random integer in the range [0; range) (upper bound exclusive),
422
 * restricted to at most 32 bits.
423
 *
424
 * \param rng The RNG.
425
 * \param range The upper bound (exclusive).
426
 * \return The random integer.
427
 */
428
83.7k
static uint32_t igraph_i_rng_get_uint32_bounded(igraph_rng_t *rng, uint32_t range) {
429
    /* Debiased integer multiplication -- Lemire's method
430
     * from https://www.pcg-random.org/posts/bounded-rands.html */
431
83.7k
    uint32_t x, l, t = (-range) % range;
432
83.7k
    uint64_t m;
433
83.7k
    do {
434
83.7k
        x = igraph_i_rng_get_uint32(rng);
435
83.7k
        m = (uint64_t)(x) * (uint64_t)(range);
436
83.7k
        l = (uint32_t)m;
437
83.7k
    } while (l < t);
438
83.7k
    return m >> 32;
439
83.7k
}
440
441
#if IGRAPH_INTEGER_SIZE == 64
442
/**
443
 * Generates a random integer in the full range of the \c uint64_t
444
 * data type.
445
 *
446
 * \param rng The RNG.
447
 * \param range The upper bound (inclusive).
448
 * \return The random integer.
449
 */
450
0
static uint64_t igraph_i_rng_get_uint64(igraph_rng_t *rng) {
451
0
    return igraph_i_rng_get_random_bits(rng, 64);
452
0
}
453
454
#if !defined(HAVE___UINT128_T)
455
static uint64_t igraph_i_umul128(uint64_t a, uint64_t b, uint64_t *hi) {
456
#if defined(HAVE__UMUL128)
457
    /* MSVC has _umul128() on x64 but not on arm64 */
458
    return _umul128(a, b, hi);
459
#elif defined(HAVE___UMULH)
460
    /* MSVC has __umulh() on arm64 */
461
    *hi = __umulh(a, b);
462
    return a*b;
463
#else
464
    /* Portable but slow fallback implementation of unsigned
465
     * 64-bit multiplication obtaining a 128-bit result.
466
     * Based on https://stackoverflow.com/a/28904636/695132
467
     */
468
469
    uint64_t a_lo = (uint32_t) a;
470
    uint64_t a_hi = a >> 32;
471
    uint64_t b_lo = (uint32_t) b;
472
    uint64_t b_hi = b >> 32;
473
474
    uint64_t a_x_b_hi  = a_hi * b_hi;
475
    uint64_t a_x_b_mid = a_hi * b_lo;
476
    uint64_t b_x_a_mid = b_hi * a_lo;
477
    uint64_t a_x_b_lo  = a_lo * b_lo;
478
479
    uint64_t carry_bit = ((uint64_t) (uint32_t) a_x_b_mid +
480
                          (uint64_t) (uint32_t) b_x_a_mid +
481
                          (a_x_b_lo >> 32) ) >> 32;
482
483
    *hi = a_x_b_hi +
484
          (a_x_b_mid >> 32) + (b_x_a_mid >> 32) +
485
          carry_bit;
486
487
    return a*b;
488
#endif
489
}
490
#endif /* !defined(HAVE___UINT128_T) */
491
492
/**
493
 * Generates a random integer in the range [0; range) (upper bound exclusive),
494
 * restricted to at most 64 bits.
495
 *
496
 * \param rng The RNG.
497
 * \param range The upper bound (exclusive).
498
 * \return The random integer.
499
 */
500
0
static uint64_t igraph_i_rng_get_uint64_bounded(igraph_rng_t *rng, uint64_t range) {
501
    /* Debiased integer multiplication -- Lemire's method
502
     * from https://www.pcg-random.org/posts/bounded-rands.html */
503
0
    uint64_t x, l, t = (-range) % range;
504
0
#if defined(HAVE___UINT128_T)
505
    /* gcc and clang have __uint128_t */
506
0
    __uint128_t m;
507
0
    do {
508
0
        x = igraph_i_rng_get_uint64(rng);
509
0
        m = (__uint128_t)(x) * (__uint128_t)(range);
510
0
        l = (uint64_t)m;
511
0
    } while (l < t);
512
0
    return m >> 64;
513
#else
514
    uint64_t hi;
515
    do {
516
        x = igraph_i_rng_get_uint64(rng);
517
        l = igraph_i_umul128(x, range, &hi);
518
    } while (l < t);
519
    return hi;
520
#endif
521
0
}
522
523
#endif /* IGRAPH_INTEGER_SIZE == 64 */
524
525
/**
526
 * Generates a random integer in the range [0; range) (upper bound exclusive).
527
 *
528
 * \param rng The RNG.
529
 * \param range The upper bound (exclusive).
530
 * \return The random integer.
531
 */
532
83.7k
static igraph_uint_t igraph_i_rng_get_uint_bounded(igraph_rng_t *rng, igraph_uint_t range) {
533
    /* We must make this function behave the same way for range < 2^32 so igraph
534
     * behaves the same way on 32-bit and 64-bit platforms as long as we stick
535
     * to integers less than 2^32. This is to ensure that the unit tests are
536
     * consistent */
537
538
#if IGRAPH_INTEGER_SIZE == 32
539
    return igraph_i_rng_get_uint32_bounded(rng, range);
540
#else
541
83.7k
    if (range <= UINT32_MAX) {
542
83.7k
        return igraph_i_rng_get_uint32_bounded(rng, range);
543
83.7k
    } else {
544
0
        return igraph_i_rng_get_uint64_bounded(rng, range);
545
0
    }
546
83.7k
#endif
547
83.7k
}
548
549
550
/**
551
 * \function igraph_rng_get_bool
552
 * \brief Generate a random boolean.
553
 *
554
 * Use this function only when a single random boolean, i.e. a single bit
555
 * is needed at a time. It is not efficient for generating multiple bits.
556
 *
557
 * \param rng Pointer to the RNG to use for the generation. Use \ref
558
 *        igraph_rng_default() here to use the default igraph RNG.
559
 * \return The generated bit, as a truth value.
560
 */
561
562
41.0k
igraph_bool_t igraph_rng_get_bool(igraph_rng_t *rng) {
563
41.0k
    const igraph_rng_type_t *type = rng->type;
564
41.0k
    const igraph_integer_t rng_bitwidth = igraph_rng_bits(rng);
565
    /* Keep the highest bit as RNGs sometimes tend to have lower entropy in
566
     * low bits than in high bits.
567
     *
568
     * Ensure that the return value is stricly 0 or 1 even if igraph_bool_t is
569
     * defined to something else than a native bool.
570
     */
571
41.0k
    return (type->get(rng->state) >> (rng_bitwidth - 1)) & (igraph_uint_t)1;
572
41.0k
}
573
574
/**
575
 * \function igraph_rng_get_integer
576
 * \brief Generate an integer random number from an interval.
577
 *
578
 * Generate uniformly distributed integers from the interval <code>[l, h]</code>.
579
 *
580
 * \param rng Pointer to the RNG to use for the generation. Use \ref
581
 *        igraph_rng_default() here to use the default igraph RNG.
582
 * \param l Lower limit, inclusive, it can be negative as well.
583
 * \param h Upper limit, inclusive, it can be negative as well, but it
584
 *        must be at least <code>l</code>.
585
 * \return The generated random integer.
586
 *
587
 * Time complexity: O(log2(h-l+1) / bits) where bits is the value of
588
 * \ref igraph_rng_bits(rng).
589
 */
590
591
igraph_integer_t igraph_rng_get_integer(
592
    igraph_rng_t *rng, igraph_integer_t l, igraph_integer_t h
593
83.7k
) {
594
83.7k
    const igraph_rng_type_t *type = rng->type;
595
83.7k
    igraph_uint_t range;
596
597
83.7k
    assert(h >= l);
598
599
83.7k
    if (h == l) {
600
0
        return l;
601
0
    }
602
603
83.7k
    if (type->get_int) {
604
0
        return type->get_int(rng->state, l, h);
605
0
    }
606
607
83.7k
    if (IGRAPH_UNLIKELY(l == IGRAPH_INTEGER_MIN && h == IGRAPH_INTEGER_MAX)) {
608
        /* Full uint range is needed, we can just grab a random number from
609
         * the uint range and cast it to a signed integer */
610
0
        return (igraph_integer_t) igraph_i_rng_get_uint(rng);
611
83.7k
    } else if (l >= 0 || h < 0) {
612
        /* this is okay, (h - l) will not overflow an igraph_integer_t */
613
83.7k
        range = (igraph_uint_t)(h - l) + 1;
614
83.7k
    } else {
615
        /* (h - l) could potentially overflow so we need to play it safe. If we
616
         * are here, l < 0 and h >= 0 so we can cast -l into an igraph_uint_t
617
         * safely and do the subtraction that way */
618
0
        range = ((igraph_uint_t)(h)) + ((igraph_uint_t)(-l)) + 1;
619
0
    }
620
621
83.7k
    return l + igraph_i_rng_get_uint_bounded(rng, range);
622
83.7k
}
623
624
/**
625
 * \function igraph_rng_get_normal
626
 * \brief Samples from a normal distribution.
627
 *
628
 * Generates random variates from a normal distribution with probability
629
 * density
630
 *
631
 * </para><para>
632
 * <code>exp( -(x - m)^2 / (2 s^2) )</code>.
633
 *
634
 * \param rng Pointer to the RNG to use. Use \ref igraph_rng_default()
635
 *        here to use the default igraph RNG.
636
 * \param m The mean.
637
 * \param s The standard deviation.
638
 * \return The generated normally distributed random number.
639
 *
640
 * Time complexity: depends on the type of the RNG.
641
 */
642
643
igraph_real_t igraph_rng_get_normal(igraph_rng_t *rng,
644
0
                                    igraph_real_t m, igraph_real_t s) {
645
0
    const igraph_rng_type_t *type = rng->type;
646
0
    if (type->get_norm) {
647
0
        return type->get_norm(rng->state) * s + m;
648
0
    } else {
649
0
        return igraph_i_norm_rand(rng) * s + m;
650
0
    }
651
0
}
652
653
/**
654
 * \function igraph_rng_get_unif
655
 * \brief Samples real numbers from a given interval.
656
 *
657
 * Generates uniformly distributed real numbers from the <code>[l, h)</code>
658
 * half-open interval.
659
 *
660
 * \param rng Pointer to the RNG to use. Use \ref igraph_rng_default()
661
 *        here to use the default igraph RNG.
662
 * \param l The lower bound, it can be negative.
663
 * \param h The upper bound, it can be negative, but it has to be
664
 *        larger than the lower bound.
665
 * \return The generated uniformly distributed random number.
666
 *
667
 * Time complexity: depends on the type of the RNG.
668
 */
669
670
igraph_real_t igraph_rng_get_unif(igraph_rng_t *rng,
671
0
                                  igraph_real_t l, igraph_real_t h) {
672
0
    assert(h >= l);
673
674
0
    if (l == h) return h;
675
676
    /* Ensure that 'h' is never produced due to numerical roundoff errors, except when l == h. */
677
0
    igraph_real_t r;
678
0
    do {
679
0
        r = igraph_rng_get_unif01(rng) * (h - l) + l;
680
0
    } while (IGRAPH_UNLIKELY(r == h));
681
0
    return r;
682
0
}
683
684
/**
685
 * \function igraph_rng_get_unif01
686
 * \brief Samples uniformly from the unit interval.
687
 *
688
 * Generates uniformly distributed real numbers from the <code>[0, 1)</code>
689
 * half-open interval.
690
 *
691
 * \param rng Pointer to the RNG to use. Use \ref igraph_rng_default()
692
 *        here to use the default igraph RNG.
693
 * \return The generated uniformly distributed random number.
694
 *
695
 * Time complexity: depends on the type of the RNG.
696
 */
697
698
0
igraph_real_t igraph_rng_get_unif01(igraph_rng_t *rng) {
699
0
    const igraph_rng_type_t *type = rng->type;
700
0
    if (type->get_real) {
701
0
        return type->get_real(rng->state);
702
0
    } else {
703
        /* We extract 52 random bits from a 64-bit uint and fill that directly
704
         * into the mantissa of a double, bit-by-bit, clear the sign bit and
705
         * set the exponent to 2^0. This way we get a 52-bit random double
706
         * between 1 (inclusive) and 2 (exclusive), uniformly distributed.
707
         * Then we subtract 1 to arrive at the [0; 1) interval. This is fast
708
         * but we lose one bit of precision as there are 2^53 possible doubles
709
         * between 0 and 1. */
710
0
        union {
711
0
            uint64_t as_uint64_t;
712
0
            double as_double;
713
0
        } value;
714
0
        value.as_uint64_t =
715
0
            (igraph_i_rng_get_random_bits_uint64(rng, 52) & 0xFFFFFFFFFFFFFull) | 0x3FF0000000000000ull;
716
0
        return value.as_double - 1.0;
717
0
    }
718
0
}
719
720
/**
721
 * \function igraph_rng_get_geom
722
 * \brief Samples from a geometric distribution.
723
 *
724
 * Generates random variates from a geometric distribution. The number \c k is
725
 * generated with probability
726
 *
727
 * </para><para>
728
 * <code>(1 - p)^k p</code>, <code>k = 0, 1, 2, ...</code>.
729
 *
730
 * \param rng Pointer to the RNG to use. Use \ref igraph_rng_default()
731
 *        here to use the default igraph RNG.
732
 * \param p The probability of success in each trial. Must be larger
733
 *        than zero and smaller or equal to 1.
734
 * \return The generated geometrically distributed random number.
735
 *
736
 * Time complexity: depends on the RNG.
737
 */
738
739
0
igraph_real_t igraph_rng_get_geom(igraph_rng_t *rng, igraph_real_t p) {
740
0
    const igraph_rng_type_t *type = rng->type;
741
0
    if (!isfinite(p) || p <= 0 || p > 1) {
742
0
        return IGRAPH_NAN;
743
0
    }
744
0
    if (type->get_geom) {
745
0
        return type->get_geom(rng->state, p);
746
0
    } else {
747
0
        return igraph_rng_get_pois(rng, igraph_i_exp_rand(rng) * ((1 - p) / p));
748
0
    }
749
0
}
750
751
/**
752
 * \function igraph_rng_get_binom
753
 * \brief Samples from a binomial distribution.
754
 *
755
 * Generates random variates from a binomial distribution. The number \c k is generated
756
 * with probability
757
 *
758
 * </para><para>
759
 * <code>(n \choose k) p^k (1-p)^(n-k)</code>, <code>k = 0, 1, ..., n</code>.
760
 *
761
 * \param rng Pointer to the RNG to use. Use \ref igraph_rng_default()
762
 *        here to use the default igraph RNG.
763
 * \param n Number of observations.
764
 * \param p Probability of an event.
765
 * \return The generated binomially distributed random number.
766
 *
767
 * Time complexity: depends on the RNG.
768
 */
769
770
0
igraph_real_t igraph_rng_get_binom(igraph_rng_t *rng, igraph_integer_t n, igraph_real_t p) {
771
0
    const igraph_rng_type_t *type = rng->type;
772
0
    if (type->get_binom) {
773
0
        return type->get_binom(rng->state, n, p);
774
0
    } else {
775
0
        return igraph_i_rbinom(rng, n, p);
776
0
    }
777
0
}
778
779
/**
780
 * \function igraph_rng_get_gamma
781
 * \brief Samples from a gamma distribution.
782
 *
783
 * Generates random variates from a gamma distribution with probability
784
 * density proportional to
785
 *
786
 * </para><para>
787
 * <code>x^(shape-1) exp(-x / scale)</code>.
788
 *
789
 * \param rng Pointer to the RNG to use. Use \ref igraph_rng_default()
790
 *        here to use the default igraph RNG.
791
 * \param shape Shape parameter.
792
 * \param scale Scale parameter.
793
 * \return The generated sample.
794
 *
795
 * Time complexity: depends on the RNG.
796
 */
797
798
igraph_real_t igraph_rng_get_gamma(igraph_rng_t *rng, igraph_real_t shape,
799
0
                                   igraph_real_t scale) {
800
0
    const igraph_rng_type_t *type = rng->type;
801
0
    if (type->get_gamma) {
802
0
        return type->get_gamma(rng->state, shape, scale);
803
0
    } else {
804
0
        return igraph_i_rgamma(rng, shape, scale);
805
0
    }
806
0
}
807
808
/**
809
 * \function igraph_rng_get_exp
810
 * \brief Samples from an exponential distribution.
811
 *
812
 * Generates random variates from an exponential distribution with probability
813
 * density proportional to
814
 *
815
 * </para><para>
816
 * <code>exp(-rate x)</code>.
817
 *
818
 * \param rng Pointer to the RNG to use. Use \ref igraph_rng_default()
819
 *        here to use the default igraph RNG.
820
 * \param rate Rate parameter.
821
 * \return The generated sample.
822
 *
823
 * Time complexity: depends on the RNG.
824
 */
825
826
0
igraph_real_t igraph_rng_get_exp(igraph_rng_t *rng, igraph_real_t rate) {
827
0
    const igraph_rng_type_t *type = rng->type;
828
0
    if (type->get_exp) {
829
0
        return type->get_exp(rng->state, rate);
830
0
    } else {
831
0
        return igraph_i_rexp(rng, rate);
832
0
    }
833
0
}
834
835
/**
836
 * \function igraph_rng_get_pois
837
 * \brief Samples from a Poisson distribution.
838
 *
839
 * Generates random variates from a Poisson distribution. The number \c k is generated
840
 * with probability
841
 *
842
 * </para><para>
843
 * <code>rate^k * exp(-rate) / k!</code>, <code>k = 0, 1, 2, ...</code>.
844
 *
845
 * \param rng Pointer to the RNG to use. Use \ref igraph_rng_default()
846
 *        here to use the default igraph RNG.
847
 * \param rate The rate parameter of the Poisson distribution. Must not be negative.
848
 * \return The generated geometrically distributed random number.
849
 *
850
 * Time complexity: depends on the RNG.
851
 */
852
853
0
igraph_real_t igraph_rng_get_pois(igraph_rng_t *rng, igraph_real_t rate) {
854
0
    const igraph_rng_type_t *type = rng->type;
855
0
    if (isnan(rate) || rate < 0) {
856
0
        return IGRAPH_NAN;
857
0
    } else if (rate == 0) {
858
0
        return 0;
859
0
    } else if (type->get_pois) {
860
0
        return type->get_pois(rng->state, rate);
861
0
    } else {
862
0
        return igraph_i_rpois(rng, rate);
863
0
    }
864
0
}
865
866
867
/**
868
 * \ingroup internal
869
 *
870
 * This function appends the rest of the needed random numbers to the
871
 * result vector. It is Algoirthm A in Vitter's paper.
872
 */
873
874
static void igraph_i_random_sample_alga(igraph_vector_int_t *res,
875
                                        igraph_integer_t l, igraph_integer_t h,
876
0
                                        igraph_integer_t length) {
877
    /* Vitter: Variables V, quot, Nreal, and top are of type real */
878
879
0
    igraph_integer_t N = h - l + 1;
880
0
    igraph_integer_t n = length;
881
882
0
    igraph_real_t top = N - n;
883
0
    igraph_real_t Nreal = N;
884
0
    igraph_integer_t S = 0;
885
0
    igraph_real_t V, quot;
886
887
0
    l = l - 1;
888
889
0
    while (n >= 2) {
890
0
        V = RNG_UNIF01();
891
0
        S = 1;
892
0
        quot = top / Nreal;
893
0
        while (quot > V) {
894
0
            S += 1;
895
0
            top = -1.0 + top;
896
0
            Nreal = -1.0 + Nreal;
897
0
            quot = (quot * top) / Nreal;
898
0
        }
899
0
        l += S;
900
0
        igraph_vector_int_push_back(res, l); /* allocated */
901
0
        Nreal = -1.0 + Nreal; n = -1 + n;
902
0
    }
903
904
0
    S = trunc(round(Nreal) * RNG_UNIF01());
905
0
    l += S + 1;
906
0
    igraph_vector_int_push_back(res, l); /* allocated */
907
0
}
908
909
/**
910
 * \ingroup nongraph
911
 * \function igraph_random_sample
912
 * \brief Generates an increasing random sequence of integers.
913
 *
914
 * This function generates an increasing sequence of random integer
915
 * numbers from a given interval. The algorithm is taken literally
916
 * from (Vitter 1987). This method can be used for generating numbers from a
917
 * \em very large interval. It is primarily created for randomly
918
 * selecting some edges from the sometimes huge set of possible edges
919
 * in a large graph.
920
 *
921
 * </para><para>
922
 * Reference:
923
 *
924
 * </para><para>
925
 * J. S. Vitter. An efficient algorithm for sequential random sampling.
926
 * ACM Transactions on Mathematical Software, 13(1):58--67, 1987.
927
 * https://doi.org/10.1145/23002.23003
928
 *
929
 * \param res Pointer to an initialized vector. This will hold the
930
 *        result. It will be resized to the proper size.
931
 * \param l The lower limit of the generation interval (inclusive). This must
932
 *        be less than or equal to the upper limit, and it must be integral.
933
 * \param h The upper limit of the generation interval (inclusive). This must
934
 *        be greater than or equal to the lower limit, and it must be integral.
935
 * \param length The number of random integers to generate.
936
 * \return The error code \c IGRAPH_EINVAL is returned in each of the
937
 *         following cases: (1) The given lower limit is greater than the
938
 *         given upper limit, i.e. \c l &gt; \c h. (2) Assuming that
939
 *         \c l &lt; \c h and N is the sample size, the above error code is
940
 *         returned if N &gt; |\c h - \c l|, i.e. the sample size exceeds the
941
 *         size of the candidate pool.
942
 *
943
 * Time complexity: according to (Vitter 1987), the expected
944
 * running time is O(length).
945
 *
946
 * \example examples/simple/igraph_random_sample.c
947
 */
948
949
igraph_error_t igraph_random_sample(igraph_vector_int_t *res, igraph_integer_t l, igraph_integer_t h,
950
0
                         igraph_integer_t length) {
951
0
    igraph_integer_t N; /* := h - l + 1 */
952
0
    IGRAPH_SAFE_ADD(h, -l, &N);
953
0
    IGRAPH_SAFE_ADD(N, 1, &N);
954
955
0
    igraph_integer_t n = length;
956
957
0
    igraph_real_t nreal = length;
958
0
    igraph_real_t ninv = (nreal != 0) ? 1.0 / nreal : 0.0;
959
0
    igraph_real_t Nreal = N;
960
0
    igraph_real_t Vprime;
961
0
    igraph_integer_t qu1 = -n + 1 + N;
962
0
    igraph_real_t qu1real = -nreal + 1.0 + Nreal;
963
0
    igraph_real_t negalphainv = -13;
964
0
    igraph_real_t threshold = -negalphainv * n;
965
0
    igraph_integer_t S;
966
967
    /* getting back some sense of sanity */
968
0
    if (l > h) {
969
0
        IGRAPH_ERROR("Lower limit is greater than upper limit.", IGRAPH_EINVAL);
970
0
    }
971
    /* now we know that l <= h */
972
0
    if (length > N) {
973
0
        IGRAPH_ERROR("Sample size exceeds size of candidate pool.", IGRAPH_EINVAL);
974
0
    }
975
976
    /* treat rare cases quickly */
977
0
    if (l == h) {
978
0
        IGRAPH_CHECK(igraph_vector_int_resize(res, 1));
979
0
        VECTOR(*res)[0] = l;
980
0
        return IGRAPH_SUCCESS;
981
0
    }
982
0
    if (length == 0) {
983
0
        igraph_vector_int_clear(res);
984
0
        return IGRAPH_SUCCESS;
985
0
    }
986
0
    if (length == N) {
987
0
        IGRAPH_CHECK(igraph_vector_int_resize(res, length));
988
0
        for (igraph_integer_t i = 0; i < length; i++) {
989
0
            VECTOR(*res)[i] = l++;
990
0
        }
991
0
        return IGRAPH_SUCCESS;
992
0
    }
993
994
0
    igraph_vector_int_clear(res);
995
0
    IGRAPH_CHECK(igraph_vector_int_reserve(res, length));
996
997
0
    Vprime = exp(log(RNG_UNIF01()) * ninv);
998
0
    l = l - 1;
999
1000
0
    while (n > 1 && threshold < N) {
1001
0
        igraph_real_t X, U;
1002
0
        igraph_real_t limit, t;
1003
0
        igraph_real_t negSreal, y1, y2, top, bottom;
1004
0
        igraph_real_t nmin1inv = 1.0 / (-1.0 + nreal);
1005
0
        while (1) {
1006
0
            while (1) {
1007
0
                X = Nreal * (-Vprime + 1.0);
1008
0
                S = floor(X);
1009
                /* if (S==0) { S=1; } */
1010
0
                if (S < qu1) {
1011
0
                    break;
1012
0
                }
1013
0
                Vprime = exp(log(RNG_UNIF01()) * ninv);
1014
0
            }
1015
0
            U = RNG_UNIF01();
1016
0
            negSreal = -S;
1017
1018
0
            y1 = exp(log(U * Nreal / qu1real) * nmin1inv);
1019
0
            Vprime = y1 * (-X / Nreal + 1.0) * (qu1real / (negSreal + qu1real));
1020
0
            if (Vprime <= 1.0) {
1021
0
                break;
1022
0
            }
1023
1024
0
            y2 = 1.0;
1025
0
            top = -1.0 + Nreal;
1026
0
            if (-1 + n > S) {
1027
0
                bottom = -nreal + Nreal;
1028
0
                limit = -S + N;
1029
0
            } else {
1030
0
                bottom = -1.0 + negSreal + Nreal;
1031
0
                limit = qu1;
1032
0
            }
1033
0
            for (t = -1 + N; t >= limit; t--) {
1034
0
                y2 = (y2 * top) / bottom;
1035
0
                top = -1.0 + top;
1036
0
                bottom = -1.0 + bottom;
1037
0
            }
1038
0
            if (Nreal / (-X + Nreal) >= y1 * exp(log(y2)*nmin1inv)) {
1039
0
                Vprime = exp(log(RNG_UNIF01()) * nmin1inv);
1040
0
                break;
1041
0
            }
1042
0
            Vprime = exp(log(RNG_UNIF01()) * ninv);
1043
0
        }
1044
1045
0
        l += S + 1;
1046
0
        igraph_vector_int_push_back(res, l);    /* allocated */
1047
0
        N = -S + (-1 + N);   Nreal = negSreal + (-1.0 + Nreal);
1048
0
        n = -1 + n;   nreal = -1.0 + nreal; ninv = nmin1inv;
1049
0
        qu1 = -S + qu1; qu1real = negSreal + qu1real;
1050
0
        threshold = threshold + negalphainv;
1051
0
    }
1052
1053
0
    if (n > 1) {
1054
0
        igraph_i_random_sample_alga(res, l + 1, h, n);
1055
0
    } else {
1056
0
        S = floor(N * Vprime);
1057
0
        l += S + 1;
1058
0
        igraph_vector_int_push_back(res, l);    /* allocated */
1059
0
    }
1060
1061
0
    return IGRAPH_SUCCESS;
1062
0
}
1063
1064
static void igraph_i_random_sample_alga_real(igraph_vector_t *res,
1065
                                       igraph_real_t l, igraph_real_t h,
1066
0
                                       igraph_real_t length) {
1067
0
    igraph_real_t N = h - l + 1;
1068
0
    igraph_real_t n = length;
1069
1070
0
    igraph_real_t top = N - n;
1071
0
    igraph_real_t Nreal = N;
1072
0
    igraph_real_t S = 0;
1073
0
    igraph_real_t V, quot;
1074
1075
0
    l = l - 1;
1076
1077
0
    while (n >= 2) {
1078
0
        V = RNG_UNIF01();
1079
0
        S = 1;
1080
0
        quot = top / Nreal;
1081
0
        while (quot > V) {
1082
0
            S += 1;
1083
0
            top = -1.0 + top;
1084
0
            Nreal = -1.0 + Nreal;
1085
0
            quot = (quot * top) / Nreal;
1086
0
        }
1087
0
        l += S;
1088
0
        igraph_vector_push_back(res, l); /* allocated */
1089
0
        Nreal = -1.0 + Nreal; n = -1 + n;
1090
0
    }
1091
1092
0
    S = trunc(round(Nreal) * RNG_UNIF01());
1093
0
    l += S + 1;
1094
0
    igraph_vector_push_back(res, l); /* allocated */
1095
0
}
1096
1097
/**
1098
 * \ingroup nongraph
1099
 * \function igraph_i_random_sample_real
1100
 * \brief Generates an increasing random sequence of integers (igraph_real_t version).
1101
 *
1102
 * This function is the 'real' version of \ref igraph_random_sample(), and was added
1103
 * so \ref igraph_erdos_renyi_game_gnm() and related functions can use a random sample
1104
 * of doubles instead of integers to prevent overflows on systems with 32-bit
1105
 * \type igraph_integer_t.
1106
 *
1107
 * \param res Pointer to an initialized vector. This will hold the
1108
 *        result. It will be resized to the proper size.
1109
 * \param l The lower limit of the generation interval (inclusive). This must
1110
 *        be less than or equal to the upper limit, and it must be integral.
1111
 *        Passing a fractional number here results in undefined behaviour.
1112
 * \param h The upper limit of the generation interval (inclusive). This must
1113
 *        be greater than or equal to the lower limit, and it must be integral.
1114
 *        Passing a fractional number here results in undefined behaviour.
1115
 * \param length The number of random integers to generate.
1116
 * \return The error code \c IGRAPH_EINVAL is returned in each of the
1117
 *         following cases: (1) The given lower limit is greater than the
1118
 *         given upper limit, i.e. \c l &gt; \c h. (2) Assuming that
1119
 *         \c l &lt; \c h and N is the sample size, the above error code is
1120
 *         returned if N &gt; |\c h - \c l|, i.e. the sample size exceeds the
1121
 *         size of the candidate pool.
1122
 */
1123
1124
igraph_error_t igraph_i_random_sample_real(igraph_vector_t *res, igraph_real_t l,
1125
0
                    igraph_real_t h, igraph_integer_t length) {
1126
    /* This function is the 'real' version of igraph_random_sample, and was added
1127
     * so erdos_renyi_game_gnm can use a random sample of doubles instead of integers
1128
     * to prevent overflows on systems with 32-bits igraph_integer_t.
1129
     */
1130
0
    igraph_real_t N = h - l + 1;
1131
0
    igraph_real_t n = length;
1132
1133
0
    igraph_real_t nreal = length;
1134
0
    igraph_real_t ninv = (nreal != 0) ? 1.0 / nreal : 0.0;
1135
0
    igraph_real_t Nreal = N;
1136
0
    igraph_real_t Vprime;
1137
0
    igraph_real_t qu1 = -n + 1 + N;
1138
0
    igraph_real_t qu1real = -nreal + 1.0 + Nreal;
1139
0
    igraph_real_t negalphainv = -13;
1140
0
    igraph_real_t threshold = -negalphainv * n;
1141
0
    igraph_real_t S;
1142
0
    int iter = 0;
1143
1144
    /* getting back some sense of sanity */
1145
0
    if (l > h) {
1146
0
        IGRAPH_ERROR("Lower limit is greater than upper limit.", IGRAPH_EINVAL);
1147
0
    }
1148
    /* now we know that l <= h */
1149
0
    if (length > N) {
1150
0
        IGRAPH_ERROR("Sample size exceeds size of candidate pool.", IGRAPH_EINVAL);
1151
0
    }
1152
1153
    /* ensure that we work in the range where igraph_real_t can represent integers exactly */
1154
0
    if (h > IGRAPH_MAX_EXACT_REAL || l < -IGRAPH_MAX_EXACT_REAL || N > IGRAPH_MAX_EXACT_REAL) {
1155
0
        IGRAPH_ERROR("Sampling interval too large.", IGRAPH_EOVERFLOW);
1156
0
    }
1157
1158
    /* treat rare cases quickly */
1159
0
    if (l == h) {
1160
0
        IGRAPH_CHECK(igraph_vector_resize(res, 1));
1161
0
        VECTOR(*res)[0] = l;
1162
0
        return IGRAPH_SUCCESS;
1163
0
    }
1164
0
    if (length == 0) {
1165
0
        igraph_vector_clear(res);
1166
0
        return IGRAPH_SUCCESS;
1167
0
    }
1168
0
    if (length == N) {
1169
0
        IGRAPH_CHECK(igraph_vector_resize(res, length));
1170
0
        for (igraph_integer_t i = 0; i < length; i++) {
1171
0
            VECTOR(*res)[i] = l++;
1172
0
        }
1173
0
        return IGRAPH_SUCCESS;
1174
0
    }
1175
1176
0
    igraph_vector_clear(res);
1177
0
    IGRAPH_CHECK(igraph_vector_reserve(res, length));
1178
1179
0
    Vprime = exp(log(RNG_UNIF01()) * ninv);
1180
0
    l = l - 1;
1181
1182
0
    while (n > 1 && threshold < N) {
1183
0
        igraph_real_t X, U;
1184
0
        igraph_real_t limit, t;
1185
0
        igraph_real_t negSreal, y1, y2, top, bottom;
1186
0
        igraph_real_t nmin1inv = 1.0 / (-1.0 + nreal);
1187
0
        while (1) {
1188
0
            while (1) {
1189
0
                X = Nreal * (-Vprime + 1.0);
1190
0
                S = floor(X);
1191
                /* if (S==0) { S=1; } */
1192
0
                if (S < qu1) {
1193
0
                    break;
1194
0
                }
1195
0
                Vprime = exp(log(RNG_UNIF01()) * ninv);
1196
0
            }
1197
0
            U = RNG_UNIF01();
1198
0
            negSreal = -S;
1199
1200
0
            y1 = exp(log(U * Nreal / qu1real) * nmin1inv);
1201
0
            Vprime = y1 * (-X / Nreal + 1.0) * (qu1real / (negSreal + qu1real));
1202
0
            if (Vprime <= 1.0) {
1203
0
                break;
1204
0
            }
1205
1206
0
            y2 = 1.0;
1207
0
            top = -1.0 + Nreal;
1208
0
            if (-1 + n > S) {
1209
0
                bottom = -nreal + Nreal;
1210
0
                limit = -S + N;
1211
0
            } else {
1212
0
                bottom = -1.0 + negSreal + Nreal;
1213
0
                limit = qu1;
1214
0
            }
1215
0
            for (t = -1 + N; t >= limit; t--) {
1216
0
                y2 = (y2 * top) / bottom;
1217
0
                top = -1.0 + top;
1218
0
                bottom = -1.0 + bottom;
1219
0
            }
1220
0
            if (Nreal / (-X + Nreal) >= y1 * exp(log(y2)*nmin1inv)) {
1221
0
                Vprime = exp(log(RNG_UNIF01()) * nmin1inv);
1222
0
                break;
1223
0
            }
1224
0
            Vprime = exp(log(RNG_UNIF01()) * ninv);
1225
0
        }
1226
1227
0
        l += S + 1;
1228
0
        igraph_vector_push_back(res, l);    /* allocated */
1229
0
        N = -S + (-1 + N);   Nreal = negSreal + (-1.0 + Nreal);
1230
0
        n = -1 + n;   nreal = -1.0 + nreal; ninv = nmin1inv;
1231
0
        qu1 = -S + qu1; qu1real = negSreal + qu1real;
1232
0
        threshold = threshold + negalphainv;
1233
1234
0
        if (++iter >= (1 << 14)) {
1235
0
            iter = 0;
1236
0
            IGRAPH_ALLOW_INTERRUPTION();
1237
0
        }
1238
0
    }
1239
1240
0
    if (n > 1) {
1241
0
        igraph_i_random_sample_alga_real(res, l + 1, h, n);
1242
0
    } else {
1243
0
        S = floor(N * Vprime);
1244
0
        l += S + 1;
1245
0
        igraph_vector_push_back(res, l);    /* allocated */
1246
0
    }
1247
1248
0
    return IGRAPH_SUCCESS;
1249
0
}
1250
1251
/*
1252
 *  Mathlib : A C Library of Special Functions
1253
 *  Copyright (C) 1998 Ross Ihaka
1254
 *  Copyright (C) 2000 The R Development Core Team
1255
 *  based on AS 111 (C) 1977 Royal Statistical Society
1256
 *  and   on AS 241 (C) 1988 Royal Statistical Society
1257
 *
1258
 *  This program is free software; you can redistribute it and/or modify
1259
 *  it under the terms of the GNU General Public License as published by
1260
 *  the Free Software Foundation; either version 2 of the License, or
1261
 *  (at your option) any later version.
1262
 *
1263
 *  This program is distributed in the hope that it will be useful,
1264
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
1265
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
1266
 *  GNU General Public License for more details.
1267
 *
1268
 *  You should have received a copy of the GNU General Public License
1269
 *  along with this program; if not, write to the Free Software
1270
 *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA.
1271
 *
1272
 *  SYNOPSIS
1273
 *
1274
 *  double qnorm5(double p, double mu, double sigma,
1275
 *            int lower_tail, int log_p)
1276
 *            {qnorm (..) is synonymous and preferred inside R}
1277
 *
1278
 *  DESCRIPTION
1279
 *
1280
 *  Compute the quantile function for the normal distribution.
1281
 *
1282
 *  For small to moderate probabilities, algorithm referenced
1283
 *  below is used to obtain an initial approximation which is
1284
 *  polished with a final Newton step.
1285
 *
1286
 *  For very large arguments, an algorithm of Wichura is used.
1287
 *
1288
 *  REFERENCE
1289
 *
1290
 *  Beasley, J. D. and S. G. Springer (1977).
1291
 *  Algorithm AS 111: The percentage points of the normal distribution,
1292
 *  Applied Statistics, 26, 118-121.
1293
 *
1294
 *      Wichura, M.J. (1988).
1295
 *      Algorithm AS 241: The Percentage Points of the Normal Distribution.
1296
 *      Applied Statistics, 37, 477-484.
1297
 */
1298
1299
/*
1300
 *  Mathlib : A C Library of Special Functions
1301
 *  Copyright (C) 1998-2004  The R Development Core Team
1302
 *
1303
 *  This program is free software; you can redistribute it and/or modify
1304
 *  it under the terms of the GNU General Public License as published by
1305
 *  the Free Software Foundation; either version 2 of the License, or
1306
 *  (at your option) any later version.
1307
 *
1308
 *  This program is distributed in the hope that it will be useful,
1309
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
1310
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
1311
 *  GNU General Public License for more details.
1312
 *
1313
 *  You should have received a copy of the GNU General Public License
1314
 *  along with this program; if not, write to the Free Software
1315
 *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
1316
 *
1317
 */
1318
1319
/* The ISNAN macro is used in some of the code borrowed from R below. */
1320
0
#define ISNAN isnan
1321
1322
/* Indicates that we use systems which support NaN values. */
1323
#define IEEE_754 1
1324
1325
/* Private header file for use during compilation of Mathlib */
1326
#ifndef MATHLIB_PRIVATE_H
1327
#define MATHLIB_PRIVATE_H
1328
1329
0
#define ML_POSINF IGRAPH_INFINITY
1330
0
#define ML_NEGINF -IGRAPH_INFINITY
1331
0
#define ML_NAN    IGRAPH_NAN
1332
1333
#define ML_ERROR(x) /* nothing */
1334
#define ML_UNDERFLOW    (DBL_MIN * DBL_MIN)
1335
#define ML_VALID(x) (!ISNAN(x))
1336
1337
#define ME_NONE     0
1338
/*  no error */
1339
#define ME_DOMAIN   1
1340
/*  argument out of domain */
1341
#define ME_RANGE    2
1342
/*  value out of range */
1343
#define ME_NOCONV   4
1344
/*  process did not converge */
1345
#define ME_PRECISION    8
1346
/*  does not have "full" precision */
1347
#define ME_UNDERFLOW    16
1348
/*  and underflow occurred (important for IEEE)*/
1349
1350
0
#define ML_ERR_return_NAN { ML_ERROR(ME_DOMAIN); return ML_NAN; }
1351
1352
#endif /* MATHLIB_PRIVATE_H */
1353
1354
1355
/* Utilities for `dpq' handling (density/probability/quantile) */
1356
1357
/* give_log in "d";  log_p in "p" & "q" : */
1358
#define give_log log_p
1359
/* "DEFAULT" */
1360
/* --------- */
1361
0
#define R_D__0  (log_p ? ML_NEGINF : 0.)        /* 0 */
1362
0
#define R_D__1  (log_p ? 0. : 1.)           /* 1 */
1363
0
#define R_DT_0  (lower_tail ? R_D__0 : R_D__1)      /* 0 */
1364
0
#define R_DT_1  (lower_tail ? R_D__1 : R_D__0)      /* 1 */
1365
1366
0
#define R_D_Lval(p) (lower_tail ? (p) : (1 - (p)))  /*  p  */
1367
0
#define R_D_Cval(p) (lower_tail ? (1 - (p)) : (p))  /*  1 - p */
1368
1369
#define R_D_val(x)  (log_p  ? log(x) : (x))     /*  x  in pF(x,..) */
1370
#define R_D_qIv(p)  (log_p  ? exp(p) : (p))     /*  p  in qF(p,..) */
1371
#define R_D_exp(x)  (log_p  ?  (x)   : exp(x))  /* exp(x) */
1372
#define R_D_log(p)  (log_p  ?  (p)   : log(p))  /* log(p) */
1373
#define R_D_Clog(p) (log_p  ? log1p(-(p)) : (1 - (p)))/* [log](1-p) */
1374
1375
/* log(1-exp(x)):  R_D_LExp(x) == (log1p(- R_D_qIv(x))) but even more stable:*/
1376
#define R_D_LExp(x)     (log_p ? R_Log1_Exp(x) : log1p(-x))
1377
1378
/*till 1.8.x:
1379
 * #define R_DT_val(x)  R_D_val(R_D_Lval(x))
1380
 * #define R_DT_Cval(x) R_D_val(R_D_Cval(x)) */
1381
#define R_DT_val(x) (lower_tail ? R_D_val(x)  : R_D_Clog(x))
1382
#define R_DT_Cval(x)    (lower_tail ? R_D_Clog(x) : R_D_val(x))
1383
1384
/*#define R_DT_qIv(p)   R_D_Lval(R_D_qIv(p))         *  p  in qF ! */
1385
0
#define R_DT_qIv(p) (log_p ? (lower_tail ? exp(p) : - expm1(p)) \
1386
0
                     : R_D_Lval(p))
1387
1388
/*#define R_DT_CIv(p)   R_D_Cval(R_D_qIv(p))         *  1 - p in qF */
1389
0
#define R_DT_CIv(p) (log_p ? (lower_tail ? -expm1(p) : exp(p)) \
1390
0
                     : R_D_Cval(p))
1391
1392
#define R_DT_exp(x) R_D_exp(R_D_Lval(x))        /* exp(x) */
1393
#define R_DT_Cexp(x)    R_D_exp(R_D_Cval(x))        /* exp(1 - x) */
1394
1395
#define R_DT_log(p) (lower_tail? R_D_log(p) : R_D_LExp(p))/* log(p) in qF */
1396
#define R_DT_Clog(p)    (lower_tail? R_D_LExp(p): R_D_log(p))/* log(1-p) in qF*/
1397
#define R_DT_Log(p) (lower_tail? (p) : R_Log1_Exp(p))
1398
/* ==   R_DT_log when we already "know" log_p == true :*/
1399
1400
#define R_Q_P01_check(p)            \
1401
0
    if ((log_p  && p > 0) ||            \
1402
0
        (!log_p && (p < 0 || p > 1)) )      \
1403
0
        ML_ERR_return_NAN
1404
1405
/* additions for density functions (C.Loader) */
1406
#define R_D_fexp(f,x)     (give_log ? -0.5*log(f)+(x) : exp(x)/sqrt(f))
1407
#define R_D_forceint(x)   floor((x) + 0.5)
1408
#define R_D_nonint(x)     (fabs((x) - floor((x)+0.5)) > 1e-7)
1409
/* [neg]ative or [non int]eger : */
1410
#define R_D_negInonint(x) (x < 0. || R_D_nonint(x))
1411
1412
#define R_D_nonint_check(x)                 \
1413
    if (R_D_nonint(x)) {                  \
1414
        MATHLIB_WARNING("non-integer x = %f", x);   \
1415
        return R_D__0;                  \
1416
    }
1417
1418
0
static double igraph_i_qnorm5(double p, double mu, double sigma, igraph_bool_t lower_tail, igraph_bool_t log_p) {
1419
0
    double p_, q, r, val;
1420
1421
0
#ifdef IEEE_754
1422
0
    if (ISNAN(p) || ISNAN(mu) || ISNAN(sigma)) {
1423
0
        return p + mu + sigma;
1424
0
    }
1425
0
#endif
1426
0
    if (p == R_DT_0) {
1427
0
        return ML_NEGINF;
1428
0
    }
1429
0
    if (p == R_DT_1) {
1430
0
        return ML_POSINF;
1431
0
    }
1432
0
    R_Q_P01_check(p);
1433
1434
0
    if (sigma  < 0) {
1435
0
        ML_ERR_return_NAN;
1436
0
    }
1437
0
    if (sigma == 0) {
1438
0
        return mu;
1439
0
    }
1440
1441
0
    p_ = R_DT_qIv(p);/* real lower_tail prob. p */
1442
0
    q = p_ - 0.5;
1443
1444
    /*-- use AS 241 --- */
1445
    /* double ppnd16_(double *p, long *ifault)*/
1446
    /*      ALGORITHM AS241  APPL. STATIST. (1988) VOL. 37, NO. 3
1447
1448
            Produces the normal deviate Z corresponding to a given lower
1449
            tail area of P; Z is accurate to about 1 part in 10**16.
1450
1451
            (original fortran code used PARAMETER(..) for the coefficients
1452
             and provided hash codes for checking them...)
1453
    */
1454
0
    if (fabs(q) <= .425) {/* 0.075 <= p <= 0.925 */
1455
0
        r = .180625 - q * q;
1456
0
        val =
1457
0
            q * (((((((r * 2509.0809287301226727 +
1458
0
                       33430.575583588128105) * r + 67265.770927008700853) * r +
1459
0
                     45921.953931549871457) * r + 13731.693765509461125) * r +
1460
0
                   1971.5909503065514427) * r + 133.14166789178437745) * r +
1461
0
                 3.387132872796366608)
1462
0
            / (((((((r * 5226.495278852854561 +
1463
0
                     28729.085735721942674) * r + 39307.89580009271061) * r +
1464
0
                   21213.794301586595867) * r + 5394.1960214247511077) * r +
1465
0
                 687.1870074920579083) * r + 42.313330701600911252) * r + 1.);
1466
0
    } else { /* closer than 0.075 from {0,1} boundary */
1467
1468
        /* r = min(p, 1-p) < 0.075 */
1469
0
        if (q > 0) {
1470
0
            r = R_DT_CIv(p);    /* 1-p */
1471
0
        } else {
1472
0
            r = p_;    /* = R_DT_Iv(p) ^=  p */
1473
0
        }
1474
1475
0
        r = sqrt(- ((log_p &&
1476
0
                     ((lower_tail && q <= 0) || (!lower_tail && q > 0))) ?
1477
0
                    p : /* else */ log(r)));
1478
        /* r = sqrt(-log(r))  <==>  min(p, 1-p) = exp( - r^2 ) */
1479
1480
0
        if (r <= 5.) { /* <==> min(p,1-p) >= exp(-25) ~= 1.3888e-11 */
1481
0
            r += -1.6;
1482
0
            val = (((((((r * 7.7454501427834140764e-4 +
1483
0
                         .0227238449892691845833) * r + .24178072517745061177) *
1484
0
                       r + 1.27045825245236838258) * r +
1485
0
                      3.64784832476320460504) * r + 5.7694972214606914055) *
1486
0
                    r + 4.6303378461565452959) * r +
1487
0
                   1.42343711074968357734)
1488
0
                  / (((((((r *
1489
0
                           1.05075007164441684324e-9 + 5.475938084995344946e-4) *
1490
0
                          r + .0151986665636164571966) * r +
1491
0
                         .14810397642748007459) * r + .68976733498510000455) *
1492
0
                       r + 1.6763848301838038494) * r +
1493
0
                      2.05319162663775882187) * r + 1.);
1494
0
        } else { /* very close to  0 or 1 */
1495
0
            r += -5.;
1496
0
            val = (((((((r * 2.01033439929228813265e-7 +
1497
0
                         2.71155556874348757815e-5) * r +
1498
0
                        .0012426609473880784386) * r + .026532189526576123093) *
1499
0
                      r + .29656057182850489123) * r +
1500
0
                     1.7848265399172913358) * r + 5.4637849111641143699) *
1501
0
                   r + 6.6579046435011037772)
1502
0
                  / (((((((r *
1503
0
                           2.04426310338993978564e-15 + 1.4215117583164458887e-7) *
1504
0
                          r + 1.8463183175100546818e-5) * r +
1505
0
                         7.868691311456132591e-4) * r + .0148753612908506148525)
1506
0
                       * r + .13692988092273580531) * r +
1507
0
                      .59983220655588793769) * r + 1.);
1508
0
        }
1509
1510
0
        if (q < 0.0) {
1511
0
            val = -val;
1512
0
        }
1513
        /* return (q >= 0.)? r : -r ;*/
1514
0
    }
1515
0
    return mu + sigma * val;
1516
0
}
1517
1518
0
static igraph_integer_t imax2(igraph_integer_t x, igraph_integer_t y) {
1519
0
    return (x < y) ? y : x;
1520
0
}
1521
1522
0
static igraph_integer_t imin2(igraph_integer_t x, igraph_integer_t y) {
1523
0
    return (x < y) ? x : y;
1524
0
}
1525
1526
0
static double igraph_i_norm_rand(igraph_rng_t *rng) {
1527
0
    double r;
1528
1529
    /* Use the inversion method based on uniform variates from (0, 1).
1530
     * We exclude 0.0 as it would lead to generating -infinity.
1531
     * It is assumed that unif01() provides sufficient accuracy.
1532
     * A resolution of 2^-32 may not be sufficient. igraph's default
1533
     * implementaton provides an accuracy of 2^-52.
1534
     */
1535
0
    do {
1536
0
        r = igraph_rng_get_unif01(rng);
1537
0
    } while (r == 0.0);
1538
1539
0
    return igraph_i_qnorm5(r, 0.0, 1.0, true, false);
1540
0
}
1541
1542
/*
1543
 * The following function is igraph code (not R / Mathlib).
1544
 *
1545
 * We use simple inverse transform sampling, with the assumption that the
1546
 * quality/resolution of uniform variates is high (52 bits in the default
1547
 * implementation). The quantile function is -log(1 - r) but given that
1548
 * r is sampled uniformly form the unit interval, -log(r) is equivalent.
1549
 * r = 0 is disallowed as it would yield infinity.
1550
 */
1551
1552
0
static double igraph_i_exp_rand(igraph_rng_t *rng) {
1553
0
    igraph_real_t r = igraph_rng_get_unif01(rng);
1554
0
    if (r == 0.0) r = 1.0; /* sample from (0, 1] instead of [0, 1) */
1555
0
    return -log(r);
1556
0
}
1557
1558
/*
1559
 *  Mathlib : A C Library of Special Functions
1560
 *  Copyright (C) 1998 Ross Ihaka
1561
 *  Copyright (C) 2000-2001 The R Development Core Team
1562
 *
1563
 *  This program is free software; you can redistribute it and/or modify
1564
 *  it under the terms of the GNU General Public License as published by
1565
 *  the Free Software Foundation; either version 2 of the License, or
1566
 *  (at your option) any later version.
1567
 *
1568
 *  This program is distributed in the hope that it will be useful,
1569
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
1570
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
1571
 *  GNU General Public License for more details.
1572
 *
1573
 *  You should have received a copy of the GNU General Public License
1574
 *  along with this program; if not, write to the Free Software
1575
 *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA.
1576
 *
1577
 *  SYNOPSIS
1578
 *
1579
 *    #include <Rmath.h>
1580
 *    double rpois(double lambda)
1581
 *
1582
 *  DESCRIPTION
1583
 *
1584
 *    Random variates from the Poisson distribution.
1585
 *
1586
 *  REFERENCE
1587
 *
1588
 *    Ahrens, J.H. and Dieter, U. (1982).
1589
 *    Computer generation of Poisson deviates
1590
 *    from modified normal distributions.
1591
 *    ACM Trans. Math. Software 8, 163-179.
1592
 */
1593
1594
0
#define a0  -0.5
1595
0
#define a1   0.3333333
1596
0
#define a2  -0.2500068
1597
0
#define a3   0.2000118
1598
0
#define a4  -0.1661269
1599
0
#define a5   0.1421878
1600
0
#define a6  -0.1384794
1601
0
#define a7   0.1250060
1602
1603
0
#define one_7   0.1428571428571428571
1604
0
#define one_12  0.0833333333333333333
1605
0
#define one_24  0.0416666666666666667
1606
1607
0
#define repeat for(;;)
1608
1609
0
#define M_1_SQRT_2PI    0.398942280401432677939946059934     /* 1/sqrt(2pi) */
1610
1611
0
static double igraph_i_rpois(igraph_rng_t *rng, double mu) {
1612
    /* Factorial Table (0:9)! */
1613
0
    const double fact[10] = {
1614
0
        1., 1., 2., 6., 24., 120., 720., 5040., 40320., 362880.
1615
0
    };
1616
1617
    /* These are static --- persistent between calls for same mu : */
1618
0
    static IGRAPH_THREAD_LOCAL int l;
1619
0
    static IGRAPH_THREAD_LOCAL igraph_integer_t m;
1620
1621
0
    static IGRAPH_THREAD_LOCAL double b1, b2, c, c0, c1, c2, c3;
1622
0
    static IGRAPH_THREAD_LOCAL double pp[36], p0, p, q, s, d, omega;
1623
0
    static IGRAPH_THREAD_LOCAL double big_l;/* integer "w/o overflow" */
1624
0
    static IGRAPH_THREAD_LOCAL double muprev = 0., muprev2 = 0.;/*, muold    = 0.*/
1625
1626
    /* Local Vars  [initialize some for -Wall]: */
1627
0
    double del, difmuk = 0., E = 0., fk = 0., fx, fy, g, px, py, t, u = 0., v, x;
1628
0
    double pois = -1.;
1629
0
    int k, big_mu;
1630
0
    bool new_big_mu = false;
1631
0
    bool kflag;
1632
1633
0
    if (!isfinite(mu) || mu < 0) {
1634
0
        ML_ERR_return_NAN;
1635
0
    }
1636
1637
0
    if (mu <= 0.) {
1638
0
        return 0.;
1639
0
    }
1640
1641
0
    big_mu = mu >= 10.;
1642
0
    if (big_mu) {
1643
0
        new_big_mu = false;
1644
0
    }
1645
1646
0
    if (!(big_mu && mu == muprev)) {/* maybe compute new persistent par.s */
1647
1648
0
        if (big_mu) {
1649
0
            new_big_mu = true;
1650
            /* Case A. (recalculation of s,d,l  because mu has changed):
1651
             * The Poisson probabilities pk exceed the discrete normal
1652
             * probabilities fk whenever k >= m(mu).
1653
             */
1654
0
            muprev = mu;
1655
0
            s = sqrt(mu);
1656
0
            d = 6. * mu * mu;
1657
0
            big_l = floor(mu - 1.1484);
1658
            /* = an upper bound to m(mu) for all mu >= 10.*/
1659
0
        } else { /* Small mu ( < 10) -- not using normal approx. */
1660
1661
            /* Case B. (start new table and calculate p0 if necessary) */
1662
1663
            /*muprev = 0.;-* such that next time, mu != muprev ..*/
1664
0
            if (mu != muprev) {
1665
0
                muprev = mu;
1666
0
                m = imax2(1, (igraph_integer_t) mu);
1667
0
                l = 0; /* pp[] is already ok up to pp[l] */
1668
0
                q = p0 = p = exp(-mu);
1669
0
            }
1670
1671
0
            repeat {
1672
                /* Step U. uniform sample for inversion method */
1673
0
                u = igraph_rng_get_unif01(rng);
1674
0
                if (u <= p0) {
1675
0
                    return 0.;
1676
0
                }
1677
1678
                /* Step T. table comparison until the end pp[l] of the
1679
                   pp-table of cumulative Poisson probabilities
1680
                   (0.458 > ~= pp[9](= 0.45792971447) for mu=10 ) */
1681
0
                if (l != 0) {
1682
0
                    for (k = (u <= 0.458) ? 1 : imin2(l, m);  k <= l; k++)
1683
0
                        if (u <= pp[k]) {
1684
0
                            return (double)k;
1685
0
                        }
1686
0
                    if (l == 35) { /* u > pp[35] */
1687
0
                        continue;
1688
0
                    }
1689
0
                }
1690
                /* Step C. creation of new Poisson
1691
                   probabilities p[l..] and their cumulatives q =: pp[k] */
1692
0
                l++;
1693
0
                for (k = l; k <= 35; k++) {
1694
0
                    p *= mu / k;
1695
0
                    q += p;
1696
0
                    pp[k] = q;
1697
0
                    if (u <= q) {
1698
0
                        l = k;
1699
0
                        return (double)k;
1700
0
                    }
1701
0
                }
1702
0
                l = 35;
1703
0
            } /* end(repeat) */
1704
0
        }/* mu < 10 */
1705
1706
0
    } /* end {initialize persistent vars} */
1707
1708
    /* Only if mu >= 10 : ----------------------- */
1709
1710
    /* Step N. normal sample */
1711
0
    g = mu + s * igraph_i_norm_rand(rng);/* norm_rand() ~ N(0,1), standard normal */
1712
1713
0
    if (g >= 0.) {
1714
0
        pois = floor(g);
1715
        /* Step I. immediate acceptance if pois is large enough */
1716
0
        if (pois >= big_l) {
1717
0
            return pois;
1718
0
        }
1719
        /* Step S. squeeze acceptance */
1720
0
        fk = pois;
1721
0
        difmuk = mu - fk;
1722
0
        u = igraph_rng_get_unif01(rng); /* ~ U(0,1) - sample */
1723
0
        if (d * u >= difmuk * difmuk * difmuk) {
1724
0
            return pois;
1725
0
        }
1726
0
    }
1727
1728
    /* Step P. preparations for steps Q and H.
1729
       (recalculations of parameters if necessary) */
1730
1731
0
    if (new_big_mu || mu != muprev2) {
1732
        /* Careful! muprev2 is not always == muprev
1733
        because one might have exited in step I or S
1734
        */
1735
0
        muprev2 = mu;
1736
0
        omega = M_1_SQRT_2PI / s;
1737
        /* The quantities b1, b2, c3, c2, c1, c0 are for the Hermite
1738
         * approximations to the discrete normal probabilities fk. */
1739
1740
0
        b1 = one_24 / mu;
1741
0
        b2 = 0.3 * b1 * b1;
1742
0
        c3 = one_7 * b1 * b2;
1743
0
        c2 = b2 - 15. * c3;
1744
0
        c1 = b1 - 6. * b2 + 45. * c3;
1745
0
        c0 = 1. - b1 + 3. * b2 - 15. * c3;
1746
0
        c = 0.1069 / mu; /* guarantees majorization by the 'hat'-function. */
1747
0
    }
1748
1749
0
    if (g >= 0.) {
1750
        /* 'Subroutine' F is called (kflag=0 for correct return) */
1751
0
        kflag = false;
1752
0
        goto Step_F;
1753
0
    }
1754
1755
1756
0
    repeat {
1757
        /* Step E. Exponential Sample */
1758
1759
0
        E = igraph_i_exp_rand(rng);/* ~ Exp(1) (standard exponential) */
1760
1761
        /*  sample t from the laplace 'hat'
1762
            (if t <= -0.6744 then pk < fk for all mu >= 10.) */
1763
0
        u = 2 * igraph_rng_get_unif01(rng) - 1.;
1764
0
        t = 1.8 + copysign(E, u);
1765
0
        if (t > -0.6744) {
1766
0
            pois = floor(mu + s * t);
1767
0
            fk = pois;
1768
0
            difmuk = mu - fk;
1769
1770
            /* 'subroutine' F is called (kflag=1 for correct return) */
1771
0
            kflag = true;
1772
1773
0
Step_F: /* 'subroutine' F : calculation of px,py,fx,fy. */
1774
1775
0
            if (pois < 10) { /* use factorials from table fact[] */
1776
0
                px = -mu;
1777
0
                py = pow(mu, pois) / fact[(int)pois];
1778
0
            } else {
1779
                /* Case pois >= 10 uses polynomial approximation
1780
                   a0-a7 for accuracy when advisable */
1781
0
                del = one_12 / fk;
1782
0
                del = del * (1. - 4.8 * del * del);
1783
0
                v = difmuk / fk;
1784
0
                if (fabs(v) <= 0.25)
1785
0
                    px = fk * v * v * (((((((a7 * v + a6) * v + a5) * v + a4) *
1786
0
                                          v + a3) * v + a2) * v + a1) * v + a0)
1787
0
                    - del;
1788
0
                else { /* |v| > 1/4 */
1789
0
                    px = fk * log(1. + v) - difmuk - del;
1790
0
                }
1791
0
                py = M_1_SQRT_2PI / sqrt(fk);
1792
0
            }
1793
0
            x = (0.5 - difmuk) / s;
1794
0
            x *= x;/* x^2 */
1795
0
            fx = -0.5 * x;
1796
0
            fy = omega * (((c3 * x + c2) * x + c1) * x + c0);
1797
0
            if (kflag) {
1798
                /* Step H. Hat acceptance (E is repeated on rejection) */
1799
0
                if (c * fabs(u) <= py * exp(px + E) - fy * exp(fx + E)) {
1800
0
                    break;
1801
0
                }
1802
0
            } else
1803
                /* Step Q. Quotient acceptance (rare case) */
1804
0
                if (fy - u * fy <= py * exp(px - fx)) {
1805
0
                    break;
1806
0
                }
1807
0
        }/* t > -.67.. */
1808
0
    }
1809
0
    return pois;
1810
0
}
1811
1812
#undef a1
1813
#undef a2
1814
#undef a3
1815
#undef a4
1816
#undef a5
1817
#undef a6
1818
#undef a7
1819
1820
/* This is from nmath/rbinom.c */
1821
1822
0
#define repeat for(;;)
1823
1824
0
static double igraph_i_rbinom(igraph_rng_t *rng, igraph_integer_t n, double pp) {
1825
1826
0
    static IGRAPH_THREAD_LOCAL double c, fm, npq, p1, p2, p3, p4, qn;
1827
0
    static IGRAPH_THREAD_LOCAL double xl, xll, xlr, xm, xr;
1828
1829
0
    static IGRAPH_THREAD_LOCAL double psave = -1.0;
1830
0
    static IGRAPH_THREAD_LOCAL igraph_integer_t nsave = -1;
1831
0
    static IGRAPH_THREAD_LOCAL igraph_integer_t m;
1832
1833
0
    double f, f1, f2, u, v, w, w2, x, x1, x2, z, z2;
1834
0
    double p, q, np, g, r, al, alv, amaxp, ffm, ynorm;
1835
0
    igraph_integer_t i, ix, k;
1836
1837
0
    if (!isfinite(pp) ||
1838
        /* n=0, p=0, p=1 are not errors <TSL>*/
1839
0
        n < 0 || pp < 0. || pp > 1.) {
1840
0
        ML_ERR_return_NAN;
1841
0
    }
1842
1843
0
    if (n == 0 || pp == 0.) {
1844
0
        return 0;
1845
0
    }
1846
0
    if (pp == 1.) {
1847
0
        return n;
1848
0
    }
1849
1850
0
    p = fmin(pp, 1. - pp);
1851
0
    q = 1. - p;
1852
0
    np = n * p;
1853
0
    r = p / q;
1854
0
    g = r * (n + 1);
1855
1856
    /* Setup, perform only when parameters change [using static (globals): */
1857
1858
    /* FIXING: Want this thread safe
1859
       -- use as little (thread globals) as possible
1860
    */
1861
0
    if (pp != psave || n != nsave) {
1862
0
        psave = pp;
1863
0
        nsave = n;
1864
0
        if (np < 30.0) {
1865
            /* inverse cdf logic for mean less than 30 */
1866
0
            qn = pow(q, (double) n);
1867
0
            goto L_np_small;
1868
0
        } else {
1869
0
            ffm = np + p;
1870
0
            m = ffm;
1871
0
            fm = m;
1872
0
            npq = np * q;
1873
            /* Note (igraph): Original code used a cast to (int) for rounding. However,
1874
             * the max npq = n*p*(1-p) value is 0.25*n, thus 2.195 * sqrt(npq) may be
1875
             * as large as 1.0975 * sqrt(n). This is not representable on a 32-bit signed
1876
             * integer when n is a 64-bit signed integer. Thus we use trunc() instead. */
1877
0
            p1 = trunc(2.195 * sqrt(npq) - 4.6 * q) + 0.5;
1878
0
            xm = fm + 0.5;
1879
0
            xl = xm - p1;
1880
0
            xr = xm + p1;
1881
0
            c = 0.134 + 20.5 / (15.3 + fm);
1882
0
            al = (ffm - xl) / (ffm - xl * p);
1883
0
            xll = al * (1.0 + 0.5 * al);
1884
0
            al = (xr - ffm) / (xr * q);
1885
0
            xlr = al * (1.0 + 0.5 * al);
1886
0
            p2 = p1 * (1.0 + c + c);
1887
0
            p3 = p2 + c / xll;
1888
0
            p4 = p3 + c / xlr;
1889
0
        }
1890
0
    } else if (n == nsave) {
1891
0
        if (np < 30.0) {
1892
0
            goto L_np_small;
1893
0
        }
1894
0
    }
1895
1896
    /*-------------------------- np = n*p >= 30 : ------------------- */
1897
0
    repeat {
1898
0
        u = igraph_rng_get_unif01(rng) * p4;
1899
0
        v = igraph_rng_get_unif01(rng);
1900
        /* triangular region */
1901
0
        if (u <= p1) {
1902
0
            ix = xm - p1 * v + u;
1903
0
            goto finis;
1904
0
        }
1905
        /* parallelogram region */
1906
0
        if (u <= p2) {
1907
0
            x = xl + (u - p1) / c;
1908
0
            v = v * c + 1.0 - fabs(xm - x) / p1;
1909
0
            if (v > 1.0 || v <= 0.) {
1910
0
                continue;
1911
0
            }
1912
0
            ix = x;
1913
0
        } else {
1914
0
            if (u > p3) { /* right tail */
1915
0
                ix = xr - log(v) / xlr;
1916
0
                if (ix > n) {
1917
0
                    continue;
1918
0
                }
1919
0
                v = v * (u - p3) * xlr;
1920
0
            } else {/* left tail */
1921
0
                ix = xl + log(v) / xll;
1922
0
                if (ix < 0) {
1923
0
                    continue;
1924
0
                }
1925
0
                v = v * (u - p2) * xll;
1926
0
            }
1927
0
        }
1928
        /* determine appropriate way to perform accept/reject test */
1929
0
        k = imaxabs(ix - m);
1930
0
        if (k <= 20 || k >= npq / 2 - 1) {
1931
            /* explicit evaluation */
1932
0
            f = 1.0;
1933
0
            if (m < ix) {
1934
0
                for (i = m + 1; i <= ix; i++) {
1935
0
                    f *= (g / i - r);
1936
0
                }
1937
0
            } else if (m != ix) {
1938
0
                for (i = ix + 1; i <= m; i++) {
1939
0
                    f /= (g / i - r);
1940
0
                }
1941
0
            }
1942
0
            if (v <= f) {
1943
0
                goto finis;
1944
0
            }
1945
0
        } else {
1946
            /* squeezing using upper and lower bounds on log(f(x)) */
1947
0
            amaxp = (k / npq) * ((k * (k / 3. + 0.625) + 0.1666666666666) / npq + 0.5);
1948
0
            ynorm = -k * k / (2.0 * npq);
1949
0
            alv = log(v);
1950
0
            if (alv < ynorm - amaxp) {
1951
0
                goto finis;
1952
0
            }
1953
0
            if (alv <= ynorm + amaxp) {
1954
                /* Stirling's formula to machine accuracy */
1955
                /* for the final acceptance/rejection test */
1956
0
                x1 = ix + 1;
1957
0
                f1 = fm + 1.0;
1958
0
                z = n + 1 - fm;
1959
0
                w = n - ix + 1.0;
1960
0
                z2 = z * z;
1961
0
                x2 = x1 * x1;
1962
0
                f2 = f1 * f1;
1963
0
                w2 = w * w;
1964
0
                if (alv <= xm * log(f1 / x1) + (n - m + 0.5) * log(z / w) + (ix - m) * log(w * p / (x1 * q)) + (13860.0 - (462.0 - (132.0 - (99.0 - 140.0 / f2) / f2) / f2) / f2) / f1 / 166320.0 + (13860.0 - (462.0 - (132.0 - (99.0 - 140.0 / z2) / z2) / z2) / z2) / z / 166320.0 + (13860.0 - (462.0 - (132.0 - (99.0 - 140.0 / x2) / x2) / x2) / x2) / x1 / 166320.0 + (13860.0 - (462.0 - (132.0 - (99.0 - 140.0 / w2) / w2) / w2) / w2) / w / 166320.) {
1965
0
                    goto finis;
1966
0
                }
1967
0
            }
1968
0
        }
1969
0
    }
1970
1971
0
L_np_small:
1972
    /*---------------------- np = n*p < 30 : ------------------------- */
1973
1974
0
    repeat {
1975
0
        ix = 0;
1976
0
        f = qn;
1977
0
        u = igraph_rng_get_unif01(rng);
1978
0
        repeat {
1979
0
            if (u < f) {
1980
0
                goto finis;
1981
0
            }
1982
0
            if (ix > 110) {
1983
0
                break;
1984
0
            }
1985
0
            u -= f;
1986
0
            ix++;
1987
0
            f *= (g / ix - r);
1988
0
        }
1989
0
    }
1990
0
finis:
1991
0
    if (psave > 0.5) {
1992
0
        ix = n - ix;
1993
0
    }
1994
0
    return (double)ix;
1995
0
}
1996
1997
0
static igraph_real_t igraph_i_rexp(igraph_rng_t *rng, double rate) {
1998
0
    igraph_real_t scale = 1.0 / rate;
1999
0
    if (!isfinite(scale) || scale <= 0.0) {
2000
0
        if (scale == 0.0) {
2001
0
            return 0.0;
2002
0
        }
2003
0
        return IGRAPH_NAN;
2004
0
    }
2005
0
    return scale * igraph_i_exp_rand(rng);
2006
0
}
2007
2008
/* This is from nmath/rgamma.c */
2009
2010
/*
2011
 *  Mathlib : A C Library of Special Functions
2012
 *  Copyright (C) 1998 Ross Ihaka
2013
 *  Copyright (C) 2000--2008 The R Core Team
2014
 *
2015
 *  This program is free software; you can redistribute it and/or modify
2016
 *  it under the terms of the GNU General Public License as published by
2017
 *  the Free Software Foundation; either version 2 of the License, or
2018
 *  (at your option) any later version.
2019
 *
2020
 *  This program is distributed in the hope that it will be useful,
2021
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
2022
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
2023
 *  GNU General Public License for more details.
2024
 *
2025
 *  You should have received a copy of the GNU General Public License
2026
 *  along with this program; if not, a copy is available at
2027
 *  http://www.r-project.org/Licenses/
2028
 *
2029
 *  SYNOPSIS
2030
 *
2031
 *    #include <Rmath.h>
2032
 *    double rgamma(double a, double scale);
2033
 *
2034
 *  DESCRIPTION
2035
 *
2036
 *    Random variates from the gamma distribution.
2037
 *
2038
 *  REFERENCES
2039
 *
2040
 *    [1] Shape parameter a >= 1.  Algorithm GD in:
2041
 *
2042
 *    Ahrens, J.H. and Dieter, U. (1982).
2043
 *    Generating gamma variates by a modified
2044
 *    rejection technique.
2045
 *    Comm. ACM, 25, 47-54.
2046
 *
2047
 *
2048
 *    [2] Shape parameter 0 < a < 1. Algorithm GS in:
2049
 *
2050
 *    Ahrens, J.H. and Dieter, U. (1974).
2051
 *    Computer methods for sampling from gamma, beta,
2052
 *    poisson and binomial distributions.
2053
 *    Computing, 12, 223-246.
2054
 *
2055
 *    Input: a = parameter (mean) of the standard gamma distribution.
2056
 *    Output: a variate from the gamma(a)-distribution
2057
 */
2058
2059
0
static double igraph_i_rgamma(igraph_rng_t *rng, double a, double scale) {
2060
    /* Constants : */
2061
0
    static const double sqrt32 = 5.656854;
2062
0
    static const double exp_m1 = 0.36787944117144232159;/* exp(-1) = 1/e */
2063
2064
    /* Coefficients q[k] - for q0 = sum(q[k]*a^(-k))
2065
     * Coefficients a[k] - for q = q0+(t*t/2)*sum(a[k]*v^k)
2066
     * Coefficients e[k] - for exp(q)-1 = sum(e[k]*q^k)
2067
     */
2068
0
    static const double q1 = 0.04166669;
2069
0
    static const double q2 = 0.02083148;
2070
0
    static const double q3 = 0.00801191;
2071
0
    static const double q4 = 0.00144121;
2072
0
    static const double q5 = -7.388e-5;
2073
0
    static const double q6 = 2.4511e-4;
2074
0
    static const double q7 = 2.424e-4;
2075
2076
0
    static const double a1 = 0.3333333;
2077
0
    static const double a2 = -0.250003;
2078
0
    static const double a3 = 0.2000062;
2079
0
    static const double a4 = -0.1662921;
2080
0
    static const double a5 = 0.1423657;
2081
0
    static const double a6 = -0.1367177;
2082
0
    static const double a7 = 0.1233795;
2083
2084
    /* State variables: */
2085
0
    static IGRAPH_THREAD_LOCAL double aa = 0.;
2086
0
    static IGRAPH_THREAD_LOCAL double aaa = 0.;
2087
0
    static IGRAPH_THREAD_LOCAL double s, s2, d;    /* no. 1 (step 1) */
2088
0
    static IGRAPH_THREAD_LOCAL double q0, b, si, c;/* no. 2 (step 4) */
2089
2090
0
    double e, p, q, r, t, u, v, w, x, ret_val;
2091
2092
0
    if (!isfinite(a) || !isfinite(scale) || a < 0.0 || scale <= 0.0) {
2093
0
        if (scale == 0.) {
2094
0
            return 0.;
2095
0
        }
2096
0
        ML_ERR_return_NAN;
2097
0
    }
2098
2099
0
    if (a < 1.) { /* GS algorithm for parameters a < 1 */
2100
0
        if (a == 0) {
2101
0
            return 0.;
2102
0
        }
2103
0
        e = 1.0 + exp_m1 * a;
2104
0
        repeat {
2105
0
            p = e * igraph_rng_get_unif01(rng);
2106
0
            if (p >= 1.0) {
2107
0
                x = -log((e - p) / a);
2108
0
                if (igraph_i_exp_rand(rng) >= (1.0 - a) * log(x)) {
2109
0
                    break;
2110
0
                }
2111
0
            } else {
2112
0
                x = exp(log(p) / a);
2113
0
                if (igraph_i_exp_rand(rng) >= x) {
2114
0
                    break;
2115
0
                }
2116
0
            }
2117
0
        }
2118
0
        return scale * x;
2119
0
    }
2120
2121
    /* --- a >= 1 : GD algorithm --- */
2122
2123
    /* Step 1: Recalculations of s2, s, d if a has changed */
2124
0
    if (a != aa) {
2125
0
        aa = a;
2126
0
        s2 = a - 0.5;
2127
0
        s = sqrt(s2);
2128
0
        d = sqrt32 - s * 12.0;
2129
0
    }
2130
    /* Step 2: t = standard normal deviate,
2131
               x = (s,1/2) -normal deviate. */
2132
2133
    /* immediate acceptance (i) */
2134
0
    t = igraph_i_norm_rand(rng);
2135
0
    x = s + 0.5 * t;
2136
0
    ret_val = x * x;
2137
0
    if (t >= 0.0) {
2138
0
        return scale * ret_val;
2139
0
    }
2140
2141
    /* Step 3: u = 0,1 - uniform sample. squeeze acceptance (s) */
2142
0
    u = igraph_rng_get_unif01(rng);
2143
0
    if (d * u <= t * t * t) {
2144
0
        return scale * ret_val;
2145
0
    }
2146
2147
    /* Step 4: recalculations of q0, b, si, c if necessary */
2148
2149
0
    if (a != aaa) {
2150
0
        aaa = a;
2151
0
        r = 1.0 / a;
2152
0
        q0 = ((((((q7 * r + q6) * r + q5) * r + q4) * r + q3) * r
2153
0
               + q2) * r + q1) * r;
2154
2155
        /* Approximation depending on size of parameter a */
2156
        /* The constants in the expressions for b, si and c */
2157
        /* were established by numerical experiments */
2158
2159
0
        if (a <= 3.686) {
2160
0
            b = 0.463 + s + 0.178 * s2;
2161
0
            si = 1.235;
2162
0
            c = 0.195 / s - 0.079 + 0.16 * s;
2163
0
        } else if (a <= 13.022) {
2164
0
            b = 1.654 + 0.0076 * s2;
2165
0
            si = 1.68 / s + 0.275;
2166
0
            c = 0.062 / s + 0.024;
2167
0
        } else {
2168
0
            b = 1.77;
2169
0
            si = 0.75;
2170
0
            c = 0.1515 / s;
2171
0
        }
2172
0
    }
2173
    /* Step 5: no quotient test if x not positive */
2174
2175
0
    if (x > 0.0) {
2176
        /* Step 6: calculation of v and quotient q */
2177
0
        v = t / (s + s);
2178
0
        if (fabs(v) <= 0.25)
2179
0
            q = q0 + 0.5 * t * t * ((((((a7 * v + a6) * v + a5) * v + a4) * v
2180
0
                                      + a3) * v + a2) * v + a1) * v;
2181
0
        else {
2182
0
            q = q0 - s * t + 0.25 * t * t + (s2 + s2) * log(1.0 + v);
2183
0
        }
2184
2185
2186
        /* Step 7: quotient acceptance (q) */
2187
0
        if (log(1.0 - u) <= q) {
2188
0
            return scale * ret_val;
2189
0
        }
2190
0
    }
2191
2192
0
    repeat {
2193
        /* Step 8: e = standard exponential deviate
2194
         *  u =  0,1 -uniform deviate
2195
         *  t = (b,si)-double exponential (laplace) sample */
2196
0
        e = igraph_i_exp_rand(rng);
2197
0
        u = igraph_rng_get_unif01(rng);
2198
0
        u = u + u - 1.0;
2199
0
        if (u < 0.0) {
2200
0
            t = b - si * e;
2201
0
        } else {
2202
0
            t = b + si * e;
2203
0
        }
2204
        /* Step  9:  rejection if t < tau(1) = -0.71874483771719 */
2205
0
        if (t >= -0.71874483771719) {
2206
            /* Step 10:  calculation of v and quotient q */
2207
0
            v = t / (s + s);
2208
0
            if (fabs(v) <= 0.25)
2209
0
                q = q0 + 0.5 * t * t *
2210
0
                ((((((a7 * v + a6) * v + a5) * v + a4) * v + a3) * v
2211
0
                  + a2) * v + a1) * v;
2212
0
            else {
2213
0
                q = q0 - s * t + 0.25 * t * t + (s2 + s2) * log(1.0 + v);
2214
0
            }
2215
            /* Step 11:  hat acceptance (h) */
2216
            /* (if q not positive go to step 8) */
2217
0
            if (q > 0.0) {
2218
0
                w = expm1(q);
2219
                /*  ^^^^^ original code had approximation with rel.err < 2e-7 */
2220
                /* if t is rejected sample again at step 8 */
2221
0
                if (c * fabs(u) <= w * exp(e - 0.5 * t * t)) {
2222
0
                    break;
2223
0
                }
2224
0
            }
2225
0
        }
2226
0
    } /* repeat .. until  `t' is accepted */
2227
0
    x = s + 0.5 * t;
2228
0
    return scale * x * x;
2229
0
}