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 |

2009-06-13

10分でコーディング 続・破壊的操作

| 21:41 | 10分でコーディング 続・破壊的操作 - わだばLisperになる を含むブックマーク はてなブックマーク - 10分でコーディング 続・破壊的操作 - わだばLisperになる

正方行列の転置を破壊的に

kozimaさんの 10分でコーディング 続・破壊的操作編 - kozima の日記 - cadr groupを見て、10分どころでなく散々試行錯誤したんですが、そうか、carを書き換えれば良いのか!、こんとんじょのいこ!! ということで

(defun transpose% (list)
  (let ((len (length list)))
    (dotimes (x len list)
      (loop :for y :from x :below len
            :do (rotatef (nth x (nth y list))
                         (nth y (nth x list)))))))

という風に書いてみました。

(transpose% (make-matrix 4))
;=> ((1 5 9 13) (2 6 10 14) (3 7 11 15) (4 8 12 16))

;; SBCL
(prog ((u (make-matrix 5)))
   (transpose% u))
;=> NIL
----------
Evaluation took:
  0.000 seconds of real time
  0.000000 seconds of total run time (0.000000 user, 0.000000 system)
  100.00% CPU
  15,687 processor cycles
  0 bytes consed

ほうほう、0bytes。

ちょっと大きくしてみよう

;; SBCL
(prog ((u (make-matrix 300)))
   (transpose% u))
;=> NIL
----------
Evaluation took:
  0.129 seconds of real time
  0.130000 seconds of total run time (0.130000 user, 0.000000 system)
  100.78% CPU
  309,236,580 processor cycles
  1,467,424 bytes consed
  ^^^^^^^^^

あれ…。carの書き換え(rplaca)だとコンシングが発生するの?

rplaca抜きで

