Emacs 在循环中生成唯一的随机数
好的，经过几个小时疯狂的调试，我终于有了这个：Emacs 在循环中生成唯一的随机数,emacs,random,lisp,elisp,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)
(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))
(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)
（按数组定义pprint
（阵列和可选的每字节二进制位分隔符）
（除非是每字节位（setq每字节位32））
（除非是字节分隔符（setq字节分隔符“，”））
让（结果）
（输出为字符串）
（普林斯“[”）
（++）（对于数组中的i）
（如果是bigendian
（++（对于从0到（-位/字节）的j）
（普林斯（logand 1（lsh i j）））
（++（对于j，从（-bits/byte）到0）
（普林斯（logand 1（lsh i j()()))）
（主字节分隔符(()()))）
（如果（>（长度结果）1）
（aset结果（1-（长度结果））？\]）
（setq结果（concat结果“]”）
结果)
（定义范围内的随机数（限位和可选位）
（除非位（setq位31））
（let（（i 0）（测试（使字符串限制？-））
（缓存（生成向量（上限位）0））
下一个随机搜索
左移（右移）
（虽然（左移0）
（setq除数（左移位位）
提醒（lsh 1（-左移位（*除数位）））
（如果（=（日志和（aref缓存除数）提醒）0）
（setf下一个随机左移
搜索零
（aref缓存除数）
（登录人（aref缓存除数）提醒）
（decf左移）
向右走，再试一次
（何时（和搜索（<右移限制））
（setq除数（地板右移位位）
提醒（lsh 1（-右移（*除数位）））
（如果（=（日志和（aref缓存除数）提醒）0）
（setf下一次随机右移）
搜索零
（aref缓存除数）
（登录人（aref缓存除数）提醒）
（incf右移(()()))）
（incf i）
（消息“缓存：%s”（pprint bytearray缓存t 31“”）
（何时（字符相等（aref测试下一个随机）？x）
（下次随机掷零）
（aset测试下一个随机？x）
（消息“下一个随机：%d”下一个随机）））
（随机范围为100）
好的，我终于想出了如何使用比特面具。更新了上面的代码。这可以节省多达64倍的内存（我想是的…），在这个范围内，您可以生成随机数。对于一种更简单的方法，只需在所需的间隔内生成一个数字序列，然后将它们洗牌。然后，当你需要一个随机数时，只需从列表中删除下一个 这样可以确保所需间隔中的所有数字都存在一次且仅存在一次，并且获取的每个随机数都是唯一的，并且如果您通过它，整个间隔将被耗尽
据我所知，这些代码满足了您的需求。以下代码经过了少量测试，可能不是最漂亮的样式，但我仍然认为它应该可以工作，并且比您的代码简单一些。我的算法可以被视为与你的算法相反：我不是向已经选择的数字集合中添加随机数，而是从可能的整数集合开始，并从中删除
Ipick(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)
（卸下捡拾器（索引袋）
“在BAG描述的集合中的位置索引处拾取整数
包的形式为（（min0.max0）（min1.max1）…）
结果以以下形式返回：（n.新包）
其中N是拾取的整数，NEW-BAG是通过
从袋子里取出氮。”
（让*（（范围（汽车包））；；集合中的第一个范围，
（beg（car range））；；形式（beg.end）
（结束（cdr范围））；；
（last（-end beg））；；范围中最后一个元素的索引
（如有）（64 26 43 44 55 5 89 20 12 25）
您可能比我更擅长编写LISP代码，因此我相信您将能够以更清晰的方式重写这段代码。好吧；我的目标是简单，我认为这是您的目标之一。在这种情况下，懒惰列表会摇摆不定：）
(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)