CodeIQの言語総選挙の予選でcodegolf
先月開催されたCodeIQの言語総選挙の問題の予選ルールがショートコーディング入門によさ気で面白かったのです。 出題者がショートーコーディング本の著者のOzyさんという事もあり、これは解説でゴルフコードの紹介なんかもあるんでないかなーと期待して気合を入れて短くしたコードを投稿したのですが、全く触れられていなくて無念…
というわけで、ここで短くして行った過程を解説してみようと思います。 私の回答はCommonLispで書いて提出したのですが、折角なので1位を取ったRubyで書きなおしてみました。
問題
問題も解説もCodeIQにログインしないと見れないので簡単に説明。
教室に席が格子状に並んでおり、出席者をO、欠席者をXで表した表が標準入力から与えられる。
生徒たちが前後or左右の隣りの生徒と2人1組のグループを作る時、余りが出ない配置の場合はyes、どう組んでも余る生徒が出てしまう場合はnoと出力せよ、という問題。
(例)
OOOOO OOOXO OOOOO
上図の場合、ペアを数字で表すと
11223 445X3 66577
のように組めるのでyesと出力する。
OOO OOX OOO
だと
122 13X O3O
のようにペアを作れない生徒が出てしまうのでno。
入力データの条件として以下の制限があります。
席の列数をW, 行数をH, 欠席者の数をXとした時
予選 : 2≦W*H≦30, 0≦X≦1
本選 : 1≦W≦10, 1≦H≦10, 0≦X≦W*H
素朴な深さ優先探索で予選も本選も用意されたテストケースは全て通ってしまうようですが、予選の条件では後に解説するように簡単に判別する方法がありました。
以下予選の条件で解法を考えていきます。
方針1. 塗り分け&数え上げ
まずCodeIQの解説にあったやり方。 下図のように各席を市松模様のように塗り分けて考えます。
ペアは必ずA席とB席の生徒で組まれるので、出席者のうちA席の生徒とB席の生徒をそれぞれ数え上げて同数なら余りが出ない、という考え方です。 欠席者が複数になるとAB同数でも余りが出る場合がありますが、欠席者が最大1名の予選ルールならこの数え上げだけで解が出ます。
というわけで最初のコード
def solve(input) map = input.split(/\n/) w = map[0].length h = map.length counts = [0, 0] # A席,B席の生徒数を記録する配列 h.times do |y| w.times do |x| if map[y][x] == "O" counts[(x+y)%2] += 1 end end end counts[0]==counts[1] end puts solve($<.read) ? "yes" : "no"
一番左上の席の座標を(x,y) = (0,0)として、x+yが偶数だったらA席、奇数だったらB席と判定しています。
変数名を短くするだとか空白・改行を削るだとかの作業は一番最後にやるとして、まずアルゴリズムの簡素化をしていきます。
1重ループ化
とりあえず2重ループを1重にできないかなと考えます。 幅が奇数の場合は、下図のように改行を取っ払って1行にしてしまっても数え上げはうまく行きます。
ABA BAB → ABABABABA ABA
左端を0番目として、偶数番目がA席で奇数番目がB席。よって2重ループの部分は
map = input.delete("\n") map.length.times do |i| if map[i] == "O" counts[i%2] += 1 end end
と短く出来ます。
幅が偶数の場合は改行を取っ払ってしまうと
ABAB BABA → ABABBABAABAB ABAB
のようになってしまってABの判別が面倒な事になります。 しかし幅が偶数ということは欠席者のいない行は必ずAの数=Bの数なので、欠席者のいる行だけ考えればよろしい。 そうすると先の奇数幅用のコードでも結果的には問題ないことがわかります。ちょっと気持ち悪いけど。
というわけで全体としてはこんな感じに。
def solve(input) map = input.delete("\n") counts = [0, 0] map.length.times do |i| if map[i] == "O" counts[i%2] += 1 end end counts[0] == counts[1] end puts solve($<.read) ? "yes" : "no"
数え上げの工夫
配列を使って数え上げてるのがイケてない気がするのでなんとかしたいと考えた所、数え上げ用変数を1つだけ用意して、偶数番目だったらデクリメント・奇数番目だったらインクリメントして最終的に0になっていればOkとする方法がありました。
def solve(input) map = input.delete("\n") c = 0 map.length.times do |i| if map[i] == "O" c += i%2*2-1 end end c == 0 end
数え上げの所はc += i%2-0.5として0.5ずつ増減させる方法もアリ。
この時点でアルゴリズム上の工夫はこれ以上思いつかなくなってしまったので、一旦畳んでスコア(コード長)を測ってみます。
c=0 (m=$<.read.delete("\n")).length.times{|i|m[i]=="O"&&c+=i%2*2-1} puts c==0?"yes":"no"
89バイトになりました。 とりあえずこの方針はここで一旦保留。
方針2. 欠席者の位置から判断
W*Hが偶数の場合は欠席者の有無、奇数の時はA席の生徒が欠席しているかどうかで判断できるのだから数え上げるまでもないですよね、という考え。
要するにこう。
- W*H が偶数
- 欠席者ナシ →
yes - 欠席者アリ →
no
- 欠席者ナシ →
- W*H が奇数
- 欠席者ナシ →
no - 欠席者はA席 →
yes - 欠席者はB席 →
no
- 欠席者ナシ →
という訳で最初のコードがこちら
def solve(input) map = input.split("\n") w = map[0].length h = map.length if (w*h).even? # 偶数なら欠席者がいなければ"yes" input !~ /X/ else # 奇数の場合 h.times do |y| w.times do |x| if map[y][x] == "X" # 欠席者が見つかったらA席かどうかを返して終了 return (x+y).even? end end end # 欠席者が見つからなかったら"no" false end end puts solve($<.read) ? "yes" : "no"
方針1に比べて大分長い所からスタートする感じですが頑張って短くして行きましょう。
まず奇数の場合は方針1で使った1重ループ化の考え方が問題なく使える & 改行取っ払ってしまえば偶奇判定も楽という事で
def solve(input) map = input.delete("\n") l = map.length if l.even? input !~ /X/ else l.times do |i| if m[i] == "X" return i.even? end end false end end
っと、ループの所、文字列の探索ならindexメソッドで十分ですね。
def solve(input) map = input.delete("\n") if map.length.even? input !~ /X/ else pos = map.index("X") !pos.nil? && pos.even? end end
大分スッキリしましたが、偶数の場合奇数の場合それぞれでXを検索してるのが気になる所。 とりあえずposの取得を前に持ってきてみる。
def solve(input) map = input.delete("\n") pos = map.index("X") if map.length.even? pos.nil? else !pos.nil? && pos.even? end end
この時点では畳んでもなんとか100を切れる程度。 全体長の偶奇で処理分けてるのコスト高いよなー何とかしたい、と風呂で考えてたら良いアイデアが降ってきました。
def solve(input) input.delete("\n").split("X").all?{|l|l.length.even?} end
入力から改行を取っ払った上でXの位置で分割してしまえ、というアイデア。どうなるかいうと
- W*H が偶数
- 欠席者アリ(no) → 分割すると
["OOOO", "O"]のように、長さが奇数の文字列と長さが偶数の文字列を要素に持つ配列になる - 欠席者ナシ(yes) → 分割されないので、偶数長の文字列1つを要素に持つ配列になる
- 欠席者アリ(no) → 分割すると
- W*H が奇数
- 欠席者ナシ(no) → 奇数長の文字列1つを要素に持つ配列になる
- 欠席者はA席(yes) →
["OO", "OOOOOO"]のように、偶数長の文字列2つを要素に持つ配列になる - 欠席者はB席(no) →
["OOO", "OOOOO"]のように、奇数長の文字列2つを要素に持つ配列になる
つまり、分割した結果、偶数長の文字列だけを持つ配列になる場合にyesとすれば良い訳です。
分割して、断片の長さの偶奇を測る、たったこれだけの作業ならアレで一発ですよねーという訳で
def solve(input) input.delete("\n") =~ /^(OO)*X?(OO)*$/ end
正規表現のマッチング1回で済んでしまいました。 畳んで全体を書くと
puts $<.read.delete("\n")=~/^(OO)*X?(OO)*$/?"yes":"no"
54バイトに。これだけ単純になると文法上のハックはほとんど必要ないですね。
保留にしておいた方針1でこれを超えるのは無理でしょう(多分)、という事でこれが私の回答の最終形。
二次元的な情報を全部捨ててしまっていて、一見するとこれは(用意されているテストケースだけ通る)cheatコードでしょーと 思ってしまいそうな回答ですが、ちゃんとどんなパターンにも対応できているっていうのが面白いです。
おまけで、予選落ちとなってしまったCommonLispのコードの供養。
(princ(if(regexp:match"^\\(OO\\)*X\\?\\(OO\\)*$"(format()"~{~A~}"(loop while(listen)collect(read))))"yes""no"))
探索の前に
- AB塗り分けによる枝刈り
- 組む相手が1人しかいない箇所を予め埋めておく
- 探索が早く収束するように、全体を4分割して欠席者が最も多いブロックから探索を開始する
といった工夫を入れた所、extracaseにも全て対応できました。
Compile Time Grass to D CompilerでGrassを実行可能バイナリにコンパイル
みどりの日恒例 Grass Hackathon (2年ぶり2回目、そして記事は2日遅れ)
D言語版のGrassインタプリタと、コンパイル時にGrassコードをD言語に変換し、結果をmixinするという流れでGrassを実行可能バイナリにコンパイルするモノを作ってみました。
https://github.com/youz/grasses/tree/master/D
grass.dが普通のインタプリタ、grassctc.d がコンパイル時Grass to Dコンパイラです。
grassctc.d コンパイル方法
grassのコードを"source.grass"というファイル名でgrassctc.dと同じ場所に保存して以下のコマンドでコンパイルします。
$ dmd -J. -of実行ファイル名 grassctc.d
あるいはwindowsならgrassc.bat, linux&Mac(or msys)ならgrassc(シェルスクリプト)にgrassファイルを渡せば良きに計らってくれます。
また、-pオプションを付けて呼び出すとstderrに変換結果を表示しつつコンパイルします。
$ cat w.grass
wWWwwww
$ path/to/grassc -p w.grass
(new F(delegate V(V f1) {
return f1(f1);
}))(new F(delegate V(V f0) {
return writer(w);
}));
$ ./w.exe
w
変換サンプル
wwWWwWWWwvWwWwWwwwwWwwwwwww
↓
(new F(delegate V(V f3) { return (new F(delegate V(V f4) { return (new F(delegate V(V f5) { return (new F(delegate V(V f6) { return (new F(delegate V(V f7) { return f7(f7); }))(f6(w)); }))(f5(writer)); }))(f4(f4)); }))(f3(f3)); }))(new F(delegate V(V f0) { return new F(delegate V(V f1) { return (new F(delegate V(V f2) { return f0(f2); }))(f0(f1)); }); }));
wwWWWWwWwwwWwwwWwwwvwwWWwWWWwvWwWwvwWWWWWwWWWwWwwwvwvWwwwwwWwwwWWwWWWwWWWWWWWWwWWWWWWwwwwwwwwwwwwwwWWWWWWWWwWWWWWwWWWWWwwwWWWWWWwwwWWWWWWWWWwWWWWWWWWWWwwwWWWWWWWWWwWWWWWWWWWWwwwWWWWWWWWWWwwwwWWWWWWWWWWWWWwWWWWWWWWWWWWwwWWWWWWWWWWWWWWWwWWWWWWWWWWWWWWWwWWWWWWWWWWWWWWWWWWWWWWWWWWWwvwWWWWWWWWWWWWWWWWWWWWWWWWWWWWwvWwwwwwwWWwwwwwwwwwwWWWwwwwwwwwwwwwwWWWWwWWWWWwwwwwwwwwwwwwwwwwWWWWWWwwwwwwwwwwWWWWWWWwwwwwwwwwvwWWWWWWWWWwvWwwwwwwwwwwwwwwwwwwwwwwwwWWwwwwwwwwwwwwwwwwwwwwwwWWWwwwwwwwwwwwwwwwwwwwwwwwwWWWWwwwwwwwwWWWWWwwwwwwwwwwwwwwwwwwwwWWWWWWwwwwwwwwwwwwwww
↓
(new F(delegate V(V f5) { return (new F(delegate V(V f9) { return (new F(delegate V(V f10) { return (new F(delegate V(V f11) { return (new F(delegate V(V f15) { return (new F(delegate V(V f17) { return (new F(delegate V(V f18) { return (new F(delegate V(V f19) { return (new F(delegate V(V f20) { return (new F(delegate V(V f21) { return (new F(delegate V(V f22) { return (new F(delegate V(V f23) { return (new F(delegate V(V f24) { return (new F(delegate V(V f25) { return (new F(delegate V(V f26) { return (new F(delegate V(V f27) { return (new F(delegate V(V f28) { return (new F(delegate V(V f29) { return (new F(delegate V(V f30) { return (new F(delegate V(V f31) { return (new F(delegate V(V f32) { return (new F(delegate V(V f33) { return (new F(delegate V(V f34) { return (new F(delegate V(V f35) { return (new F(delegate V(V f36) { return (new F(delegate V(V f37) { return (new F(delegate V(V f39) { return (new F(delegate V(V f40) { return (new F(delegate V(V f41) { return (new F(delegate V(V f42) { return (new F(delegate V(V f43) { return (new F(delegate V(V f44) { return (new F(delegate V(V f45) { return (new F(delegate V(V f46) { return (new F(delegate V(V f48) { return (new F(delegate V(V f49) { return (new F(delegate V(V f50) { return (new F(delegate V(V f51) { return (new F(delegate V(V f52) { return (new F(delegate V(V f53) { return (new F(delegate V(V f54) { return f54(f54); }))(f48(f37)); }))(f48(f31)); }))(f48(f43)); }))(f48(f25)); }))(f48(f26)); }))(f48(f23)); }))(new F(delegate V(V f47) { return f39(f47); })); }))(f39(f36)); }))(f39(f34)); }))(f39(f26)); }))(f39(f42)); }))(f39(f28)); }))(f39(f30)); }))(f39(f33)); }))(new F(delegate V(V f38) { return writer(f38); })); }))(succ(f36)); }))(f21(f35)); }))(f20(f34)); }))(f22(f32)); }))(f20(f32)); }))(f22(f28)); }))(f21(f28)); }))(f21(f29)); }))(f19(f26)); }))(f19(f27)); }))(f21(f24)); }))(f21(f23)); }))(f20(f24)); }))(f15(f23)); }))(f17(w)); }))(f10(f21)); }))(f18(f20)); }))(f18(f19)); }))(f18(f15)); }))(f17(f9)); }))(new F(delegate V(V f16) { return f16; })); }))(new F(delegate V(V f12) { return (new F(delegate V(V f13) { return (new F(delegate V(V f14) { return f14(f12); }))(f11(f13)); }))(f5(f12)); })); }))(f10(f10)); }))(f9(f9)); }))(new F(delegate V(V f6) { return new F(delegate V(V f7) { return (new F(delegate V(V f8) { return f6(f8); }))(f6(f7)); }); })); }))(new F(delegate V(V f0) { return new F(delegate V(V f1) { return (new F(delegate V(V f2) { return (new F(delegate V(V f3) { return (new F(delegate V(V f4) { return f4(f2); }))(f3(f1)); }))(f2(f0)); }))(succ(f1)); }); }));
ベンチマーク
wを (2^2)^(3^2) = 262144回succした結果を印字するコードでインタプリタとコンパイルした奴の速度を比較してみる。
$ cat 262144.grass wwWWwWWWwvwwWWwWWWwWWWWwvWWwwWWWwwWwwWwwwwwwwWwwwwwwwwwWWWWWWWWw $ time grass.exe 262144.grass w real 0m0.520s user 0m0.015s sys 0m0.000s $ grassc 262144.grass $ time ./262144.exe w real 0m0.265s user 0m0.015s sys 0m0.046s
もうちょっと重い処理をさせてみたいけど簡単に書ける重いコードってのがなかなか難しい…
（宣伝) Willow Wind Orchestra 第6回定期演奏会
1週間前告知。
来週2月17日(日)長野県千曲市のあんずホールにて私の所属してる吹奏楽団「Willow Wind Orchestra」の第6回定期演奏会があります。
平成２５年２月１７日（日） 千曲市更埴文化会館 あんずホール 開場13:00 開演13:30 入場料：500円（未就学児無料） 指揮：藤井貴宏 [曲目] ♪13管楽器のためのセレナード／R.シュトラウス ＊オーボエ：藤井貴宏 ♪ハンガリー民謡「くじゃく」による変奏曲／Z.コダーイ ♪エル・カミーノ・レアル／A.リード ♪オリエント急行／P.スパーク ♪「サウンド・オブ・ミュージック」メドレー 他
メインは「くじゃく」を全曲やります。
興味のある方はお気軽にお越しくださいませ。
Schemeベースのcyber-physical programming環境 "Extempore"
Lisp Advent Calendar 2012の記事です。
あまり知られてなさそうなScheme処理系 "Extempore" で遊んでみます。
Extemporeとは
Andrew Sorensen氏によって開発されているOpenSourceのScheme処理系です。
https://github.com/digego/extempore
クロスプラットフォームで動作するよう開発が進められていて、現在はLinux, MacOS X, Windows(いずれも64bitのみ)がサポートされています。
cyber-physical programming って何?
Andrew氏らの提唱する概念で論文がこちら。
LiveCoding+αみたいなモンでしょうか。(読んでない
あ、ここでいうLiveCodingっていうのは10日目のnitroさんの記事のソレではなく、英語版Wikipediaにある方の意味。
a performance practice centred upon the use of improvised interactive programming in creating sound and image based digital media.
http://en.wikipedia.org/wiki/Livecoding
要するにプログラミングで行うVJみたいなモンですね。
ExtemporeにはImpromptuという前身があり、Macで動作する無料のソフトでした。（ソースコードは非公開)
3年ほど前にRadium SoftwareのKZRさんが紹介されていたのでご存じの方もいるかもしれません。
Impromptuのデモ(Vimeo)
動画を見るとわかりますがImpromptuの時点で相当クールな処理系でした。より強力で柔軟な言語機能を得る為に0から処理系を作りなおしたようです。
Extemporeの言語仕様
インタープリタで実行されるSchemeと、LLVMを通してネイティブコードにコンパイルされて実行される見た目Scheme風の静的型付き言語 "xtlang" を組み合わせて処理するハイブリッドなシステムになっています。
;; Schemeのfib
(define (fib n)
(if (< n 2) 1
(+ (fib (- n 1))
(fib (- n 2)))))
;; xtlangのfib
(bind-func fibx
(lambda (n:i64)
(if (< n 2) 1
(+ (fibx (- n 1))
(fibx (- n 2))))))SchemeはR5RSのサブセットっぽい感じで、継続なんかも使えますがdefine-syntaxがない等いくつか足りない物があるようです。
bind-funcフォームの中身がxtlangです。64bit intを受け取って64bit intを返すコードがllvmでコンパイルされ、fibxに束縛されます。
文法他詳しい説明はこちらにあります。
言語機能以外ではDSP(Digital Sound Processing)機能とOpenGLを使ったグラフィクス描画の機能が用意されていますが、FFI機構があるのでほぼなんでもできる感じです。
例. Kinectから入力を読み取るライブラリ
Extemporeのビルド
LinuxとMacについてはgithubレポジトリのドキュメントの通りに作業すればOK。
Windowsの場合はVS2010製品版でビルドする場合はドキュメントの通りでOKですが2012の場合はLinuxとMac共通のLLVMパッチの他にいくつか修正しないといけない作業があります。
http://benswift.me/2012-11-05-building-extempore-on-windows.html
VS2012の場合↑このページの説明の通りに作業すればOK。
ちなみにVS2010expressだとCMAKEがうまく動かなくてLLVMのビルドでハマります…2012ならexpressでも大丈夫。
また、BoostとかLLVMにパッチ合っててフルビルドとかめんどくせーって人用にLinuxとMac OSX用のコンパイル済みバイナリが用意されています。
https://github.com/digego/extempore/downloads
Githubのdownloadsページはつい先日廃止が決まったので欲しい人はお早めに。
Windows用バイナリは公式で配布されてませんが、私がビルドした物をDropboxに置いておきました。
- 64bit Windows用
- 32bit Windows用 (danger!)
32bit環境はサポートされてないんですが、音鳴らすだけならとりあえず大丈夫なんで置いておきます。
FFI関係の機能が全滅なのでOpenGLのサンプルとか動かそうとすると死にます。
Extemporeの起動
Extemporeはファイルを渡して実行するようなインタプリタではなく、SWANKの様なS式サーバーとして動作します。
引数なしで起動すると、ポート7099でTCP接続を待ちます。
##########################################
## ##
## EXTEMPORE ##
## ##
## andrew@moso.com.au ##
## ##
## (c) 2010-2012 ##
## ##
##########################################
################################
######################
############
##
// 中略 //
Starting primary process
Trying to connect to 'localhost' on port 7099
New client connection
Successfully connected to remote process
Starting utility process
Trying to connect to 'localhost' on port 7098
New client connection
Successfully connected to remote processデータの送受信は評価したいS式をそのまま送って最後にCRLFを付ければ良いようです。
レポジトリにEmacs用とVim用のプラグインがありますが、今回はEmacsを使って行きます。
extempore-modeの使い方
extempore-modeの設定方法は省略。(elファイルを見て下さい)
操作は
- C-x C-j … Extemporeに接続
- C-x C-x … カーソル位置のフォーム(トップレベルまで)をExtemporeに送信
- C-x C-r … リージョン内のフォームをExtemporeに送信
- C-x C-b … バッファ内のすべてのフォームをExtemporeに送信
左がソースバッファ(extempore-mode)で右がshell-modeから起動したextemporeの出力
左側のカーソル位置(緑の□)で C-x C-x を押すと、 (define (fib ... )) が評価されます。
print, display関数等の出力は標準出力へ、フォームの評価結果の値はminibufferに表示されます。
先ほどの2種のフィボナッチ関数を走らせてみて、どのくらい差があるか見てみましょう。
(define-macro (time form) `(let ((t (clock:clock)) (result ,form)) (print (- (clock:clock) t) "sec.\n") result)) (time (println (fib 30))) (time (println (fibx 30))) (time (println (fibx 40)))
結果
1346269 20.868164 sec. 1346269 0.072266 sec. 165580141 9.282226 sec.
私のマシンでは(fib 30)はGaucheで0.5秒くらいですからxtlangはかなり速いですね。sbclの最適化ナシの速度と大体同じくらいになっています。
しかし実際に触ってみるとわかるのですがコンパイルがとても重いです。
ですので重い処理はあらかじめロード(コンパイル)しておいて、Schemeで各々の処理を組み合わせてLiveCodingしていく、というスタイルになります。
音を鳴らしてみる
前述のとおり実行速度はとても速いので、MIDI等使って外部のシンセサイザーを鳴らすまでもなくxtlangで波形生成からエフェクト処理まで書けてしまいます。
このサンプルを実行してみると、こんな音がします、と紹介しようと思ったんですがUSB音源がダメすぎてループバック録音ができない事に気づいた午後11時。両オスのコードも見つからないぞ。ぎゃー
(12/28 追記) 録音できた
竹内関数音楽をExtemporeで
昨年話題になった竹内関数音楽をExtemporeで演奏するコードを書いたのですがこれも録音できず。
折角なのでコードだけ載せておきます。録音は後日…
(12/28 追記) こっちも録音できた
;; 音色はさっきのサンプルから拝借 (load "libs/core/instruments.xtm") (define-instrument synth synth_note_c synth_fx) (bind-func dsp:[double,double,double,double,double*]* (lambda (in time chan dat) (cond ((< chan 2.0) (synth in time chan dat)) (else 0.0)))) (dsp:set! dsp) ;; 音階 (define (scale n base) (let ((m (modulo n 7))) (+ base (* 12 (/ (- n m) 7)) (list-ref '(0 2 4 5 7 9 11) m)))) ;; tak関数 (define (tak x y z next) (let* ((len (* 2 44100)) ; 2秒ずつ鳴らす (t (+ (now) len))) ; 次の音へ移る時刻 (print "[" x y z "]\n") ; 和音発声 (map (lambda (n) (play-note (now) synth (scale n 60) 70 len)) (list x y z)) ; 次の音へ (if (<= x y) (callback t next y) (callback t tak (- x 1) y z (lambda (nx) (tak (- y 1) z x (lambda (ny) (tak (- z 1) x y (lambda (nz) (tak nx ny nz next)))))))))) ;; start (tak 10 5 1 println) ;; stop (define (tak x y z next) )
tak関数がCPS変換されている理由ですが、普通の形だと発音の後に発音時間分待ってから(※)次の再帰呼び出しへ行かないといけないので、途中で演奏を止めたくなったらC-c C-cで強制終了するしかありません。
というかそもそも処理をブロックしてしまったらLiveCodingどころではないので、再帰的な演奏はcallback機構を使って "Temporal Recursion" というスタイルで書くのがExtempore流です。
http://benswift.me/2012-10-15-time-in-extempore.html
↑この辺参照
(tak 10 5 1 println)を評価するとcallbackで演奏を継続しつつ入力も受け付ける状態になります。
stopコメントの式を評価すると、takが何もしない関数に上書きされて大体1フレーズ後に演奏が止まります。
※ play-noteによる発音自体は非同期処理
Extempore動画
Andrew氏がVimeoに投稿しているモノをいくつかご紹介。とても面白いモノばかりですので是非一度ご覧あれ。
チュートリアル。ちょっとxtlangの書き方が今と違いますがExtemporeとはどんな物なのかがよくわかります。
YAMAHAの自動演奏ピアノ"disklavier"をExtemporeからコントロールして演奏。
3Dモデルを動かすサンプル。
Extemporeでモーションキャプチャーからの入力を読み取って音を鳴らす実験。これはKinectではない模様。
複数の巨大タッチパネルの入力＆物理演算。
最新作。楽しそー。
Impromptuの動画ですが、未来のIDEっぽくてステキ。
映像をリアルタイム解析してBGMを自動生成するシステム。(ImpromptuかExtemporeかどっちか分からず)
Impromptuでのクリスマス風音楽の即興演奏。
以上Extemporeの紹介でした。
音鳴らすだけならそんなに難しくないのでみなさんも是非遊んでみて下さい。
xyzzyのole-reader
この記事はLisp Reader Macro Advent Calendar 2012の記事です。
lisp方言のリーダーマクロの紹介という事で、Windows用テキストエディタ xyzzy のマクロ言語 xyzzy lisp よりole-readerをご紹介。
xyzzy lispのリーダーマクロ
まずはxyzzyをあまり知らない人向けにxyzzy lispのリーダー機能について簡単にご説明。
xyzzyはいわゆる1つのEmacsenってやつですが、マクロ言語はCommon LispのサブセットになっているためEmacs Lispとは結構違う所があります。
マクロ言語として採用されているxyzzy LispはCommon Lispに近く6割程度の仕様が実装されている。
http://ja.wikipedia.org/wiki/Xyzzy
Emacs Lispとの互換性はあまり無い。その一方で、Windows APIにアクセスできるなど、Windowsネイティブのソフトウェアである利点をいかした作りになっている。
リーダー機能については、CommonLispの全ての標準マクロ文字と #* (bit-vector), #P (pathname) 以外の全ての#ディスパッチマクロに対応しています。
;;; xyzzy lisp REPL user> #b01010101 85 user> #xffffffff 4294967295 user> #36r123456789abcdefghijklmnopqrstuvwxyz 86846823611197163108337531226495015298096208677436155 user> (exp (* pi #C(0 1))) #C(-1.0d0 1.224646799147353d-16) user> (aref #(1 2 3) 1) 2 user> (apply #'+ 1 2 3 '(4 5 6)) 21 user> (list #+xyzzy 1 #-xyzzy 2 #+cl 3 #|comment|# ) (1) user> #1=(format t "~S" '#1#) #1=(format t "~S" '#1#) nil
これらに加え、標準添付されているole拡張をロードするとole-reader #{ } が使えるようになります。
xyzzyのole-reader
xyzzy lispにはOLEオートメーションサーバーを操作する為の関数がいくつか用意されています。
- ole-create-object
- ole-get-object
- ole-getprop
- ole-putprop
- ole-method
- etc..
これらを使ってコードを書くと、
;;; http://xyzzy.s53.xrea.com/reference/wiki.cgi?p=OLE%A5%AA%A1%BC%A5%C8%A5%E1%A1%BC%A5%B7%A5%E7%A5%F3%A4%CE%BB%C8%CD%D1%CE%E3 ; 意味もなく全部のシートに「東西南北」を書き込む (let* ((xl (ole-create-object "Excel.Application")) (book (ole-method (ole-getprop xl 'Workbooks) 'Add)) (numsh (ole-getprop (ole-getprop book 'Worksheets) 'count))) (dotimes (i numsh) (let ((sheet (ole-getprop book 'Worksheets (1+ i)))) (ole-putprop (ole-method sheet 'Range "A1:D1") 'Value #("東" "西" "南" "北")))) (ole-putprop xl 'Visible t))
ole-getprop, ole-methodがネストしまくってとても書きづらいし読みづらい。
そこでole-readerを使うと
(require 'ole) (let* ((xl (ole-create-object "Excel.Application")) (book #{xl.Workbooks.Add})) (dotimes (i #{book.Worksheets.Count}) (setf #{book.Worksheets[(1+ i)].Range["A1:D1"].Value} #("東" "西" "南" "北"))) (setf #{xl.Visible} t))
VBに近い形で書けるようになり、とてもスッキリします。
動作は単純で、
user> '#{book.Worksheets[(1+ i)].Range["A1:D1"].Value} (ole-method (ole-method (ole-method book ':Worksheets (1+ i)) ':Range "A1:D1") ':Value)
こんな風に展開しています。
実装を見ると分かるんですが、ドットがマクロ文字になっていて1つのトークンになっているので、ドットの前後にスペースや改行が入れられます。
user> '#{book.foo .bar .baz} (ole-method (ole-method (ole-method book ':foo) ':bar) ':baz)
この辺はVBよりもちょっと柔軟ですね。
このリーダーが使われているコードはあまり見かけないのですが、突如大量のExcelに関する作業が発生した時等にとても便利ですので、なんか変な方眼紙とか投げ付けられてVBAで片そうとしてブチ切れる前にカカッとxyzzyを起動してサクっとやっつけてみましょう。
oleメソッドの名前付き引数呼び出し
以下半分余談。
xyzzyのole-method関数には名前付き引数呼び出し機能がなく、
'VBA Worksheets(1).Copy After:=Workbook(2).Worksheets(1)
このような呼び出し方が出来ません。
Rubyのwin32oleだとHashを使って
# Ruby xl = WIN32OLE.new("Excel.Application") book = xl.Workbooks.Add book.Worksheets(1).Copy(:After => book.Worksheets(1))
こんな風に書けます。
しかしつい先日、この名前付き引数呼び出しに対応した関数が追加されました。
OLE メソッドの名前付き引数に対応 (#361) · c628b3d · xyzzy-022/xyzzy · GitHub
ole-readerの方の対応はまだなのですが、中の人からは以下の様な書き方が提案されてます。
#{excel.Copy[worksheet1 {:Count 3}]} ;; できるかな?
https://github.com/xyzzy-022/xyzzy/issues/361#issuecomment-10626273
他に良い記法のアイディアがありましたらこのissue #361までコメントをお寄せ下さい。
windowsでsbcl+lispbuilderのセットアップ
chatonのCL部屋で困ってる人がいたみたいなので。
ここのsbclのwindows forkを使えば最速(全プラットフォーム中)でサンプルの動作まで持っていけるはず。
配布のこととかも考えたらライブラリの配置、ロード方法をしっかり理解しといた方が良いとは思うけどとりあえず動かすまでを最優先で。
1. sbcl windows forkのダウンロード
ここからStand-alone executableってのをダウンロード。
zipファイルを展開して出てくるsbcl-with-contrib-win32-うんたらかんたら.exeをパスの通ってる場所に置き、名前が長いのでsbcl.exeにリネームしておく。
2. sdl.dllのダウンロード
公式サイトからwindows用バイナリ(dll)をダウンロード
zipファイルを展開して出てくるsdl.dllをパスの通ってる場所に置く。
※ 今回スクリーンショットを撮るにあたって、新規環境でのセットアップをシミュレートするためwindowsにGuestログインし、C:\Users\Guest\bin というフォルダを作ってここにパスを通してsbcl.exeとsdl.dllを置いている。
3. sbcl起動 & lispbuilder-sdlインストール
コマンドプロンプトからsbclを起動し、おもむろに ":ql lispbuilder-sdl-examples" とタイプしてリターン
するとまずquicklispのインストールが始まります。
このsbclのwindows forkにはquicklisp用のREPLコマンドが組み込んであってとっても便利。
ちなみにquicklispはexeに埋め込まれてるわけではなく、qlコマンドの初回使用時に最新版を取得してインストールするようになってるっぽいです。
quicklispのインストールが完了すると絶え間なくlispbuilder-sdl-examplesのロードが始まり、依存するライブラリがインストール＆ロードされて行きます。
SLIMEのセットアップ
折角なのでEmacsとSlimeのセットアップもしてみよう。
1. quicklisp-slime-helperのインストール
SLIMEのインストールもquicklispでやっちゃえば簡単。
:ql quicklisp-slime-helper と打ち込んでインストール。
インストール完了後、.emacsの設定方法が表示されるのでコピペしておく。
(load (expand-file-name "~/AppData/Local/common-lisp/quicklisp/slime-helper.el")) ;; Replace "sbcl" with the path to your implementation (setq inferior-lisp-program "sbcl")
Win7なら↑これ。XPだとslime-helper.elのパスが変わるはず。
2. .sbclrcの設定
quicklispは:qlコマンドを使うまでロードされないので、REPLコマンドが使えないSLIMEからquicklispを使うにはsbclの初期化ファイル .sbclrc でロードするよう設定が必要。
コマンドプロンプトで起動してるsbclのREPLから (ql:add-to-init-file) を実行すれば .sbclrc に必要な設定が書き込まれます。
逆FizzBuzz
http://www.jasq.org/2/post/2012/05/inverse-fizzbuzz.html
http://d.hatena.ne.jp/matarillo/20120515/p1
より。
入力を正規表現に変換してしまえばとても簡単になる。
https://gist.github.com/2708823
けれど、cl-ppcreだと上記のコードのままじゃちょっと長めの入力を渡すと死んでしまう。
バックトラックが爆発してるんだろうけど、正しい書き方あるのかな。
CL-USER(10): (defun test (n) (time (inverse-fizzbuzz (loop repeat n append '(fizz buzz fizz fizz buzz fizz fizzbuzz))))) TEST CL-USER(11): (test 5) Evaluation took: 0.091 seconds of real time 0.093601 seconds of total run time (0.093601 user, 0.000000 system) 103.30% CPU 225,231,803 processor cycles 65,520 bytes consed (3 75) CL-USER(12): (test 6) Evaluation took: 8.923 seconds of real time 8.907657 seconds of total run time (8.907657 user, 0.000000 system) 99.83% CPU 22,234,078,381 processor cycles 98,296 bytes consed (3 90) CL-USER(13): (test 7) ;; 返って来ない…
7個以上渡された時は最初の7個の繰り返しになってるか確認してから最初の7個をチェック、で終点は入力の長さから計算って形にしないといけなさそう。
user> (defun scan-all (re str &optional (start 0)) (let ((s (string-match re str start))) (when s (cons (list (1+ s) (match-end 0)) (scan-all re str (1+ s)))))) scan-all user> (defun inverse-fizzbuzz (fb) (let ((re (format nil "~{~A~^_*?~}" (mapcar #'(lambda (s) (case s (fizz "f") (buzz "b") (t "z"))) fb))) (pattern (format nil "~V@{__f_bf__fb_f__z~}" (+ 2 (floor (length fb) 7)) t))) (car (sort (scan-all re pattern) #'> :key (lambda (p) (apply #'- p)))))) inverse-fizzbuzz user> (defun test (n) (inverse-fizzbuzz (loop repeat n append '(fizz buzz fizz fizz buzz fizz fizzbuzz)))) test user> :time (test 5) (3 75) ---------- 0.000 sec. user> :time (test 10) (3 150) ---------- 0.000 sec. user> :time (test 1000) (3 15000) ---------- 0.484 sec.
7000個渡しても大丈夫。
