好的,经过几个小时的疯狂调试,我终于有了这个:
(defmacro assoc-bind (bindings expression &rest body)
(let* ((i (gensym))
(exp (gensym))
(abindings
(let ((cursor bindings) result)
(while cursor
(push (caar cursor) result)
(push (cdar cursor) result)
(setq cursor (cdr cursor)))
(setq result (nreverse result))
(cons (list i `(quote ,result))
(cons (list exp expression) result)))))
`(let (,@abindings)
(while ,i
(set (car ,i) (caar ,exp))
(setq ,i (cdr ,i))
(set (car ,i) (cdar ,exp))
(setq ,i (cdr ,i) ,exp (cdr ,exp)))
,@body)))
(let ((i 0) (limit 100) (test (make-string 100 ?-))
bag bag-iter next-random last)
(while (< i limit)
;; bag is an alist of a format of ((min . max) ...)
(setq bag-iter bag next-random (random limit))
(message "original-random: %d" next-random)
(if bag-iter
(catch 't
(setq last nil)
(while bag-iter
;; cannot use `destructuring-bind' here,
;; it errors if not enough conses
(assoc-bind
((lower-a . upper-a) (lower-b . upper-b))
bag-iter
(cond
;; CASE 0: ============ no more conses
((and (null lower-b) (>= next-random upper-a))
(cond
((= next-random upper-a)
(if (< (1+ next-random) limit)
(setcdr (car bag-iter) (incf next-random))
(setcar (car bag-iter) (incf next-random))
(when (and last (= 1 (- (cdar last) next-random)))
(setcdr (car last) upper-a)
(setcdr last nil))))
;; increase right
((= (- next-random upper-a) 1)
(setcdr (car bag-iter) next-random))
;; add new cons
(t (setcdr bag-iter
(list (cons next-random next-random)))))
(message "case 0")
(throw 't nil))
;; CASE 1: ============ before the first
((< next-random lower-a)
(if (= (1+ next-random) lower-a)
(setcar (car bag-iter) next-random)
(if last
(setcdr last
(cons (cons next-random next-random)
bag-iter))
(setq bag (cons (cons next-random next-random) bag))))
(message "case 1")
(throw 't nil))
;; CASE 2: ============ in the first range
((< next-random upper-a)
(if (or (and (> (- next-random lower-a)
(- upper-a next-random))
(< (1+ upper-a) limit))
(= lower-a 0))
;; modify right
(progn
(setq next-random (1+ upper-a))
(setcdr (car bag-iter) next-random)
(when (and lower-b (= (- lower-b next-random) 1))
;; converge right
(setcdr (car bag-iter) upper-b)
(setcdr bag-iter (cddr bag-iter))))
;; modify left
(setq next-random (1- lower-a))
(setcar (car bag-iter) next-random)
(when (and last (= (- next-random (cdar last)) 1))
;; converge left
(setcdr (car last) upper-a)
(setcdr last (cdr bag-iter))))
(message "case 2")
(throw 't nil))
;; CASE 3: ============ in the middle
((< next-random lower-b)
(cond
;; increase previous
((= next-random upper-a)
(setq next-random (1+ next-random))
(setcdr (car bag-iter) next-random)
(when (= (- lower-b next-random) 1)
;; converge left, if needed
(setcdr (car bag-iter) upper-b)
(setcdr bag-iter (cddr bag-iter))))
;; converge right
((= (- lower-b upper-a) 1)
(setcdr (car bag-iter) upper-b)
(setcdr bag-iter (cddr bag-iter)))
;; increase left
((= (- next-random 1) upper-a)
(setcdr (car bag-iter) next-random)
(when (= next-random (1- lower-b))
(setcdr (car bag-iter) upper-b)
(setcdr bag-iter (cddr bag-iter))))
;; decrease right
((= (- lower-b next-random) 1)
(setcar (cadr bag-iter) next-random))
;; we have room for a new cons
(t (setcdr bag-iter
(cons (cons next-random next-random)
(cdr bag-iter)))))
(message "case 3")
(throw 't nil)))
(setq last bag-iter bag-iter (cdr bag-iter)))))
(setq bag (list (cons next-random next-random))))
(message "next-random: %d" next-random)
(message "bag: %s" bag)
(when (char-equal (aref test next-random) ?x)
(throw nil nil))
(aset test next-random ?x)
(incf i))
(message test))
它有效,但超级丑陋。当我开始研究这个时,我想到这个函数不应该占用十几行代码。我希望我最初的假设不是那么遥远,我要求你尽力帮助整理它。
如果阅读我的代码让你头疼(我完全可以理解!)这里是对上述内容的描述:
在给定的时间间隔内生成随机数(为简单起见,从零开始,最多为limit
)。每次迭代通过根据已经生成的预先记录的数字范围进行验证,确保新生成的数字是唯一的。这些范围以alist
的形式存储,即((min-0 . max-0) (min-1 . max-1) ... (min-N . max-N))
。在检查新生成的随机数不在任何范围内之后,使用该数字,并使用生成的数字更新范围。否则,该数字将替换为该数字,该数字与其所在范围的最小值或最大值更接近,但不能超过limit
或为负值。
更新范围的规则:
给定N =新的随机数,以及两个范围((a . b) (c . d))
可能会发生以下变化:
if N < a - 1: ((N . N) (a . b) (c . d))
if N < a + (b - a) / 2: (((1- a) . b) (c . d))
if N < b and (c - b) > 2: ((a . (1+ b)) (c . d))
if N < b and (c - b) = 2: ((a . d))
if N = c - 1: ((a . b) ((1- c) . d))
if N < c: ((a . b) (N . N) (c . d))
我希望我能涵盖所有案件。
如果你有办法描述算法的时间/空间复杂性,那么奖励积分:)此外,如果你能想到问题的另一种解决方法,或者你可以肯定地告诉我这里的分布均匀性有问题好的,告诉我们!
修改
此刻测试它太累了,但这是我的另一个想法,以防万一:
(defun pprint-bytearray
(array &optional bigendian bits-per-byte byte-separator)
(unless bits-per-byte (setq bits-per-byte 32))
(unless byte-separator (setq byte-separator ","))
(let ((result
(with-output-to-string
(princ "[")
(++ (for i across array)
(if bigendian
(++ (for j from 0 downto (- bits-per-byte))
(princ (logand 1 (lsh i j))))
(++ (for j from (- bits-per-byte) to 0)
(princ (logand 1 (lsh i j)))))
(princ byte-separator)))))
(if (> (length result) 1)
(aset result (1- (length result)) ?\])
(setq result (concat result "]")))
result))
(defun random-in-range (limit &optional bits)
(unless bits (setq bits 31))
(let ((i 0) (test (make-string limit ?-))
(cache (make-vector (ceiling limit bits) 0))
next-random searching
left-shift right-shift)
(while (< i limit)
(setq next-random (random limit))
(let* ((divisor (floor next-random bits))
(reminder (lsh 1 (- next-random (* divisor bits)))))
(if (= (logand (aref cache divisor) reminder) 0)
;; we have a good random
(aset cache divisor (logior (aref cache divisor) reminder))
;; will search for closest unset bit
(setq left-shift (1- next-random)
right-shift (1+ next-random)
searching t)
(message "have collision %s" next-random)
(while searching
;; step left and try again
(when (> left-shift 0)
(setq divisor (floor left-shift bits)
reminder (lsh 1 (- left-shift (* divisor bits))))
(if (= (logand (aref cache divisor) reminder) 0)
(setf next-random left-shift
searching nil
(aref cache divisor)
(logior (aref cache divisor) reminder))
(decf left-shift)))
;; step right and try again
(when (and searching (< right-shift limit))
(setq divisor (floor right-shift bits)
reminder (lsh 1 (- right-shift (* divisor bits))))
(if (= (logand (aref cache divisor) reminder) 0)
(setf next-random right-shift
searching nil
(aref cache divisor)
(logior (aref cache divisor) reminder))
(incf right-shift))))))
(incf i)
(message "cache: %s" (pprint-bytearray cache t 31 ""))
(when (char-equal (aref test next-random) ?x)
(throw nil next-random))
(aset test next-random ?x)
(message "next-random: %d" next-random))))
(random-in-range 100)
哪个应该减少31倍的内存使用量(也许它可以是32,我不知道在eLisp中可以安全使用多少个int,ints似乎与平台有关)。
即。我们可以将每个组中的自然数除以31个数字,并且在每个这样的组中,可以将其所有成员(或它们的组合)存储为单个int(每个数字只需要一位来显示它的存在)。这使得搜索最近的未使用的邻居有点复杂,但是31次内存减少(并且不需要动态分配)的好处看起来像是一个很好的视角......
EDIT2:
好的,我终于想出了如何使用位掩码来做到这一点。更新了上面的代码。这样可以节省大约64倍的内存(我认为是......),你可以随机生成。
答案 0 :(得分:2)
对于更简单的方法,只需在所需的时间间隔内生成一系列数字,然后将它们混洗。然后,当你需要一个随机数时,只需从该列表中取出下一个。
这确保了所需间隔中的所有数字都只有一次,并且获取的每个随机数都是唯一的,如果您通过它,整个时间间隔将会耗尽。
根据我的理解,这些满足您的要求。
答案 1 :(得分:1)
下面的代码经过了轻度测试,可能不是最漂亮的样式,但我仍然认为它应该有效并且比你的更简单。我的算法可以被视为与你的算法相反:我不是将随机数添加到已经选择的数字集中,而是从完整的可能整数集开始并从中删除i
(这是通过{ {1}})。我使用与你的存储相同的存储器来存储整数。
pick
你可能是一个比我更好的LISP编码器,所以我相信你能够以更清晰的方式重写这段代码。