重複無し乱数 in Common Lisp DouKaku?

整数nを渡すと1 ～ n までの整数を重複しないようランダムに出力する関数「bingo」を作ってください。

このお題はraynstardさんの投稿を元にしています。ご投稿ありがとうございました。投稿の内容には表示のしかたも含まれていたのですが、このお題では「重複しない1～nまでの乱数をどうやって作るか」という点に集中することにして、結果の整形は続編としてこの後のお題で出すことにします。サンプル入出力は下のようになります。

>>> bingo(10)
[10, 7, 8, 4, 5, 2, 3, 1, 6, 9]
>>> bingo(3)
[2, 3, 1]
>>> bingo(3)
[2, 3, 1]
>>> bingo(3)
[3, 1, 2]
>>> bingo(10)
[7, 3, 8, 6, 4, 10, 9, 2, 1, 5]

(print (bingo 10))
 => (2 4 8 10 6 7 5 9 3 1)

(defun bingo (n)
  (loop repeat n
        for rand = (loop 
                     (let* ((*random-state* (make-random-state t))
                            (rand (1+ (random n))))
                       (if (not (member rand lst))
                         (return rand))))
        collect rand into lst
        finally (return lst)))

1-n のリストを作っといてランダムに取り出せばいいかなと思いましたが、
それだとあまりきれいにいかなくて考えた末こうなりました。

コメントアウトを外すとわかりやすいと思いますが
リングをランダムに回しながら取り出すようなイメージで作ってます。

(defun bingo (n)
  (let ((r '#1=(nil . #1#)))
    (do ((i 1 (1+ i)))
        ((> i n))
      (push i (cdr r)))
    (let (buf)
      (do ((i n (1- i))
           (st (make-random-state t)))
          ((= i 0))
        (push (pop (cdr (nthcdr (random i st) r)))
              buf)
        ;; (write r :circle t) (terpri)
        )
      (write buf))))

ランダムシャッフルならリストより配列を使った方がいいですね。理由は簡単で要素にアクセスする時間からです。

(defun bingo(max)
  (let ((vec (make-array 0 :fill-pointer t)))
    (loop for i from 1 to max do
     (vector-push-extend i vec))
    (loop for i from max downto 1 collect
     (if (equal i 1)
         (vector-pop vec)
         (let ((loc (random i)))
           (rotatef (aref vec (1- i))
            (aref vec loc))
           (vector-pop vec))))))

arefはsvrefより遅いのでsvref版を用意しました。

(defun bingo-v2(max)
  (let ((vec (make-array max)))
    (loop for i from 1 to max do
     (setf (svref vec (1- i)) i))
    (loop for i from max downto 1 collect
     (if (equal i 1)
         (svref vec (1- i))
         (let ((loc (random i))
           (ii (1- i)))
           (rotatef (svref vec ii) (svref vec loc))
           (svref vec ii))))))

svref と arefの差は次のようなものです。
consingで2/3  実時間で1/2.5程度ですかね。
--
CL-USER> (time (and (bingo 100000) nil))
Evaluation took:
  0.074 seconds of real time
  0.056004 seconds of user run time
  0.004001 seconds of system run time
  0 calls to %EVAL
  0 page faults and
  3,698,800 bytes consed.
NIL
CL-USER> (time (and (bingo-v2 100000) nil))
Evaluation took:
  0.027 seconds of real time
  0.016001 seconds of user run time
  0.0 seconds of system run time
  0 calls to %EVAL
  0 page faults and
  2,397,456 bytes consed.
NIL

最後に最適化オプションをつけて。。。bingo_v2より1/2の時間
になりましたね。

CL-USER> (time (and (bingo-v3 100000) nil))
Evaluation took:
  0.013 seconds of real time
  0.016001 seconds of user run time
  0.0 seconds of system run time
  0 calls to %EVAL
  0 page faults and
  2,397,536 bytes consed.
NIL

(defun bingo-v3(max)
  (declare (optimize (speed 3) (debug 0) (safety 0)))
  (declare (fixnum max))
  (let ((vec (make-array max)))
    (declare (simple-vector vec))
    (loop for i from 1 to max do
     (setf (svref vec (1- i)) i))
    (loop for i from max downto 1 collect
     (if (equal i 1)
         (svref vec (1- i))
         (let ((loc (random i)) (ii (1- i)))
           (rotatef (svref vec ii) (svref vec loc))
           (svref vec ii))))))

DouKaku?

重複無し乱数

Posted feedbacks - Common Lisp

Index

Feed

Other

Link

Pathtraq