Displaying posts written in

7月 2009

Common Lisp  | 2009 年 7 月 29 日 By | No comments yet

『実践Common Lisp』20.6 EVAL-WHEN

「20.6 EVAL-WHEN」に書いてある内容がどう考えてもおかしくて、これは翻訳のミスじゃないかと思って調べてみたら、やはり正誤表に載っていた。とはいえ多分、そもそも原文も分かりにくいのだろうと思う。HyperSpecの説明の方がずっと分かりやすい。

:compile-toplevel と :load-toplevel が意味を持つのは、次の2つの条件が揃ったときだけだ。

  1. COMPILE-FILE でlispファイルをコンパイルするとき
  2. EVAL-WHEN がトップレベルフォームとして現れる場合

:comile-toplevel が指定されていれば、コンパイル時に評価される。:load-toplevel が指定されていれば、faslファイルを LOAD したときに評価される。

上の2条件が揃わない場合は、「:execute が指定されていれば評価される」「:execute が指定されていないと評価されない」という、ごく単純な動作になる。

HyperSpecに載っている例よりも、さらに直接的な例を考えてみた。

(eval-when (:execute)
  (defun foo ()
    "foo-execute"))
 
(eval-when (:compile-toplevel)
  (defun foo ()
    "foo-compile-toplevel"))
 
(eval-when (:load-toplevel)
  (defun foo ()
    "foo-load-toplevel"))
 
(defmacro foo-macro()
  (foo))
 
(defun main()
  (format t "~a~%" (foo))
  (format t "~a~%" (foo-macro)))

LOAD でlispファイルを読み込めば、

foo-execute
foo-execute

と表示される。COMPILE-FILEでコンパイルしたfaslファイルを読み込めば、

foo-load-toplevel
foo-compile-toplevel

と表示される。

Common Lisp  | 2009 年 7 月 26 日 By | No comments yet

Common LispでFizz-Buzz問題・コンディションで

コンディションの練習のために、Fizz-Buzz問題をコンディションを使って解いてみた。「15で割り切れる」「3で割り切れる」「5で割り切れる」といった事態をそれぞれエラーと見なし、別の値を使うという選択肢（use-value）を用意した上で、loop時にFizz,Buzz,FizzBuzzという文字列を割り当てている。

(define-condition multiple-of-15 (error) ())
(define-condition multiple-of-3  (error) ())
(define-condition multiple-of-5  (error) ())
 