(defun no-transpose (list)
  (let ((len (length list)))
    (dotimes (x len list)
      (loop :for y :from x :below len
            :do (progn (nth x (nth y list))
                     #|(nth y (nth x list))|#)))))
;; SBCL
(prog ((u (make-matrix 600)))
   (no-transpose u))
;=> NIL
----------
Evaluation took:
  0.745 seconds of real time
  0.750000 seconds of total run time (0.750000 user, 0.000000 system)
  100.67% CPU
  1,786,044,609 processor cycles
  46,352 bytes consed

あれ…、rlpacaが原因かどうか以前に、nthでアクセスするとコンシングが発生するの?

うーん、

;; 中身あり
(defun transpose (list)
  (let ((len (length list)))
    (dotimes (x len list)
      (loop :for y :from x :below len
            :do (let ((a (nth x (nth y list)))
                      (b (nth y (nth x list))))
                  (rotatef a b))))))

;; 中身なし
(defun no-transpose (list)
  (let ((len (length list)))
    (dotimes (x len list)
      (loop :for y :from x :below len
            :do (let ((a (nth x (nth y list)))
                      (b (nth y (nth x list))))
                  () )))))

;; なにもなし
(defun no-transpose-complete (list)
  (let ((len (length list)))
    (dotimes (x len list)
      (loop :for y :from x :below len
            :do (progn)))))
;; 中身あり
;; SBCL
(prog ((u (make-matrix 600)))
   (time (transpose u)))
;=> NIL
----------
Evaluation took:
  1.119 seconds of real time
  1.120000 seconds of total run time (1.120000 user, 0.000000 system)
  100.09% CPU
  2,679,908,625 processor cycles
  79,328 bytes consed

;; 中身なし
;; SBCL
(prog ((u (make-matrix 600)))
   (time (no-transpose u)))
;=> NIL
----------
Evaluation took:
  0.604 seconds of real time
  0.610000 seconds of total run time (0.610000 user, 0.000000 system)
  100.99% CPU
  1,447,224,714 processor cycles
  44,848 bytes consed

;; なにもなし
;; SBCL
(prog ((u (make-matrix 600)))
   (time (no-transpose-complete u)))
;=>
----------
Evaluation took:
  0.000 seconds of real time
  0.000000 seconds of total run time (0.000000 user, 0.000000 system)
  100.00% CPU
  292,959 processor cycles
  0 bytes consed

おやー、SBCLのnthが変なのかしらん…。

ちなみに、CLISPだとコンシングは0でした。

探索はつづく…。

2009-05-23

10分でコーディングx2〜リストの破壊的操作篇〜【まとめ】

| 19:53 | 10分でコーディングx2〜リストの破壊的操作篇〜【まとめ】 - わだばLisperになる を含むブックマーク はてなブックマーク - 10分でコーディングx2〜リストの破壊的操作篇〜【まとめ】 - わだばLisperになる

元ネタが10分だったのでそれを踏襲して10分ということにしましたが、どうも10分は短過ぎたようですw

自分の解答は、

(defun nalist-to-plist (alist)
  (do ((a alist (cddr a)))
      ((endp a) alist)
    (rotatef (cdr a) (caar a))
    (rotatef (caar a) (cdar a))
    (rotatef (cdr a) (car a))))
(defun nplist-to-alist (plist)
  (do ((p plist (cdr p)))
      ((endp p) plist)
    (rotatef (cdr p) (car p))
    (rotatef (caar p) (cdar p))
    (rotatef (cdr p) (caar p))))

という感じです。

解答に掛った時間ですが、「そういえば、alist/plistの変換ができるな〜」と考えてからコードが完成するまで2〜30分掛ったと思います、当人が10分で解けてなくて、すいません(笑)

考え方

((foo . 1) (bar . 2)...)→(foo 1 bar 2 ...)

という形で考えると難しいので、セル一つ一つを省略しないで記述したものを元に考えると良いかなと思いました。

'((foo . 1)) ⇒ '((foo . 1) . ())

ということで、更に分かりやすいように

'((1 . 2) . 3)

と置きます。

alist->plistの場合、これが、

'(1 . (2 . 3))

となれば良いわけなので順番は色々ありますが、

  1. ((3 . 2) . 1) ;1と3を交換
  2. ((2 . 3) . 1) ;2と3を交換
  3. (1 . (2 . 3)) ;1と(2 . 3)を交換
  4. 以下、3の指しているコンスでも同様

とすれば良いことになります。

ちなみに交換の方法はCLには色々あります。

rotatefかsetfとvaluesを組み合わせたものが一番分かりやすいかなと個人的には思っています。

;; setf+valuesの場合
(defun nplist-to-alist (plist)
  (mapl (lambda (p)
          (setf (values (cdr p) (car p)) 
                (values (car p) (cdr p))
                
                (values (caar p) (cdar p))
                (values (cdar p) (caar p))
                
                (values (cdr p) (caar p))
                (values (caar p) (cdr p))))
        plist))

交換の部分は、rotatefを駆使すれば1式で書けると思い最初はそれで書いたのですが、意図したように動かないので自分は分割しました。

この件についてはquekさんが探究されています。さすが!

2009-05-21

10分でコーディング x 2 〜リストの破壊的操作篇〜

| 21:36 | 10分でコーディング x 2 〜リストの破壊的操作篇〜 - わだばLisperになる を含むブックマーク はてなブックマーク - 10分でコーディング x 2 〜リストの破壊的操作篇〜 - わだばLisperになる

今日の問題はかなり簡単です。

できるだけ短い時間でエレガントなコードを書きましょう。

あまりに簡単なので制限時間を10分としてやってみてください。

これ以上かかった人は

自分はLisperの癖にかなり破壊的リスト操作プログラミングができない。

とつらい事実を認識しましょう。

そして、これからすごくなりましょう。

では、10分だけこの問題に付き合ってみてください。

スタート!!

>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

その1(nalist-to-plist)

難易度 激簡単 目標時間10分以内

alist 例.((foo . 1) (bar .2) ...)とplist 例.(foo 1 bar 2 ....)の使うコンスセル数は同じことが知られています。

ということは、alistからplistへの変換は、余計なコンシングを一切せずに組み換えることができるということです。

alistを破壊的にplistに変換する関数を書いて下さい。

CLなら、nalist-to-plist、Schemeなら、alist->plist!のような命名になりそうです。

CLで書いてみたものをテストすると下記のようになる筈です。

(nalist-to-plist (copy-tree '((foo . 1) (bar . 2) (baz . 3))))
;=> (FOO 1 BAR 2 BAZ 3)

;; alistからplistへの変換を計測
(prog ((data (loop :repeat 100000 :collect (cons 1 2))))
      (time (nalist-to-plist data)))
;=> NIL
----------
Evaluation took:
  0.003 seconds of real time
  0.000000 seconds of total run time (0.000000 user, 0.000000 system)
  0.00% CPU
  6,267,654 processor cycles
  0 bytes consed
  ^^^^^^^^^^^^^^

;; 非破壊版
(prog ((data (loop :repeat 100000 :collect (cons 1 2))))
      (time (loop :for (x . y) :in data :collect x :collect y)))
;=> NIL
----------
Evaluation took:
  0.023 seconds of real time
  0.020000 seconds of total run time (0.020000 user, 0.000000 system)
  [ Run times consist of 0.020 seconds GC time, and 0.000 seconds non-GC time. ]
  86.96% CPU
  56,597,643 processor cycles
  3,198,976 bytes consed
  ^^^^^^^^^^^^^^^^^^^^^^

その2(nplist-to-alist)

ついでなので、nplist-to-alistも作ってみて下さい。

こちらの方が難しい気がしますが、前の問題で馴れたと思うので同じく10分で。

>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

難易度 超簡単 目標時間10分以内

(nplist-to-alist (list 'foo 1 'bar 2 'baz 3))
;=> ((FOO . 1) (BAR . 2) (BAZ . 3))

※註. とりあえず煽った方が面白いかと思って煽り気味で書いていますw

2008-06-11

TCONC

| 13:54 | TCONC - わだばLisperになる を含むブックマーク はてなブックマーク - TCONC - わだばLisperになる

先日のCL勉強会で、TCONCのことを知ったのですが、TCONCの解説で、古いINTERLISPのマニュアルでTCONCをリストで表現していたのが気に入ったので、作ってみることにしました。

TCONCという構造は、リストとリストの末尾のペアをすぐ取り出せる構造なので、末尾への要素の追加のコストが低いというのが特長です。

今回再現してみるリスト表現のTCONCは、CARにリスト、CDRに末尾のペアのポインタを保持する構造になっています。

つまり

(1 2 3 4)

というリストならば、

((1 2 3 4) . (4)) 
 ≡ ((1 2 3 4) 4) 

となります。

見た目はリストなので、ちょっと区別し難かったりしますが、なるほど!という表現で、どんなにリストが長くても、TCONCをCDRすれば、末尾のペアが取り出せます。

ちなみに、PCLのLOOP章の註釈で解説があるのですが、LOOPマクロのcollectもTCONCなことが多いのかもしれません。

INTERLISP-10のマニュアルには、TCONCの他にリストとリストを継ぐLCONC、CONSと似ていますが、リストのポインタは変化しないATTACHの解説もあり、これも面白そうなのでついでに作ってみました。

;; tconcの動作
(loop :with start := 1 :and end := 10
      :with tc := (tconc () start)
      :for i :from (1+ start) :to end :do (tconc tc i) 
      :finally (return (car tc)))

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

;; lconcの動作
(loop :with start := 1 :and end := 10
      :with lc := (lconc (list ()) (list start))
      :for i :from (1+ start) :to end :do (lconc lc (list i)) 
      :finally (return (car lc)))

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

;; attachの動作
(setq foo (list 100))

(eq foo (attach 0 foo))
;==> T

foo
;==> (0 100)

;; 定義
(defpackage #:tconc
  (:use #:cl)
  (:export #:tconc
           #:lconc
           #:attach))

(in-package :tconc)

(defun TCONC (ptr x)
  (declare (list ptr))
  (let ((x (list x)))
    (if (null ptr)
        (cons x x)
        (progn (psetf (cddr ptr) x             
                      (cdr ptr) x)
               ptr))))

(defun LCONC (ptr x)
  (declare (cons ptr x))
  (let ((last (last x)))
    (rplaca ptr (nconc (car ptr) x))
    (rplacd ptr last)))

(defun ATTACH (x y)
  (declare (cons y))
  (let ((ptr y)
        (tail (cons (car y) (cdr y))))
    (setf (car ptr) x
          (cdr ptr) tail)
    ptr))

2008-05-19

構造体と総称関数の組み合わせ

| 07:16 | 構造体と総称関数の組み合わせ - わだばLisperになる を含むブックマーク はてなブックマーク - 構造体と総称関数の組み合わせ - わだばLisperになる

bit別冊 Common Lisp オブジェクトシステム - CLOSとその周辺を読んでいて、defmethodとdefstructを組み合わせる例が紹介されていたので試してみます。

なんだか関係のないところに力が入ってしまいましたが、CLでは、クラスと型が融合していて、defstructで作った型も引数特定子として扱えるということが本題です…。

(setq ガガンボ (make-双翅目))
(setq オニヤンマ (make-蜻蛉目))
(setq なんらかの虫 (make-昆虫))

(昆虫の足の数 ガガンボ)
;=> 6

(昆虫の足の数 オニヤンマ)
;=> 6

(双翅目の足の数 ガガンボ)
;=> 6

(双翅目の翅の数 ガガンボ)
;=> 2

(虫博士 なんらかの虫)
;=> 昆虫は足が6本だけど、そんな虫知らない。

(虫博士 ガガンボ)
;=>昆虫は足が6本、双翅目は、翅が2枚なんだ。

(虫博士 オニヤンマ)
;=>昆虫は足が6本、蜻蛉目は、翅が4枚なんだ。

(虫博士 'foo)
;=> それは虫じゃないね。

;; 定義
(defstruct (昆虫 (:conc-name "昆虫の"))
  (足の数 6))

(defstruct (双翅目 (:include 昆虫) (:conc-name "双翅目の"))
  (翅の数 2))

(defstruct (蜻蛉目 (:include 昆虫) (:conc-name "蜻蛉目の"))
  (翅の数 4))

(defmethod 虫博士 ((虫 双翅目))
  (format t "昆虫は足が6本、~Aは、翅が~D枚なんだ。~%" 
	  (type-of 虫) (双翅目の翅の数 虫)))

(defmethod 虫博士 ((虫 蜻蛉目))
  (format t "昆虫は足が6本、~Aは、翅が~D枚なんだ。~%" 
	  (type-of 虫) (蜻蛉目の翅の数 虫)))

(defmethod 虫博士 ((虫 昆虫))
  (format t "昆虫は足が6本だけど、そんな虫知らない。~%"))

(defmethod 虫博士 (虫)
  (format t "それは虫じゃないね。~%"))

2008-05-03

gensymのリスト

| 11:58 | gensymのリスト - わだばLisperになる を含むブックマーク はてなブックマーク - gensymのリスト - わだばLisperになる

当初、気の効いたイディオムを探索するという趣旨でしたが、見付けようと思ってもなかなか見付からないので、適当にイディオムを探してエントリを書くことにしました(^^;

さて、CLのマクロを書いていると、変数のリストと同じ長さのgensymのリストが欲しくなることがあると思います。

'(a b c)
;=>
(#:g000001 #:g000002 #:g000003)

そこに焦点を当てて人間模様を観察してみたいと思います。

とりあえず、

(defparameter *lst* '(foo bar baz))

としておきます。

(1)Paul Graham氏

(mapcar (lambda (x) (gensym)) *lst*)

;; コンパイラに警告されるので、ignoreする場合。
(mapcar (lambda (x) 
	  (declare (ignore x))
	  (gensym))
	*lst*)

アンチloopの人なので、mapcarで。

declareあり、45文字。なしは、31文字

(2)適当に変種。declareが長いので、valuesで2値目を捨てるぞ、という場合。

(mapcar (lambda (x) (values (gensym) x))
	*lst*)

でも、分かりにくい。42文字

(3)やっぱりloopが定番だろう

(loop :for g :in *lst* :collect (gensym))

loopがぴったり嵌まる状況な気がする。36文字。

アンチloopじゃない人は、普通にこちらかも。

(4)dolistはどうか。

(let (res)
  (dolist (g *lst* res)
    (push (gensym) res)))

見たことない。49文字

(4)Brian Mastenbrook氏(common-idiomsより)

わざわざ、fconstantlyというconstantlyに似た関数を定義して使う。

(mapcar (fconstantly #'gensym) *lst*)

fconstantlyに汎用性はあるんだろうか。基本的にこのシチュエーション専用な気が…。

fconstantlyをインポートすれば、32文字。しなければ、46文字。

まとめ

以上、色々(といっても基本的に3バージョン)纏めてみましたが、最短は、31文字で、declareなしのPG方式。警告回避の場合32文字でfconstantly

しかし、やっぱりloopが定番なのではないでしょうか。

もっと良い方法があったら教えて下さい!

2008-02-21

短絡演算子的and

| 17:07 | 短絡演算子的and - わだばLisperになる を含むブックマーク はてなブックマーク - 短絡演算子的and - わだばLisperになる

今回も、当たり前すぎる例です。

;; and
(and p x)(if p
         x
         nil)

殆どのLISP処理系では、andの返り値は真偽の2種類ではなくて、評価した値、もしくは偽となっています。

これの起源ですが、古参LISPハッカーのBill Gosper氏のウェブサイトによれば、

Was de-facto in charge of MacLisp
before Jon L. White (while Greenblatt was preoccupied).
(E.g., added the feature that AND and OR can return non-Booleans.)

Gosper氏が考案したとのこと。「これは俺が考えたんだ!」と主張する人も皆無だと思うので、多分本当なのでしょう(笑)

実際のところLISP1.5では、真偽値しか返しませんでしたが、MacLISPの前身の(とはいえ境界が曖昧)PDP-6 LISPのマニュアルを眺めると、ブール値以外の値も返すようになっているので史実的にもこの時期(1966年頃)のようです。

また、空リストがNILと同じシステムでは、

(if (null x)
    ()
    (cons (car x) ...))(and x (cons (car x) ...))

のようにも書けます。

なんとなく通っぽいですが、実際のところは真偽値としてのNIL -> 空リストとしてのNILを混ぜて書くことはあまりないようで、太古のコードから最近のコードまで、あまり見掛けることもありません。

2008-02-18

家出する局所関数

| 15:05 | 家出する局所関数 - わだばLisperになる を含むブックマーク はてなブックマーク - 家出する局所関数 - わだばLisperになる

もうネタ切れなので、今回はイディオムってよりはただのネタです。

CL策定のためのメーリングリストの1981〜83年頃のメールを眺めててみつけたものです。

元は、レキシカルクロージャ万歳ということで、labelsから定義した関数を外に返してるという例なんですが、ちょっとアレンジしてみました。

;; CL
(mapcar (labels ((fib (n &optional (a1 1) (a2 0))
		   (cond ((zerop n) 0)
			 ((< n 2) a1)
			 ('T (fib (1- n) (+ a1 a2) a1)))))
	  #'fib)
	'(0 1 2 3 4 5 6 7 8 9 10))

;=> (0 1 1 2 3 5 8 13 21 34 55) 

;; Scheme
(map (letrec ((fib 
	       (lambda (n a1 a2)
		 (cond ((zero? n) 0)
		       ((< n 2) a1)
		       (else (fib (- n 1) (+ a1 a2) a1))))))
       (cut fib <> 1 0))
     (iota 11))

;=> (0 1 1 2 3 5 8 13 21 34 55)

他に

(define fib
  (letrec ((f (lambda (c a1 a2)
		(cond ((zero? c) 0)
		      ((< c 2) a1)
		      (else (f (- c 1) (+ a1 a2) a1))))))
    (cut f <> 1 0)))

なんてのも考えてみましたが、Schemeだと、

(define (fib n)
  (define (f c a1 a2)
    (cond ((zero? c) 0)
	  ((< c 2) a1)
	  (else (f (- c 1) (+ a1 a2) a1))))
  (f n 1 0))

と書けるので、なんの意味もないですね(笑)

2008-02-17

結合法則的変形

| 18:30 | 結合法則的変形 - わだばLisperになる を含むブックマーク はてなブックマーク - 結合法則的変形 - わだばLisperになる

今回も当たり前過ぎる例ですが、GLS氏もこれって美しいってどっかで言ってたような憶えがあります。

(cons (if p x y) z)(if p 
	 (cons x z)
	 (cons y z))

2008-02-16

3つ以上の引数の不等号

| 17:56 | 3つ以上の引数の不等号 - わだばLisperになる を含むブックマーク はてなブックマーク - 3つ以上の引数の不等号 - わだばLisperになる

良さげなフレーズを集めるといっても経験豊富でもなんでもない私が集めるのは、なかなか無理があるのですが、まあ、とりあえず…。

今回も、なあんだ、というようなものですが、個人的には前置記法の特色が出てる気がして結構好きなものの一つです。

;; 1
(< 1 2 3 4 5 6 7)
;=> t

;; 2
(<= 2 x 3)(and (<= 2 x) (<= x 3))

(defun fib (n)
  (if (<= 0 n 1)
      n
      (+ (fib (1- n))
	 (fib (- n 2)))))(defun fib (n)
       (cond ((= 0 n) n)
	     ((= 1 n) n)
	     ('T (+ (fib (1- n))
		    (fib (- n 2))))))

;; 3
(= 1 x y)(and (= 1 x) (= 1 y))

2008-02-15

みにくいアヒルの子系演算

| 15:56 | みにくいアヒルの子系演算 - わだばLisperになる を含むブックマーク はてなブックマーク - みにくいアヒルの子系演算 - わだばLisperになる

「ハッカーのたのしみ」という延々とビット演算が載ってる本がありますが、多分好きな人にとっては堪らない本だと思うのですね。

私もこの本をブックオフで購入したのですが、内容的にはさっぱりです。

しかし、作者はこういうのが相当好きなんだなということは伝わってきて、こういう本って良いなあと思ってしまい買ってしまったのですね…。

LISPでもリスト処理などに、こういうのが沢山あるような気がするので、微力ながらも気になったものを集めてみようかなと思いました。

なんというか、LISPで生活してないと出てこないような発想のようなものを集められると良いなと思うのですが、私の実力的にはなかなか難しそうです。

今回は、昔のLispマシンのソースを読んでて、そういえばそうだよなあと思った例です。

;; 1
(+ 1 2 3 -4 5)(+ (- (+ 1 2 3) 4) 5) 

(+ a b c (- d) e)(+ (- (+ a b c) d) e) 

(+ (frob) -1 2 3 4 5)(+ (1- (frob)) 2 3 4 5)

;; 2
(* a b c (/ d) e)(* (/ (* a b c) d) e)

どっちかというとこういうのは掲示板で募集してみた方が良いのかもしれないですね。

連続ものにしたいとは思っているのですが、ネタのストックはあと2つ3つ位しかありません(笑)