4

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

(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 是安全的，int 似乎取决于平台）。

即我们可以将自然数分成每组 31 个数字，并且在每个这样的组中，可以将其所有成员（或它们的组合）存储为单个 int（每个数字只需要一位来显示它的在场）。这使得搜索最近的未使用邻居更加复杂，但是减少 31 倍内存的好处（并且不需要动态分配）看起来是一个很好的视角......

编辑2：

好的，我终于想出了如何使用位掩码来做到这一点。更新了上面的代码。这可以节省内存高达范围的 64 倍（我想是的......），您可以在其中生成随机数。

4

2 回答 2

2

对于更简单的方法，只需生成所需间隔内的数字序列，然后将它们打乱。然后，当您需要一个随机数时，只需从该列表中取出下一个即可。

这样可以确保所需区间中的所有数字都存在一次且仅一次，并且获得的每个随机数都是唯一的，并且如果您经过它，整个区间将被耗尽。

据我了解，这些满足您的要求。

于 2012-12-04T22:43:28.887 回答
1

下面的代码经过了轻微的测试，可能不是最漂亮的风格，但我仍然认为它应该可以工作并且比你的简单一点。我的算法可以被视为与您的相反：我没有将随机数添加到已选择的数字集合中，而是从完整的可能整数集开始并i从中删除 th （这是由 完成的pick）。我使用与您相同的存储来存储整数集。

(defun pick (index bag)
  "Pick integer at position INDEX in the set described by BAG

BAG is of the form ((min0 . max0) (min1 . max1) ...)

The result is returned in the form: (n . new-bag)
where N is the integer picked, and NEW-BAG is the set obtained by
removing N from BAG."
  (let* ((range (car bag))   ;; The first range in the set,
         (beg (car range))   ;; of the form (beg . end)
         (end (cdr range))   ;;
         (last (- end beg))) ;; index of the last element in the range

    (if (<= index last)
        ;; We are picking an element of the first range
        (let ((n (+ beg index)))
          (cons n
                (cond
                 ;; Case of a singleton (n . n)
                 ((= last 0)
                  (rest bag))

                 ;; If we are picking the first element of the range
                 ((= index 0)
                  (cons `(,(1+ beg) . ,end) (rest bag)))

                 ;; If we are picking the last element
                 ((= index last)
                  (cons `(,beg . ,(- end 1)) (rest bag)))

                 ;; Otherwise, the range is split into two parts
                 (t
                  (concatenate 'list
                               `((,beg . ,(- n 1))
                                 (,(1+ n) . ,end))
                               (rest bag))))))

      ;; We will pick an element from a range further down the list
      ;; by recursively calling `pick' on the tail
      (let* ((rec     (pick (- index last 1) (rest bag)))
             (n       (car rec))
             (new-bag (cdr rec)))
        (cons n (cons range new-bag))))))

(defun generate (count limit)
  (let ((bag `((1 . ,limit)))
        (result nil)
        n pick-result)
    (dotimes (i count)
      (setq pick-result (pick (random (- limit i)) bag))
      (setq n   (car pick-result))
      (setq bag (cdr pick-result))
      (setq result (cons n result)))
    result))

(generate 10 100)
;; ==> (64 26 43 44 55 5 89 20 12 25)

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

于 2012-12-04T23:50:02.167 回答