14a238c70SJohn Marino /* mpfr_grandom (rop1, rop2, state, rnd_mode) -- Generate up to two
24a238c70SJohn Marino pseudorandom real numbers according to a standard normal gaussian
34a238c70SJohn Marino distribution and round it to the precision of rop1, rop2 according
44a238c70SJohn Marino to the given rounding mode.
54a238c70SJohn Marino
6*ab6d115fSJohn Marino Copyright 2011, 2012, 2013 Free Software Foundation, Inc.
7*ab6d115fSJohn Marino Contributed by the AriC and Caramel projects, INRIA.
84a238c70SJohn Marino
94a238c70SJohn Marino This file is part of the GNU MPFR Library.
104a238c70SJohn Marino
114a238c70SJohn Marino The GNU MPFR Library is free software; you can redistribute it and/or modify
124a238c70SJohn Marino it under the terms of the GNU Lesser General Public License as published by
134a238c70SJohn Marino the Free Software Foundation; either version 3 of the License, or (at your
144a238c70SJohn Marino option) any later version.
154a238c70SJohn Marino
164a238c70SJohn Marino The GNU MPFR Library is distributed in the hope that it will be useful, but
174a238c70SJohn Marino WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
184a238c70SJohn Marino or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
194a238c70SJohn Marino License for more details.
204a238c70SJohn Marino
214a238c70SJohn Marino You should have received a copy of the GNU Lesser General Public License
224a238c70SJohn Marino along with the GNU MPFR Library; see the file COPYING.LESSER. If not, see
234a238c70SJohn Marino http://www.gnu.org/licenses/ or write to the Free Software Foundation, Inc.,
244a238c70SJohn Marino 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. */
254a238c70SJohn Marino
264a238c70SJohn Marino
274a238c70SJohn Marino /* #define MPFR_NEED_LONGLONG_H */
284a238c70SJohn Marino #include "mpfr-impl.h"
294a238c70SJohn Marino
304a238c70SJohn Marino
314a238c70SJohn Marino int
mpfr_grandom(mpfr_ptr rop1,mpfr_ptr rop2,gmp_randstate_t rstate,mpfr_rnd_t rnd)324a238c70SJohn Marino mpfr_grandom (mpfr_ptr rop1, mpfr_ptr rop2, gmp_randstate_t rstate,
334a238c70SJohn Marino mpfr_rnd_t rnd)
344a238c70SJohn Marino {
354a238c70SJohn Marino int inex1, inex2, s1, s2;
364a238c70SJohn Marino mpz_t x, y, xp, yp, t, a, b, s;
374a238c70SJohn Marino mpfr_t sfr, l, r1, r2;
384a238c70SJohn Marino mpfr_prec_t tprec, tprec0;
394a238c70SJohn Marino
404a238c70SJohn Marino inex2 = inex1 = 0;
414a238c70SJohn Marino
424a238c70SJohn Marino if (rop2 == NULL) /* only one output requested. */
434a238c70SJohn Marino {
444a238c70SJohn Marino tprec0 = MPFR_PREC (rop1);
454a238c70SJohn Marino }
464a238c70SJohn Marino else
474a238c70SJohn Marino {
484a238c70SJohn Marino tprec0 = MAX (MPFR_PREC (rop1), MPFR_PREC (rop2));
494a238c70SJohn Marino }
504a238c70SJohn Marino
514a238c70SJohn Marino tprec0 += 11;
524a238c70SJohn Marino
534a238c70SJohn Marino /* We use "Marsaglia polar method" here (cf.
544a238c70SJohn Marino George Marsaglia, Normal (Gaussian) random variables for supercomputers
554a238c70SJohn Marino The Journal of Supercomputing, Volume 5, Number 1, 49–55
564a238c70SJohn Marino DOI: 10.1007/BF00155857).
574a238c70SJohn Marino
584a238c70SJohn Marino First we draw uniform x and y in [0,1] using mpz_urandomb (in
594a238c70SJohn Marino fixed precision), and scale them to [-1, 1].
604a238c70SJohn Marino */
614a238c70SJohn Marino
624a238c70SJohn Marino mpz_init (xp);
634a238c70SJohn Marino mpz_init (yp);
644a238c70SJohn Marino mpz_init (x);
654a238c70SJohn Marino mpz_init (y);
664a238c70SJohn Marino mpz_init (t);
674a238c70SJohn Marino mpz_init (s);
684a238c70SJohn Marino mpz_init (a);
694a238c70SJohn Marino mpz_init (b);
704a238c70SJohn Marino mpfr_init2 (sfr, MPFR_PREC_MIN);
714a238c70SJohn Marino mpfr_init2 (l, MPFR_PREC_MIN);
724a238c70SJohn Marino mpfr_init2 (r1, MPFR_PREC_MIN);
734a238c70SJohn Marino if (rop2 != NULL)
744a238c70SJohn Marino mpfr_init2 (r2, MPFR_PREC_MIN);
754a238c70SJohn Marino
764a238c70SJohn Marino mpz_set_ui (xp, 0);
774a238c70SJohn Marino mpz_set_ui (yp, 0);
784a238c70SJohn Marino
794a238c70SJohn Marino for (;;)
804a238c70SJohn Marino {
814a238c70SJohn Marino tprec = tprec0;
824a238c70SJohn Marino do
834a238c70SJohn Marino {
844a238c70SJohn Marino mpz_urandomb (xp, rstate, tprec);
854a238c70SJohn Marino mpz_urandomb (yp, rstate, tprec);
864a238c70SJohn Marino mpz_mul (a, xp, xp);
874a238c70SJohn Marino mpz_mul (b, yp, yp);
884a238c70SJohn Marino mpz_add (s, a, b);
894a238c70SJohn Marino }
904a238c70SJohn Marino while (mpz_sizeinbase (s, 2) > tprec * 2); /* x^2 + y^2 <= 2^{2tprec} */
914a238c70SJohn Marino
924a238c70SJohn Marino for (;;)
934a238c70SJohn Marino {
944a238c70SJohn Marino /* FIXME: compute s as s += 2x + 2y + 2 */
954a238c70SJohn Marino mpz_add_ui (a, xp, 1);
964a238c70SJohn Marino mpz_add_ui (b, yp, 1);
974a238c70SJohn Marino mpz_mul (a, a, a);
984a238c70SJohn Marino mpz_mul (b, b, b);
994a238c70SJohn Marino mpz_add (s, a, b);
1004a238c70SJohn Marino if ((mpz_sizeinbase (s, 2) <= 2 * tprec) ||
1014a238c70SJohn Marino ((mpz_sizeinbase (s, 2) == 2 * tprec + 1) &&
1024a238c70SJohn Marino (mpz_scan1 (s, 0) == 2 * tprec)))
1034a238c70SJohn Marino goto yeepee;
1044a238c70SJohn Marino /* Extend by 32 bits */
1054a238c70SJohn Marino mpz_mul_2exp (xp, xp, 32);
1064a238c70SJohn Marino mpz_mul_2exp (yp, yp, 32);
1074a238c70SJohn Marino mpz_urandomb (x, rstate, 32);
1084a238c70SJohn Marino mpz_urandomb (y, rstate, 32);
1094a238c70SJohn Marino mpz_add (xp, xp, x);
1104a238c70SJohn Marino mpz_add (yp, yp, y);
1114a238c70SJohn Marino tprec += 32;
1124a238c70SJohn Marino
1134a238c70SJohn Marino mpz_mul (a, xp, xp);
1144a238c70SJohn Marino mpz_mul (b, yp, yp);
1154a238c70SJohn Marino mpz_add (s, a, b);
1164a238c70SJohn Marino if (mpz_sizeinbase (s, 2) > tprec * 2)
1174a238c70SJohn Marino break;
1184a238c70SJohn Marino }
1194a238c70SJohn Marino }
1204a238c70SJohn Marino yeepee:
1214a238c70SJohn Marino
1224a238c70SJohn Marino /* FIXME: compute s with s -= 2x + 2y + 2 */
1234a238c70SJohn Marino mpz_mul (a, xp, xp);
1244a238c70SJohn Marino mpz_mul (b, yp, yp);
1254a238c70SJohn Marino mpz_add (s, a, b);
1264a238c70SJohn Marino /* Compute the signs of the output */
1274a238c70SJohn Marino mpz_urandomb (x, rstate, 2);
1284a238c70SJohn Marino s1 = mpz_tstbit (x, 0);
1294a238c70SJohn Marino s2 = mpz_tstbit (x, 1);
1304a238c70SJohn Marino for (;;)
1314a238c70SJohn Marino {
1324a238c70SJohn Marino /* s = xp^2 + yp^2 (loop invariant) */
1334a238c70SJohn Marino mpfr_set_prec (sfr, 2 * tprec);
1344a238c70SJohn Marino mpfr_set_prec (l, tprec);
1354a238c70SJohn Marino mpfr_set_z (sfr, s, MPFR_RNDN); /* exact */
1364a238c70SJohn Marino mpfr_mul_2si (sfr, sfr, -2 * tprec, MPFR_RNDN); /* exact */
1374a238c70SJohn Marino mpfr_log (l, sfr, MPFR_RNDN);
1384a238c70SJohn Marino mpfr_neg (l, l, MPFR_RNDN);
1394a238c70SJohn Marino mpfr_mul_2si (l, l, 1, MPFR_RNDN);
1404a238c70SJohn Marino mpfr_div (l, l, sfr, MPFR_RNDN);
1414a238c70SJohn Marino mpfr_sqrt (l, l, MPFR_RNDN);
1424a238c70SJohn Marino
1434a238c70SJohn Marino mpfr_set_prec (r1, tprec);
1444a238c70SJohn Marino mpfr_mul_z (r1, l, xp, MPFR_RNDN);
1454a238c70SJohn Marino mpfr_div_2ui (r1, r1, tprec, MPFR_RNDN); /* exact */
1464a238c70SJohn Marino if (s1)
1474a238c70SJohn Marino mpfr_neg (r1, r1, MPFR_RNDN);
1484a238c70SJohn Marino if (MPFR_CAN_ROUND (r1, tprec - 2, MPFR_PREC (rop1), rnd))
1494a238c70SJohn Marino {
1504a238c70SJohn Marino if (rop2 != NULL)
1514a238c70SJohn Marino {
1524a238c70SJohn Marino mpfr_set_prec (r2, tprec);
1534a238c70SJohn Marino mpfr_mul_z (r2, l, yp, MPFR_RNDN);
1544a238c70SJohn Marino mpfr_div_2ui (r2, r2, tprec, MPFR_RNDN); /* exact */
1554a238c70SJohn Marino if (s2)
1564a238c70SJohn Marino mpfr_neg (r2, r2, MPFR_RNDN);
1574a238c70SJohn Marino if (MPFR_CAN_ROUND (r2, tprec - 2, MPFR_PREC (rop2), rnd))
1584a238c70SJohn Marino break;
1594a238c70SJohn Marino }
1604a238c70SJohn Marino else
1614a238c70SJohn Marino break;
1624a238c70SJohn Marino }
1634a238c70SJohn Marino /* Extend by 32 bits */
1644a238c70SJohn Marino mpz_mul_2exp (xp, xp, 32);
1654a238c70SJohn Marino mpz_mul_2exp (yp, yp, 32);
1664a238c70SJohn Marino mpz_urandomb (x, rstate, 32);
1674a238c70SJohn Marino mpz_urandomb (y, rstate, 32);
1684a238c70SJohn Marino mpz_add (xp, xp, x);
1694a238c70SJohn Marino mpz_add (yp, yp, y);
1704a238c70SJohn Marino tprec += 32;
1714a238c70SJohn Marino mpz_mul (a, xp, xp);
1724a238c70SJohn Marino mpz_mul (b, yp, yp);
1734a238c70SJohn Marino mpz_add (s, a, b);
1744a238c70SJohn Marino }
1754a238c70SJohn Marino inex1 = mpfr_set (rop1, r1, rnd);
1764a238c70SJohn Marino if (rop2 != NULL)
1774a238c70SJohn Marino {
1784a238c70SJohn Marino inex2 = mpfr_set (rop2, r2, rnd);
1794a238c70SJohn Marino inex2 = mpfr_check_range (rop2, inex2, rnd);
1804a238c70SJohn Marino }
1814a238c70SJohn Marino inex1 = mpfr_check_range (rop1, inex1, rnd);
1824a238c70SJohn Marino
1834a238c70SJohn Marino if (rop2 != NULL)
1844a238c70SJohn Marino mpfr_clear (r2);
1854a238c70SJohn Marino mpfr_clear (r1);
1864a238c70SJohn Marino mpfr_clear (l);
1874a238c70SJohn Marino mpfr_clear (sfr);
1884a238c70SJohn Marino mpz_clear (b);
1894a238c70SJohn Marino mpz_clear (a);
1904a238c70SJohn Marino mpz_clear (s);
1914a238c70SJohn Marino mpz_clear (t);
1924a238c70SJohn Marino mpz_clear (y);
1934a238c70SJohn Marino mpz_clear (x);
1944a238c70SJohn Marino mpz_clear (yp);
1954a238c70SJohn Marino mpz_clear (xp);
1964a238c70SJohn Marino
1974a238c70SJohn Marino return INEX (inex1, inex2);
1984a238c70SJohn Marino }
199