Hatena::Groupcadr

わだばLisperになる このページをアンテナに追加 RSSフィード

2004 | 12 |
2005 | 01 | 02 | 07 | 10 | 11 |
2006 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2007 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2008 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2009 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2010 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2011 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 11 |

2008-05-24

CLOSでL-99 (P23 ランダムに指定した個数を選択)

| 13:08 | CLOSでL-99 (P23 ランダムに指定した個数を選択) - わだばLisperになる を含むブックマーク はてなブックマーク - CLOSでL-99 (P23 ランダムに指定した個数を選択) - わだばLisperになる

P20で定義したREMOVE-ATを使えとありますが、L-99の元になったP-99では、REMOVE-ATが結果と残りのリストの両方を結果として返すものなので、このお題で使えるということのようです。

ということで、REMOVE-ATを修正して使ってみました。

しかし無駄に長いなあ…。

(rnd-select '(a b c d e f g h) 3)
;=> (G A F)

(rnd-select #(a b c d e f g h) 3)
;=> #(D E G)

(rnd-select "abcdefgh" 3)
;=> "gbc"

(defgeneric RND-SELECT (sequence number)
  (:documentation
"P23 (**) Extract a given number of randomly selected elements from a list.
    The selected items shall be returned in a list." ))

(defmethod RND-SELECT :around ((sequence sequence) (count integer))
  (let ((len (length sequence)))
    (cond ((zerop len) sequence)
          ((or (> 1 count) (< len count)) 
           (MAKE-EMPTY-SEQUENCE sequence))
          ('T (call-next-method sequence count)))))

(defmethod RND-SELECT ((sequence sequence) (count integer))
  (loop :with seq := sequence
        :with res := ()
        :for len := (length seq) :then (1- len) 
        :for i :from count :downto 1 :when (> 1 count) :do (loop-finish)
        :do (multiple-value-bind (s item) (REMOVE-AT seq (1+ (random len)))
              (push item res)
              (setq seq s))
        :finally (return (coerce res (class-of sequence))))))

(defgeneric REMOVE-AT (sequence position)
  (:documentation "P20 (*) Remove the K'th element from a list."))

(defmethod REMOVE-AT ((sequence sequence) (position integer))
  (values (concatenate (class-of sequence)
                       (subseq sequence 0 (1- position)) 
                       (subseq sequence position))
          (elt sequence (1- position))))

(defgeneric make-empty-sequence (obj))
(defmethod make-empty-sequence ((obj list)) 
  () )
(defmethod make-empty-sequence ((obj vector))
  (make-array 0))
(defmethod make-empty-sequence ((obj string))  
  (make-string 0))