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 |

2007-11-02

Series (1)

| 20:39 |  Series (1) - わだばLisperになる を含むブックマーク はてなブックマーク -  Series (1) - わだばLisperになる

CLTL2の巻末の付録にも載っていて非常に魅力的にも見えるseriesですが、全然使い方が分からないので、loopの解説と対照させつつ機能を散策してみることにしました。

下記のloopマクロを解説したサイトさんを参考にさせて頂きました。

こちらの方々のloopの事例を拾ってSERIESに変換してみています。

元々使い方が分ってないので、妙なところもあるんじゃないかと思います。

下準備

SERIESはasdf-install可能です。

(asdf-install:install :series)

いろいろなケースをSERIESで処理してみる

(use-package "SERIES")
リスト
(loop for i from 10 to 50 by 5 collect i)
;==> (10 15 20 25 30 35 40 45 50)

;; SERIESで
(collect (scan-range :from 10 :upto 50 :by 5))

まず、SERIESの作法としては、scan~でシリーズと呼ばれる列を生成し、collect~や、mapping、iterateでシリーズを加工するという流れのようです。

上では、scan-rangeでシリーズを作成し、collectでシリーズのアイテムを集めてリストに変換しています。

(loop for x in '(1 2 3 4) by #'cddr collect x) 

;; SERIESで
(collect
    (choose (series t nil)
	    (scan '(1 2 3 4))))
;==> (1 3) ; 一つ飛ばし

一つ飛しというのが良く分からず、chooseで選択しています。

(series t nil)で、tとnilが無限に続いたシリーズを作成し、それと、(scan '(1 2 3 4))を重ね合せることによってtの部分だけ拾っています。

(loop for x on '(1 2 3) collect x) 
;==> ((1 2 3) (2 3) (3))

;; SERIESで
(collect (scan-sublists '(1 2 3)))
(loop for x on '(1 2 3 4 5) by #'cddr collect x)
;==> ((1 2 3 4 5) (3 4 5) (5))

;; SERIESで
(collect
  (choose (series t nil)
	  (scan-sublists '(1 2 3 4 5))))
ハッシュ
;; 下準備
(defvar ht (make-hash-table))
(setf (gethash 'foo ht) 1)
(setf (gethash 'bar ht) 2)
(loop for x being the hash-keys in ht collect x)
; ==> (BAR FOO)

;; SERIESで
(collect (scan-hash ht))
(loop for x being the hash-keys in ht using (hash-value y) collect (cons x y))
;==> ((BAR . 2) (FOO . 1))

;; SERIESで
(collect
  (mapping (((k v) (scan-hash ht)))
    (cons k v)))

scan-hashはキーと値の多値を返すので、それをmappingで拾っています。

分割代入
(loop :for (a b) in '((1 2) (3 4) (5 6) (8))
      :collecting (list a b 'foo))
;==> ((1 2 FOO) (3 4 FOO) (5 6 FOO) (8 NIL FOO)) 

;; SERIESで
(collect 
  (mapping ((x (scan '((1 2) (3 4) (5 6) (8)))))
    (destructuring-bind (a &optional b) x
      (list a b 'foo))))

分割代入の機構は存在するのかどうかが分からなかったので、mappingの内部でdestructuring-bindを使用しています。

要素ごとに処理
(loop for i in '(1 2 3) do (print i))
;1
;2
;3

;; SERIESで
(iterate ((x (scan '(1 2 3))))
  (print x))

mapppingとiterateは、mapcarとmapcのような関係です。ということで、副作用が目的なので、iterateを使っています。

(loop for i on '(1 2 3) do (print i))
;(1 2 3)
;(2 3)
;(3)

;; SERIESで
(iterate ((x (scan-sublists '(1 2 3))))
  (print x))
(loop for i across #(1 2 3) do (print i))
;1
;2
;3

;; SERIESで
(iterate ((i (scan #(1 2 3))))
  (print i))

リスト、ベクタ、ストリング等は普通にscanで処理できます。

数値の範囲を処理
(loop for i from 1.0 to 3.0 by 0.5 do (print i))
;==>1.0
;   1.5 
;   2.0 
;   2.5 
;   3.0 

;; SERIESで
(iterate ((i (scan-range :from 1 :upto 3 :by 0.5)))
  (print i))
(loop for i from 3 downto 1 do (print i))
;==>3
;   2
;   1

;; SERIESで
(iterate ((i (scan-range :from 3 :by -1 :above 0)))
  (print i))

;downtoもあるようなのですが、手元の環境では上手く動かなかったため、:byにマイナスの数値を指定しています。

(loop for i from 3.0 downto 1.0 by 0.5 do (print i))
;==>3.0 
;   2.5 
;   2.0 
;   1.5 
;   1.0 

;; SERIESで
(iterate ((i (scan-range :from 3 :by -0.5 :above 0.5)))
  (print i))
> (loop for i from 1 to 3 for x = (* i i) do (print x))
;==>1
;   4
;   9

;; SERIESで
(iterate ((i (scan-range :from 1 :upto 3)))
  (let ((x (* i i)))
    (print x)))

iterateのボディで普通に計算してみています。seriesを加工するという手もあるのかもしれません。

フィルタリング
(loop for i from 1 to 3 when (oddp i) collect i)
;==> (1 3)

;; SERIESで
(collect
  (choose 
   (mapping ((i (scan-range :from 1 :upto 3)))
     (when (oddp i)
       i))))
  • scan-rangeで1~3のシリーズを作成
  • mappingは節の最後に評価された値を集める(#Z(1 nil 3)のようになる。)
  • chooseでシリーズからnilのアイテムを捨てる
  • collectでリストに変換

もっと短く書く方法があるに違いないですが、とりあえず…。

まとめ

以上、まだまだシリーズの一部なのですが、独自の作法はあるもののseriesは、なかなか便利な気がします。

Common Lispの標準に取り込まれることも検討されていたらしいですが、もし取り込まれていたらまた面白い展開があったような気がします。さらに巨大化しちゃいますが…。

今後もまたシリーズで処理できる例題を探して変換してみたいと思います。

Common Idioms (3)

| 15:09 | Common Idioms (3) - わだばLisperになる を含むブックマーク はてなブックマーク - Common Idioms (3) - わだばLisperになる

Brian Mastenbrook氏のCommon Idiomsを拾い読みしてみることの3回目

Common Idioms→CLiki: common-idioms

お題

run-tests

暗記で再現:間違えた

(defmacro run-tests (&rest tests)
  (let ((*print-case* :upcase))
    (with-gensyms (e j)
      `(let ((*print-case* :upcase))
	 (loop for ,j in ',(mapcar (lambda (test) 
				     (cons
				      test
				      (format nil "Test ~A: ~~A~%" test)))
				   tests)
	    for ,e = (apply #'funcall (car ,j))
	    do (format t (cdr ,j) ,e)
	    collect ,e)))))
;; 正解
(defmacro run-tests (&rest tests)
  "Run the functions named by the supplied TESTS (not evaluated),
printing and collecting their values."
  (let ((*print-case* :upcase))
    (with-gensyms (e j)
      `(let ((*print-case* :upcase))
         (loop for ,e in (list ,@(mapcar #'(lambda (test) (list 'cons `(function ,test) (format nil "Test ~A: ~~A~%" test))) tests))
            for ,j = (funcall (car ,e))
            do (format t (cdr ,e) ,j)
            collect ,j)))))

間違えた。テストの関数を実行するものだったのに式を実行するものと勘違いして随分悩んだ。(apply #'funcall)などとしているのはそのため。

;; 動作
(run-tests (lambda() (print "foo"))
	   (lambda() (print "bar"))
	   (lambda() (print "zot")))

=>
;Test (LAMBDA () (PRINT foo)): foo
;Test (LAMBDA () (PRINT bar)): bar
;Test (LAMBDA () (PRINT zot)): zot

お題

macroexpand-n

暗記で再現:間違えた

(defmacro macroexpand-n (n expr)
  (if (eql n 1)
      `(macroexpand-1 ,expr)
      `(macroexpand-1 (macroexpand-n ,(1- n) ,expr))))

;; 正解
(defmacro macroexpand-n (n form)
  "MACROEXPAND-1 FORM recursively N times."
  (if (eql n 1)
      `(macroexpand-1 ,form)
      `(macroexpand-n ,(1- n) (macroexpand-1 ,form))))

間違えた。再帰の部分で入れ子の順番を間違えた。しかし結果は一緒なんだけれど、これら2つ詳細な動作がどう違うのか/違わないのか、良く分からない…。

;; 動作
(defmacro pg (arg &rest body)
  `(prog (,arg)
      ,@body))

(macroexpand-n 1 '(pg () (print "hello")))
=>
(PROG (NIL) (PRINT "hello")) 

(macroexpand-n 2 '(pg () (print "hello")))
=>
(BLOCK NIL
  (LET (())
    (TAGBODY (PRINT "hello"))))