(defun fizz-buzz-cond (n)
  (restart-case
      (cond ((zerop (mod n 15)) (error 'multiple-of-15))
	    ((zerop (mod n 3))  (error 'multiple-of-3))
	    ((zerop (mod n 5))  (error 'multiple-of-5))
	    (t n))
    (use-value (value) value)))
 
(defun use-value-fn (value)
  #'(lambda (c)
      (declare (ignore c))
      (invoke-restart 'use-value value)))
 
(defun run-fizz-buzz ()
  (handler-bind ((multiple-of-15 (use-value-fn "FizzBuzz"))
		 (multiple-of-3  (use-value-fn "Fizz"))
		 (multiple-of-5  (use-value-fn "Buzz")))
    (loop for n from 1 to 100 do (format t "~a~%" (fizz-buzz-cond n)))))
Common Lisp  | 2009 年 7 月 25 日 By | No comments yet

Common LispでFizz-Buzz問題・総称関数を使って

総称関数の練習のために、Fizz-Buzz問題を総称関数を使って解いてみた。独自のメソッド結合まで使った、無駄に大掛かりな物になっている。

(defun strcat (&rest strings)
  (apply 'concatenate `(string ,@strings)))
 
(define-method-combination strcat :identity-with-one-argument t)
 
(defgeneric fizz-buzz-method (mod3 mod5)
  (:documentation "mod3が0ならFizz, mod5が0ならBuzz")
  (:method-combination strcat))
 
(defmethod fizz-buzz-method strcat ((mod3 (eql 0)) mod5)
  "Fizz")
 
(defmethod fizz-buzz-method strcat (mod3 (mod5 (eql 0)))
  "Buzz")
 
(defmethod fizz-buzz-method strcat (mod3 mod5)
  "")
 
(defun empty-p (seq)
  (if (= 0 (length seq)) nil seq))
 
(defun fizz-buzz (n)
  (format t "~a~%" (or (empty-p (fizz-buzz-method (mod n 3) (mod n 5))) n)))

総称関数の使い勝手はHaskellやErlangのパターンマッチと似たところがあるが、マッチするメソッドが一度に全部手に入り、それらを結合できるところが決定的に違う。

未分類  | 2009 年 7 月 24 日 By | No comments yet

Redmineのマイページで終了チケットを表示しない

マイページの「報告したチケット」の中で、終了したチケットが表示されて鬱陶しかったので、
app/views/my/blocks/_issuesreportedbyme.rhtml
を修正。:conditionsの中に以下の条件を追加。

#{IssueStatus.table_name}.is_closed=0
Common Lisp  | 2009 年 7 月 23 日 By | No comments yet

Common LispでFizz-Buzz問題・さらに短く

『実践Common Lisp』18章を読んで、さらに別の書き方を思いついた。format関数の条件制御構文を使用する。

(defun fizz-buzz-format (n)
  (let ((s (format nil "~[Fizz~;~]~[Buzz~;~]" (mod n 3) (mod n 5))))
    (format t "~a~%" (if (string= "" s) n s))))

2つのformat関数を１つにまとめるのは…無理かな？

追記:思いついた

(defun fizz-buzz-format2 (n)
  (format t "~[Fizz~;~]~[Buzz~;~]~@*~[~:;~[~:;~a~]~]~%" (mod n 3) (mod n 5) n))

わずか一行に収まるとは。

Common Lisp  | 2009 年 7 月 21 日 By | No comments yet

Common Lisp で Fizz-Buzz問題

ベタに書けばこんな感じか。

(defun fizz-buzz-normal (num)
  (format t "~a~%" (cond
                     ((zerop (mod num 15)) "FizzBuzz")
                     ((zerop (mod num 3)) "Fizz")
                     ((zerop (mod num 5)) "Buzz")
                     (t num))))

with-output-to-string を使うとよりエレガント、かも知れない。

(defun fizz-buzz (num)
  (let ((r (with-output-to-string (s)
	       (when (zerop (mod num 3)) (format s "Fizz"))
	       (when (zerop (mod num 5)) (format s "Buzz")))))
    (format t "~a~%" (if (string= "" r) num r))))

一般化バージョン。

(defun gen-fizz-buzz (rules)
  (lambda (num)
    (let ((r (with-output-to-string (s)
		 (loop for (b w) in rules do
		      (when (zerop (mod num b)) (format s "~a" w))))))
      (format t "~a~%" (if (string= "" r) num r)))))

実行。

(loop for n from 1 to 100 do (fizz-buzz n))
 
;; 3,5,7の倍数の時、それぞれFizz,Buzz,Kozz
(let ((fizz-buzz-kozz (gen-fizz-buzz '((3 "Fizz") (5 "Buzz") (7 "Kozz")))))
    (loop for n from 1 to 100 do (funcall fizz-buzz-kozz n)))
未分類  | 2009 年 7 月 20 日 By | No comments yet

どんなにへたくそでも一日後には絵が上手くなる方法

夜眠れなかったので、たまたま見かけた『どんなにへたくそでも一日後には絵が上手くなる方法:ハムスター速報　２ろぐ』を試してみた。

元スレ主の主張は半ば精神論になっていたので半信半疑だったが、6枚7枚と円を描き続けるうちに、ごく単純で合理的なトレーニングであることに気が付いた。要するにこれは文字通り「手を動かす訓練」なのだ。思った通りに手を動かすことができなければ、どれほど明確なイメージが頭の中にあっても、たとえ円のように普遍的で揺らぎようのないイメージであっても、上手に描くことはできない。逆に言えば明確なイメージの元で延々手を動かし続ければ、やがては適切な手の動かし方を身体が覚える。そして思った通りに手が動き、イメージ通りのモノが描き上がる、という経験は確かに楽しく、私自身10枚のつもりが気が付けば15枚以上描いてしまい、最後の方は「真っ直ぐに線を引く練習」などを延々繰り返していた。

プログラミングの世界では有名な格言がある：「プログラムは思った通りには動かない。書いた通りに動く。」絵についても同じなのかも知れない：「絵は思った通りには描けない。手を動かした通りに描ける。」

はてブのコメントを見るとプログラミングの”Hello World”に例えた方もいらっしゃっるようだが、私の感覚では、（特定のプログラミング言語の）基本的な制御構造をエディタ上ですらすらと書く練習、に相当するような気がする。プログラミングそのものの技量にはならないが、それ以前に必要となるスキルで、特に新しい言語を学ぶ場合には真っ先に習得する必要がある。

未分類  | 2009 年 7 月 10 日 By | 1 comment

RedmineでGitのリモートリポジトリを参照

Redmineでブラウズの対象とするには local かつ bare なリポジトリでなければならないので、そのままでは使えない。そこでまず対象リポジトリのミラーとなるbareリポジトリを作る。

git clone --bare git://host/path.git
cd path
git remote add --mirror origin git://host/path.git

最近のバージョンの git では clone のオプションに –mirror を直接指定することができるらしいが、1.5.6 では上の手順が必要だった。

# git-1.6.0.6以降
git clone --mirror git://host/path.git

リポジトリを同期するには、ミラーリポジトリ内で fetch を実行する。cronで定期的に実行するよう設定しておけば実用上は十分だろう。

git fetch origin

あとはこのミラーリポジトリのパスをRedmineに設定しておく。

異なるブランチを使用する

Redmineの設定画面にはブランチ名の項目は無い。
lib/redmine/scm/adapters/git_adapter.rb
をチェックしたところ、常に”現在の”ブランチが使用されるようだ。

@branch ||= shellout("#{GIT_BIN} --git-dir #{target('')} branch") { |io| io.grep(/\*/)[0].strip.match(/\* (.*)/)[1] }

改造するのも面倒なので、異なるブランチには異なるリポジトリを割り当てることにした。上と全く同じ手順で bare リポジトリを作った後、HEADファイル内の参照を書き換える（bareリポジトリ なので checkout は使用できない）。

ref: refs/heads/your_branch

fetch の手順などは全く同じで良い。

Common Lisp  | 2009 年 7 月 9 日 By | No comments yet

SUBST-IFの動作に注意

『実践Common Lisp』13.1のSUBST-IFについての説明は間違っている。

SUBST-IFは、古いアイテムを１つ受け取る代わりに、1引数関数を受け取る。この関数は木に含まれる各アトミックな値に対して呼び出され、その結果が真になった箇所をすべて新しい値で置き換えた新しい木を返す。

「各アトミックな値に対して呼び出され」とあるが、実際にはコンスセルも含む（木自体も含む）全ての要素に対して呼び出される。SUBST-IF-NOTなども同様。

(subst-if 10 #'consp '(1 3 2 (1 2) (3 4) (5 6)))
;; => 10
 
(subst-if 10 #'atom '(1 3 2 (1 2) (3 4) (5 6)))
;; => (10 10 10 (10 10 . 10) (10 10 . 10) (10 10 . 10) . 10)
 
(subst-if 10 #'evenp '(1 3 2 (1 2) (3 4) (5 6)))
;; => エラー
;; The value (1 3 2 (1 2) (3 4) (5 6)) is not of type INTEGER.
 
(subst-if 10 #'(lambda (x) (and (integerp x) (evenp x)))
	  '(1 3 2 (1 2) (3 4) (5 6)))
;; => (1 3 10 (1 10) (3 10) (5 10))

そもそもアトミックな値も定義上は木である。

(subst-if 10 #'evenp 2)
;; => 10
Common Lisp  | 2009 年 7 月 8 日 By | No comments yet

Common Lispマージソート

組み込みの merge を使ってマージソートを実装してみた。

(defun merge-sort (result-type seq pred &key key)
  (let* ((len (length seq))
	 (mid (floor (/ len 2))))
    (if (> 2 len)
	seq
	(merge result-type
	       (merge-sort result-type (subseq seq 0 mid) pred :key key)
	       (merge-sort result-type (subseq seq mid) pred :key key)
	       pred
	       :key key))))

動作確認

(merge-sort 'list '("Wii" "DS" "PSP" "PS3" "Xbox360") #'string<)
;; => ("DS" "PS3" "PSP" "Wii" "Xbox360")
 
(merge-sort 'list '("Wii" "DS" "PSP" "PS3" "Xbox360") #'char<
              :key #'(lambda (x) (elt x 0)))
;; => ("DS" "PSP" "PS3" "Wii" "Xbox360")
← Older Posts