这个实现基本上是从 Wiki 上的 Python 版翻译过来的,大量使用了赋值。

  1. ;; Mersenne twister algorithm from Wikipedia
  2. ;; returns a closure that returns a pseudo-random integer
  3. ;; for each call
  4. ;;
  5. (define (make-MT19937 seed)
  6. ;; some bitwise procedure alias for short
  7. (define << bitwise-arithmetic-shift-left)
  8. (define >> bitwise-arithmetic-shift-right)
  9. (define xor bitwise-xor)
  10.  
  11. (letrec ((mt (make-vector 624))
  12. (index 624)
  13. ;; reset index
  14. (twist
  15. (lambda ()
  16. (for i in (range 624)
  17. (let ((y (bitwise-and
  18. #xffffffff
  19. (+ (bitwise-and (vector-ref mt i)
  20. #x80000000)
  21. (bitwise-and (vector-ref mt (mod (+ i 1) 624))
  22. #x7fffffff)))))
  23. (vector-set! mt i (xor (vector-ref mt (mod (+ i 397) 624))
  24. (>> y 1)))
  25. (when (odd? y)
  26. (vector-set!
  27. mt i (xor (vector-ref mt i) #x9908b0df)))))
  28. (set! index 0)))
  29. ;; generates a number
  30. (extract_number
  31. (lambda ()
  32. (when (>= index 624)
  33. (twist))
  34. (let ((y (vector-ref mt index)))
  35.  
  36. (set! y (xor y (>> y 11)))
  37. (set! y (xor y (bitwise-and (<< y 7) 2636928640)))
  38. (set! y (xor y (bitwise-and (<< y 15) 4022730752)))
  39. (set! y (xor y (>> y 18)))
  40. (set! index (+ index 1))
  41. (bitwise-and #xffffffff y)))))
  42.  
  43. (vector-set! mt 0 seed)
  44.  
  45. ;; initialize the vector
  46. (for i in (range 1 624)
  47. (vector-set!
  48. mt
  49. i
  50. (bitwise-and (+ i
  51. (* 1812433253
  52. (bitwise-xor (vector-ref mt (- i 1))
  53. (>> (vector-ref mt (- i 1)) 30))))
  54. #xffffffff)))
  55. ;; return a closure
  56. (lambda ()
  57. (extract_number))))
  58.  
  59. ;; It may be better to set the seed as the system clock
  60. ;; but that involves different implementations
  61. (define generator (make-MT19937 4294967296)) ;; the seed
  62.  
  63. (define (randint . arg)
  64. (if (null? arg)
  65. (generator)
  66. (mod (generator) (car arg))))

我使用了自己定义的 for 宏,以及 range 函数来实现 Python 风格的 for 循环,下面是相关的定义:

  1. (define-syntax for
  2. (syntax-rules ()
  3. ;; loop in list
  4. ;; (for i in '(a b c) do something...)
  5. ((_ i in lst body ...)
  6. (let loop ((l lst))
  7. (unless (null? l)
  8. (let ((i (car l)))
  9. body ...
  10. (loop (cdr l))))))))
  11.  
  12. (define range
  13. (let ((make-range
  14. (lambda (first end step)
  15. (if (or (= step 0)
  16. (> (abs (- (+ first step) end))
  17. (abs (- first end))))
  18. (error 'range "wrong `step' leads to an infinite loop")
  19. (let iter ((cnt first) (result '()))
  20. (cond ((or (and (> step 0) (>= cnt end))
  21. (and (< step 0) (<= cnt end)))
  22. (reverse result))
  23. (else (iter (+ cnt step) (cons cnt result)))))))))
  24. (case-lambda
  25. ((a) (make-range 0 a 1))
  26. ((a b) (make-range a b 1))
  27. ((a b c) (make-range a b c)))))

使用了 R6RS 特有的一些函数及语法,使用时不要忘记在头部加上 (import (rnrs),如果还依赖别的库请查阅 R6RS 文档。

Mersenne twister 随机数算法实现 in Scheme的更多相关文章

  1. 伪随机数生成算法-梅森旋转(Mersenne Twister/MT)

    今天主要是来研究梅森旋转算法,它是用来产生伪随机数的,实际上产生伪随机数的方法有很多种,比如线性同余法, 平方取中法等等.但是这些方法产生的随机数质量往往不是很高,而今天介绍的梅森旋转算法可以产生高质 ...

  2. PHP Math 函数 mt_rand() 使用 Mersenne Twister 算法返回随机整数。

    语法 mt_rand(min,max) 说明 如果没有提供可选参数 min 和 max,mt_rand() 返回 0 到 RAND_MAX 之间的伪随机数.例如想要 5 到 15(包括 5 和 15) ...

  3. C语言生成32位和64位随机数算法

    C语言生成32位和64位随机数算法 /** * randstd.h * * Standard definitions and types, Bob Jenkins * * 2015-01-19: re ...

  4. 基于“均态分布”随机数算法的一次性口令OneTimePassword(原创)

    /* 所谓均态分布随机数算法是指:每个数(整数或实数)无序地分布在数轴上,值只出现一次永不重复.体现了香农的一次一密理论. * 均体现在每个数的值是平均概率,即都有出现:态体现在每个数在数轴上的位置是 ...

  5. java基础 - 冒泡排序,随机数算法

    从简单做起 任何困难的事情都是由简单的一步步一件件事情堆起来 理解好算法才是最重要 1.冒泡排序: public class Test { public static void main(String ...

  6. **PHP随机数算法

    <?php $tmp = range(1,30);print_r(array_rand($tmp,10));?> 输出: Array( [0] => 6 [1] => 8 [2 ...

  7. js随机数算法

    function rnd( seed ){ seed = ( seed * 9301 + 49297 ) % 233280; //为何使用这三个数? return seed / ( 233280.0 ...

  8. C/C++ 开源库及示例代码

    C/C++ 开源库及示例代码 Table of Contents 说明 1 综合性的库 2 数据结构 & 算法 2.1 容器 2.1.1 标准容器 2.1.2 Lockfree 的容器 2.1 ...

  9. PHP Math 函数

    abs() 绝对值. 3 acos() 反余弦. 3 acosh() 反双曲余弦. 4 asin() 反正弦. 3 asinh() 反双曲正弦. 4 atan() 反正切. 3 atan2() 两个参 ...

随机推荐

  1. 能力素质模型咨询工具(Part1)

          之前写过由企业家基本素质想到的文章,里面提及一些能力与素质,以下有内容也可以参考: 领导职位 表6-1 远见卓识的行为表现 级 别 行 为 表 现 A (1)关注行业的前景和环境的变化, ...

  2. 高性能javascript学习笔记系列(6) -ajax

    参考 高性能javascript javascript高级程序设计 ajax基础  ajax技术的核心是XMLHttpRequest对象(XHR),通过XHR我们就可以实现无需刷新页面就能从服务器端读 ...

  3. React-Native性能优化点

    shouldComponentUpdate 确保组件在渲染之后不需要再更新的,即静态组件,尽量在其中增加shouldComponentUpdate方法,防止二次消耗所产生的性能消耗 shouldCom ...

  4. Sharepoint学习笔记—习题系列--70-573习题解析 -(Q142-Q143)

    Question 142You have a Feature that contains an image named ImageV1.png.You plan to create a new ver ...

  5. iOS国际化

    本文介绍iOS国际化包含以下几种: 应用名称,文字,图片和xib 首先在工程里添加支持的语言,这里用了English和中文 然后创建两个.strings类型的文件,文件名分别为InfoPlist和Lo ...

  6. iOS开发之聊天模块--内容保存逻辑实现

    需求详解: 在实际开发中,有可能是在后期优化的时候,会有这么需要优化的需求:聊天输入框保存之前输入的文本,提高用户的良好体验. 在聊天模块中,用户可能会在输入框输入若干字符,但是没有点击发送就点击退出 ...

  7. 解决PKIX:unable to find valid certification path to requested target 的问题

    这两天在twitter服务器上忽然遇到这样的异常: e: sun.security.validator.ValidatorException: PKIX path building failed: s ...

  8. Play Framework 完整实现一个APP(三)

    1.添加Post类 package models; import java.util.*; import javax.persistence.*; import play.db.jpa.*; @Ent ...

  9. 在Linux环境下,将Solr部署到tomcat7中,导入Mysql数据库数据, 定时更新索引

    什么是solr solr是基于Lucene的全文搜索服务器,对Lucene进行了扩展优化. 准备工作 首先,去下载以下软件包: JDK8:jdk-8u60-linux-x64.tar.gz TOMCA ...

  10. SQL Server中的“最大并行度”的配置建议

    SQL Server中的最大并行度(max degree of parallelism)如何设置呢? 设置max degree of parallelism有什么好的建议和指导方针呢?在微软官方文档R ...