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

;; Mersenne twister algorithm from Wikipedia
;; returns a closure that returns a pseudo-random integer
;; for each call
;;
(define (make-MT19937 seed)
;; some bitwise procedure alias for short
(define << bitwise-arithmetic-shift-left)
(define >> bitwise-arithmetic-shift-right)
(define xor bitwise-xor) (letrec ((mt (make-vector 624))
(index 624)
;; reset index
(twist
(lambda ()
(for i in (range 624)
(let ((y (bitwise-and
#xffffffff
(+ (bitwise-and (vector-ref mt i)
#x80000000)
(bitwise-and (vector-ref mt (mod (+ i 1) 624))
#x7fffffff)))))
(vector-set! mt i (xor (vector-ref mt (mod (+ i 397) 624))
(>> y 1)))
(when (odd? y)
(vector-set!
mt i (xor (vector-ref mt i) #x9908b0df)))))
(set! index 0)))
;; generates a number
(extract_number
(lambda ()
(when (>= index 624)
(twist))
(let ((y (vector-ref mt index))) (set! y (xor y (>> y 11)))
(set! y (xor y (bitwise-and (<< y 7) 2636928640)))
(set! y (xor y (bitwise-and (<< y 15) 4022730752)))
(set! y (xor y (>> y 18)))
(set! index (+ index 1))
(bitwise-and #xffffffff y))))) (vector-set! mt 0 seed) ;; initialize the vector
(for i in (range 1 624)
(vector-set!
mt
i
(bitwise-and (+ i
(* 1812433253
(bitwise-xor (vector-ref mt (- i 1))
(>> (vector-ref mt (- i 1)) 30))))
#xffffffff)))
;; return a closure
(lambda ()
(extract_number)))) ;; It may be better to set the seed as the system clock
;; but that involves different implementations
(define generator (make-MT19937 4294967296)) ;; the seed (define (randint . arg)
(if (null? arg)
(generator)
(mod (generator) (car arg))))

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

(define-syntax for
(syntax-rules ()
;; loop in list
;; (for i in '(a b c) do something...)
((_ i in lst body ...)
(let loop ((l lst))
(unless (null? l)
(let ((i (car l)))
body ...
(loop (cdr l)))))))) (define range
(let ((make-range
(lambda (first end step)
(if (or (= step 0)
(> (abs (- (+ first step) end))
(abs (- first end))))
(error 'range "wrong `step' leads to an infinite loop")
(let iter ((cnt first) (result '()))
(cond ((or (and (> step 0) (>= cnt end))
(and (< step 0) (<= cnt end)))
(reverse result))
(else (iter (+ cnt step) (cons cnt result)))))))))
(case-lambda
((a) (make-range 0 a 1))
((a b) (make-range a b 1))
((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. jsp读取properties文件

    jsp读取properties文件 jsp中读取properties文件,并把值设到js变量中: mpi.properties文件内容: MerchantID=00000820 CustomerEMa ...

  2. iOS UINavigationController的使用

    NavigationController,又称导航控制器.是iOS开发中比较常用的一种容器ViewController,常用于页面的管理和切换. 在开发中,NavigationController常常 ...

  3. 自定义View字段表头

    适用场景: 三个列表进行Join,然后试图上显示ProjectedField,而ProjectedField不支持设置DisplayName.默认只能显示英文名. join caml如下: <V ...

  4. 学习Maven之Maven Enforcer Plugin

    1.Maven Enforcer plugin是什么鬼? 在说这个插件是什么前我们先思考这么一个问题:当我们开发人员进入项目组进行开发前,要准备开发环境,而领导总是会强调工具的统一,编译环境的统一.比 ...

  5. git rebase与 git合并(error: failed to push some refs to)解决方法

    1.遇到的问题 本地有一个git仓库,在github上新建了一个空的仓库,但是更新了REWADME.md的信息,即在github上多了一个提交. 关联远程仓库,操作顺序如下: git remote a ...

  6. 全新的membership框架Asp.net Identity(1)——.Net membership的历史

    在Asp.net上,微软的membershop框架经历了Asp.net membership到Asp.net simple membership,再到现在的Asp.net Identity. 每一次改 ...

  7. iPhone 6 被盗记录二【写在315前夕:苹果售后福州直信创邺在没有三包的情况下帮小偷翻新、助力小偷换机销赃!无视王法。让人震惊,痛心,憎恨!消费者很受伤很无奈】

    投诉公司: 北京直信创邺数码科技有限公司  标题: 写在315前夕:苹果售后在没有三包的情况下帮小偷翻新.助力小偷换机销赃!无视王法.让人震惊,痛心,憎恨!消费者很受伤很无奈 期望: 还我手机,或者赔 ...

  8. Java导入的项目乱码怎么解决?(Ⅰ)

    1.项目右键 打开  >>  Properties  >>  Resource  >>  Text file encoding  >>  Other 如 ...

  9. ORACLE Linux以及 Unbreakable Enterprise Kernel

    Oracle Linux,全称为Oracle Enterprise Linux,简称OEL,Linux发行版本之一.Oracle公司在2006年初发布第一个版本,以对Oracle软件和硬件支持较好见长 ...

  10. Django入门

    Django文档: https://docs.djangoproject.com/en/1.10/ref/ 一.简单创建app 1.1 命令行创建project和app. django-admin s ...