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

SLIMEとElispを連携させたい その2

| 16:35 | SLIMEとElispを連携させたい その2 - わだばLisperになる を含むブックマーク はてなブックマーク - SLIMEとElispを連携させたい その2 - わだばLisperになる

コメント覧にて、佐野さんから値を取得する場合には、slime-evalを使う、と教えてもらったので早速試してみました。

slime-evalの仕様がいまいち分かっておらず、シンボルのパッケージの指定は強制的に文字列で置換した後にSLIMEに送ることにしてみました。

;; Emacs Lisp
(require 'cl)

(defun has-package-name-p (symbol)
  (and (position ?: (symbol-name symbol)) 'T))

(defun put-package-name (tree &optional pkg)
  (let ((pkg (symbol-name (or pkg 'cl-user))))
    (*put-package-name tree pkg)))

(defun *put-package-name (tree pkg)
  (cond ((null tree) () )
        ((consp (car tree))
         (cons (*put-package-name (car tree) pkg)
               (*put-package-name (cdr tree) pkg)))
        ((and (symbolp (car tree))
              (not (has-package-name-p (car tree))))
         (cons (intern (concat pkg "::" (symbol-name (car tree))))
               (*put-package-name (cdr tree) pkg)))
        ('T (cons (car tree)
                  (*put-package-name (cdr tree) pkg)))))

(defmacro cl-funcall (fn &rest expr)
  `(slime-eval 
    ',(put-package-name `(funcall ,fn ,@expr))))

;; 動作
(+ (cl-funcall #'+ 30 40) 30)
100

(cl-funcall #'ppcre:scan "良し" "これで良し")
3

効率は悪そうですが、まずこれで良しとします。cl-evalとかも欲しいかも。

SLIMEとElispを連携させたい

| 13:41 | SLIMEとElispを連携させたい - わだばLisperになる を含むブックマーク はてなブックマーク - SLIMEとElispを連携させたい - わだばLisperになる

先日はSLIME経由で、CLの関数を呼んでみたりしました(→LINK)

しかし、これだけだとつまらないので、もう一歩進んで、CLの関数をELispと混ぜて使えたら便利だなということで、適当に試してみました。

希望としては、Elisp上で

(+ 33 (cl-funcall #'fib 10))
;=> 88

みたいな事ができれば最高です。

とりあえずElisp上でCLの関数が定義できるようにしてみました。

先日定義した、slime-eval-mesgを使用します。

(defmacro define-cl-function (name arg &rest body)
  (slime-eval-mesg
   (format "(defun %s %s %s)"
           name arg (mapconcat (lambda (x) (format "%s" x)) body " "))))

(defun eval-cl (expr)
  (slime-eval-mesg (format "%s" expr)))

;; 関数を定義してみる
(define-cl-function fib (n)
  (if (< n 2)
      n
      (+ (fib (1- n))
         (fib (- n 2)))))

(eval-cl '(fib 20))
;>>> 6765

とりあえずですが、関数は定義できました。ちなみにパッケージの連携については謎です。

それで、その値を取得したい訳なのですが、

(defun cl-funcall (fn &rest args)
  (slime-eval-async
   `(swank:eval-and-grab-output 
     ,(format "(funcall #'%s %s)" 
              fn (mapconcat (lambda (x) (format "%S" x)) args " ")))
   (lambda (result)
     (setq *ans* (cadr result))))
  *ans*) ;; 大域変数に逃すという苦肉の策。しかし*ans*の値がリアルタイムに取得できない。

みたいなものを定義しても、どうやら駄目なようです。

SLIMEの値の受渡しについてもう少し探ってみる必要があるようですが、自分は、根性無しなので知っている方がいらっしゃったら是非教えて欲しいです(笑)

2008-10-29

ContextLを使ってみよう

| 12:08 | ContextLを使ってみよう - わだばLisperになる を含むブックマーク はてなブックマーク - ContextLを使ってみよう - わだばLisperになる

先日開催されたLisp50で作者のPascal Costanza氏によってデモされたこともあって、ちょっと話題になり気味のContextL。

以前から存在は知っていたのですが、コンテクスト指向とか、アスペクト指向というのがさっぱり理解できなかったので放置していました。

しかし、自分は、最近MOPづいているので、これは試してみた方が良いだろうということでとりあえず触ってだけはみることにしました。

インストールは、(asdf-install:install :contextl)のみでOK。

test/demo3.lispになんとなくの使い方と、本家サイトに論文があるので、それを眺めれば筋の良い人は理解できるんだと思います。

どうやらコンテクストという名のレイヤで階層を分けて、特定のレイヤで呼び出すとそのコンテクストに応じたメソッドが呼び出されるという仕組みのようです。

自分は筋が悪いので、良く分からないながらも適当に思い付いた利用法を書き散らかしてみることにしました。

とりあえず、クラスは定義しないで、メソッドのみを実行して遊んでみています。

(require :contextl)

(in-package :contextl-user)

;; 総称関数(defgenericみたいなもの)
(define-layered-function fib (number))

;; 基本
(define-layered-method fib ((n integer))
  (if (< n 2)
      n
      (+ (fib (1- n))
         (fib (- n 2)))))

;; 型宣言してみる/optimize-speedレイヤ
(deflayer optimize-speed)

(define-layered-method fib
  :in optimize-speed ((n integer))
  (declare (fixnum n))
  (if (< n 2)
      n
      (+ (fib (1- n))
         (fib (- n 2)))))

;; 末尾再帰で実装したもの/tail-recurレイヤ
(deflayer tail-recur)

(define-layered-method fib
  :in tail-recur ((n integer))
  (labels ((*fib (n a1 a2)
             (declare (fixnum n a1 a2))
             (if (< n 2)
                 a1
                 (*fib (1- n) (+ a1 a2) a1))))
    (*fib n 1 0)))

;; 無理矢理まぜてみたもの/mixedレイヤ
(deflayer mixed)

(define-layered-method fib
  :in mixed ((n integer))
  (declare (fixnum n))
  (if (< n 2)
      n
      (+ (with-active-layers (tail-recur)
           (fib (1- n)))
         (with-active-layers (optimize-speed)
           (fib (- n 2))))))

;; 試してみる
(progn
  (time (fib 30))

  (time 
   (with-active-layers (optimize-speed)
     (fib 30)))
  
  (time 
   (with-active-layers (tail-recur)
     (fib 30)))
  
  (time 
   (with-active-layers (mixed)
     (fib 30))))

;; >>>
Evaluation took:
  0.231 seconds of real time
  0.228015 seconds of total run time (0.228015 user, 0.000000 system)
  98.70% CPU
  554,444,019 processor cycles
  365,728 bytes consed
  
Evaluation took: optimize-speed
  0.179 seconds of real time
  0.180011 seconds of total run time (0.180011 user, 0.000000 system)
  100.56% CPU
  430,328,007 processor cycles
  219,808 bytes consed
  
Evaluation took: tail-recur
  0.000 seconds of real time
  0.000000 seconds of total run time (0.000000 user, 0.000000 system)
  100.00% CPU
  8,469 processor cycles
  3,008 bytes consed
  
Evaluation took: mixed
  0.039 seconds of real time
  0.040002 seconds of total run time (0.040002 user, 0.000000 system)
  102.56% CPU
  93,135,816 processor cycles
  0 bytes consed

まだ、レイヤが入れ子になった場合にどのレイヤが有効になるのか等、詳しく分っていませんが、なかなか面白そうです。

とか書いてみたんですが、さらに眺めてみると、fibonacci-test.lispというもっと高度なことをやってるファイルがありました…。

11/1 第22回 慢性的CL勉強会@Lingr8時だョ!全員集合告知

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

今回は、趣向を変えまして、井戸端会議的な感じで開催してみたいと思います。

内容は、2部構成で、

(1) CL家族会議

名前からすると何だか良く分かりませんが、毎週CLの活動を報告しあうことによってなんらかしらCL的行動が活性化しないかというものです。

ひとりずつ順番に

[1]今週のCL的活動を報告(書いたコード/勉強してる内容とか)

[2]疑問に思ったことを報告

[3]やってみたいことを相談

みたいな感じで報告しあったら何か面白いんじゃないのかしら、という企画です。

(2) どう書くorgを眺める

どう書くorgにも100を越えるCLのコードが蓄積されています。これらのコードを先頭からレビューしたりして眺めつつ勉強というのはどうかなという企画です。

解答されていない問題に挑戦してみるのもありかなと思いますが、簡単でないので解答されてないことが多いので時間的にちょっと厳しいんじゃないかなと思います。

場所:Lingr: Common Lisp部屋
日時11/1 (土) 20:00から適当(途中参加/離脱/ROM歓迎)
勉強会の目標CLに関して一つ位賢くなった気になること
時刻お題対象者参考リンク
20:00-21:00位まで(1)CL家族会議 (2)どう書くorg/CL部門を眺めるCLで色々書く(書きたい)方-

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

2008-10-28

mapfでonce-only

| 09:34 | mapfでonce-only - わだばLisperになる を含むブックマーク はてなブックマーク - mapfでonce-only - わだばLisperになる

ひょっとして実はmapfならonce-onlyみたいなのは綺麗に書けるんじゃないのか?と思ったので書いてみましたが、別に綺麗に書ける訳ではないようです…。というかloop以上に読み難いかもという。

(defmacro once-only ((&rest vars) &body body)
  (mapf (lambda (&rest arg)
          `(let ,(mapcar #'first arg)
             (with-gensyms ,(mapcar #'second arg)
               `(let (,,@(mapcar #'third arg))
                  ,,@body))))
        (lambda (v &aux (g (gensym)))
          `((,g ,v) ,v `(,,v ,,g)))
        vars))

;; with-gensymsも使わない版
(defmacro once-only ((&rest vars) &body body)
  (mapf (lambda (&rest arg)
          `(let ,(mapcar #'first arg)
             (let ,(mapcar (lambda (x) `(,(second x) (gensym))) arg)
               `(let (,,@(mapcar #'third arg))
                  ,,@body))))
        (lambda (v &aux (g (gensym)))
          `((,g ,v) ,v `(,,v ,,g)))
        vars))

;; 動作
(once-only (a b c)
  `(list ,a ,b ,c))
;->
(LET ((#:G2788 A) (#:G2789 B) (#:G2790 C))
  (LET ((A (GENSYM)) (B (GENSYM)) (C (GENSYM)))
    `(LET ((,A ,#:G2788) (,B ,#:G2789) (,C ,#:G2790))
       (LIST ,A ,B ,C))))

GOOでL-99 (P22 指定した範囲の数列のリスト)

| 00:15 | GOOでL-99 (P22 指定した範囲の数列のリスト) - わだばLisperになる を含むブックマーク はてなブックマーク - GOOでL-99 (P22 指定した範囲の数列のリスト) - わだばLisperになる

久々にGOOをひっぱり出してきてみました。何に由来するのか分かりませんが、GOOの作法はひどく覚えにくいと感じます。

多分、命名規則が、他のLISP方言と違うところにあるのではないかと思うのですが、この違いというのが、はっきりくっきり違うというのではなくて、微妙に違うというところが逆に覚えづらい気がします。あと関数名を短くしすぎなのも微妙に覚えづらい。あと引数の順番とか、微妙に逆。そしてマニュアルも微妙に独自。

今回は、総称関数にする必要もないので、関数です。define-functionの略のdfを使用。

(df my-range (start|<num> end|<num> by|... => <seq>)
  (def ans (packer-fab <lst>))
  (def by (if (empty? by) 1 (1st by)))
  (def r (if (<= start end)
             (range-by start <= end (op + _ by))
             (range-by start > end (op - _ by))))
  (for ((x r)) (pack-in ans x))
  (packer-res ans))

(my-range 4 9)
;=> (4 5 6 7 8 9))
(my-range 9 4)
;=> (9 8 7 6 5 4)
(my-range 3 3)
;=> '(3)

2008-10-27

EMACSからSLIMEにS式を投げてEMACS側で受けとりたい

| 05:28 | EMACSからSLIMEにS式を投げてEMACS側で受けとりたい - わだばLisperになる を含むブックマーク はてなブックマーク - EMACSからSLIMEにS式を投げてEMACS側で受けとりたい - わだばLisperになる

自分は、はてな日記をsimple-hatena-modeで書いて、SLIMEで投稿ということを試みているのですが、EMACS->SLIMEという風にSLIMEに式を送ることは比較的簡単なのですが、SLIMEから結果を受けとる方法は良く分からないので放置していて、面倒なのでREPLから投稿したりしていました。(とはいえSLIMEのREPLには履歴機能があるのでそんなに不便でなかったりします)

しかし、SLIMEは、EMACSとCL処理系の連携をしているわけであり、結果を受け取れない筈はありません。

という訳でちょっとslime.elを追っ掛けてみたら、すぐ目的の関数はみつかってしまいました。

目的の関数は、slime-eval-printという関数で、式を文字列として受けとって、結果をS式で返してくれる関数のようです。

これをちょっと改造すれば色々応用できそうだということで、結果をエコーエリアに表示してくれるようなものを作成しました。

(defun slime-eval-mesg (string)
  "Eval STRING in Lisp; Echo any output."
  (slime-eval-async `(swank:eval-and-grab-output ,string)
                    (lambda (result)
                      (destructuring-bind (output value) result
                        (message (format "%s" value))))))

この関数の動作の詳細は良く分かっていないので、本当に適当です。(outputは、出力、valueは返り値の様子)

それで、simple-hatena-modeの日記を投稿する関数/simple-hatena-submitを上書きして内容をCLのはてな日記を投稿する関数を呼び出すようにします。

(defun simple-hatena-submit ()
  (interactive)
  (slime-eval-mesg "(post-todays-group-entry)"))

CL側のpost-todays-group-entryは、日記を投稿して成功したら文字数を返すような関数で、成功すれば、エコーエリアに文字数が表示されることになります。

ということで、早速このエントリもこの仕組みで投稿していますが、今のところは上手く行っているようです。(エラー時のリカバリはどうするのかという謎は残っていますが…)

2008-10-25

第21回慢性的CL勉強会@Lingr8時だョ!全員集合まとめ

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

本日、10/25 20:00から21回目の勉強会を開催させて頂きました!

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

今回は、onjo(lispuser.net)さんによる、永続化第2弾で、cl-prevalenceについてでした。

良かったところ

分かりやすい解説のお蔭でcl-prevalenceは思ったより敷居が低くシンプルな方式で、割と気軽に利用できるのではないかと思えました。

ログ:

謝辞:

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

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

Cyan風のif

| 03:10 | Cyan風のif - わだばLisperになる を含むブックマーク はてなブックマーク - Cyan風のif - わだばLisperになる

デフォルトでif-let風味なCyanのifが面白いので、CLのマクロで真似してみました。

2種類考えたのですが、letのバインド部をそのまんまifの判定のところに埋め込んでしまったバージョンのcifと、代入的な構文の時のみif-letに展開されて普通の場合はifになるというcif2です。

やはり、変数が複数になった場合どうするんだろうねという感じなのですが、cifは全部のandをとる、cif2は、変数1つということにしました。

ちなみに、if-letとの違いですが形がちょっと違ってるだけです(笑)

;;; cif
(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun car-or-atom (obj)
    (if (consp obj)
      (car obj)
      obj)))

(defmacro cif (pred con &optional alt)
  (let ((vars (mapcar #'car-or-atom pred)))
    `(let ,pred
       (declare (ignorable ,@(remove nil vars)))
       (if (and ,@vars)
           ,con
           ,alt))))

;; 動作
(cif ((x "そのとおり") (y t) (z (zerop (random 2))))
     (format t "はい~A~%" x)
     (format t "いいえ~%"))
;=> はいそのとおり(ランダム)

;;; cif2
(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun cif-bind-p (obj)
    (and (consp obj)
         (= 3 (length obj))
         (string-equal "=" (second obj)))))
  
(defmacro cif2 (pred con &optional alt)
  (if (cif-bind-p pred)
      `(let ((,(first pred) ,(third pred)))
         (cif2 ,(first pred) ,con ,alt))
      `(if ,pred ,con ,alt)))

;; 動作
(cif2 (x := "そのとおり")
      (format t "はい~A~%" x)
      (format t "いいえ~%"))
;=> はいそのとおり

(cif2 "そのとおり"
      (format t "はい~%")
      (format t "いいえ~%"))
;=> はい

Cyan面白い

| 01:56 | Cyan面白い - わだばLisperになる を含むブックマーク はてなブックマーク - Cyan面白い - わだばLisperになる

L-99でトラックバックが飛んで来たのでTB元を覗いてみたのですが、LISP風なマクロが書けつつS式でないという面白い俺言語の作者さんのブログでした。

この俺言語はCyan(さいあん)というらしいのですが、面白そうなので早速インストール。

インストールは、Ubuntu 8.04では「→no title」のページからダウンロードして展開するだけでした。

マクロが書けるということで、やっぱり早速マクロを書いてみようという感じなのですが、とりあえず、aifだろうということで、作ってみました。

mac(aif)^(pred, con, alt):
  `let^(&opt it = ?pred):
     if(it):
       ?con
      else:
       ?alt

aif("こんにちは", say(it), say(it))
#=> こんにちは。

しかし、これだと、構文っぽくないので、サンプルコードを探していたら、なんと最初からaifが定義してありました(*'-')

ということで、それを参考に書き直し

mac(maif)^(pred, con, &key alt):
  `let^(&opt it = ?pred):
     if(it, ?con, :else ?alt)

maif("こんにちは"):
  say(it)
 else:
  false
#=> こんにちは

aifが最初から備え付けであったので、じゃあ、when-letを定義してみようということで、定義してみました。

mac(whenlet)^(var, val, body):
  `let^(&opt ?var = ?val):
     if(?val, ?body, :else false)

whenlet(x, 3):
  say(x)
#=> 3

Cyanのletの形式と合せる程マクロの書き方を分かっていないので中途半端な感じなのですが、色々探っていたら、Cyanの場合、元から、if等は、if-letの様な動きをすることが分かりました。

if(x = "そのとおり"):
  say("はい" + x)
 else:
  say("いいえ")
#=> はいそのとおり

なるほど! これは便利。

他にもCyanには面白いところが沢山あるので動かして色々試してみると楽しいと思います!

2008-10-22

ClojureでL-99 (P26 指定した個数を抜き出す組み合わせ)

| 17:01 | ClojureでL-99 (P26 指定した個数を抜き出す組み合わせ) - わだばLisperになる を含むブックマーク はてなブックマーク - ClojureでL-99 (P26 指定した個数を抜き出す組み合わせ) - わだばLisperになる

Arcの[]や、Clojureの#()は、便利なんですが、更に進んで、mapの等で、`#(~(first coll) ~@%)みたいに書きたくなることが結構あります。どっちも今のところできません。というか、筋道立てて考えるとそもそも無理な相談という感じなのですが。

(defn 
  #^{:doc "P26 (**) Generate the combinations of K distinct objects 
chosen from the N elements of a list"
     :test (do (test= (combination 0 [1 2 3]) [])
               (test= (combination 88 []) [])
               (test= (count (combination 3 (range 12))) 220))}
  combination
  ([num coll]
     (cond (or (empty? coll) (>= 0 num)) 
           []
           (= 1 num) 
           (map list coll)
           :else
           `(~@(map #(cons (first coll) %)
                    (combination (- num 1) (rest coll)))
             ~@(combination num (rest coll))))))

2008-10-21

ClojureでL-99 (P25 ランダムに並び換え)

| 12:21 | ClojureでL-99 (P25 ランダムに並び換え) - わだばLisperになる を含むブックマーク はてなブックマーク - ClojureでL-99 (P25 ランダムに並び換え) - わだばLisperになる

ちょっと鬱気味だなあと思ったら、L-99をやってませんでした。いけないいけない。L-99は心が安らぎます。

(defn 
  #^{:doc "P25 (*) Generate a random permutation of the elements of a list."
     :test (do (test= (rnd-permu []) [] ))}
; ---------
  rnd-permu
; ---------
  ([coll]
     (rnd-select coll (count coll))))

2008-10-20

mapf私の解答

| 00:47 | mapf私の解答 - わだばLisperになる を含むブックマーク はてなブックマーク - mapf私の解答 - わだばLisperになる

割と無茶な感じなのですが、がんばってみました。ひどいです(笑)

catchとthrowをgensymにしていますが、これはコンパイルした場合にタグ名の競合は回避できるのでしょうかという謎。

(eq '#:foo '#:foo)
;=> NIL
(eq #0='#:foo #0#)
;=> T

という感じなので大丈夫なのかしら。

--

1. onjoさん(lispuser.net)にも挑戦して頂けました!

流石、綺麗な解答です(*'-')

2. quekさんにも挑戦して頂けました!

なるほど!、catch/throwを使わなくても解けるという例ですね。

3. youzさんの解答

これもすっきり纏まっていて素晴らしい!

皆それぞれ面白いですねー。GOとか関数跨いでTHROWしてるのは私だけでした(笑)

--

;; g000001の苦戦
(progn
  (defun mapleave (&optional vals)
    (throw '#0=(gensym "MAPFLEAVE-") vals))
  
  (defun mapstop (&rest vals)
    (throw '#1=(gensym "MAPSTOP-") (copy-list vals)))
  
  (defun mapret (&rest vals)
    (throw '#2=(gensym "MAPRET-") (copy-list vals)))
  
  (defun mapf (finalf loopf &rest lists)
    ;; mapleave
    (catch '#0#
      (prog* ((lists (copy-tree lists)) 
              (len (length lists))
              (ans (list :ans))
              (tem ans))
       :top  (when (some #'endp lists) (go :fin))
             (progn
               ;; mapstop
               (setf (cdr tem)
                     (catch '#1#
                       ;; mapret
                       (setf (cdr tem)
                             (catch '#2#
                               ;; nomal
                               (setf (cdr tem)
                                     (list
                                      (apply loopf (and lists 
                                                        (mapcar #'car lists)))))
                               (or finalf (go :esc)) ;finalf?
                               (setf tem (cdr tem))
                               (go :esc)))
                       (setf tem (last tem))
                       (go :esc)))
               (setf tem (last tem))
               (go :fin))
       :esc  (dotimes (i len) (pop (nth i lists)))
             (go :top)
       :fin  (return (and finalf (apply finalf (cdr ans))))))))

2008-10-18

L4uの->とit

| 23:43 | L4uの->とit - わだばLisperになる を含むブックマーク はてなブックマーク - L4uの->とit - わだばLisperになる

今日は、Shibuya.lispで色々と興味深いお話を聴けて非常に面白かったです。

なかでもmitamex4uさんのL4uで面白そうなアイディアが披露されていたので、マクロで真似てみました。

※quekさんがLingrでもっと綺麗なバージョンを披露されています('-'*)

http://www.lingr.com/room/common-lisp-jp/archives/2008/10/19#msg-49982339

(defmacro with-l4u (&body body)
  `(let (it)
     (macrolet ((-> (fn &rest args)
                  `(apply #',fn it ',args)))
       ,@(mapcar (lambda (x)
                   `(setq it ,x))
                 body))))
(with-l4u
  4
  (-> print)
  (-> list :foo :bar :baz)
  (print it))

;>>> 4 
;>>> (4 :FOO :BAR :BAZ) 

aifのような、itは、なでしこ由来だそうで、こういうのは確かに書きたくなることがあると思います。

->は、前の評価を次の第1引数に送り込むものだそうなので、そういう感じで作ってみました。

2008-10-16

ClojureでL-99 (P24 ロトくじ)

| 12:21 | ClojureでL-99 (P24 ロトくじ) - わだばLisperになる を含むブックマーク はてなブックマーク - ClojureでL-99 (P24 ロトくじ) - わだばLisperになる

こういうランダムな場合に上手く条件をテストできる方法が知りたいと思ったり。

(defn
  #^{:doc "P24 (*) Lotto: Draw N different random numbers from the set 1..M."}
; ------------
  lotto-select
; ------------
  ([nums rng]
     (if (or (>= 0 rng) (>= 0 nums)) 
       nil
       (rnd-select (range 1 (+ 1 rng)) nums))))

2008-10-15

【どう書く】MDL/Muddleのmapfを作る

| 17:29 | 【どう書く】MDL/Muddleのmapfを作る - わだばLisperになる を含むブックマーク はてなブックマーク - 【どう書く】MDL/Muddleのmapfを作る - わだばLisperになる

deliciousを眺めていたところ、MDLの古いマニュアルをみつけることができました。

MDLとは、MITで開発されていたLISP系の処理系でZetalisp〜Common Lispのオプショナル引数等の複雑なラムダリストキーワドやバッククオートのアイディアの源泉らしいです。

The MDL Programming Language Primer:

ということで、つらつらとマニュアルを眺めていたのですが、このマニュアルで紹介されているmapfというのが何だか面白そうなので再現してみることにしました。

しかし、ただ再現するだけでは面白くないので、挑戦問題として掲げてみることにしました。

mapfの仕様は下記の通りです。

(mapf final-function loop-function &rest lists)
基本動作

殆どmapcarのようなものなのですが、結果にfinal-functionを適用するというのが違います。

副作用のみに使用する等の目的でfinal-functionにはnilも指定でき、final-functionを省略可能です。

(mapf #'list #'identity '(1 2 3 4))
;=> (1 2 3 4)

(defun mappend (fn &rest lists)
  (apply #'mapf #'append fn lists))

(mappend #'list 
         '(1 2 3 4 5)
         '(a b c d e))

;=> (1 A 2 B 3 C 4 D 5 E) 

loop-function内で利用できる関数

mapleave

mapleaveという関数が利用でき、呼び出された場合は、mapleaveの引数を返り値にして終了します。(returnみたいなもの)

(defun first-nonzero (list)
  (mapf ()
        (lambda (x)
          (when (not (zerop x)) (mapleave x)))
        list))

(first-nonzero '(0 0 0 0 9 0 0))
;=> 9
mapret

mapretという関数が利用でき、呼び出された場合は、mapretの引数を蓄積します。

複数の値が指定された場合は、1つのリストで合体するのではなく、スプライスされた状態でくっつきます。

また、mapretの引数が省略された場合は、何も蓄積されません。

(defun odd-list (list)
  (mapf #'list
        (lambda (x) (if (oddp x)
                        x
                        (mapret)))
        list))

(odd-list '(1 2 3 4 5))
;=> (1 3 5)

(defun odd-list2 (list)
  (mapf #'list
        (lambda (x) (if (oddp x)
                        x
                        (mapret 'e 'ven)))
        list))

(odd-list2 '(1 2 3 4 5))
;=> (1 E VEN 3 E VEN 5)
mapstop

mapstopという関数が利用でき、呼び出された場合は、それまでの蓄積された結果と、mapstopの引数を合成して返します。

(defun first-ten (list)
  (let ((cnt 10))
    (mapf #'list
          (lambda (x)
            (when (zerop (decf cnt)) (mapstop 10))
            x)
          list)))

(first-ten '(1 2 3 4 5 6 7 8 9 10 11 12))
;=> (1 2 3 4 5 6 7 8 9 10)
引数指定でリストを省略できる

mapfでは、final-functionと、loop-functionのみで、リストを取らずに使用することも可能です。

この場合、mapstopや、mapleaveで抜ける必要があり、loop-functionでの値は蓄積されます。

(defun lnum (n &aux (cnt 0))
  (mapf #'list
        (lambda ()
          (if (<= n (incf cnt))
              (mapstop n)
              cnt))))
;=> (lnum 10)
(1 2 3 4 5 6 7 8 9 10)

というような仕様です。コードの例は、MDLの例をCLに翻訳してみました。

詳しくは、マニュアルを眺めてみると分かりやすいかもしれません。

CLでの実装は、割と良い感じにトリッキーなコードにならざるを得ないと思うので、暇な時のパズルにでもどうでしょうか!

自分の解答は、来週位にエントリしてみたいと思います。…誰も挑戦してくれなさそうですが挑戦お待ちしています!

lisp2で、functionがうざい問題

| 07:28 | lisp2で、functionがうざい問題 - わだばLisperになる を含むブックマーク はてなブックマーク - lisp2で、functionがうざい問題 - わだばLisperになる

一定周期で耳にするCLの#'がうざい問題ですが、今日のチャットでも話題になったので、また色々考えてみました。

前のネタとしては、symbol-valueに、symbol-functionの値をグローバルにセットしてしまえば、#'を書く手間だけは省けるだろうというものでしたが、

そういえば、lisp1という、CLをlisp1的に書く試みがどっかにあったなと思い出したので、探して試してみました。

ちょっと試してみたのですが、ネタ的には、やはり、symbol-functionの値をsymbol-valueにセットするというのが骨子なようです(笑)

ついでにローカルな感じでlisp1的に書けるwith-lisp1ってのを考えてみました。ちなみに局所関数には対応してません。

(import 'kmrcl:flatten)

(defmacro with-lisp1 (&body body)
  (let ((syms (remove-if-not (lambda (x) 
                               (and (symbolp x) 
                                    (fboundp x)
                                    (not (eq 'quote x))))
                             (flatten body))))
    `(let ,(mapcar (lambda (x) `(,x (symbol-function ',x))) syms)
       (declare (ignorable ,@syms))
       ,@body)))

;; 動作
(with-lisp1
  (mapcar 1+ '(1 2 3 4)))
;=> (2 3 4 5)

(with-lisp1 
  (sort (list 38 29 3 1) <))

;=> (1 3 29 38)

2008-10-14

10/25 第21回慢性的CL勉強会@Lingr8時だョ!全員集合告知

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

今週は、順当な流れで行くと、第21回目のCL勉強会なのですが、10/18日はShibuya.lispと正面からぶつかってしまい、参加者が少ないことが懸念されるということで、21回目は、10/25日にずれることになりました。

21回目のお題は、onjoさんによる「Common Lisp と永続化 (2)」で、

  • CL-PREVALENCE

ルートオブジェクトから辿れるオブジェクトの構造を保存する仕組み

  • CL-SQL

RDBMS とのインターフェースの紹介

の二本立てです。

時間的には30〜1時間程度ではないかと予想されます。

場所:Lingr: Common Lisp部屋
日時10/25 (土) 20:00から適当(途中参加/離脱/ROM歓迎)
勉強会の目標CLに関して一つ位賢くなった気になること
時刻お題対象者参考リンク
20:00-21:00位までCommon Lisp 永続化入門 〜復活の呪文から冒険の書まで(2)〜CLで色々書く(書きたい)方-

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

ClojureでL-99 (P23 ランダムに指定した個数の要素を選択)

| 06:37 | ClojureでL-99 (P23 ランダムに指定した個数の要素を選択) - わだばLisperになる を含むブックマーク はてなブックマーク - ClojureでL-99 (P23 ランダムに指定した個数の要素を選択) - わだばLisperになる

P20で作ったremove-atを使用します。どうも、ぱっとしない出来。

(defn
  #^{:doc "P20 (*) Remove the K'th element from a list."
     :test (do (test= (rnd-select [] 3) [])) }
; ----------
  rnd-select
; ----------
  ([coll num]
     (loop [coll coll, cnt 1, len (length coll), ans [] ]
       (if (or (empty? coll) (> cnt num))
         ans
         (let [p (rand-int len)]
           (recur (remove-at coll (+ 1 p))
                  (+ 1 cnt)
                  (+ -1 len)
                  (conj ans (nth coll p))))))))

2008-10-13

TAOの!をCLで再現したい

| 10:09 | TAOの!をCLで再現したい - わだばLisperになる を含むブックマーク はてなブックマーク - TAOの!をCLで再現したい - わだばLisperになる

ELISは国産Lispマシンで、その処理系である、TAO/ELISは、PrologとSmalltalkとZetalispを足したような感じになっています。

このTAO/ELIS以外にも、その後続のTAO/SILENT等バリエーションはあるようなのですが、TAO/ELISはマニュアルが公開されているので、マニュアルから動作を推測してCLで関数/マクロを作ってみるのも一興です。

ということで、自分は、昨年あたりに毎日TAOのマニュアルを眺めながら、関数を作成していた訳なのですが、CLで真似するには一筋縄では行かないようなものが沢山あります。

その中の一つが今回のテーマである!の解釈なのですが、TAOでは、!を色々に解釈します。

  1. (!x 3) → (setf x 3)のような代入の構文として
  2. (! nil ! t) → バックトラックするor
  3. (! nil ! t) → 同じくバックトラックする構文でのカット記号
  4. cdr!、cons! → 普通の関数名/マクロ名に現われる
  5. (!!cons !x y) → 自己代入式の!!
  6. (!!cons !x y) → 同じく、自己代入式での代入される変数の目印としての!

という風に様々です。

単体の!等はリーダーマクロにしても良いのですが、そうすると他の!が上手く動かず、普通のマクロにしては、!xや、!!consという風に表記することもできません。

ということで、色々悩んで、アスキー文字以外のものを使ってみることも考えたりしました(TAOの!! - わだばLisperになる - cadr group)が、今回他の方法として、!!と、!は、妥協してディスパッチマクロにしてしまうことにしました。

とりあえず、!は、setfに置き換えてしまえば解決しますが、それだけだと!!が動かなくなってしまうので、

(set-dispatch-macro-character #\# #\!
                              (lambda (stream char arg)
                                (declare (ignore char arg))
                                (if (char= #\! (peek-char nil stream))
                                    (progn
                                      (read-char stream nil nil)
                                      'selfass)
                                    'setf)))

としてみました。

それで、!!はselfassという名前をつけて#!!から展開するようにします。

(defmacro selfass (fn &rest args)
  (let (var nargs)
    (dolist (item args)
      (if (and (symbolp item)
               (string-equal "!" (subseq (string item) 0 1)))
          (LET ((sym (intern (subseq (string item) 1))))
            (push sym var)
            (push sym nargs))
          (PUSH item nargs)))
    `(setq ,(car var) (,fn ,@(nreverse nargs)))))
(let ((foo 0))
  (#!foo 3)
 
  (#!!cons !foo ())
  foo)
;=> (3)

(let ((x 40))
  (#!!list 10 20 30 !x 50)
  x)

;=> (10 20 30 40 50)

#が気になりますが、とりあえず、良しとします。

それで他のリーダーマクロではないものですが、

cdr!は、(setq foo (cdr foo))のような動きをするもので、cons!も似た感じで、(cons! x y) → (setq x (cons x y))という物です。

cdr!はpopと副作用は同じですが返り値がcdrって感じなのでしょうか。

あとは、バックトラックするorの!ですが、これは、Prolog系の節で使うらしく、マニュアルからだけでは、詳細が不明なのですが、とりあえず無理に作ってみました。

こんな感じに動作します。

(let ((foo 0)
      result)
  (! result
     (= foo 100)
     (progn (#!!1+ !foo) 
            (#!!append !result (list foo)))))

(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27
 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51
 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75
 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99
 100)

動作の解説ですが、

1. resultはnilなので先に進む(ORなので…)

2. (= foo 100)はnilなので先に進む

3. (progn (#!!1+ !foo) (#!!append !result (list foo)))/CL風だと(progn (incf foo) (push foo result))/は、非nilなので前に戻る

4. (= foo 100)はnilなので先に進む

... 繰り返し...

5. (= foo 100)はtなので前に戻る

6. resultは非nilなので戻りたいが、入口なので結果となる

という感じかなと思っています。

ちなみに、補助変数が取れるので、

(! (&aux (foo 0) result)
   result
   (= foo 100)
   (progn (#!!1+ !foo) 
          (#!!append !result (list foo))))

とも書けます。

また、多分、

(! nil ! nil nil)

みたいな場合は、カットを入れないと無限ループじゃないかなあと推測しています。

以下が、作成してみたコードですが、GOTOしまくりで、かなり無理矢理ですので、良かったらマクロ展開してみて下さい(笑)

もっと良い書き方あるよ!、TAOじゃそんな動きはしないよ!等々のアドバイスお待ちしております!

(defmacro ! (&body forms)
  (let ((aux-vars (and (consp (car forms))
                       (string-equal '&aux (string (caar forms)))
                       (prog1 (cdar forms) (pop forms))))
        (exit (gensym "EXIT-")))
    (cl:loop 
       :with cuts 
       :and tags := (list exit)
       :and body 
       :and ans := (gensym "ANS-")

       :for x :in forms
       :if (and (symbolp x) (string-equal '! x))
       :do (progn
             (push (gensym "CUT-") cuts)
             (push `(if ,(car cuts) (go ,exit) (setq ,(car cuts) t))
                   (cdr body)))
       :else 
       :do (progn
             (push (gensym "TAG-") tags)
             (push (car tags) body)
             (push `(and (setq ,ans ,x) (go ,(cadr tags))) body))
       :finally (return `(prog* (,ans ,@aux-vars ,@cuts)
                            ,@(nreverse body)
                            ,exit
                            (return ,ans))))))

ClojureでL-99 (P22 指定した範囲の数列のリスト)

| 06:26 | ClojureでL-99 (P22 指定した範囲の数列のリスト) - わだばLisperになる を含むブックマーク はてなブックマーク - ClojureでL-99 (P22 指定した範囲の数列のリスト) - わだばLisperになる

fromの反対のdownfromとか定義してみましたが、もう一工夫という感じです。

ちなみに、標準で、Clojureには、rangeがありますが、このお題と同じ動きではありません。

(defn downfrom 
  ([start]
     (downfrom start 1))
  ([start step]
     (iterate #(- % step) start)))

(defn
  #^{:doc "P22 (*) Create a list containing all integers within a given range."
     :test (do (test= (my-range 4 9)
                      '(4 5 6 7 8 9))
               (test= (my-range 9 4)
                      '(9 8 7 6 5 4))
               (test= (my-range 3 3)
                      '(3)))}
; --------
  my-range
; --------
  ([start end]
     (cond (< start end) 
           (take (+ 1 (- start) end) (from start))
           (> start end) 
           (take (+ 1 start (- end)) (downfrom start))
           :else
           (list start))))

2008-10-12

第20回慢性的CL勉強会@Lingr8時だョ!全員集合まとめ

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

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

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

今回は、Let Over Lambdaの2章から、3章のまでの概要30分、その後onjoさんの「Common Lisp 永続化入門 〜復活の呪文から冒険の書まで〜」で、1時間程度でした。

良かったところ

今回もonjoさんのプレゼンは分かりやすく素晴らしかったです。

反省と課題

今回、Let Over Lambdaはかなり飛していたので、ついてこれない方が多かったようです。

ただし、Let Over Lambdaの回は、「こういう技法がこの本で、紹介されてるよ!」というのがメインなので、ざっとでやってます。

が、しかし、それにしても飛し過ぎたかも(;´Д`)

ログ:
onjoさん発表資料「Common Lisp と永続化 (1)」

謝辞:

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

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

2008-10-10

ClojureでL-99 (P21 指定した位置に要素を挿入する)

| 06:42 | ClojureでL-99 (P21 指定した位置に要素を挿入する) - わだばLisperになる を含むブックマーク はてなブックマーク - ClojureでL-99 (P21 指定した位置に要素を挿入する) - わだばLisperになる

前回と同じく無限リストを利用してみました。あとおまけで、EmacsのC-tのような操作でくるくるひっくり返してゆくパターンを思い付いたので書いてみました。

とりあえず、condの節の括弧はやっぱりあった方が良いと思うんですよねー。

(defn
  #^{:doc "P21 (*) Insert an element at a given position into a list."
     :test (do (test= (insert-at 'alfa '(a b c d) 2)
                      '(a alfa b c d))
               (test= (insert-at 'alfa [] 2)
                       '(alfa))        
               (test= (insert-at 'alfa '(a b c d) -2)
                      '(alfa a b c d))
               (test= (insert-at 'alfa '(a b c d) 100)
                      '(a b c d alfa))) }
; ---------
  insert-at
; ---------
  ([item coll pos]
     (let [len (count coll)]
       (cond 
        (empty? coll) 
        (list item)
        ;; 
        (>= 0 pos) 
        (cons item coll)
        ;; 
        (<= len pos) 
        (concat coll (list item))
        ;; 
        :else 
        (mapcat #(if (= pos %1) 
                   (list item %2)
                   (list %2))
                (from 1)
                coll)))))

;; 要素をくるくるひっくり返しつつ送ってゆくパターン
(defn insert-at
  ([item coll pos]
     (loop [coll (cons item coll), cnt pos, acc [] ]
       (if (or (>= 1 cnt) (nil? (rest coll)))
         (concat (reverse acc) coll)
         (recur (cons (first coll) (rrest coll))
                (+ -1 cnt)
                (cons (second coll) acc))))))

Flavorsとデザインパターン - Template Method

| 05:18 | Flavorsとデザインパターン - Template Method - わだばLisperになる を含むブックマーク はてなブックマーク - Flavorsとデザインパターン - Template Method - わだばLisperになる

最近Lispマシンのエミュレータを触ってないので、Flavorsでデザインパターンネタはどうかなと思って書いてみました。

とりあえず先日のTemplate Methodです。

Flavorsは、メソッドがクラス属していて、マルチメソッドでもないので、Javaの例を写すにもなんとなくしっくりくる気もします。

CADRエミュレータのFlavorsは最初期のもので、sendの代わりに<-を使用します。

ちなみに、この時期は、<-とfuncallは同じもので、インスタンスをfuncallしてもOKで、(funcall-self 'key)という構文もあり、(<- self 'key)と同じです。

キーワードに一々quoteを付けないといけないのですが、ソースのコメント等では、quoteは無く、この辺が歴史的変遷というか、謎の一つです。

さらにちなむと、Allegro CLには、Flavorsが付いてくるので、AllegroのFlavorsで遊んでみるのも一興かもしれません。

(defflavor abstract () ())

(defmethod (abstract :template-method) (str)
  (<- self ':op2 (<- self ':op1 str)))

(defflavor concrate () (abstract))

(defmethod (concrate :op1) (str)
  (string-upcase str))

(defmethod (concrate :op2) (str)
  (string-reverse str))

(<- (make-instance 'concrate) ':template-method "foo")
;=> OOF

(defflavor concrate2 () (abstract))

(defmethod (concrate2 :op1) (str)
  (string-pluralize str))

(defmethod (concrate2 :op2) (str)
  (string-reverse str))

(<- (make-instance 'concrate2) ':template-method "foo")

;=> soof

CLとデザインパターン - State

| 02:19 | CLとデザインパターン - State - わだばLisperになる を含むブックマーク はてなブックマーク - CLとデザインパターン - State - わだばLisperになる

Template Methodは割とピンとくるものがあったのですが、次はどれにしようかと色々と物色。

どうも、それぞれのパターンの概念が飲込めないので苦戦しています。

とりあえず、Stateパターンは理解できた気がしたので、CLOSで考えてみることに。

Norvig氏によれば、ファーストクラスの型があれば、それで代用可能みたいなことが書いてありましたが、どういうことなんでしょうか。型を変数に格納して渡す?。うーむ。

それで、Stateパターンですが、状態xすることの状態遷移表をそのまま実装したりする簡単になるそうです。確かにそうかもしれません。自分的には、上位のクラスで抽象的な処理を書いて下位のクラスで具体的に実装というところが、前回のTemplate Methodに似ていて、それが束になったような印象もありますが、実際のところはどうなんでしょう。

Greg Sullivan氏の解説では、状況の変更にはchange-classが使えるだろう、とのことだったので、何も考えないで使ってみました。

下の表で言えば、横軸の変化に、change-class、縦の変化には、actionメソッドでの変化ということになるでしょうか。更にactionメソッド内でchange-classを実行すれば、色々変化できそうではあります。

状況
行動挨拶挨拶挨拶
天気についてなし天気について
(defclass foo-state () ())
(defclass asa (foo-state) ())
(defclass hiru (foo-state) ())
(defclass ban (foo-state) ())

(defgeneric action (stat)
  (:documentation "なんらかの行動"))

(defmethod action ((stat foo-state))
  (foo-mesg stat)
  (tenki stat))

(defgeneric foo-mesg (stat)
  (:documentation "挨拶"))

(defmethod foo-mesg ((stat foo-state)))
(defmethod foo-mesg ((stat asa))
  (format 'T "おはよう、おはよう~%"))
(defmethod foo-mesg ((stat hiru))
  (format 'T "こんにちは、こんにちは~%"))
(defmethod foo-mesg ((stat ban))
  (format 'T "こんばんは、こんばんは~%"))

(defgeneric tenki (stat)
  (:documentation "天気について言及"))
(defmethod tenki ((stat foo-state))))
(defmethod tenki ((stat asa))
  (format 'T "良い朝ですね~%"))
(defmethod tenki ((stat ban))
  (format 'T "良い夜ですね~%"))


;; 実験
(let ((stat (make-instance 'hiru)))
  (mapc (lambda (x)
          (change-class stat x) 
          (action stat)
          (format 'T "----~%"))
        '(asa hiru ban)))

;>>>
おはよう、おはよう
良い朝ですね
----
こんにちは、こんにちは
----
こんばんは、こんばんは
良い夜ですね
----

2008-10-09

ClojureでL-99 (P20 指定した要素を削除)

| 21:31 | ClojureでL-99 (P20 指定した要素を削除) - わだばLisperになる を含むブックマーク はてなブックマーク - ClojureでL-99 (P20 指定した要素を削除) - わだばLisperになる

1..∞ な遅延リストと、リストを対応付けて解いてみました。

fromは、pfcから拝借(pfcのことなのでHaskellとかが元ネタかも…)。

fromの中のiterateは、初期値に関数を適用して、その結果にまた関数を適用して…な遅延リストを作成します。

stepはオプショナルにしていますが、clojureの場合、オプショナル引数は、オプションがある場合とない場合を分けて記述します。この辺がCLとはちょっと違うところ。

(defn
  #^{:doc "P20 (*) Remove the K'th element from a list."
     :test (do (test= (remove-at [] 3) [])
               (test= (remove-at '(a b c d) -3)
                      '(a b c d))
               (test= (remove-at '(a b c d) 100)
                      '(a b c d))
               (test= (remove-at '(a b c d) 2)
                      '(a c d))) }
; ---------
  remove-at
; ---------
  ([coll pos]
     (if (empty? coll)
       []
       (mapcat #(if (= pos %1) [] (list %2))
               (from 1)
               coll))))

(defn from 
  ([start]
     (from start 1))
  ([start step]
     (iterate #(+ step %) start)))

2008-10-07

10/11 第20回慢性的CL勉強会@Lingr8時だョ!全員集合告知

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

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

今回のお題は、先週のLet Over Lambdaの続き(2章途中から)とonjoさんの「Common Lisp 永続化入門 〜復活の呪文から冒険の書まで〜」で、前半30分、後半30〜という予定です。

場所:Lingr: Common Lisp部屋
日時10/11 (土) 20:00から適当(途中参加/離脱/ROM歓迎)
勉強会の目標CLに関して一つ位賢くなった気になること
時刻お題対象者参考リンク
20:00-21:30位までCommon Lisp 永続化入門 〜復活の呪文から冒険の書まで〜、その他CLで色々書く(書きたい)方-

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

2008-10-06

ClojureでL-99 (P18 範囲切り出し)

| 21:31 | ClojureでL-99 (P18 範囲切り出し) - わだばLisperになる を含むブックマーク はてなブックマーク - ClojureでL-99 (P18 範囲切り出し) - わだばLisperになる

Clojureには標準でsubseqがあります。

(defn
  #^{:doc "P18 (**) Extract a slice from a list."
     :test (do (test= (slice [] 3 7) [])
               (test= (slice '(a b c d e f g h i k) 3 7)
                      '(c d e f g))
               (test= (slice '(a b c d e f g h i k) -3 7)
                      (slice '(a b c d e f g h i k) 1 7))
               (test= (slice '(a b c d e f g h i k) -3 100)
                      '(a b c d e f g h i k))) }
; -----
  slice
; -----
  ([coll start end]
     (if (empty? coll)
       []
       (let [len (count coll), start (max start 1), end (min end len)]
         (loop [coll coll, pos 1, acc [] ]
           (if (or (empty? coll) (< end pos))
             (reverse acc)
             (recur (rest coll)
                    (+ 1 pos)
                    (if (<= start pos end)
                      (cons (first coll)
                            acc)
                      acc))))))))

2008-10-05

ClojureでL-99 (P17 指定した位置でリストを分割)

| 17:18 | ClojureでL-99 (P17 指定した位置でリストを分割) - わだばLisperになる を含むブックマーク はてなブックマーク - ClojureでL-99 (P17 指定した位置でリストを分割) - わだばLisperになる

ありあわせの関数を使っちゃいけないということなので自前で処理しましたが、take、drop、take-while等々あるのでそれを使えば簡単に書けます。

(defn 
  #^{:doc "P17 (*) Split a list into two parts; the length of the first part is given."
     :test (do (test= (split [] 3) [[] []])
               (test= (split '(a b c d e f g h i k) 3)
                      '((a b c) (d e f g h i k)))
               (test= (split '(a b c d e f g h i k) -3)
                      '(()(a b c d e f g h i k)))
               (test= (split '(a b c d e f g h i k) 100)
                      '((a b c d e f g h i k) () ))) }
; -----
  split
; -----
  ([coll pos]
     (let [len (count coll)]
       (cond 
        (<= len pos) (list coll [])
        (>= 0 pos) (list [] coll)
        :else
        (loop [coll coll, cnt pos, head [] ]
          (if (or (empty? coll) (zero? cnt))
            (list (reverse head) coll)
            (recur (rest coll)
                   (+ -1 cnt)
                   (cons (first coll) head))))))))

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

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

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

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

今回は、Let Over Lambdaの2章の中程までの概要で、今回より正味30分で、後雑談です。

良かったところ

割とこの本は、Cをバックグラウンドにしたプログラマに向けて書いてあるようなところがある気がしていたのですが、C経験者には説明に共感するものがあるらしいことが判りました(*'-')

また、正味30分の方が疲れもなく、後の雑談は盛り上がるようなので、これはこれで良い気がしています。

反省と課題

1〜4章を30分というのは、やはり、無理でした(;´Д`)続きものにする予定です。

ログ:

謝辞:

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

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

2008-10-03

ClojureでL-99 (P16 周期Nで要素を間引く)

| 18:34 | ClojureでL-99 (P16 周期Nで要素を間引く) - わだばLisperになる を含むブックマーク はてなブックマーク - ClojureでL-99 (P16 周期Nで要素を間引く) - わだばLisperになる

このお題では、関数名がdropとなっているのですが、dropはClojureにも存在するので、my-dropとしています。

clojure/dropの動作としては、SRFIのdropと同じです。

Clojureの場合、名前空間を分けられるので、競合を防ぐことも可能だと思いますが、とりあえず今回は大元のdropも使っていて紛らわしいので、それはなしの方向で。

(defn 
  #^{:doc "P16 (**) Drop every N'th element from a list."
     :test (do (test= (my-drop [] 3) [])
               (test= (my-drop '(a b c d e f g h i k) -1)
                      '(a b c d e f g h i k))
               (test= (my-drop '(a b c d e f g h i k) 0)
                      '(a b c d e f g h i k))
               (test= (my-drop '(a b c d e f g h i k) 3)
                      '(a b d e g h k))) }
; ----
  my-drop
; ----
  ([coll n]
     (if (empty? coll)
       []
       (loop [coll coll, acc [] ]
         (if-let block (butlast (take n coll))
           (recur (drop n coll) (concat acc block))
           (concat acc coll))))))

2008-10-02

CLとデザインパターン - Template Method

| 23:09 | CLとデザインパターン - Template Method - わだばLisperになる を含むブックマーク はてなブックマーク - CLとデザインパターン - Template Method - わだばLisperになる

どういう訳かLISP系言語とデザインパターンについて以前から興味があります。

しかし、どうもデザインパターンの解説が馴れないと難解というか、コードの例もUML図もさっぱり分からないことが多いので、さっぱり理解できません。

といっても、このままでは、何も分からないままなので、とりあえず理解できそうなところから手を付けて行くことにしました。

基本的に手引とするのは、Norvig氏のDesign Patterns in Dynamic LanguagesとGreg Sullivan氏のGOF Design Patterns in a Dynamic OO Languageの文献と、矢沢久雄氏のITproでの連載-no titleです。

今回は、一番簡単っぽい、Template Methodを考えてみることにしました。

Template Method

Template Methodとは、具体的な処理をサブクラスにまかせるパターンとのこと。雛型のクラスを作成し、そこで抽象的な処理の流れを記述して、具体的な処理の記述は、サブクラスで行なうというパターンのようです。

それで、上述のNorvig氏の資料によれば、LISPの場合、関数がファースト・クラスなので取り立ててパターンとして意識されることもない、というような説明があります。

とりあえず、どういうことなのか良く分からないので

の内容を参考に適当にコードを書いてみました。

高階関数版
(defun template-function (&optional (op1 #'values) (op2 #'print))
  (lambda (string)
    (funcall op2 (funcall op1 string))))

(defun op1 (string)
  (string-upcase string))

(defun op1-1 (string)
  (string-capitalize string))

(defun op2 (string)
  (print string))

(let ((abstract (template-function))
      (concrete (template-function #'op1 #'op2))
      (concrete1 (template-function #'op1-1 #'op2)))
  (funcall abstract "foo bar baz")
  (funcall concrete "foo bar baz")
  (funcall concrete1 "foo bar baz"))

;>>> "foo bar baz" 
;>>> "FOO BAR BAZ" 
;>>> "Foo Bar Baz" 

関数をとって、手順を合成した関数を返すというtemplate-functionを作成してみています。

この場合、template-functionは全体の流れだけを保持しているような感じです。

次にクラスを使って書いてみました。

クラス版
(progn
  (defclass abstract () () )
  
  (defmethod op1 ((class abstract) (string string))
    string)
  (defmethod op2 ((class abstract) (string string))
    string)
  (defmethod template-method ((class abstract) (string string))
    (op2 class (op1 class string))))
  
(progn
  (defclass concrete (abstract) () )

  (defmethod op1 ((class concrete) (string string))
    (string-upcase string))
  (defmethod op2 ((class concrete) (string string))
    (format t "~A~%" string)))

(progn
  (defclass concrete2 (abstract) () )

  (defmethod op1 ((class concrete2) (string string))
    (string-capitalize string))
  (defmethod op2 ((class concrete2) (string string))
    (princ string)
    (terpri)))

(template-method (make-instance 'concrete) "foo bar baz")
;>>> FOO BAR BAZ

(template-method (make-instance 'concrete2) "foo bar baz")
;>>> Foo Bar Baz

(template-method (make-instance 'abstract) "foo bar baz")
;=> "foo bar baz"

何となく抽象的な雛型を作成しておいて、その穴を埋めるという感じは理解できました。

Template-Methodの場合、情報の隠蔽性も重要なところみたいなのですが、CLOSの場合、隠蔽することに力点を置いてないのと、総称関数なので隠すのはちょっと難しいですね(;´Д`)

隠すとしたら、パッケージの機能でメインの関数だけをexportする等の方法になるんでしょうか。

ClojureでL-99 (P15 要素を任意回数複製する)

| 18:37 | ClojureでL-99 (P15 要素を任意回数複製する) - わだばLisperになる を含むブックマーク はてなブックマーク - ClojureでL-99 (P15 要素を任意回数複製する) - わだばLisperになる

この問題は、2つ星で難しめということになっているのですが、Prologだとこういうのは難しかったりするんでしょうか。

(defn 
  #^{:doc "P15 (**) Replicate the elements of a list a given number of times."
     :test (do (test= (repli [] -1) [])
               (test= (repli [1 2] 0) nil)
               (test= (repli [1 2] -1) nil)
               (test= (repli '(a b c) 3)
                      '(a a a b b b c c c))) }
; -----
  repli
; -----
  ([coll n]
     (reduce #(concat %1 (take n (repeat %2)))
             []
             coll)))

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

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

今回も告知が遅くなってしまいました。今週もCL勉強会は開催させて頂きます!

今回のお題はいきなりですが、Let Over Lambdaの1〜4章の概要をさらってみることにしてみました。

Let Over LambdaはOn Lispの流れを推し進めたような本で、主にマクロの本なのですが、4章までは割と基礎的なところも多く、その割に妙なところもあるので面白いかと思います。

こちらから4章までは、無料でウェブ上で読めます。

また、今回から、時間を大幅に短縮して、20:00〜20:30の30分間でできる範囲にしたいと思います。

その後ですが、主に雑談タイムとすることを考えています。

場所:Lingr: Common Lisp部屋
日時10/4 (土) 20:00から適当(途中参加/離脱/ROM歓迎)
勉強会の進行Let Over Lambda 1〜4
勉強会の目標CLに関して一つ位賢くなった気になること
時刻お題対象者参考リンク
20:00-20:30位までLet Over Lambda 1〜4CLのマクロが好きな方Let Over Lambda

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

2008-10-01

添字的symbol-macrolet

| 17:18 | 添字的symbol-macrolet - わだばLisperになる を含むブックマーク はてなブックマーク - 添字的symbol-macrolet - わだばLisperになる

Common Lispの標準では、[]は単なる文字なので、添字のように使ってみようという思い付き。

;; 添字
(let ((foo '(1 2 3 4)))
  (symbol-macrolet ((foo[1] (nth 0 foo))
                    (foo[2] (nth 1 foo))
                    (foo[3] (nth 2 foo))
                    (foo[4] (nth 3 foo))
                    (foo[5] (nth 4 foo))
                    (foo[6] (nth 5 foo))
                    (foo[7] (nth 6 foo)))
    (list foo[2] foo[3] foo[1])))
;=> (2 3 1)

;; ハッシュ
(let ((ht (make-hash-table)))
  (setf (gethash :foo ht) 30)
  (symbol-macrolet ((ht[foo] (gethash :foo ht)))
    (setf ht[foo] 40)
    ht[foo]))
;=> 40 , T

with-l/ists

| 16:57 | with-l/ists - わだばLisperになる を含むブックマーク はてなブックマーク - with-l/ists - わだばLisperになる

前回のwith-???では、名前の競合を接頭/尾語を付けることによって解決してみたのですが、リストの名前の最初の一文字をcar残りをcdrであると見立ててみるのはどうかと思い、試してみました。

問題点は、temの場合、t、emとなる訳ですが、tは使えないということと、人工的に名前が作られるので意図しない競合の管理が大変そうです。

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun symbol-car (sym)
    (intern (subseq (string sym) 0 1)))
  (defun symbol-cdr (sym)
    (intern (subseq (string sym) 1))))

(defmacro with-l/ists ((&rest lists) &body body)
  (let ((xx (mapappend (lambda (x)
                         `((,(symbol-car x) (car ,x))
                           (,(symbol-cdr x) (cdr ,x))))
                       lists)))
    `(symbol-macrolet ,xx
       ,@body)))

;; 動作
(let ((foo '(1 2 3 4))
      (bar '(a b c d)))
  (with-l/ists (foo bar)
    (list f oo b ar)))
;=> (1 (2 3 4) A (B C D))

;; もうちょっと混み入った例
(defun encode-direct (list)
  (with-l/ists (list item)
    (if (null list)
        ()
        (labels ((recur (list item acc)
                   (cond ((null list) 
                          (cdr (reverse acc)))
                         ((eql l tem)
                          (recur ist `(,(1+ i) . ,l) acc))
                         (:else
                          (recur ist 
                                 `(1 . ,l)
                                 (cons (if (= 1 i)
                                           tem
                                           `(,i ,tem))
                                       acc))))))
          (recur `(,@list ,(gensym)) 
                 `(1 . ,(gensym))
                 () )))))
(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))

with-??? その2

| 14:16 | with-??? その2 - わだばLisperになる を含むブックマーク はてなブックマーク - with-??? その2 - わだばLisperになる

前回、入れ子にして使うのは不便ということが分かったので、複数の引数に対応してみようということで、拡張してみましたが、作成途中で、シンボルの連結を"-"ではなくて、"."にすると、Arcみたいに書けることに気付いたので、"."で連結してみることにしました。連結を逆にすると、JAVA等でお馴染の連結順にもなります。

(import 'pg:symb)
(import 'kmrcl:mapappend)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defparameter *fn*
    '(car cdr rest first second third forth fifth sixth seventh eighth ninth tenth 
      reverse length null gensym 1+ 1-)))

(defmacro with-??? ((&rest args) &body body)
  (let ((xx (mapappend (lambda (y)
                         (mapcar (lambda (x)
                                   `(,(symb x "." y) (,x ,y))) *fn*))
                       args)))
    `(symbol-macrolet ,xx
       ,@body)))

(defmacro with-???-reverse ((&rest args) &body body)
  (let ((xx (mapappend (lambda (y)
                         (mapcar (lambda (x)
                                   `(,(symb y "." x) (,x ,y))) *fn*))
                       args)))
    `(symbol-macrolet ,xx
       ,@body)))

;; 適当に書いてみる。
(defun encode-direct (coll &aux (g "G"))
  (with-??? (coll tem g acc cnt reverse.acc)
    (if null.coll
        ()
        (labels ((recur (coll tem acc)
                   (let ((cnt first.tem) (item second.tem))
                     (cond (null.coll cdr.reverse.acc)
                           ((eql car.coll item)
                            (recur cdr.coll (list 1+.cnt car.coll) acc))
                           (:else
                            (recur cdr.coll 
                                   `(1 ,car.coll)
                                   (cons (if (= 1 cnt)
                                             item
                                             tem)
                                         acc)))))))
          (recur `(,@coll ,gensym.g)
                 `(1 ,gensym.g)
                 () )))))

;; 逆順で連結
(defun encode-direct (coll &aux (g "G"))
  (with-???-reverse (coll tem g acc cnt acc.reverse)
    (if coll.null
        ()
        (labels ((recur (coll tem acc)
                   (let ((cnt tem.first) (item tem.second))
                     (cond (coll.null acc.reverse.cdr)
                           ((eql coll.car item)
                            (recur coll.cdr (list cnt.1+ coll.car) acc))
                           (:else
                            (recur coll.cdr
                                   `(1 ,coll.car)
                                   (cons (if (= 1 cnt)
                                             item
                                             tem)
                                         acc)))))))
          (recur `(,@coll ,g.gensym)
                 `(1 ,g.gensym)
                 () )))))

(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))

という感じでなんとなくArcっぽく書けますが、なんにしろカオスな感じです。

defunや、defmacroと合体してみるというのもアリな気もしてきました。

ClojureでL-99 (P14 要素を2回繰り返す)

| 13:09 | ClojureでL-99 (P14 要素を2回繰り返す) - わだばLisperになる を含むブックマーク はてなブックマーク - ClojureでL-99 (P14 要素を2回繰り返す) - わだばLisperになる

Clojureにも畳み込み用のreduceがあります。

(defn
  #^{:doc "P14 (*) Duplicate the elements of a list."
     :test (do (test= (dupli []) [])
               (test= (dupli '(a b c c d))
                      '(a a b b c c c c d d))) }
; -----
  dupli
; -----
  ([coll]
     (reduce #(concat % (list %2 %2))
             []
             coll)))

anaphoric-destructuring-bind改め、with-???

| 01:05 | anaphoric-destructuring-bind改め、with-??? - わだばLisperになる を含むブックマーク はてなブックマーク - anaphoric-destructuring-bind改め、with-??? - わだばLisperになる

前回のエントリでは、anaphoric-destructuring-bindとかいう名前の変なマクロを考えてみたわけなのですが、前に出てきたものを参照してるわけでもなんでもないので、anaphoricというのは変だということに気付きました。

また、使い方もリストに限定されているわけでもないので、destructuring-bindという訳でもないということに気付きました。

とりあえず、変だということは分かったのですが、かといって上手い名前も思い付かず…。

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defparameter *fn*
    '(car cdr rest first second third forth fifth sixth seventh eighth ninth tenth 
      reverse length null)))

(defmacro with-??? (list &body body)
  (let ((xx (mapcar (lambda (x) `(,x (,x ,list))) *fn*)))
    `(symbol-macrolet ,xx
       ,@body)))

;---- 
(let ((foo (list 1 2 3 4)))
  (with-??? foo
    (list :orig foo
          :reverse reverse
          :length length
          :null null)))
;=> (:ORIG (1 2 3 4) :REVERSE (4 3 2 1) :LENGTH 4 :NULL NIL)

;; 適当に何か書いてみる。
(defun encode-direct (coll)
  (with-??? coll
    (if null
        ()
        (labels ((recur (coll tem acc)
                   (with-??? coll
                     (destructuring-bind (cnt item) tem
                       (cond (null (cdr (reverse acc)))
                             ((eql car item)
                              (recur cdr (list (+ 1 cnt) car) acc))
                             (:else
                              (recur cdr 
                                     (list 1 car)
                                     (cons (if (= 1 cnt)
                                               item
                                               tem)
                                           acc))))))))
          (recur (append coll (list (gensym)))
                 (list 1 (gensym))
                 () )))))

(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)) 

適当に小物を書いてみたのですが、with-???は、入れ子だと名前が競合して使いにくいことが判明しました。(当然といえば当然なのですが)

(with-??? foo bar ... )とした場合、foo-car、bar-first等で参照できるようにすると解決できそうではありますが、混沌としたものになりそうです…。