Posted 2008-07-06 06:25:00 GMT

機能を順に紹介して行くのも良いのですが、実際に手を動かしてみるのも良いだろうということで、意味なくL-99のP25まで、無理にLOOPを使って解いてみました。



;; P01 (defun last-pair (list) (loop :for x :on list :when (atom (cdr x)) :return x)) (last-pair '(1 2 3 4)) ;=> (4) (last-pair '(1 2 3 . 4)) ;=> (3 . 4) ;; P02 (defun last-2-pair (list) (loop :for x :on list :when (atom (cddr x)) :return x)) (last-2-pair '(1 2 3 4)) ;=> (3 4) (last-2-pair '(1 2 3 . 4)) ;=> (2 3 . 4) ;; P03 (defun element-at (list position) (loop :for p := 1 :then (1+ p) :for x :in list :when (= position p) :return x)) (element-at '(a b c d e) 13) ;=> NIL (element-at '(a b c d e) 3) ;=> C ;; P04 (defun len (list) (loop :for x :in list :count 'T)) (len '(1 2 3 4)) ;=> 4 ;; P05 (defun rev (list) (loop :for a := (copy-list list) :then (prog1 (cdr a) (rplacd a b)) :and b := () :then a :when (null a) :return b)) (rev '(1 2 3 4)) ;=> (4 3 2 1) ;; P06 (defun palindrome-p (list) (loop :for nom :in list :and rev :in (reverse list) :always (equal nom rev))) (palindrome-p '(1 2 3 2 1)) ;=> T ;; P07 (defun flatten (list) (loop :for x :in list :if (listp x) :append (flatten x) :else :collect x)) (flatten '(1 2 3 (4 5 (6 (7 (8 (9 (((10((((((())))))))))))))))) ;=> (1 2 3 4 5 6 7 8 9 10) ;; P08 (defun compress (list) (loop :for x :in list :and prev := (gensym) :then x :unless (equal prev x) :collect x)) (compress '(a a a a b c c a a d e e e e)) ;=> (A B C A D E) ;; P09 (defun pack (list) (loop :for x :in (nconc (copy-list list) (list (gensym))) :and prev := (gensym) :then x :and tem := () :then (cons x tem) :unless (or (equal prev x) (null tem)) :collect tem :and :do (setq tem () ) :end)) (pack '(a a a a b c c a a d e e e e e)) ;=> ((A A A A) (B) (C C) (A A) (D) (E E E E E)) ;; P10 (defun encode (list) (loop :for x :in (pack list) :collect `(,(length x) ,(car x)))) (encode '(a a a a b c c a a d e e e e)) ;=> ((4 A) (1 B) (2 C) (2 A) (1 D) (4 E)) ;; P11 (defun encode-modified (list) (loop :for x :in (pack list) :when (= 1 (length x)) :collect (car x) :else :collect `(,(length x) ,(car x)))) (encode-modified '(a a a a b c c a a d e e e e)) ;=> ((4 A) B (2 C) (2 A) D (4 E)) ;; P12 (defun decode (list) (loop :for x :in list :when (atom x) :collect x :else :append (make-list (first x) :initial-element (second x)))) (decode '((4 A) B (2 C) (2 A) D (4 E))) ;=> (A A A A B C C A A D E E E E) ;; P13 (defun encode-direct (list) (loop :for x :in (nconc (copy-list list) (list (gensym))) :and prev := (gensym) :then x :and tem := () :then (cons x tem) :and cnt := 0 :then (1+ cnt) :unless (or (equal prev x) (null tem)) :when (= 1 cnt) :collect prev :else :collect (list cnt prev) :end :and :do (setq tem () cnt 0) :end)) (encode-direct '(a a a a b c c a a d e e e e)) ;=> ((4 A) B (2 C) (2 A) D (4 E)) ;; P14 (*) Duplicate the elements of a list. (defun dupli (list) (loop :for x :in list :nconc (list x x))) (dupli '(a b c c d)) ;=> (A A B B C C C C D D) ;; P15 (defun repli (list times) (loop :for x :in list :nconc (loop :repeat times :collect x))) (repli '(a b c) 3) ;=> (A A A B B B C C C) ;; P16 (defun drop (list n) (loop :for x :in list :and pos :from 1 :unless (zerop (mod pos n)) :collect x)) (drop '(a b c d e f g h i k) 3) ;=> (A B D E G H K) ;; P17 (defun split (list n) (loop :for x :on list :for pos :from 1 :when (> pos n) :do (return-from split (list tem x)) :else :collect (car x) :into tem) :end :finally (return-from split (list list () ))) (split '(a b c d e f g h i k) 3) ;=> ((A B C) (D E F G H I K)) ;; P18 (defun slice (list start end) (loop :for x :in list :for pos :from 1 :when (<= start pos end) :collect x :into res :finally (return res))) (slice '(a b c d e f g h i k) 3 7) ;=> (C D E F G) ;; P19 (defun rotate (list n) (loop :with n := (mod n (length list)) :for x :on list :for pos :from 1 :when (> pos n) :do (return-from rotate (append x tem)) :else :collect (car x) :into tem) :end :finally (return-from rotate list)) (rotate '(a b c d e f g h) 3) ;=> (D E F G H A B C) ;; P20 (defun remove-at (list n) (loop :for x :in list :and pos :from 1 :unless (= pos n) :collect x)) (remove-at '(a b c d) 2) ;=> (A C D) ;; P21 (defun insert-at (item list n) (loop :for x :in list :and pos :from 1 :when (= pos n) :append (list item x) :else :collect x)) (insert-at 'alfa '(a b c d) 2) ;=> (A ALFA B C D) ;; P22 (defun range (start end) (loop :for i :from start :to end :collect i)) (range 4 9) ;=> (4 5 6 7 8 9) ;; P23 (defun remove-at (list n) "取り除く要素/残りの多値を返すバージョン" (loop :for x :in list :and pos :from 1 :unless (= pos n) :collect x :into res :else :collect x :into item :finally (return-from remove-at (values res item)))) (remove-at '(1 2 3 4) 4) ;=> (1 2 3),(4) (defun rnd-select (list n) (flet ((choose (lst) (multiple-value-list (remove-at lst (1+ (random (length lst))))))) (loop :for i :from 1 :to (min n (length list)) :for (tem x) := (choose list) :then (choose tem) :append x))) (rnd-select '(a b c d e f g h) 7) ;=> (H E G F D B C) ;; P24 (defun lotto-select (n range) (rnd-select (range 1 range) n)) (lotto-select 6 49) ;=> (14 37 4 8 9 46) ;; P25 (defun rnd-permu (list) (rnd-select list (length list))) (rnd-permu '(a b c d e f)) ;=> (A C B F D E)

「できるだけLOOPマクロ内で完結させる」ということをテーマに書いてみました。自分はLOOPマクロは苦手でしたが、それでも200行位LOOPばっかり書けば、いい加減馴れて来るようです…。