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-01-22

お題(126): ライフゲーム

| 19:21 | お題(126): ライフゲーム - わだばLisperになる を含むブックマーク はてなブックマーク - お題(126): ライフゲーム - わだばLisperになる

一人でArc祭りをしていたため、どう書くorgのお題をスルーしておりました。

もちろん、ぱっと見で簡単なら、スルーしないんですが、ライフゲームってのがAIっぽくて、いやに難しそうだったので、まあ今回もスルーで良いかなと思っていたんですが、Wikipediaの解説を読んだら、ライフゲームが成立するルールは想像していたより簡単だったので、挑戦することにしました。

以前から升目を見る度に、*LISPが使えるんじゃないかと思ってはいたのですが、今回初めて*LISP(シミュレータ)で書いてみました。

*LISPは、Connection Machine用に開発されたこともあり、並列処理のための構文が沢山あります。

画像処理等も、1ピクセルを1プロセッサに割り振って、一回で処理したりするらしいです。

しかし、附属のチュートリアルを読んでも、全然理解できず、一発で並列処理させる構文も見付けられなかったので、無念ながら普通にループで書きました。

自分のイメージとしては、

(defun get-next!! (〜)
  "セルが次に生きているかを判定する関数"
  〜)

(get-next!! *cell*)
とか
(map!! (lambda (x) (get-env!! x) *cell*) ...etc

みたいな感じで、グリッドを丸ごと一発で処理できる筈だと思ってはいるんですが…。(!!は、グリッド全体を一気に処理する関数に付く目印)

*LISPのインストールについては、割と手間が掛って面倒臭く、解説も長くなりそうなので別エントリに書いてみたいと思います。

俺Arc祭り 2008冬 (8)

| 08:10 | 俺Arc祭り 2008冬 (8) - わだばLisperになる を含むブックマーク はてなブックマーク - 俺Arc祭り 2008冬 (8) - わだばLisperになる

やっと最後まで辿り着きました、俺Arc祭りこと、生後3週間目のArc追っかけ。

最後に来て、ラムダパラメータリストについてです。

keyの代わりに、db(ハッシュ)を使用することにし、また、分割代入をサポートするとのこと。

キーワードを一々指定するのは面倒だから、ハッシュテーブルを引数として食べさせるってことでしょうか。

便利なような便利でないような…。

ノープランで頭から作っていただけに、let、with、def、macro(mac)は定義し直し。

また、変数の分割代入ですが、混み入ってくると正しい文法なのかどうか怪しいです。

;; 動作
(def foo (x (ds (i j)) (get m n) (opt q 'a) . z)
  (list x i j m n q z))

(foo 1 '(red green) (db m 'a n 'b) 'hel 'lo)
;-> (1 RED GREEN A B HEL (LO))

(let x 5
     x)
;-> 5

(with (x 5 y 6)
  (list x y))
;-> (5 6)

(let (ds (x y (z))) '(1 2 (3))
     (list x y z))
;-> 1 2 3

(with ((ds (x y z)) '(1 2 3) a 5)
  (list x y z a))
;-> 1 2 3 5

;; これはアリなのだろうか?
(let (a . b) '(1 2 3 4)
     (list a b))
;->(1 (2 3 4))

;; これで良いのか?
(let (ds ((a b) . rest)) '((1 2) 3 4)
     (list a b rest))
;->(1 2 (3 4))

(with ((ds ((a b) . rest)) '((1 2) 3 4)
       x 10)
  (list a b rest x))
;->(1 2 (3 4) 10)

;; おれおれ定義
(cl:defmacro let (var val cl:&body body)
  `(cl:destructuring-bind ,(remove-ds 
			    (opt-to-&optional
			     (dotex-to-&rest `(,var))))
       (list ,val)
     (declare (ignorable ,@(metatilities:flatten (remove-ds `(,var)))))
     ,@body))

(cl:defmacro with (spec &body body)
  (reduce (fn (x res) `(let ,@x ,res))
	  (loop :for i :on spec :by #'cddr 
	        :collect (metatilities:firstn 2 i))
	  :initial-value `(progn ,@body)
	  :from-end 'T))

(cl:defmacro def (name args cl:&body body)
  (multiple-value-bind (spec /ds /syms) 
      (replace-specs (opt-to-&optional (dotex-to-&rest args)))
    (if /ds
	`(cl:defun ,name ,spec
	   (destructuring-bind ,/ds ,/syms
	     ,@body))
	`(cl:defun ,name ,spec
	   ,@body))))

;; 他のエッセイを読んだら、macroじゃなくて、macになってたのでついでに変更してみる
(cl:defmacro mac (name args cl:&body body)
  (multiple-value-bind (spec /ds /syms) 
      (replace-specs (opt-to-&optional (dotex-to-&rest args)))
    (if /ds
	`(cl:defmacro ,name ,spec
	   (destructuring-bind ,/ds ,/syms
	     ,@body))
	`(cl:defmacro ,name ,spec
	   ,@body))))

;; ラムダパラメータ分解ユーティリティ
(cl:defun opt-to-&optional (expr)
  (loop :for x :in expr
        :nconc (if (eq 'opt (metatilities:car-safe x))
		   `(&optional ,(if (cl:= 2 (length x))
				    (cadr x)
				    (cdr x)))
		   (list x))))

(cl:defun dotex-to-&rest (expr)
  (cl:cond ((atom expr) `(&rest ,expr))
	   ((tailp () expr) expr)
	   ('T (cl:let ((x (copy-list expr)))
		 (rplacd (last x) (list '&rest (cdr (last x))))
		 x))))

(cl:defun replace-specs (expr)
  (loop :with ds :and vars
     :for x :in expr
     :collect (cl:cond ((eq 'ds (metatilities:car-safe x))
			(cl:let ((sym (gensym "DS-")))
			  (push sym vars)
			  (push (cadr x) ds)
			  sym))
		       ((eq 'get (metatilities:car-safe x))
			(cl:let ((sym (gensym "DB-")))
			  (push (cdr x) ds)
			  (push `(list ,@(mapcar (cl:lambda (x) `(get ,x ,sym)) (cdr x))) vars)
			  sym))
		       ('T x))
     :into specs
     :finally (return (values specs ds `(list ,@vars)))))

(defun remove-ds (expr)
  (loop :for x :in expr
        :collect (if (eq 'ds (metatilities:car-safe x))
		     (cadr x)
		     x)))

俺Arc祭り 2008冬 (7)

| 02:46 | 俺Arc祭り 2008冬 (7) - わだばLisperになる を含むブックマーク はてなブックマーク - 俺Arc祭り 2008冬 (7) - わだばLisperになる

もう少しで終了の俺Arc祭り。知らぬ間に世の中では、俺Scheme/Lisp祭りが始まっている様子。

今年、Schemeは盛り上がりそうだなー。

Common Lispも、意味なく盛り上がんないかな。

Common Lisp面白いと思うんだけどなあ。

それはさておき、

16. Overloading

クラスを作るときに関数を指定して実行時に指定した関数をオーバーロードするとのことですが、ギブアップです(;´Д`)

 (= pt (class nil 'x 0 'y 0 pr my-pr))

とかすると、ptの呼び出しでは、prじゃなくて、my-prが呼び出される、ということでしょうか。

どうすれば良いのか検討もつかないなあ。

17. DBs are hashes/alists

dbというものが定義されて、これは、連想リストや、ハッシュ的なものだそうです。

  • newdb、db、get

newdbで新規のdbを作成、dbは簡略版で、問い合わせのテストにeqを過程するものだそうです。

getで、キーを指定して値を取り出します。

また、問い合わせに失敗した場合は、大域変数*fail*を返すとのこと。

;;
;; 動作
;(newdb eq 'x 'a 'y 'b)

(= foo (db x 'a y 'b))

(get x foo)
;-> a

(each x (db x 1 y 2)
   (pr x)
   (keep key))
;12
;(X Y)

;; おれおれ定義
(cl:defmacro newdb (test &rest keys-&-vals)
  `(loop :with ht = (make-hash-table :test #',test)
         :for kv :on ',keys-&-vals :by #'cddr
         :do (setf (cl:gethash (car kv) ht) (%unquote (cadr kv)))
         :finally (return ht)))

(cl:defmacro db (&rest keys-&-vals)
  `(newdb eq ,@keys-&-vals))

(shadow 'get)

(defparameter *fail* nil)

(cl:defmacro get (key db)
  `(multiple-value-bind (val test) (cl:gethash ',key ,db)
     (cl:if test val '*fail*)))

;; dbを扱えるようにeachを拡張。禁斷のeval発動…。
(macro each body
  (if (hash-table-p (eval (cadr body)))
      `(with-keep-or-sum 
	 (each/hash ,@body))
      `(with-keep-or-sum 
	 (each1 ,@body))))

(cl:defun %keys+values (ht)
  (loop :for k :being :the :hash-keys :in ht :using (:hash-value v)
        :collect k :into ks
        :collect v :into vs
        :finally (return (values (coerce ks 'vector) (coerce vs 'vector)))))

(cl:defmacro each/hash (var ht cl:&body body)
  (with (/v (gensym) /k (gensym) /cnt (gensym))
    `(multiple-value-bind (,/k ,/v) (%keys+values ,ht)
       (cl:let (,var key)
	 (declare (ignorable key ,var))
	 (to1 ,/cnt (length ,/k)
	   (setq ,var (aref ,/v ,/cnt) key (aref ,/k ,/cnt))
	   ,@body)))))

;; with-keep-or-sumの定義が変だったので変更
(cl:defmacro with-keep-or-sum (&body body)
  (with (s (x-finder 'sum body) k (x-finder 'keep body))
    (cl:cond ((and s k) (error "SUMとKEEPはどちらかでお願いしたい。"))
	     (s `(with-sum
		   ,@body))
	     (k `(with-keep
		   ,@body))
	     ('T `(progn ,@body)))))