在循环中生成唯一的随机数

时间:2012-12-04 22:40:45

标签: emacs random lisp elisp

好的,经过几个小时的疯狂调试,我终于有了这个:

(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倍的内存(我认为是......),你可以随机生成。

2 个答案:

答案 0 :(得分:2)

对于更简单的方法,只需在所需的时间间隔内生成一系列数字,然后将它们混洗。然后,当你需要一个随机数时,只需从该列表中取出下一个。

这确保了所需间隔中的所有数字都只有一次,并且获取的每个随机数都是唯一的,如果您通过它,整个时间间隔将会耗尽。

根据我的理解,这些满足您的要求。

答案 1 :(得分:1)

下面的代码经过了轻度测试,可能不是最漂亮的样式,但我仍然认为它应该有效并且比你的更简单。我的算法可以被视为与你的算法相反:我不是将随机数添加到已经选择的数字集中,而是从完整的可能整数集开始并从中删除i(这是通过{ {1}})。我使用与你的存储相同的存储器来存储整数。

pick

你可能是一个比我更好的LISP编码器,所以我相信你能够以更清晰的方式重写这段代码。