DouKaku?

;
; choose-winners for common lisp version 0.2 by ytakenaka
;
; 使い方: (choose-winners 候補者リスト 選ぶ人の数) => 当選者リスト
;     (choose-winners '(john taro mika mick) 2)
;            example: =>  (john taro)  リスト内で選ばれたもの
;
; (エラー処理)
; 候補者リスト: ドット付きリスト や リスト以外のもの => nil
; 選ぶ人の数：  候補者リストの長さより大きい => nil
; 選ぶ人の数：  負 => nil

(defun choose-winners (candidates-list number)
  (labels ((choose-1 (candit-lst len)
             ; 候補者リストから一人の当選者と当選者を除いた残りのリストを多値で返す関数
             ; candit-lst 候補者リスト len 候補者リストの大きさ
             (let* ((select-num (random len))
                    (select-el (nth select-num candit-lst)))
               (values select-el (remove select-el candit-lst :count 1))))

           (choose-n (lst winners-lst num len)
             ; 候補者リストからnum人の当選者を選ぶ関数
             ; lst 候補者リスト winners-lst 当選者リスト
             ; num 残り当選者数 len 候補者リストの大きさ
             (if (zerop num)
                 ; 残り当選者数が０になったときに当選者リストを返す。
                 winners-lst
                 (multiple-value-bind (winner rest)
                     (choose-1 lst len)
                   ; 当選者を当選者リストにくわえて、残りの候補者リストを再帰させる。
                   (choose-n rest (cons winner winners-lst)
                             (1- num) (1- len)))))) 

    (and (consp candidates-list)
         (null (cdr (last candidates-list)))
         (let ((length (length candidates-list)))
           (when (and (>= length number) (< 0 number))
                (choose-n candidates-list nil number length))))))

(defun lot (n m)
  "lot 対象人数 当選者数 => 当選者番号のリスト"
  (labels ((range (x acc)    ;レンジを作成する関数
                  (if (zerop x) acc 
                    (range (1- x) (cons x acc))))
           (draw (lst acc)   ;くじを引く関数
                 (if (<= m (length acc))
                   acc
                   (let* ((winner 
                            (nth (random (length lst) (make-random-state t)) lst))
                          (loosers
                            (remove-if #'(lambda (x) (eql winner x)) lst)))
                     (draw loosers (cons winner acc))))))
    (draw (range n nil) nil)))

(defun lot (n m)
  (let ((lot (loop for i from 1 to n collect i)))
    (loop repeat m collect
         (let ((x (nth (random (length lot)) lot)))
           (setf lot (delete x lot))
           x))))

(defun lot (n m &optional (lst (let ((i 0))
                                 (mapcar #'(lambda (x) (+ (incf i) x))
                                         (make-list n :initial-element 0)))))
  (and
   (= (length lst) n)
   (labels
       ((pickup (lst m)
          (labels
              ((pickup1 (lst n m acc)
                 (if (or (zerop n) (zerop m))
                     acc
                   (let ((r (random n)))
                     (if (zerop r)
                         (pickup1 (cdr lst)
                                  (1- n)
                                  (1- m)
                                  (cons (car lst) acc))
                       (pickup1 (nconc (subseq lst 0 r)
                                       (subseq lst (1+ r)))
                                (1- n)
                                (1- m)
                                (cons (nth r lst) acc)))))))
            (pickup1 lst n m nil))))
     (pickup lst m))))