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-31

Common Lispと改行コード

| 10:47 | Common Lispと改行コード - わだばLisperになる を含むブックマーク はてなブックマーク - Common Lispと改行コード - わだばLisperになる

最近、勉強会の進行などをしているため、分からないことは、はっきり説明できるまで書けないような気持ちになってしまっていますが、よくよく内省してみれば、自分はただの初心者日曜プログラマなので、妙に自分の中で敷居を高くすることはせず、間違ったことに対しては、ツッコミを期待するとして、思い付いたことを素直に書くことにしました。

とはいえ、あんまり「初心者、初心者」と連呼する訳にもいかない流れにはまってしまうこともあるので、そういう場合はしょうがないですね…。

でも、きちんとしたことはきちんとした人が書けば良いのです(笑)

ということで、zickさんの「リリカル☆Lisp開発日記 » ページが見つかりませんでした」のエントリを読んだので、そういえば、改行問題ってありますなーと思いつつ。自分も対策を知らないのでエントリを書いてみることにしました。

CRやLFの扱いついては、確か、色々問題があったのをどっかで読んだ憶えがあるのですが、見付けられませんでした(^^;

たしか、#\Linefeedや、#\Returnという文字のCLでの扱い自体にも問題があったような…。

ということで、自分ならどうするのかということでコードを書いてみたのですが、遅そうですねー。

;; 虫入り
(defun chomp-read-line (&optional (stream *standard-input*) (eof-error-p t)
                                  eof-value recursive-p)
  (let ((line (read-line stream eof-error-p eof-value recursive-p)))
    (if (eq line eof-value)
        eof-value
        (let ((pos (position #\Return line :from-end 'T)))
          (if pos
              (subseq line 0 pos)
              line)))))

;; 修正したもの
(defun chomp-read-line (&optional (stream *standard-input*) (eof-error-p t)
                                  eof-value recursive-p)
  (let* ((line (read-line stream eof-error-p eof-value recursive-p))
         (llen (length line)))
    (if (eq line eof-value)
        eof-value
        (delete #\Return line :from-end t :end llen :start (1- llen)))))

(print (series:scan-file "/tmp/foo.txt" #'read-line))
;=> #Z("こんにちは^M" "おはようございます^M") 

(print (series:scan-file "/tmp/foo.txt" #'chomp-read-line))
;=> #Z("こんにちは" "おはようございます") 

この方式で対処する場合、この例のようにラッピングするのではなく、逆に遡ってカスタマイズしたread-lineを書くことになるのでしょうか。

CLで学ぶ「プログラミングGauche」 (9.4)

| 08:49 | CLで学ぶ「プログラミングGauche」 (9.4) - わだばLisperになる を含むブックマーク はてなブックマーク - CLで学ぶ「プログラミングGauche」 (9.4) - わだばLisperになる

9.4 連想リストふたたび

連想リストについての復習といった感じ。

元の連想リストを破壊的に変更したりする例を取り上げています。

CLでも同じ感じかなと。

2008-07-30

CLで学ぶ「プログラミングGauche」 (9.3)

| 08:05 | CLで学ぶ「プログラミングGauche」 (9.3) - わだばLisperになる を含むブックマーク はてなブックマーク - CLで学ぶ「プログラミングGauche」 (9.3) - わだばLisperになる

9.3 手続きによるパターンの抽象化

9.3は、memberと、deleteと、assocの共通点を括り出してまとめて抽象化してみせるという内容です。

何となくの個人的な感覚ですが、CLというか伝統的なLISPだと、高階関数的に関数で括り出すんじゃなくて、ベタな感じで関数で括り出すかマクロにする傾向が強い気がします。

Schemeを学ぶなら、この辺のところを重点的に学ぶとプログラミング技法的に得られるものも多いんだろうなあという気がしています。

以下CLでさらってみたもの

(defun traverse (fallback get-key return repeat)
  (lambda (elt lst &optional (cmp-fn #'equal))
    (labels ((frob (lst)
                (cond ((endp lst) fallback)
                      ((funcall cmp-fn elt (funcall get-key lst)) (funcall return lst))
                      ('T (funcall repeat #'frob lst)))))
      (frob lst))))

(setf (fdefinition 'member2)
      (traverse () 
                #'car
                #'values
                (lambda (rep lst) (funcall rep (cdr lst)))))

抽象化の手法の違い

CLでは、今回の例のような方法で括り出すよりは、関数を定義するマクロを作ってしまうという割とそのまんまな方法で解決しているコードの方が多い気がします。大同小異ですけれど…。

(use-package :lispworks)

(defmacro define-traverse-function (name &key fallback get-key return repeat)
  (with-unique-names (frob lst)
    `(defun ,name (elt lst &optional (cmp-fn #'equal))
       (labels ((,frob (,lst)
                  (cond ((endp ,lst) ,fallback)
                        ((funcall cmp-fn elt (,get-key ,lst)) (,return ,lst))
                        ('T (,repeat #',frob ,lst)))))
         (,frob lst)))))

(define-traverse-function member2
    :fallback nil
    :get-key car
    :return values
    :repeat (lambda (rep lst) (funcall rep (cdr lst))))

(MEMBER2 'baz '(foo bar baz))
;=> (baz)

2008-07-29

8/2 第10回 慢性的CL勉強会@Lingr 8時だョ!全員集合 告知

| 13:59 | 8/2 第10回 慢性的CL勉強会@Lingr 8時だョ!全員集合 告知 - わだばLisperになる を含むブックマーク はてなブックマーク - 8/2 第10回 慢性的CL勉強会@Lingr 8時だョ!全員集合 告知 - わだばLisperになる

今週も、開催させて頂きます! オフラインを含めて今回で10回目となりました。

今回は「CLの落し穴」の続きで"Limits."からの再開です!

  • CLの落し穴集(コーディングではまるところ)
場所:Lingr: Common Lisp部屋
日時8/2 (土) 20:00から適当(途中参加/離脱/ROM歓迎)
勉強会の進行テキストを最初から参加者が眺めてゆき、質問があったり、議論になりそうなことがあったら議論してゆきます。
勉強会の目標CLに関して一つ位賢くなった気になること
時刻お題対象者参考リンク
20:00-21:30位までCommon Lisp PitfallsCLでコーディングする方Common Lisp Pitfalls

勉強会のネタがあれば、このブログにコメント頂くか、Lingr等に書き置きしてみて下さい。好きなテーマを持ち込んでみて頂くというのも大歓迎です!

CLで学ぶ「プログラミングGauche」 (9.2)

| 08:05 | CLで学ぶ「プログラミングGauche」 (9.2) - わだばLisperになる を含むブックマーク はてなブックマーク - CLで学ぶ「プログラミングGauche」 (9.2) - わだばLisperになる

また間が開いてしまいました。今回は、9.2です。

9.2 連想リスト

連想リストは古いLISPからの伝統ということでCLもSchemeも共通といったところでしょう。

Schemeでは、SRFIの拡張で、assocが比較のための述語をオプションで取れるとのこと。

MacLISP等の時代は、比較述語によってバリエーションが作られるということが行なわれていたようで、equalで比較するassoc、eqで比較するassqがあったりしました。この辺の伝統は、一部のSRFIや、elispに残っているようですが、CLは、デフォルトの述語をeqlにして他は:testキーワードで述語を指定するという風に統一されたので派生の専用関数を作るということはあまり行なわれなくなりました。

(assoc 'foo '((bar . 3) (foo . 2) (baz . 1)) :test #'eq)

ということで、本の内容とは全く関係のないことを延々と書いてしまいました…。

次回は9.3から再開したいと思います。

2008-07-27

7/26 第9回 慢性的CL勉強会@Lingr 8時だョ!全員集合まとめ

| 20:09 | 7/26 第9回 慢性的CL勉強会@Lingr 8時だョ!全員集合まとめ - わだばLisperになる を含むブックマーク はてなブックマーク - 7/26 第9回 慢性的CL勉強会@Lingr 8時だョ!全員集合まとめ - わだばLisperになる

昨日、7/26 20:00から9回目の勉強会を開催させて頂きました!

発言して頂いた方約12名前後observer(ROM)の方約10名前後で、大体20〜22名前後を推移しつつでした。

今回は、cl-cookbookより文字列操作篇でした。

反省と課題

今回3分クッキングの様に進行役の自分の発言を予めすべて用意しておき、本番では基本的にペタペタ貼り付けて行くという方法を試してみたのですが、この方法は割と上手く纏まる気がしました。

準備した原稿のようなものは、コードも入れて約8000文字、400行程度ですが、今回はこの量で大体90分位を乗り切れました。

エクストリーム勉強会の全く逆を行くという感じですが、思ったより発言が活溌にならないと予想される場合(最初の1回目等)には非常に有効ではないかと思います。

自分自身Lingrを使ってのオンラインでの勉強会を実施するなかで、オンラインで勉強会を実施するよりは、取り上げるネタをブログに纏めてエントリにした方がまとまりがあって良いのではないかと、何度か思うことがありましたが、今回ブログのエントリとオンラインでのプレゼンとチャットの間を取ったような感じになったかと思います。

どのレベルの人でも予習なしで参加できて、かつある程度まとまりがある形にしようと思うとこの辺が落し所なのかもしれません。

また、どうしてもキーボードからタイプすることになるので、発言が遅くなりがちなのですが、予め発言を準備しておくと、会話ベースのようにテンポ良く進む気がしました。

矛盾しているようですが、チャットでリアルタイムに進めるからこそ下原稿が大切なのかもしれません。下原稿を用意したからといって予定調和なものになるかといえば、そんなこともなく、寧ろ丁度良いようです。ジャズのアドリブみたいなものかもしれません。

展望

ということで、原稿さえ用意しておけば、誰でも自分の好きなテーマで勉強会を開催できるのではないかと思います。

LISP関係の話題に限定されてしまうのですが「慢性的CL勉強会@Lingr 8時だョ!全員集合」のお題を進行する方も募集しております!

ぶっちゃけ90分ですので、10秒に一回発言ペースなら、540行、20秒毎なら、270行の原稿を用意しておけば良いのではないかと。

個人的には、Schemeネタになってしまいますが、call/ccのパターン解説が面白いネタだと思うのでどなたか進行役になってくれないかなあ、と思っています。

ログ:

宿題的なもの

  1. http://www.lingr.com/room/gKpArxPn9wi/archives/2008/07/26#msg-43421663
  2. http://www.lingr.com/room/gKpArxPn9wi/archives/2008/07/26#msg-43423946
  3. http://www.lingr.com/room/gKpArxPn9wi/archives/2008/07/26#msg-43426131

謝辞

ページへの勉強会のロゴ設置ありがとうございます!

今回も勉強会の一員に加えて頂いてありがとうございます!

次回…。

8/2日 20時から開催します!

お題は、Common Lispの落し穴の続きです。

その他、何か、アイディア/要望等ありましたら、Lingrに書き置きでもしてみて下さい!。

2008-07-26

実践Common Lisp発売!!

| 16:34 | 実践Common Lisp発売!! - わだばLisperになる を含むブックマーク はてなブックマーク - 実践Common Lisp発売!! - わだばLisperになる

このブログでPractical Common Lispのことを取り上げるのは、英語版を読んでいた5章の記録を最後に実に半年ぶりです(笑)

原著は、すべての内容がウェブ上で読めたりPDFで入手可能だったり、かなり太っ腹ですが、当然ながら英語ということで内容は面白いものの英語の苦手な自分にはちょっと敷居が高いものでした。

内容的には、CL入門から中級程度の話題まで一通りのことを網羅してあり、かつタイトルどおり実践的なものなので、

  1. On Lispから入門しようとして挫折した
  2. ANSI Common Lispを読んで次の書物を物色している
  3. 古いCommon Lispの文献で色々調べていたけれど、なんか今どきのCommon Lispと細かいところで書法が違って混乱した
  4. 入門書を読んで大体Common Lispの検討はついたけれど、実践的なコードはどう書くのか迷子になっている
  5. Schemeは知っているけれど、親戚のCommon Lispは知らない

等々の方々には、良い教材になるに違いないと思います。

早速ジュンク堂には(昨日、金曜の時点で)大量入荷しているという情報も。

2008-07-25

SERIESでファイル処理

| 01:15 | SERIESでファイル処理 - わだばLisperになる を含むブックマーク はてなブックマーク - SERIESでファイル処理 - わだばLisperになる

夏バテのせいなのか、鬱のせいなのか、行動する気力が全然湧いてきません(;´Д`)

しかし、何か書かなくてはいけないという強迫観念が収まらないので、2chのCL入門スレでみつけた質問に挑戦してみたいと思います(笑)

お題

CL入門スレ128さんの質問。ファイルから特定の行を抽出し、その行のみ新たにファイルへ書き出す。

(make-thread :name common-lisp :part 5)

(use-package :series)
(series::install)

(defun kakikaki (infile outfile lines)
  (collect-file-supersede outfile
   (choose (mask (choose-if #'plusp (#M1- (scan (sort (copy-list lines) #'<)))))
           (scan-file infile #'read-line))
   #'write-line))

;; 補助マクロ(ファイルが存在する場合は上書きする: 今回の問題には本質的には関係なし)
(defmacro collect-file-supersede (file items &optional (printer #'print))
  `(progn
     (when (probe-file ,file)
       (delete-file ,file))
     (collect-file ,file ,items ,printer)))

実行

(kakikaki "/etc/passwd" "/tmp/baz" '(400 2 4 8 -1))

抜き出したい行をリストで指定します。ファイル行数の範囲を越えた指定は無視されます。

結果

$ cat /tmp/baz
daemon:x:1:1:daemon:/usr/sbin:/bin/sh
sys:x:3:3:sys:/dev:/bin/sh
lp:x:7:7:lp:/var/spool/lpd:/bin/sh

2008-07-22

7/26 第9回 慢性的CL勉強会@Lingr 8時だョ!全員集合 告知

| 19:21 | 7/26 第9回 慢性的CL勉強会@Lingr 8時だョ!全員集合 告知 - わだばLisperになる を含むブックマーク はてなブックマーク - 7/26 第9回 慢性的CL勉強会@Lingr 8時だョ!全員集合 告知 - わだばLisperになる

今週もCL勉強会は開催させて頂きます!

今回は、cl-cookbookより文字列篇です。CLの文字列処理は、割と癖があると思うので疑問に思ったことなどガンガン質問してみてください!

場所:Lingr: Common Lisp部屋
日時7/26 (土) 20:00から適当(途中参加/離脱/ROM歓迎)
勉強会の進行テキストを最初から参加者が眺めてゆき、質問があったり、議論になりそうなことがあったら議論してゆきます。
勉強会の目標CLに関して一つ位賢くなった気になること
時刻お題対象者参考リンク
20:00-21:30位までThe Common Lisp Cookbook(Strings篇)CLで色々書く(書きたい)方The Common Lisp Cookbook - Strings

勉強会のネタがあれば、このブログにコメント頂くか、Lingr等に書き置きしてみて下さい。好きなテーマを持ち込んでみて頂くというのも大歓迎です!

2008-07-20

7/19 第8回 慢性的CL勉強会@Lingr 8時だョ!全員集合まとめ

| 11:48 | 7/19 第8回 慢性的CL勉強会@Lingr 8時だョ!全員集合まとめ - わだばLisperになる を含むブックマーク はてなブックマーク - 7/19 第8回 慢性的CL勉強会@Lingr 8時だョ!全員集合まとめ - わだばLisperになる

昨日、7/19 20:00から7回目の勉強会を開催させて頂きました!

発言して頂いた方約12名前後observer(ROM)の方約8名前後で、大体18〜20名前後を推移しつつでした。

今回は、CLの落し穴の続きでした。

反省と課題

  • 今回お題の解釈が難しいところがありましたが、議論したりアドバイスを頂いたりで、なんとかなりました。
ログ:

宿題的なもの

* If the comparison predicate (strictly speaking, the combination
of the predicate and the key function) does not consistently express
a total order on the items being sorted, then the items "will be
scrambled in some unpredictable way" [CLtL p 408].

と、これの前後のお題のsortの動きについて良く考える

謝辞

ページへの勉強会のロゴ設置ありがとうございます!

今回も勉強会の一員に加えて頂いてありがとうございます!

次回…。

7/26日 20時から開催します!

お題は、cl-cookbookの続きにしたいのですが、cookbookは若干Lingrでの展開が難しいようなのでもう少し考えたいと思います。明日か明後日にエントリで告知したいと思います。

何か、アイディア/要望等ありましたら、Lingrに書き置きでもしてみて下さい!。

2008-07-18

Getting Started in *LISP (12)

| 20:38 | Getting Started in *LISP (12) - わだばLisperになる を含むブックマーク はてなブックマーク - Getting Started in *LISP (12) - わだばLisperになる

こちらも放置しておりました、*Lispのチュートリアル。

同じく細かく進めて行くことにしました。

3.3 Communication Operators

データをCPU間でやりとりすることを"コミュニケーション"と表現することにする。

コミュニケーションには2種類あって、ルータコミュニケーションと、グリッドコミュニケーションがある。

3.3.1 Router Communication - General-Purpose Data Exchange

CM(コネクションマシン)では、各CPUは接続されていて、互いに通信ができるネットワークを持つ。これをルータと呼ぶらしい。

各プロセッサには、番地があるので、(self-address!!で取得可能)、これを利用してデータを特定のプロセッサ間で通信できる。

3.3.2 The Router Communication Opetators of *Lisp

ルータコミュニケーションに使用するオペレータには

  • *pset

あるプロセッサからデータを対象のプロセッサに送信する。パラレル動作。

  • pref!!

あるプロセッサが対象のプロセッサよりデータを取得。パラレル動作。

の2種類がある。

;; *pset

*number-of-processors-limit*
;==> 256

(*let (data)
  (*pset :no-collisions
         (self-address!!) ;送信元番地
         data             ;格納場所
         (-!! *number-of-processors-limit* ;着信番地
              (self-address!!)
              1))
  ;; 表示
  (ppp data))
;>>> 255 254 253 252 251 250 249 248 247 246 
;==>NIL

*psetは、(*pset combiner source-pvar dest-pvar send-address-pvar ...)という形式

  • 上の例の場合、自分の番地を値として送信。
  • dataは格納されるpvar
  • (-!! 〜)の部分は、送信先アドレス

つまり、255番プロセッサが、255という値を、0番プロセッサに送信、結果として、pvarの0番目に255が格納される。

次回3.3.3より再開

SERIESでツリーマッチング

| 01:36 | SERIESでツリーマッチング - わだばLisperになる を含むブックマーク はてなブックマーク - SERIESでツリーマッチング - わだばLisperになる

独習 Scheme 三週間 Teach Yourself Scheme in Fixnum Daysでは、ジェネレータを使うことによって、2つのツリーをflattenして比較するよりも効率の良いツリーマッチングを実現しているわけなのですが、SERIESは遅延評価なので効率良く似たようなことができるだろうということで色々考えてみました。

(same-fringe? '(1 (2 3)) '((1 2) 3))
(same-fringe? '(1 (2 3)) '(1 2 3))
;=> T

(same-fringe? '(1 (2 3)) '((1 2) 3 4))
;=> nil

;; コード
(use-package :series)
(series::install) ;#Mや、#Z等のリーダーマクロを使うため

;; 1
(defun same-fringe? (tree1 tree2)
  (let ((t1 (scan-lists-of-lists-fringe tree1))
        (t2 (scan-lists-of-lists-fringe tree2)))
    (and (collect-and (#Mequal t1 t2))
         (= (collect-length t1) (collect-length t2)))))

;; 2 割と無理やりにgeneratorを使ってみたもの
(defun same-fringe? (tree1 tree2)
  (let ((t1 (scan-lists-of-lists-fringe tree1))
        (t2 (scan-lists-of-lists-fringe tree2)))
    (let ((g1 (generator t1))
          (g2 (generator t2))
          (limit (max (collect-length t1) (collect-length t2))))
      (loop :repeat limit :always (equal (next-in g1) (next-in g2))))))

1は、割と普通に書いてみました。SERIESは基本的に短い方に長さが揃えられてしまうので、長さを計っています。長さを計らなければ、無限リストにも対応できますが、今度は、(1 2 3 .....)と、(1 2 3)の場合で真が返ってしまいます。

2は、オリジナルがジェネレータ使用ということで、generatorを使ってみたのですが、いまいちです。

そもそも、collect-lengthを使ってしまった時点で駄目な気がしますが、どうやったら良いんでしょうー。

CLで学ぶ「プログラミングGauche」 (9.1)

| 00:05 | CLで学ぶ「プログラミングGauche」 (9.1) - わだばLisperになる を含むブックマーク はてなブックマーク - CLで学ぶ「プログラミングGauche」 (9.1) - わだばLisperになる

「プログラミングGauche」をCLで演習してみていましたが、2ヶ月も放置してしまいました。

どうも一回の内容を長くしてしまうと億劫になってしまうようなので、細切れに行くことに方針変更しました。

9.1 集合

このセクションで登場するmemberですが、CLでは、memberは、比較の為の関数を:testで指定できるので、srfi-1拡張相当です。

デフォルトでは、eqlが比較に使われます。

また、keyが取れて、

member
(member 'bar '((foo) (bar) () (baz)) :key #'car)
;=> ((BAR) NIL (BAZ))

のようなこともできます。

(defparameter *inventory* '(cookie dagger))

(member 'cookie *inventory* :test #'equal)

(defun has-item? (item)
  (member item *inventory*))
delete

srfi-1のdeleteに相当するものは、CLでは、removeになります。

また、同じ機能で引数リストを破壊的に変更するものにdeleteがあります。

(remove 1 '(1 2 1 2 1 2 1 2))
;=> (2 2 2 2)

itemを取り除く上限の個数も標準で指定できます。

(remove 1 '(1 2 1 2 1 2 1 2) :count 1)

;=> (2 1 2 1 2 1 2)

[練習問題]

CLのremoveは、この問題のように全く削除要素がみつからなかった場合に、与えられた引数をそのまま返しても良いということになっています。

CLHS: Function REMOVE, REMOVE-IF, REMOVE-IF-NOT...

逆にいえば、この仕様だとremoveの結果を破壊することの安全が保証されていないので破壊する場合は、リストをコピーしてやる必要があります。

(defun delete-1 (item lst test)
  (if (endp lst)
      ()
      (let ((tail (delete-1 item (cdr lst) test)))
        (if (funcall test item (car lst))
            tail
            (if (eq (cdr lst) tail)
                lst
                (cons (car lst) tail))))))

(let ((data (list 1 2 3 4 5)))
  (eq data (delete-1 0 data #'equal)))
;=> T
代入

Gaucheのset!に相当するものは、setfか、setqになります。

また、Schemeの命名規則では、名前の最後に!が付くと破壊的操作となりますが、CLの場合、CL以前のLISPの色々な命名規則が混っていますので、いまいち統一感に欠けます。

nconc、nreverse等、nが付いたり、remove系に対してのdelete系というのが主なところです。

2008-07-16

7/19 第8回 慢性的CL勉強会@Lingr 8時だョ!全員集合 告知

| 16:26 | 7/19 第8回 慢性的CL勉強会@Lingr 8時だョ!全員集合 告知 - わだばLisperになる を含むブックマーク はてなブックマーク - 7/19 第8回 慢性的CL勉強会@Lingr 8時だョ!全員集合 告知 - わだばLisperになる

遅くなってしまいましたが、今週も、開催させて頂きます!

今回は「CLの落し穴」の続きで"potential numbers"からの再開です!

  • CLの落し穴集(コーディングではまるところ)
場所:Lingr: Common Lisp部屋
日時7/19 (土) 20:00から適当(途中参加/離脱/ROM歓迎)
勉強会の進行テキストを最初から参加者が眺めてゆき、質問があったり、議論になりそうなことがあったら議論してゆきます。
勉強会の目標CLに関して一つ位賢くなった気になること
時刻お題対象者参考リンク
20:00-21:30位までCommon Lisp PitfallsCLでコーディングする方Common Lisp Pitfalls

勉強会のネタがあれば、このブログにコメント頂くか、Lingr等に書き置きしてみて下さい。好きなテーマを持ち込んでみて頂くというのも大歓迎です!

2008-07-15

SERIESでL-99 (P07 リストの平坦化)

| 15:56 | SERIESでL-99 (P07 リストの平坦化) - わだばLisperになる を含むブックマーク はてなブックマーク - SERIESでL-99 (P07 リストの平坦化) - わだばLisperになる

この前のエントリでは、ややこしく書いてしまいましたが、マニュアルを読んでいたら、ツリーを走査する専用の関数がありました。

(flatten '(1 2 3 (4 5  (6 (7 (8 (9 (((10(11(((((()))))))))))))))12))
;=> (1 2 3 4 5 6 7 8 9 10 11 12)

(defun flatten (list)
  (collect (choose (scan-lists-of-lists-fringe list))))

2008-07-13

7/12 第7回 慢性的CL勉強会@Lingr 8時だョ!全員集合まとめ

| 23:12 | 7/12 第7回 慢性的CL勉強会@Lingr 8時だョ!全員集合まとめ - わだばLisperになる を含むブックマーク はてなブックマーク - 7/12 第7回 慢性的CL勉強会@Lingr 8時だョ!全員集合まとめ - わだばLisperになる

昨日、7/12 20:00から7回目の勉強会を開催させて頂きました!

発言して頂いた方約8名observer(ROM)の方約12名で、大体20名前後を推移しつつでした。

今回は、cl-cookbookよりLOOPマクロ篇でした。

反省と課題

  • オンライン勉強会にはあまり向いていないお題だった気がする。
ログ:

今回の勉強会について言及のブログエントリ

謝辞

  • zick、quekさん

ブログでの関連エントリありがとうございます!

ページへの勉強会のロゴ設置ありがとうございます!

今回も勉強会の一員に加えて頂いてありがとうございます!

次回…。

7/19日 20時から開催します!

お題は、CLの落し穴の続きの予定です。

何か、アイディア/要望等ありましたら、Lingrに書き置きでもしてみて下さい!。

2008-07-12

サンプルコードによるSERIES入門 (番外編)

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

LOOP、ITERATEと来たので、SERIESでもやらないではいられません…。

インストール

(asdf-install:install :series)

一発です。

使ってみる

これもなんとなくL-99を25問目まで解いてみました。

なんとなく、iterate、mappingで、繰り返し的に、scan-fnで末尾再帰的な感覚で書ける気がしてきました。

それにつけても、SERIESで書かれたソースがあまり出回ってないので、定石な書法がいまいち分からないんですよね…。

(defpackage :l99-series
  (:use :cl :series))

(in-package :l99-series)

;; P01
(defun last-pair (list)
  (collect-last
   (scan-fn 't
            (lambda () list)
            #'cdr 
            #'atom)))

(last-pair '(1 2 3 4))
;=> (4)

(last-pair '(1 2 3 . 4))
;=> (3 . 4)

;; P02
(defun last-2-pair (list)
  (collect-last
   (scan-fn 't
            (lambda () list)
            #'cdr 
            (lambda (x) (atom (cdr 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)
  (first 
   (collect-last
    (scan-fn-inclusive 
     '(values list integer)
     (lambda () (values list 0))
     (lambda (l cnt) (values (cdr l) (1+ cnt)))
     (lambda (l cnt) (or (null l)
                         (>= cnt (1- position))))))))

(element-at '(a b c d e) 3)
;=> C
(element-at '(a b c d e) 13)
;=> NIL

;; P04
;; 1
(defun len (list)
  (let ((cnt 0))
    (iterate ((i (scan list)))
      (incf cnt))
    cnt))

;; 2
(defun len (list)
  (collect-last
   (scan-fn-inclusive '(values integer t)
                      (lambda () (values 0 list))
                      (lambda (cnt lst) (values (1+ cnt) (cdr lst)))
                      (lambda (cnt lst) 
                        (declare (ignore cnt))
                        (null lst)))))

(len (loop :repeat 5 :collect t))
;=> 5

;; P05
(defun rev (list)
  (collect-last
   (scan-fn-inclusive '(values list list)
                      (lambda () (values () list))
                      (lambda (ans list)
                        (values (cons (car list) ans) (cdr list)))
                      (lambda (ans list)
                        (declare (ignore ans))
                        (null list)))))

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

;; P06
(defun palindrome-p (list)
  (iterate ((org (scan list))
            (rev (scan (reverse list))))
    (unless (equal org rev)
      (return-from palindrome-p nil)))
  'T)

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

;; P07
;; 1. 普通にの繰り返しと再帰
(defun flatten (list)
  (collect-append 
   (mapping ((x (scan list )))
     (if (listp x)
         (flatten x)
         (list x)))))

;; 2. gatheringで要素を投げる系
(defun flatten (list)
  (gathering ((ans collect))
    (labels ((f (list gatherer)
               (iterate ((x (scan list)))
                 (if (listp x)
                     (f x gatherer)
                     (next-out gatherer x)))))
      (f list ans))))

;; 3. 普通にの繰り返しと再帰 その2
(defun flatten (list)
  (collect-last
   (scan-fn-inclusive
    '(values list list)
    (lambda () (values () list ))
    (lambda (acc list)
      (values (append acc
                      (if (listp (car list))
                          (flatten (car list))
                          (list (car list))))
              (cdr list)))
    (lambda (acc list)
      (declare (ignore acc))
      (endp list)))))

(flatten '(1 2 3 (4 5  (6 (7 (8 (9 (((10(11(((((()))))))))))))))12))
;=> (1 2 3 4 5 6 7 8 9 10 11 12)

;; P08
(defun compress (list)
  (gathering((ans collect))
    (iterate ((prev (previous (scan list) (gensym) 1))
              (cur (scan list)))
      (unless (equal prev cur)
        (next-out ans cur)))))

(compress '(a a a a b c c a a d e e e e e))
;=> (A B C A D E)

;; P09
(defun pack (list)
  (gathering ((ans collect))
    (let ((list (nconc (copy-list list) (list (gensym))))
          tem)
      (iterate ((x (scan list))
                (prev (previous (scan list) (gensym) 1)))
        (unless (or (equal prev x) (null tem))
          (next-out ans tem)
          (setq tem () ))
        (push x 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)
  (collect
    (mapping ((x (scan (pack list))))
      `(,(length x) ,(car x)))))

(encode '(a a a a b c c a a d e e e e e))
;=> ((4 A) (1 B) (2 C) (2 A) (1 D) (5 E))

;; P11
(defun single (list)
  (and (consp list)
       (null (cdr list))))

(defun encode-modified (list)
  (collect
    (mapping ((x (scan (pack list))))
      (if (single 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)
  (collect-nconc
   (mapping ((x (scan list)))
     (if (atom x)
         (list x)
         (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
;; gdgd
(defun encode-direct (list)
  (let ((cnt 0)
        (prev (gensym))
        flag)
    (gathering ((ans collect))
      (iterate ((x (scan (nconc (copy-list list) (list (gensym))))))
        (if (or (equal prev x) (not flag))
            (incf cnt)
            (progn 
              (next-out ans (list cnt prev))
              (setq cnt 1)))
        (setq prev x flag 'T)))))

(encode-direct '(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))

;; P14
(defun dupli (list)
  (collect-nconc 
   (mapping ((x (scan list)))
     (list x x))))

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

;; P15
(defun repli (list times)
  (collect-nconc 
   (mapping ((x (scan list)))
     (make-list times :initial-element x))))

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

;; P16
(defun drop (list n)
  (gathering ((ans collect)) 
    (iterate ((x (scan list))
              (pos (scan-range :from 1)))
      (unless (zerop (mod pos n))
        (next-out ans x)))))

(drop '(1 2 3 4 5 6 7 8 9 10) 3)
;=> (1 2 4 5 7 8 10)

;; P17
(defun split (list n)
  (let ((front (gatherer #'collect)))
    (iterate ((tail (scan-sublists list))
              (pos (scan-range :from 1)))
      (if (<= pos n)
          (next-out front (car tail))
          (return-from split (list (result-of front) tail))))))

(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)
  (gathering ((ans collect))
    (iterate ((x (scan list))
              (pos (scan-range :from 1)))
      (when (<= start pos end)
        (next-out ans x)))))

(slice '(a b c d e f g h i k) 3 7)
;=> (C D E F G)

;; P19
(defun rotate (list n)
  (let ((front (gatherer #'collect))
        (n (mod n (length list))))
    (iterate ((tail (scan-sublists list))
              (pos (scan-range :from 1)))
      (if (<= pos n)
          (next-out front (car tail))
          (return-from rotate (append tail (result-of front)))))))

(rotate '(a b c d e f g h) 3)
;=> (D E F G H A B C)

(rotate '(a b c d e f g h) -2)
;=> (G H A B C D E F)

;; P20
(defun remove-at (list n)
  (gathering ((ans collect))
    (iterate ((x (scan list))
              (pos (scan-range :from 1)))
      (unless (= pos n)
        (next-out ans x)))))

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

;; P21
(defun insert-at (item list n)
  (gathering ((ans collect))
    (iterate ((x (scan list))
              (pos (scan-range :from 1)))
      (when (= pos n)
        (next-out ans item))
      (next-out ans x))))

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

;; P22
(defun range (start end)
  (collect (scan-range :from start :upto end)))

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

;; P23
(defun rnd-pop (list)
  (if (null list)
      ()
      (let ((n (1+ (random (length list)))))
        (gathering ((ans collect)
                    (rem collect))
          (iterate ((x (scan list))
                    (pos (scan-range :from 1)))
                   (next-out (if (= pos n) rem ans) 
                             x))))))

(defun rnd-select (list n)
  (collect-nth (1- n) 
    (nth-value 1               
      (scan-fn '(values t t) 
               (lambda () (rnd-pop list))
               (lambda (x ans)
                 (multiple-value-bind (a b) (rnd-pop x)
                   (values a (append b ans))))))))

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

;; P24             
(defun lotto-select (n range)
  (rnd-select (range 1 range) n))

(lotto-select 6 50)
;=> (8 3 45 43 5 34)

;; P25
(defun rnd-permu (list)
  (rnd-select list (length list)))

(rnd-permu '(a b c d e f))
;=> (C B A E F D)

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)

2008-07-10

サンプルコードによるLOOPマクロ入門 (9)

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

繰り返し途中での脱出等

繰り返しの中で脱出したい場合は、良くあります。

この場合、(return)や使える場所では:returnを使用して繰り返しから抜けることができます。

これら以外にも脱出の常套句的なものが用意されています。

  • :while

次の式の値がNILの場合即座にLOOPを終了させます

集積の結果や、:finally節は実行されます。

(loop :as i :upfrom 0 :while (< i 10)
      :collect i)
;=> (0 1 2 3 4 5 6 7 8 9)
  • :until

次の式の値が非NILの場合即座にLOOPを終了させます。

集積の結果や、:finally節は実行されます。

(loop :as i :upfrom 0 :until (>= i 10)
      :collect i)
;=> (0 1 2 3 4 5 6 7 8 9)

以上、2つは、脱出というよりは、LOOPの終了条件といった感じです。

  • :always

次の式の値がNILの場合即座にLOOPから抜けます。脱出した場合のLOOPの返り値は、NILですが、途中脱出しなかった場合は、Tになります。

集積の結果や、:finally節は実行されません。

(defun list= (x y)
  (loop :for xx :in x
        :for yy :in y
        :always (eql xx yy)))

(list= '(1 2 3 4) '(1 2 3 4))
;=> T
  • :never

次の式の値が非NILの場合即座にLOOPから抜けます。脱出した場合のLOOPの返り値は、NILですが、途中脱出しなかった場合は、Tになります。

集積の結果や、:finally節は実行されません。

(loop :never 1)
;=> NIL
  • :thereis

次の式の値が非NILの場合即座にLOOPから抜けます。脱出した場合のLOOPの返り値は、式の値ですが、途中脱出しなかった場合は、NILになります。

集積の結果や、:finally節は実行されません。

(loop :thereis 1)
;=> 1

その他

CLでは、someや、every等がありますが、CL以前のMacLISPには存在しないということもあり、

(if (some #'oddp '(1 2 3 4))
    'foo
    'bar)
;=> FOO

(if (loop :for x :in '(1 2 3 4) :thereis (oddp x))
    'foo
    'bar)
;=> FOO

と書いたような例がちらほらあります。

サンプルコードによるLOOPマクロ入門 (8)

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

for/as色々

全く計画性もなく書いてるので話題が前後してしまいますが、値を生成する:for節は色々な書き方ができます。

また、:forは別名で:asとも書けます。

初期値〜更新

DOマクロのように初期化〜更新を組で書くことができます。

この場合、:=と、:thenを組で使用します。

(loop :as i := 0 :then (1+ i)
      :repeat 10            ;これがないと止まりません。
      :collect i)
;=> (0 1 2 3 4 5 6 7 8 9)

更新部分と初期化部分が同じ場合、更新部分を省略できます。

(loop :for i := 0       ;毎度0が代入される
      :repeat 10
      :collect i 
      :do (setq i nil)) ;iをnilに変更して邪魔をする。
;=> (0 0 0 0 0 0 0 0 0 0)

サンプルコードによるLOOPマクロ入門 (7)

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

値の収集 その2

:collectや、:sum等で値を収集する場合、一つだけでなく複数に分散して値を格納したい時があります。

そういう時には、:collect等の後に:intoを付け変数名を指定します。

注意点としては、:intoを指定しない場合は暗黙の収集変数に値が格納され、LOOPを抜けたときにその値がLOOPの結果の値とされますが、:intoで指定した場合は、手動で値を返してやらないといけません。この場合、:finally節で指定するのが一般的なようです。また、:into以下の変数は:into節により適切に初期化されるので、手動で初期化する必要はありません。

(loop :for i :upfrom 0 :upto 10
      :collect i :into all
      :when (oddp i)
        :collect i :into odds
      :else
        :collect i :into evens
      :end
      :sum i :into sum
      :maximize i :into max
      :minimize i :into min
      :finally (return `(all => ,all odds => ,odds evens => ,evens sum => ,sum max => ,max min => ,min)))
;=>
(ALL => (0 1 2 3 4 5 6 7 8 9 10)
 ODDS => (1 3 5 7 9)
 EVENS => (0 2 4 6 8 10)
 SUM => 55
 MAX => 10
 MIN => 0)

はまりどころ

  • finallyで(return)を忘れる
(loop :for i :from 0 :to 10 :collect i :into ans
      :finally ans)
  • せっかく丁寧に収集用の変数を宣言してあげたのに怒られる
(loop :with ans := ()
      :for i :from 0 :to 10 :collect i :into ans
      :finally (return ans))
;>>> Variable ANS in INTO clause is a duplicate

2008-07-09

良い数珠繋ぎ、悪い数珠繋ぎ

| 15:20 | 良い数珠繋ぎ、悪い数珠繋ぎ - わだばLisperになる を含むブックマーク はてなブックマーク - 良い数珠繋ぎ、悪い数珠繋ぎ - わだばLisperになる

;; (´д`;)
(do ((i 0 (1+ i))
     (res () (cons i res)))
    ((< 10 i) 
     (do ((x res (cdr x))
          (res () (cons (* 3 (car x)) res)))
         ((endp x) 
          (do ((x res (cdr x))
               (res () (cons (princ-to-string(car x)) res)))
              ((endp x) (nreverse res)))))))

;=> ("0" "3" "6" "9" "12" "15" "18" "21" "24" "27" "30")

;; (:.;゜;Д;゜;.:)
(do ((x (do ((x (do ((i 0 (1+ i))
                     (res () (cons i res)))
                    ((< 10 i) res)) (cdr x))
             (res () (cons (* 3 (car x)) res)))
            ((endp x) res)) (cdr x))
     (res () (cons (princ-to-string(car x)) res)))
    ((endp x) (nreverse res)))

;=> ("0" "3" "6" "9" "12" "15" "18" "21" "24" "27" "30")

末期LOOPマクロ病および、末期DOマクロ病患者のコード

| 14:14 | 末期LOOPマクロ病および、末期DOマクロ病患者のコード - わだばLisperになる を含むブックマーク はてなブックマーク - 末期LOOPマクロ病および、末期DOマクロ病患者のコード - わだばLisperになる

;; 末期LOOP病
(defun fib (n)
  (loop :if (< n 2) 
          :return n
        :else
          :return (+ (fib (1- n))
                     (fib (- n 2)))))

;; 末期DO病
(defun fib (n)
  (do ()
      ((< n 2) n)
    (return 
      (+ (fib (1- n))
         (fib (- n 2))))))

2008-07-08

7/12 第7回 慢性的CL勉強会@Lingr 8時だョ!全員集合 告知

| 17:41 | 7/12 第7回 慢性的CL勉強会@Lingr 8時だョ!全員集合 告知 - わだばLisperになる を含むブックマーク はてなブックマーク - 7/12 第7回 慢性的CL勉強会@Lingr 8時だョ!全員集合 告知 - わだばLisperになる

今週もCL勉強会は開催させて頂きます!

新しいネタを物色ということで、色々探してみました。

候補は何点かあるのですが、とりあえず、しばらく、cl-cookbookとCLの落し穴を週代りで交互に勉強することにしてみました。

これは、実践的なレシピをまとめた感じのものなのですが、CLで実践的なコードを書くというイメージはまだ薄い気がするので実際のところどんな感じで書くものなのかを、cl-cookbookを通して学べるんじゃないかと思ったりしています。

とりあえず頭のStrings篇から開始しても良いとは思うのですが、ボリュームが多いので、ならしということでLOOP篇から開始します。

場所:Lingr: Common Lisp部屋
日時7/12 (土) 20:00から適当(途中参加/離脱/ROM歓迎)
勉強会の進行テキストを最初から参加者が眺めてゆき、質問があったり、議論になりそうなことがあったら議論してゆきます。
勉強会の目標CLに関して一つ位賢くなった気になること
時刻お題対象者参考リンク
20:00-21:30位までThe Common Lisp Cookbook(LOOP篇)終ったらStrings篇CLで色々書く(書きたい)方The Common Lisp Cookbook

勉強会のネタがあれば、このブログにコメント頂くか、Lingr等に書き置きしてみて下さい。好きなテーマを持ち込んでみて頂くというのも大歓迎です!

2008-07-06

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

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

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

「できるだけLOOPマクロ内で完結させる」ということをテーマに書いてみました。

自分はLOOPマクロは苦手でしたが、それでも200行位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マクロ入門 (6)

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

ローカル変数

LOOP内ではループ内でローカル変数を宣言して使用することができます。

良く

(let ((foo 1)
      (bar 2)
      (baz 3))
  (loop :repeat 5 :collect (list foo bar baz)))

;=> ((1 2 3) (1 2 3) (1 2 3) (1 2 3) (1 2 3))

のようなコードを見かけますが、これは、

(loop :with foo := 1 :and bar := 2 :and baz := 3
      :repeat 5 :collect (list foo bar baz)))

;=> ((1 2 3) (1 2 3) (1 2 3) (1 2 3) (1 2 3))

という風に:withを使って書けます。

上の元の例の場合、foo、bar、bazはletを使って並列に束縛されているのですが、この場合、:andでつなぎます。

では、

(let* ((foo 1) 
       (bar 2)
       (baz (* 3 foo)))
  (loop :repeat 5 :collect (list foo bar baz))))

;=> ((1 2 3) (1 2 3) (1 2 3) (1 2 3) (1 2 3))

のようにlet*で順番に上から束縛する場合はどう書くかというと、

(loop :with foo := 1 :and bar := 2
      :with baz := (* 3 foo)
      :repeat 5 :collect (list foo bar baz))

;=> ((1 2 3) (1 2 3) (1 2 3) (1 2 3) (1 2 3))

と:withを複数回使って書きます。

LOOPでは、:andが文脈によって意味が変ってくるのですが、どっちがパラレルでどっちがシリアル束縛か忘れてしまったら、マクロ展開をして結果を確認するのがてっとり早いかもしれません。

まとめ

という風にLOOPマクロ内で変数宣言もできるのですが、複雑になると若干読み難くくなるところもあるかもしれません…。

2008-07-05

defun-compile-time

| 23:07 | defun-compile-time - わだばLisperになる を含むブックマーク はてなブックマーク - defun-compile-time - わだばLisperになる

先日yharaさんのブログで、Edi Weitz氏のマクロ入門の記事が取り上げられていました。

黒帯マクロ使いを目指す皆様はソースに目を通してみるといいんじゃないでしょうか。
とりあえずscreamer.lsp のdefun-compile-timeの大群が恐ろしいです。

というdefun-compile-timeについての言及があったのですが、自分は、このマクロ入門のネタで勉強会を開催しておきながら、Screamerのソースは眺めもしていなかったのでdefun-compile-timeも知りませんでした(笑)

ということで、ちょっと追っ掛けてみることにしました。

  • インストール
(asdf-install:install "http://archive.ubuntu.com/ubuntu/pool/universe/c/cl-screamer/cl-screamer_3.24.2.orig.tar.gz")

cliki経由のインストールは失敗してしまうようなので、直にファイルを指定してインストールしてみました。

  • 中身を探る

インストールはできたので、ソースを眺めてみることにします。

defun-compile-timeの定義は、

(defmacro defun-compile-time (function-name lambda-list &body body)
 `(eval-when (:compile-toplevel :load-toplevel :execute)
   (cl:defun ,function-name ,lambda-list ,@body)
   #-(or akcl harlequin-common-lisp)
   (eval-when (:compile-toplevel) (compile ',function-name))))

のようになっているようです。

akclや、harlequin-common-lispの記述になんとく時代を感じさせます。ちなみにsbclもコンパイルされるので、この2つの仲間に入れても良いのかもしれません。

それで、このマクロが解決しようとしている問題ですが、

(defpackage :eval-when-test 
  (:use :cl))

(defmacro defun-compile-time (function-name lambda-list &body body)
 `(eval-when (:compile-toplevel :load-toplevel :execute)
   (cl:defun ,function-name ,lambda-list ,@body)
   #-(or akcl harlequin-common-lisp sbcl)
   (eval-when (:compile-toplevel) (compile ',function-name))))

(defun my-car (list)
  (car list))

(defmacro eval-when-test-ng (&rest args)
  `(list ,(my-car args)))

(defun-compile-time my-car2 (list)
  (car list))

(defmacro eval-when-test (&rest args)
  `(list ,(my-car2 args)))


(eval-when-test '(1 2 3 4))

(eval-when-test-ng '(1 2 3 4))

のようなeval-when-test.lispというファイルを作ったとします。

eval-when-test、eval-when-test-ngはマクロなのですが、このマクロが使うヘルパー関数として、my-carとmy-car2が同じファイルで定義されています。また、定義したマクロは、同じファイル中で早速使っているという状況です。

eval-when-testが使うヘルパー関数は、はdefun-compile-timeで定義。

eval-when-test-ngが使うヘルパー関数は、は普通にdefunで定義。

それで、

(compile-file "/u/mc/lisp/Work/eval-when-test")
(load "/u/mc/lisp/Work/eval-when-test.fasl")

のようにコンパイル→ロードと実行するのですが、通常のdefunでは、コンパイル時に関数の評価まではされないので、eval-when-test-ngは、内部で使用しているmy-carが未定義となり上手く動かないという問題が発生します。

これを回避するためには、コンパイル時に評価もされるように、eval-whenで包むことになるのですが、これを便利にするマクロだったようです。

これと同じ問題は、defvar、defstructにもあるので、兄弟マクロとして、defvar-compile-time、defstruct-compile-timeが同居していました。

なるほど、なるほど。

他にも便利そうなマクロが隠れていそうです。

7/5 第6回 慢性的CL勉強会@Lingr 8時だョ!全員集合まとめ

| 22:31 | 7/5 第6回 慢性的CL勉強会@Lingr 8時だョ!全員集合まとめ - わだばLisperになる を含むブックマーク はてなブックマーク - 7/5 第6回 慢性的CL勉強会@Lingr 8時だョ!全員集合まとめ - わだばLisperになる

昨日、7/5 20:00から4回目の勉強会を開催させて頂きました!

発言して頂いた方約6名、observer(ROM)の約方8、9名で、大体14名前後を推移しつつでした。

今回は、CLの落し穴で1時間半でした。

反省と課題

  • 良くも悪くも、なんとなくまったりしていた。
ログ:
  1. Common Lispの落し穴集
  2. http://www.lingr.com/room/gKpArxPn9wi/archives/2008/07/05#msg-41636737

謝辞

勉強会の告知をして頂き、その上、なんとロゴを作って頂いたようです!

ありがとうございます!!

今回も勉強会の一員に加えて頂いてありがとうございます!

次回…。

7/12日 20時から開催します!

お題は、未確定ですが何か面白そうなものを物色しております。

何か、アイディア/要望等ありましたら、Lingrに書き置きでもしてみて下さい!。

2008-07-03

第6回 慢性的CL勉強会@Lingr 8時だョ!全員集合 告知

| 22:12 | 第6回 慢性的CL勉強会@Lingr 8時だョ!全員集合 告知 - わだばLisperになる を含むブックマーク はてなブックマーク - 第6回 慢性的CL勉強会@Lingr 8時だョ!全員集合 告知 - わだばLisperになる

遅くなってしまいましたが、今週も、開催させて頂きます!

これまでの経験からやっぱり1回につき1テーマが良かろうということで、今回残りの「CLの落し穴」を終らせてしまうことにしました。今回で終わるかどうかはちょっと疑問なのですが、終らなかったら次回ということで…。

  • CLの落し穴集(コーディングではまるところ)
場所:Lingr: Common Lisp部屋
日時7/5 (土) 20:00から適当(途中参加/離脱/ROM歓迎)
勉強会の進行テキストを最初から参加者が眺めてゆき、質問があったり、議論になりそうなことがあったら議論してゆきます。
勉強会の目標CLに関して一つ位賢くなった気になること
時刻お題対象者参考リンク
20:00-21:30位までCommon Lisp PitfallsCLでコーディングする方Common Lisp Pitfalls

勉強会のネタがあれば、このブログにコメント頂くか、Lingr等に書き置きしてみて下さい。好きなテーマを持ち込んでみて頂くというのも大歓迎です!

2008-07-02

サンプルコードによるLOOPマクロ入門 (5)

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

値の走査/生成

集める方法を先に紹介してしまいましたが、値を走査/生成する方法にも色々あります。

大まかに分けると、数値を生成するものと、リスト/ベクタを走査するものです。

リスト

:inと:onが使えます。:inは、各要素を順番に、:onは、デフォルトで順にcdrを取得します。

(loop :for i :in '(1 2 3 4 5) :collect i)
;=> (1 2 3 4 5)

(loop :for i :on '(1 2 3 4 5) :collect i)
;=> ((1 2 3 4 5) (2 3 4 5) (3 4 5) (4 5) (5))
  • 取得する間隔を変更する

:byの後に関数を指定することで間隔を変更することができます。

デフォルトでは、#'cdrなので、1つおきにしたい場合、#'cddrという風になります。

なんとなく、:inで、#'cddrという指定は直感的でない気もします。

(loop :for i :in '(1 2 3 4 5) :by #'cddr :collect i)
;=> (1 3 5)

(loop :for i :on '(1 2 3 4 5) :by #'cddr :collect i)
;=> ((1 2 3 4 5) (3 4 5) (5))
ベクタ
(loop :for i :across #(1 2 3 4 5) :collect i)
;=> (1 2 3 4 5)

(loop :for i :across "1-2-3-4-5" 
      :when (parse-integer (string i) :junk-allowed 'T) 
        :collect :it)
;=> (1 2 3 4 5)

ベクタの場合は、:inや、:onではなくて、別の:acrossというキーワードを使います。

一々型によって使い分けるのも面倒な気もしますが、マクロ展開時に、型に応じてコードを出力するためらしいので型が変れば違う指定をする位に考えておくと良いかもしれません。とはいえ文字列もベクタなので同じキーワードです。

数値
(loop :for i :from 0 :to 10 :collect i)
;=> (0 1 2 3 4 5 6 7 8 9 10)

(loop :for i :from 0 :to 10 :by 2 :collect i)
;=> (0 2 4 6 8 10)

(loop :for i :from 0 :below 10 :collect i)
;=> (0 1 2 3 4 5 6 7 8 9)

(loop :for i :from 10 :downto 0 :collect i)
;=> (10 9 8 7 6 5 4 3 2 1 0)

(loop :for i :from 10 :above 0 :collect i)
;=> (10 9 8 7 6 5 4 3 2 1)

数値の生成には、:fromや、:toのように範囲を指定すれば、順に増加/減少した数値を取得できます。これも:byによってステップを変更できます。

:from、:downfromが開始の指定、:to、:upto、:downto、:below、:above等色々あって一々面倒ですが、これもマクロ展開ため(キーワードで方向を明示しないと増加方向なのか、減少方向なのか推測できない)ためらしいので、そういうものだと思って暗記するしかないでしょう。

(loop :repeat 10 :for i :from 0 :collect i)
;=> (0 1 2 3 4 5 6 7 8 9)

(loop :repeat 10 :for i :downfrom 100 :by 3 :collect i)
;=> (100 97 94 91 88 85 82 79 76 73)

のように、:repeatと組み合わせれば、終点の指定を省略できます。XからYステップでN個欲しいというような場合には、こっちの方が分かりやすいかもしれません。

2008-07-01

サンプルコードによるLOOPマクロ入門 (4)

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

フィルター

:collectを使って値を集めてリストにする方法を取り上げてきましたが、ただ集めるだけでなくて、対象を選別しつつ集めたいこともあります。

そのような場合には、:if、:when、:unless等の述語と:collectとを組み合わせます。

(loop :for i :in '(1 2 3 4 5 6 7) 
      :do (when (oddp i) :collect i))

のように書けば良さそうなものですが、飽くまで:collectは、LOOPのキーワードであり、LOOPの中でしか機能しないので、通常の式の中に組み込んで使うことができません。

ということで、

(loop :for i :in '(1 2 3 4 5 6 7) 
      :when (oddp i) :collect i)
;=> (1 3 5 7)

となります。

また、これらの述語と組み合わせると、:collectでは、:itで述語の結果を参照できるので

(loop :for i :in '(1 2 3 4 5 6 7) :when (and (oddp i) i) :collect :it)
;=> (1 3 5 7)

とも書けます。ちなみに、ここでは、わざわざ:itを使うために述語の部分が冗長になっていますが、

(loop :for i :in '(1 () 2 () 3 () 4) :when i :collect :it)
;=> (1 2 3 4)

という風に、nilか真値を返すような述語を使う場合に便利かもしれません。

また、:if、:when、:unlessは、2系統に分岐することができます。

(loop :for i :in '(1 2 3 4 5 6 7) 
      :when (oddp i)
        :collect i
      :else
        :collect '?
      :end)
;=> (1 ? 3 ? 5 ? 7)

若干ややこしいのですが、LOOPの:whenは、通常のLISPのwhenと違い、:ifとまったく同じなもので単なる別名です。

また、:endというキーワードが使えて区切りをハッキリさせる目的で使えます。

6/28第5回 慢性的CL勉強会@Lingr 8時だョ!全員集合まとめ

| 09:54 | 6/28第5回 慢性的CL勉強会@Lingr 8時だョ!全員集合まとめ - わだばLisperになる を含むブックマーク はてなブックマーク - 6/28第5回 慢性的CL勉強会@Lingr 8時だョ!全員集合まとめ - わだばLisperになる

まとめが遅くなってしまいましたが、先日、6/28 20:00から5回目の勉強会を開催させて頂きました!

発言して頂いた方約7名、observer(ROM)の約方5、6名で、大体12名前後を推移しつつでした。

今回は、マクロの巻を終らせようということで、それが終り次第、CLの落し穴に移る予定だったのですが、マクロの巻をに1時間半費してしまいました。

今回人数は少なかったのですが、発言は多く、これまでと比べても割と活溌だったような気がします。

反省と課題

  • 30分で区切りでお題を変えるよりは、1時間半で一つのお題に集中して行なった方が良いかも。
  • 新しい課題を追加しなかったので、zickさんの予習ネタを切らしてしまった(笑) 目下、予習したくなるような面白そうなネタを探しています!

関連資料

ログ:
  1. The Power of LISP Macros

謝辞

勉強会の告知をして頂きありがとうございます!

今回も勉強会の一員に加えて頂いてありがとうございます!

次回…。

7/5日 20時から開催したいと思います!

お題は、CLの落し穴がまだ完了していないので、それを中心にしたいと思っていますが、詳しくは、明日あたりでもエントリに書きたいと思います。