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-07-11

サンプルコードによるITERATEマクロ入門 (番外編)

| 13:50 | サンプルコードによるITERATEマクロ入門 (番外編) - わだばLisperになる を含むブックマーク はてなブックマーク - サンプルコードによるITERATEマクロ入門 (番外編) - わだばLisperになる

LOOPマクロも一段落ついた気がするので、LOOPマクロのように繰り返し処理をを便利にするマクロであるITERATEを紹介してみることにしました。

インストール

(asdf-install:install :iterate)

一発です。

良いなと思ったところ

  1. LOOPマクロを知っていれば、ちょっとマニュアルを読むくらいで書けるようになる。
  2. 外の世界の(通常のCLの)制御構文が使える。

不便だなと思ったところ

  1. ループ変数を並列に束縛できない。DOマクロで言えば、DO*しかない。回避するための仕組みもあるようですが、それを使ってもいまいち挙動が把握できない気がします。

使ってみる

どんなものか自分でもあまり良く分かっていないので、なんとなくL-99を25問目まで解いてみました。

(defpackage :l99-iter (:use :cl :iterate))
(in-package :l99-iter)

;; P01
(defun last-pair (list)
  (iter (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)
  (iter (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)
  (iter (for p :from 1)
        (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)
  (iter (for x :in list)
        (count 'T)))

(len '(1 2 3 4))
;=> 4

;; P05
(defun rev (list)
  (iter (for tem :initially () :then a)
        (for a :initially (copy-list list)
               :then (prog1 (cdr a) (rplacd a b)))
        (for b :initially () :then tem)
        (when (null a) 
          (return b))))

(rev '(1 2 3 4))
;=> (4 3 2 1)

;; P06
(defun palindrome-p (list)
  (iter (for nom :in list)
        (for rev :in (reverse list))
        (always (equal nom rev))))

(palindrome-p '(1 2 3 2 1))
;=> T

;; P07
(defun flatten (list)
  (iter (for x :in list)
        (if (listp x)
            (appending (flatten x))
            (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)
  (iter (for x :in list)
        (for prev :initially (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)
  (iter (for x :in (nconc (copy-list list) (list (gensym))))
        (for prev :initially (gensym) :then x)
        (for tem :initially () :then (cons x tem))
        (unless (or (equal prev x) (null tem))
          (collect tem)
          (setq tem ()))))

(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)
  (iter (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)
  (iter (for x :in (pack list))
        (collect
            (if (= 1 (length x)) 
            (car x)
            `(,(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)
  (iter (for x :in list)
        (if (atom x)
            (collect x)
            (appending
             (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)
  (iter (for x :in (nconc (copy-list list) (list (gensym))))
        (for prev :initially (gensym) :then x)
        (for tem :initially () :then (cons x tem))
        (for cnt :initially 0 :then (1+ cnt))
        (unless (or (equal prev x) (null tem))
          (collect
              (if (= 1 cnt) 
                  prev
                  (list cnt prev)))
          (setq tem () cnt 0))))

(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)
  (iter (for x :in list)
        (nconcing (list x x))))

(dupli '(a b c c d))
;=> (A A B B C C C C D D)

;; P15
(defun repli (list times)
  (iter (for x :in list)
        (nconcing (iter (repeat times)
                        (collect x)))))

(repli '(a b c) 3)
;=> (A A A B B B C C C)

;; P16
(defun drop (list n)
  (iter (for x :in list)
        (for 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)
  (iter (for x :on list)
        (for pos :from 1)
        (if (> pos n) 
            (return (list tem x))
            (collect (car x) :into tem))
        (finally (return (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)
  (iter (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)
  (iter (with n := (mod n (length list)))
        (for x :on list)
        (for pos :from 1)
        (if (> pos n) 
            (return (append x tem))
            (collect (car x) :into tem))
        (finally (return 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)
  (iter (for x :in list)
        (for 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)
  (iter (for x :in list)
        (for pos :from 1)
        (if (= pos n)
          (appending (list item x))
          (collect x))))

(insert-at 'alfa '(a b c d) 2)
;=> (A ALFA B C D)

;; P22
(defun range (start end)
  (iter (for i :from start :to end)
        (collect i)))

(range 4 9)
;=> (4 5 6 7 8 9)

;; P23
(defun remove-at (list n)
  "取り除く要素/残りの多値を返すバージョン"
  (iter (for x :in list)
        (for pos :from 1)
        (if (/= pos n)
            (collect x :into res)
            (collect x :into item))
        (finally (return (values res item)))))

(remove-at '(1 2 3 4) 4)
;=> (1 2 3),(4)

(defun rnd-select (list n)
  (flet ((choose (lst)
           (if (null lst)
               ()
               (multiple-value-list 
                (remove-at lst (1+ (random (length lst))))))))
    (iter (repeat (min n (length list)))
          (for (tem x) :initially (choose list) :then (choose tem))
          (appending x))))

(rnd-select '(a b c d e f g h) 8)
;=> (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マクロ入門 (10)

| 13:07 | サンプルコードによるLOOPマクロ入門 (10) - わだばLisperになる を含むブックマーク はてなブックマーク - サンプルコードによるLOOPマクロ入門 (10) - わだばLisperになる

initially節とfinally節

繰り返し処理の流れとしては、

  1. 変数の初期化等の前準備
  2. 繰り返し本体
  3. 後始末

等が多いかと思いますが、LOOPでは、initiallyで、前準備の節を、finallyで後始末の節を区切ることができます。

  • :finally

後始末を:finallyキーワードの後に書くと繰り返し終了時にまとめて実行されます。

(loop :repeat 5 
      :collect (random 10) :into rs
      :collect (gensym) :into gs
      :finally (return (list rs gs)))
;=> ((5 3 3 0 6) (#:G2112 #:G2113 #:G2114 #:G2115 #:G2116))

返り値を返したい場合は、明示的に(return)する必要があります。

  • :initially

:initiallyは、他の構文で代用できることが多いためか、実際の使用例は殆ど見掛けません。

あえて、

(prog (list ans)
      (setq list '(1 2 3 4 5))
  L   (cond ((null list) (return (nreverse ans))))
      (push (* 2 (pop list)) ans)
      (go L))
;=> (2 4 6 8 10)

;; ※はるか昔のPROGでは、変数宣言と、初期化は同時にできなかった

のような古えのPROGを使った繰り返しのイディオムをそのまま移植したりするのには便利かもしれません。

(loop :with list :and ans
      :initially (setq list '(1 2 3 4 5))
      :when (null list) :return (nreverse ans)
      :do (push (* 2 (pop list)) ans))
;=> (2 4 6 8 10)

ゲスト



トラックバック - http://cadr.g.hatena.ne.jp/g000001/20080711