emacs - ループ内で一意の乱数を生成する

Question

OK、数時間の非常識なデバッグの後、私はついにこれを手に入れました：

(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))

動作しますが、非常に醜いです。これに取り組み始めたとき、関数は数十行以上のコードを必要としないはずだと想像しました。私の最初の仮定がそれほどかけ離れていないことを願って、これを整理するのを手伝ってくれるようにお願いしています.

私のコードを読んで頭痛がするなら (私はそれを完全に理解できます!)、上記の機能の説明を次に示します。

指定された間隔内で乱数を生成します (簡単にするために 0 から までlimit)。各反復では、新しく生成された番号が、既に生成された事前に記録された範囲の番号に対して検証されることにより、一意であることを確認します。これらの範囲はalist、つまりの形式で保存され((min-0 . max-0) (min-1 . max-1) ... (min-N . max-N))ます。新しく生成された乱数がどの範囲内にもないことを確認した後、その数が使用され、生成された数で範囲が更新されます。それ以外の場合、数値はその範囲の最小値または最大値のいずれかから近い数値に置き換えられますが、 を超えlimitたり、負になったりすることはできません。

範囲を更新するためのルール:

N = 新しい乱数と 2 つの範囲を指定((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 分の 1 に削減されます (おそらく 32 になる可能性があります。eLisp で安全に使用できる int のビット数はわかりません。int はプラットフォームに依存するようです)。

つまり、自然数をそれぞれ 31 個のグループに分割することができ、そのような各グループ内で、そのすべてのメンバー (またはそれらの組み合わせ) を単一の int として格納することができます (各数値は、その数値を示すために 1 ビットしか必要としません)。面前）。これにより、最も近い未使用の隣人の検索がやや複雑になりますが、31 倍のメモリ削減 (および動的割り当ての必要がない) の利点は良い見通しのように見えます...

EDIT2：

OK、ようやくビットマスクでそれを行う方法を見つけました。上記のコードを更新しました。これにより、ランダムを生成する範囲の最大 64 倍 (私はそう思います...) までメモリを節約できます。

Answer 1

より簡単な方法として、必要な間隔で一連の数値を生成し、それらをシャッフルします。次に、乱数が必要な場合は、そのリストから次の乱数を取り出します。

これにより、目的の間隔内のすべての数値が一度だけ存在し、取得された各乱数が一意であり、それを通過すると間隔全体が使い果たされることが保証されます。

私が理解しているように、これらはあなたの要件を満たしています。

Answer 2

次のコードは簡単にテストされており、おそらく最も美しいスタイルではありませんが、それでも機能するはずであり、あなたのコードよりも少し単純だと思います。私のアルゴリズムはあなたのアルゴリズムの反対と見なすことができます。すでに選択された数値のセットに乱数を追加する代わりに、可能な整数の完全なセットから始めて、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コーダーなので、このコードをより読みやすい方法で書き直すことができると確信しています。