pureでag
ニュートン誌のバックナンバーを見ていたら、音声でパソコン入力なんて言うCMが出てた。 それによると、アメリカの医学界で鍛えられ、絶大な人気を誇っているとか。 おいらが行ってる町医者も、診断結果をマイクに向かって喋っていたな。
パソコン入力の世界記録保持者が、42秒で160単語を入力するのを尻目に16秒で音声入力 しちゃったとか。こう素晴らしいものなら、ツイター大好き人間は、ツイターの語源の ごとく、このソフトを使わななりません。ツイター社が一括ライセンスして、使える ようにしませんかね？さあさあ、つぶやけ、つぶやけ、ツイター社へつぶやけ攻撃！！
ぐぐる様は暫く前から、音声検索出来るようになったので、ブームなんですかね？ かの 広告にも、音声入力の歴史は1950年台から始まりIBMあたりが熱心に研究してたなんて説明 されてた。１次ブームは1997年頃に、確率モデルを取り入れる事によってよってもたらされ、2次ブームは 当社が作ったと豪語してました。
当然、ライバルは居るわけで、比較をやってる方 とか、ドラゴンの応援団 が居たりして、面白い。
この分野もいろいろな雑誌に取り上げられていたな。Haskellで何とかしようという人も居て Haskellで作る超コンパクト音声認識システム：Husky なんてのも公開されてます。
でも、トータルで進んでいるのは、今の所アプルなんだな。ひょっとしてアプルでも Haskellを使っているのかしらん？
そうそう、冒頭に町医者の話が出てきたけど、最近は医者もコンピュータの御託を採用 する方向で動いているみたい。クイズ番組で名をはせた ワトスン君が、医療分野でも いい味を出しているようですよ。無駄知識も特定分野に絞れば人を超える英知を発揮する らしいですよ。
agの下調べ
agってのは、おいらが勝手に付けた名前。CUI端末で星を並べて棒グラフを書きましょってやつ。 前回の続きだ。まずは、先輩がどうやってるか見てみる。
main = mapM_ go (histogram list)
where go (h, l) = putStrLn $ show h ++ " " ++ replicate l '*'
-- ^ h : head; l: length
list = [1,2,3,4,2,5,0,0,8,9,1,7,8,9,7,4,7,7,7]
画面に表示とは、副作用です。副作用を起せるのはmainって決まっているので、関数名は 自動的にmainに決定。
表示の為のデータは、histgram関数が佳きにあしらってくれるんで、それをcarしながら、 棒を一本づつ書いて行く。cdrを取りながら、リストが空になるまで繰り返せばいいんで、 そんな関数あったよねと言う事でmapを思い出す。但し扱うデータがHaskellさんからは 不浄に見えるので、不浄なデータを扱うため恐怖のモナド。って事で、モナド対応のmapM。
で、mapの返り値はリストになるんだけど、どうせ()しか返ってこないんで、そんなものを 見せられたって嬉しくない。いらないものは棄ててね機能を付けた、mapM_ 。 なかなか、 都合よい関数を用意してるな。
各棒を書くのは、下請けのgoにお任せ。引数の受け渡し方法に注目。carしたやつを分解 してから渡しているので、後が楽になる。某SIみたいに丸投げしない所が偉いぞ。
下請けさんは、文字列を表示してから改行してねっていうアクション（と言う、詐欺みたいな 名前で納得させられるマジック）を定義、++ で、文字列を結合。hって言う、棒のタイトルを 見せ、スペースを挟んでから、データ分だけ星印を生成。なんとも分かり易い動作だ。
ああ、histgram関数から渡ってくるリストは、こんなんだった。
[(52,51),(57,247),(62,57),(67,5)]
これってLispで言う、連想リストだよな。そうするとassoc一族は有るのかな？ 軽く探して みたけど、見つからなかった。プログラミングGaucheでも参考に、移植してみるか。とか言いながら パラパラ見てたら、foldなんてのが出てきたぞ。やっぱりと言うか当然と言うか。。。（以下省略）
素朴なag
下調べが終わったので、Haskellのそれをpureに移植してみる。移植って足りない分や 挙動が違う部分を補ったり、補正したりする作業だな。
Haskellに有ってpureに無いものとして、replicateがある。エラーになってしまったので、 間違いない。念の為、マニュアルを眼grepしたけど、無かったぞ。pureって最小主義なんだな。 ある意味、昔のSchemeに通じる所がある。ああ、昔のSchemeってのは、R5RSまでの事ね。 6以降は、肥大主義と言うか実用主義に走っちゃって、面白みに欠ける。
無いものは適当に寄せ集めて、でっち上げればいいんだ。こんなのでどうだ。
replicate n = (join "" . repeatn n) ;
関数合成+ポイントフリースタイルで、書いてみました。 Haskell Advent Calendar 2013の 4日目、arrowの話には負けるけど。
取り合えず、足りない分は揃ったので、pure流に書いてみる。
ag xs = do go xs with
go (k,v) = puts (str k+" "+replicate v "*");
end;
pureはモナドなんて有るかどうかは知らないけど、doが用意されてた。rubyで言うeachね。 mapの親戚。putsを使う時は、systemをインポートしとく事。showの代わりにstrを使って、 整数を文字列に変換してる。以上で、移植終了。
と、簡単に書いちゃったけど、マイナーなトラブルが発生してたんだ。gplotのnamespaceを 有効にしてたものだから、そのスペースにあるputsが使われちゃっててねぇ。おかしな事に なってたのさ。最初、それに気付かずオロオロしちゃったけど、show ag してみたら、 何処の関数が使われているか表示してくれたんで、事無きを得ました。
圧縮付きag
概要が分かったので、barが１画面に収まるような圧縮機能付きの棒グラフ作成関数を 書いてみる。均等にデータをスケーリングしちゃうと、棒が表示されない事もありうる。
どうする？ RのCUIグラフにヒントを得て、そういう時は、データを文字にエンコード しちゃえってのにいたる。先に作ったagの変形なので、Haskell宜しくag' とでもしたい んだけど、pureでは、そんな文字使っちゃだめって言われるので、（ドイツだとウムラウト 文字を許すのかな？）、変形の印として、aGにした。
aG xs = do go xs with
sv v = if (dm * v div vm) > 0
then replicate (dm * v div vm) "*"
else chr (ord "0" + v) ;
go (k,v) = puts (str k+" "+ (sv v)+" "+str v);
end when
vm = foldl1 max $ unzip xs ! 1;
dm = 50 ;
end ;
最大星印は、50文字まで。いきなりマジックナンバーが出てこないように、バインドしといた けど、意味不な名前だな。我ながら反省！
> aG (hist 5 hi); 101 **** 9 106 ************** 29 111 ***************************** 60 116 ************************************************** 103 121 **************************************** 83 126 ************************ 50 131 ********** 21 136 * 4 141 1 1 ()
まあ、目的達成って事で。
> aG $ hist 4 $ zipwith (-) hi low; 24 * 3 28 **** 8 32 ********************* 41 36 ************************************ 68 40 ************************************************** 94 44 ********************************************* 86 48 ******************* 36 52 ********** 19 56 ** 5
こちらは、血圧差のヒストグラム。じぇじぇじぇ～ 差が24って測定の不確かさから 来てるのだろうか？ 素人目に、超やばそうな気がするんだけど。。
こいつのQって幾らぐらいなんだろう？ (おっと、これは無線用語か。ちなみにQの定義って、 同調周波数を、そこより6dBダウンした帯域幅で割った数値だったな) 尖っている程、 標準偏差が小さいって、なんかQと通じるものがあるな。
慣れてくると、ヒストグラムの形を見るだけで、標準偏差が予想出来るって言うけど、今の オイラーには、まだ無理。ばらつきが小さければ、相関係数が高いってのは、確信を持って 言えるけど。
練習帳を作って、ヒストグラムから標準偏差を推定したり、相関係数を予測したりするのも 面白いかも知れないな。
do一族
上で活躍してくれた、do、Haskellではモナドの構文糖衣だけど、pureにはそんなのが 無いんで、関数として実装されているはず。どういう実装なんだろう？
mapみたいなものとすれば、headを取ってそれに関数を適用。それとtail側の再帰結果を何らかの 演算子(mapなら、consがそれに当たる）で結合してくはず。その演算子が思い浮かばない。
しょうがないので、答えをちょろ見。
do f [] = ();
do f (x:xs) = f x $$ do f xs;
dowith f (x:xs) (y:ys) = f x y $$ dowith f xs ys;
dowith f _ _ = () otherwise;
dowith3 f (x:xs) (y:ys) (z:zs)
= f x y z $$ dowith3 f xs ys zs;
dowith3 f _ _ _ = () otherwise;
doにはzipみたいに複数のリストを同時に扱う奴も用意されてるのね。今後の為に頭の 片隅に入れておこう。 で、今回の肝は、＄＄ですよ。何だろうこれ？
infixl 1000 $$ ; // sequence operator
順番に実行するんだな。shellでよく configure && make && make install とかやるけど、 それより制限が緩いんだな。
> 3 $$ 4 $$ 5 ; 5 > true $$ false ; 0
最後に実行した結果を返すとな。Lispのprognか。
上の定義を見ると、doの最終結果は、()って事で、意味無 を強調してる。
まとめ
pureって統計用にうってつけ。統計で多用するシグマってのは畳み込み、これ簡単。 グラフはgnuplotにお任せよ。変なGUIを導入する事無く使える。疎結合はunixの思想。 データの取り込みも簡単。haskellみたいに、やれモナドとか言い出さなくて良い。
今まで、何回かに分けてコードを書いてきたけど、最後に一挙公開。将来の自分の為に。 凝った事はしていない、部品の寄せ集めだけどね。
using system; // for __show__ time puts
using math; // for sqrt ceil
using gplot;
using csv;
using namespace csv;
getcsv f = v when
d = dialect {quote_flag=>MINIMAL};
p = open (f, "r", d);
v = fgetr p;
z = close p;
end;
putcsv f x = #x when
d = dialect {quote_flag=>MINIMAL};
p = open (f, "w", d);
v = fputr p x;
z = close p;
end;
group n [] = [];
group n xs = (take n xs) : (group n (drop n xs));
sum xs = foldl (+) 0 xs;
avg xs = sum xs / #xs ;
ss xs = sum [(x - avg xs) ^ 2 | x = xs;] / ( #xs - 1) ;
sd xs = sqrt $ ss xs ;
median xs = if #xs mod 2 == 1 then
head $ drop (#xs div 2) $ sort (<) xs
else
(rs ! 0 + rs ! 1) / 2 with
rs = drop (#xs div 2 - 1) $ sort (<) xs
end;
cor xs ys = (sum $ map tmc $ zip xs ys) / (#xs - 1) with
tmc z = ((z!0 - ax) / sx) * ((z!1 - ay) / sy) ;
end when
ax = avg xs ;
ay = avg ys ;
sx = sd xs ;
sy = sd ys ;
end ;
hist s xs = mk n (sort (<) xs) with
n = s + (foldl1 min xs) ;
len xs = # xs ;
cs n xs = (n - s, (len $ takewhile (<n) xs));
mk n [] = [] ;
mk n ss = cs n ss : mk (n+s) (dropwhile (<n) ss) ;
end ;
let gp = gplot::open "/usr/bin/gnuplot";
lg xs = gplot::plot gp xs ("style", "lines") ;
ltg ttl xs = s when
a = gplot::title gp ttl;
s = str (time mod 86400) + ".png";
b = gplot::output gp "png" s;
e = lg xs ;
c = gplot::output gp "x11" "";
d = gplot::title gp "";
end;
replicate n = (join "" . repeatn n) ;
ag xs = do go xs with
go (k,v) = puts (str k+" "+replicate v "*");
end;
aG xs = do go xs with
sv v = if (dm * v div vm) > 0
then replicate (dm * v div vm) "*"
else chr (ord "0" + v) ;
go (k,v) = puts (str k+" "+ (sv v)+" "+str v);
end when
vm = foldl1 max $ unzip xs ! 1;
dm = 50 ;
end ;
// __show__ x::double = sprintf "%0.1f" x;
let m = getcsv "2013.csv";
let am = [x | x = m; x ! 0 ! 7 == "0"] ;
let pm = [x | x = m; x ! 0 ! 7 == "2"] ;
let hia = [x!1 | x = am; ];
let lowa= [x!2 | x = am; ];
let plsa= [x!3 | x = am; ];
let hip = [x!1 | x = pm; ];
let lowp= [x!2 | x = pm; ];
let plsp= [x!3 | x = pm; ];
祝 FreeBSD 10.0
今回はRC４まで行く、難産であったけど、無事にリリースされた。 早速、入れるだけしてみた。
$ uname -a FreeBSD fb10 10.0-RELEASE FreeBSD 10.0-RELEASE #0 r260789: Fri Jan 17 01:46:25 UTC 2014 root@snap.freebsd.org:/usr/obj/usr/src/sys/GENERIC i386 $ df Filesystem 1K-blocks Used Avail Capacity Mounted on /dev/ada0p2 19278684 2269360 15467032 13% / devfs 1 1 0 100% /dev
CDからみんな入りってやってportsとsrcを入れただけ。おいおい、ユーザーランドを追加して、 PCBSDから引越ししよう。
pkgの在り処が、http://pkg.freebsd.org/freebsd:10:x86:32/latest/ なの？
root@fb10:~ # pkg install pure
Updating repository catalogue
The following 9 packages will be installed:
Installing gmp: 5.1.3
Installing gettext: 0.18.3.1
Installing perl5: 5.16.3_6
Installing libltdl: 2.4.2_2
Installing mpfr: 3.1.2
Installing python27: 2.7.6_1
Installing python2: 2_2
Installing llvm32: 3.2_2
Installing pure: 0.58_1
The installation will require 202 MB more space
41 MB to be downloaded
Proceed with installing packages [y/N]: y
なんか、linuxっぽくなってきたな。/var/db/pkgの下も、とうとうsqliteで占められる ように、なっちまったい。これも時代の流れか。