Changeset 7258
- Timestamp:
- Sep 19, 2007, 9:48:44 AM (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/working-0709/ccl/level-0/l0-numbers.lisp
r7195 r7258 1722 1722 1723 1723 1724 #+32-bit-target 1724 1725 (defun random (number &optional (state *random-state*)) 1725 1726 (if (not (typep state 'random-state)) (report-bad-arg state 'random-state)) … … 1729 1730 (if (< number 65536) 1730 1731 (fast-mod (%next-random-seed state) number) 1731 (%bignum-random number state)))) 1732 (let* ((n 0) 1733 (nhalf (ash (+ 15 (integer-length number)) -4))) 1734 (declare (fixnum n nhalf)) 1735 (dotimes (i nhalf (fast-mod n number)) 1736 (setq n (logior (the fixnum (ash n 16)) 1737 (the fixnum (%next-random-seed state))))))))) 1732 1738 ((and (typep number 'double-float) (> (the double-float number) 0.0)) 1733 1739 (%float-random number state)) … … 1738 1744 (t (report-bad-arg number '(or (integer (0)) (float (0.0))))))) 1739 1745 1746 #+64-bit-target 1747 (defun random (number &optional (state *random-state*)) 1748 (if (not (typep state 'random-state)) (report-bad-arg state 'random-state)) 1749 (cond 1750 ((and (fixnump number) (> (the fixnum number) 0)) 1751 (locally (declare (fixnum number)) 1752 (let* ((n 0) 1753 (n32 (ash (+ 31 (integer-length number)) -5))) 1754 (declare (fixnum n n32)) 1755 (dotimes (i n32 (fast-mod n number)) 1756 (setq n (logior (the fixnum (ash n 16)) 1757 (the fixnum (%next-random-seed state)))))))) 1758 ((and (typep number 'double-float) (> (the double-float number) 0.0)) 1759 (%float-random number state)) 1760 ((and (typep number 'short-float) (> (the short-float number) 0.0s0)) 1761 (%float-random number state)) 1762 ((and (bignump number) (> number 0)) 1763 (%bignum-random number state)) 1764 (t (report-bad-arg number '(or (integer (0)) (float (0.0))))))) 1765 1740 1766 1741 1767 #| … … 1760 1786 1761 1787 What makes this generator so simple is that multiplication and addition mod 1762 2^n-1 is easy. See Knuth Ch. 4.3.2 (2nd Ed. p 272).1788 2^n-1 is easy. See Knuth Ch. 4.3.2 (2nd Ed. p 272). 1763 1789 1764 1790 ab mod m = ... … … 1780 1806 1781 1807 #+64-bit-target 1782 (defun %next-random-pair (high low) 1783 (declare (type (unsigned-byte 16) high low)) 1784 (let* ((n0 1785 (%i* 42871 1786 (the (unsigned-byte 31) 1787 (logior (the (unsigned-byte 31) 1788 (ash (ldb (byte 15 0) high) 16)) 1789 (the (unsigned-byte 16) 1790 (ldb (byte 16 0) low)))))) 1791 (n (fast-mod n0 (1- (expt 2 31))))) 1808 (defun %next-random-seed (state) 1809 (let* ((n (the fixnum (* (the fixnum (random.seed-1 state)) 48271)))) 1792 1810 (declare (fixnum n)) 1793 (values (ldb (byte 15 16) n) 1794 (ldb (byte 16 0) n)))) 1795 1811 (setf (random.seed-1 state) (fast-mod n (1- (expt 2 31)))) 1812 (logand n (1- (ash 1 32))))) 1813 1814 #+32-bit-target 1796 1815 (defun %next-random-seed (state) 1797 1816 (multiple-value-bind (high low) (%next-random-pair (%svref state 1) … … 1803 1822 (logior high (the fixnum (logand low (ash 1 15)))))) 1804 1823 1805 1824 #+32-bit-target 1806 1825 (defun %bignum-random (number state) 1807 1826 (let* ((bits (+ (integer-length number) 8)) … … 1832 1851 1833 1852 (defun %float-random (number state) 1834 (if (zerop number) 1835 number 1836 (let ((ratio (gvector :ratio (random most-positive-fixnum state) most-positive-fixnum))) 1837 (declare (dynamic-extent ratio)) 1838 (* number ratio)))) 1853 (let ((ratio (gvector :ratio (random most-positive-fixnum state) most-positive-fixnum))) 1854 (declare (dynamic-extent ratio)) 1855 (* number ratio))) 1839 1856 1840 1857 (eval-when (:compile-toplevel :execute)
Note: See TracChangeset
for help on using the changeset viewer.