fork download
  1. (defun weighted-pseudorandom (fn)
  2. (do ((r 0 (random 1.0))
  3. (test 1 (random 1.0)))
  4. ((< test (apply fn (list r))) r)))
  5.  
  6. (defun linear-prob-distribution (r)
  7. r)
  8.  
  9. (defun quadratic-prob-distribution (r)
  10. (expt r 2))
  11.  
  12. (defun check-distribution (fn)
  13. (let ((randoms
  14. (sort
  15. (loop
  16. for i
  17. from 0 below 100000
  18. collecting (weighted-pseudorandom fn))
  19. #'<))
  20. (scale (loop for i from 0 below 1 by 1/100 collecting i))
  21. (result (make-hash-table))
  22. (ptr -1/100))
  23. (dolist (x randoms)
  24. (if (> x ptr)
  25. (progn
  26. (princ (float ptr))
  27. (princ ",")
  28. (princ (gethash ptr result))
  29. (fresh-line)
  30. (setf ptr (+ ptr 1/100))
  31. (setf (gethash ptr result) 0))
  32. (incf (gethash ptr result))))))
  33.  
  34. (print "Linearly weighted generation of a 100,000 numbers")
  35. (fresh-line)
  36. (check-distribution #'linear-prob-distribution)
  37. (print "Quadratic")
  38. (fresh-line)
  39. (check-distribution #'quadratic-prob-distribution)
  40.  
Success #stdin #stdout 3.53s 13392KB
stdin
Standard input is empty
stdout
"Linearly weighted generation of a 100,000 numbers" 
-0.01,NIL
0.0,0
0.01,7
0.02,32
0.03,49
0.04,72
0.05,105
0.06,83
0.07,149
0.08,136
0.09,180
0.1,198
0.11,228
0.12,228
0.13,261
0.14,265
0.15,299
0.16,308
0.17,315
0.18,341
0.19,381
0.2,394
0.21,426
0.22,437
0.23,478
0.24,441
0.25,472
0.26,516
0.27,560
0.28,522
0.29,583
0.3,612
0.31,638
0.32,571
0.33,625
0.34,693
0.35,707
0.36,700
0.37,730
0.38,734
0.39,794
0.4,775
0.41,794
0.42,828
0.43,810
0.44,871
0.45,897
0.46,965
0.47,977
0.48,961
0.49,945
0.5,911
0.51,1030
0.52,1070
0.53,1109
0.54,1041
0.55,1092
0.56,1081
0.57,1133
0.58,1091
0.59,1133
0.6,1129
0.61,1192
0.62,1283
0.63,1287
0.64,1248
0.65,1277
0.66,1341
0.67,1295
0.68,1375
0.69,1382
0.7,1405
0.71,1446
0.72,1435
0.73,1476
0.74,1439
0.75,1446
0.76,1555
0.77,1562
0.78,1637
0.79,1594
0.8,1558
0.81,1571
0.82,1574
0.83,1602
0.84,1720
0.85,1698
0.86,1687
0.87,1748
0.88,1718
0.89,1845
0.9,1763
0.91,1783
0.92,1776
0.93,1806
0.94,1845
0.95,1917
0.96,1907
0.97,1941
0.98,1936
0.99,1939

"Quadratic" 
-0.01,NIL
0.0,0
0.01,0
0.02,0
0.03,0
0.04,0
0.05,1
0.06,7
0.07,9
0.08,12
0.09,34
0.1,29
0.11,40
0.12,45
0.13,48
0.14,56
0.15,60
0.16,62
0.17,93
0.18,92
0.19,80
0.2,127
0.21,132
0.22,135
0.23,158
0.24,154
0.25,171
0.26,173
0.27,205
0.28,227
0.29,232
0.3,248
0.31,277
0.32,282
0.33,324
0.34,345
0.35,351
0.36,387
0.37,394
0.38,457
0.39,478
0.4,471
0.41,507
0.42,537
0.43,538
0.44,531
0.45,564
0.46,629
0.47,648
0.48,673
0.49,716
0.5,731
0.51,764
0.52,747
0.53,822
0.54,859
0.55,938
0.56,929
0.57,1001
0.58,1006
0.59,991
0.6,1096
0.61,1075
0.62,1137
0.63,1160
0.64,1253
0.65,1207
0.66,1296
0.67,1316
0.68,1335
0.69,1418
0.7,1408
0.71,1515
0.72,1485
0.73,1593
0.74,1669
0.75,1653
0.76,1709
0.77,1760
0.78,1768
0.79,1803
0.8,1900
0.81,1925
0.82,1950
0.83,2085
0.84,2096
0.85,2115
0.86,2207
0.87,2258
0.88,2267
0.89,2368
0.9,2397
0.91,2450
0.92,2555
0.93,2508
0.94,2643
0.95,2739
0.96,2727
0.97,2771
0.98,2831
0.99,2954