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)