Haskell::OGR-nの探索(その2)

前回、PGR(n,m)の探索過程でm'<mであるm’が見つかった時点で、一旦全計算をキャンセルしてm’で計算をやり直したほうが計算量を削減できる、という仮定を立てたので本当にそうなのか実際にコードを書いてみた。

ogr2.hs

例外処理の類は使わずに、愚直にm(m’)を計算結果と一緒に持ちまわるようにしたので、ぱっと見やはり冗長というかうざったい感じのコードになった。HaskellらしくMaybeモナドなんかで途中の計算をつないでやるようなコードが書ければもっとシンプルになりそうな気はするが、その境地にはまだ程遠い。
ついでに、得られた計算結果の内鏡像解をタプルにまとめて返すようにしたので多少結果が見易くなっていると思う。

で、肝心の計算時間は、

% time ./ogr2 8
([0,1,4,9,15,22,32,34],[0,2,12,19,25,30,33,34])
3.651u 0.001s 0:03.65 100.0%    685+850k 0+0io 0pf+0w
% time ./ogr2 9
([0,1,5,12,25,27,35,41,44],[0,3,9,17,19,32,39,43,44])
56.130u 0.060s 0:56.19 100.0%   686+851k 0+0io 0pf+0w
% time ./ogr2 10
([0,1,6,10,23,26,34,41,53,55],[0,2,14,21,29,32,45,49,54,55])
647.876u 0.789s 10:50.60 99.7%  685+850k 0+0io 0pf+0w

となり、予想通り大幅な計算量の削減に成功している(前回のコードではOGR-9を求めるのにも2時間以上かかっていたし)。
とは言っても、OGR-11以降の計算はまだまだ相当な時間がかかりそう。distribute.netでチャレンジするのがOGR-22の探索だから、先は果てしないね。

秋葉原で飲む

先週の木曜日にまたまた前職の知人(別人)と秋葉原で飲んできた。
秋葉原で飲むのは2年ぶりぐらいですかね。

仕事ネタから馬鹿話はてはプリンタ選びまで、なんだかとりとめのない話でやたら盛り上がってたな。

17:00から22:00までのんびり肴をつつきつつ、ビール->酎ハイ->焼酎(ロック)とまあまあ飲んでたか。
これでも一応セーブしつつ飲んでいたのでさすがに翌日には残らなかった。

普通木曜の晩ならもっと混んでいるらしいが、自分たちが飲んでいるときは多少人が入れ替わる程度でずっとすいていた。忘年会シーズンなのにやっぱり不景気なんですかねぇ。

最近外で飲むことがめっきり無くなったので、知人と店で飲むのがやたらと嬉しい。

Real World Haskell(無事配達完了)

年内に届くかどうかやきもきしていたが、本日配達され無事受け取ることができた。

まだざっと目を通したところだが、Haskellの一通りの特徴を押さえているのはもちろんだが、Real Worldの名に恥じないだけのコードサンプルが用意されているのが良いね。
ざっと挙げただけでも、

  • 一般的なファイルI/O(をどうやってHaskellで料理するか)
  • 外部Cライブラリのバインディングの作成(本書ではPCREを例に解説)
  • GUIプログラミング(gtk2hsでGTK+ & Gladeでのアプリケーション開発)
  • SQLベースのデータベースアクセス
  • スレッドプログラミング
  • ランタイムシステムによるコードプロファイル/カバレッジ
  • ネットワークプログラミング(これはほんのちょっとって感じ)

など、純粋関数型言語でどうやって従来の手続き型言語でやっていたことが達成できるか結構詳細に解説されている。また、コード例を通してHaskellに特徴的なモナドによる様々な計算合成の仕組みの解説も丹念にされている。

なお、本書で採用している言語系はGHC(6.8.3)なので、Hugs向けにはちょっと不向きな所もあるかも。

Haskell関連の書籍はまだまだ少ないと思うが、本書は洋書・邦書の中でもかなりお勧めできる内容・質を備えていると思う。

ちなみに邦書でお手軽入門向きには

がお勧めかな。

とりあえず、Haskellでちょっとしたファイル処理なんかを実装するために、必要最低限の構文・関数について解説するところから、最後のほうではWikiシステムの開発など今時の言語系できることはHaskellでもできるんだぜぃってのりが、肩肘張ってなくてなかなか好印象。
リファレンスとするにはちょっともの足りないけど、そういうものは今時Web上にもいっぱい転がっているのでまずはこれからという点では悪くない。

警察の巡回調査

本日、警察職員の人がやって来て巡回調査ということで、住所、氏名、連絡先などを聴かれ調査票に記入した。
周辺で空き巣被害などが多発しているということで、定期的にアパート・マンションを戸別訪問してこのような調査をしているらしい。あわせて防犯上の注意などを説明された。

が、身分証を確認するのをうっかり忘れたので、念の為最寄の警察署に連絡し調査員の人からコールバックをしてもらって、調査が実際に警察で行われているものであることが確認できた。

防犯対策としてやってもらっていることなので本来はありがたいことなのだが、一歩間違えると振り込め詐欺のネタを提供していたかもしれず、結構冷や汗ものだった。
身分証を確認していたとしてもそれが本物かどうかもすぐには判別できないし(名前と所属を控えておけば後で確認はとれるだろうけど)、このような調査って実は不安感を高める効果の方が強いかも。それが防犯にはいいのかもしれないが。

一昔前ならご苦労様の一言で済ませられていたたことなのに、今時はここまで注意をしなければいけないご時勢なんだなぁということを実感させられた。

Haskell::OGR-nの探索

GR-nの生成もそろそろ飽きてきたので、OGR-nの探索問題について考えてみる。

まず、GR-nは無限列なのでそのままでは、終了条件を決めることができない。
そこで、探索範囲を有限領域に抑え込むために次の戦略を考える

  • まずGR-nの先頭いくつか(今回はn*2個)をサンプルとして計算し、その内最短のものを求め長さをmとする
  • PGR(n-1,m-1)とn(n-1)/2~mの組み合わせから、PGR(n,m)を計算する。ここで、PGR(n,m)はGR-nの内長さはm以下のものの集合でGR-nの定義よりこれは有限集合である。
  • PGR(n-1,m-1)はPGR(n-2,m-2)以下より再帰的に計算可能
  • PGR(n,m)からOGR-nを探索する

以上から、まず第一弾のコードを書いてみた。90行程度になったのでさすがに別リンクで。

ogr.hs

このコードでOGR-8までは一応一分以内に計算できる。
OGR-9になると途端に2時間以上かかる。

PGR(n,m)を計算する過程でm'<mなるm’が見つかった時点で一旦全ての計算をキャンセルして、m’を新しいmとして計算し直した方が全体の計算量を減らせそうな気がする。
まだ、Haskellの例外処理はさっぱり理解できていないので、この手法の実装はまたいずれということで。

Haskell::GR-nの生成(時間計算量)

その4のコードでGR-nの生成にかかる時間計算量を大雑把に推定してみる。
n=3~50で最初の一つを求めるのにかかる時間を測定し、gnuplotでグラフにしてみた。
grs.png

f(n)もこれまたgnuplotで大雑把にfitさせてみたが、全般的に上限は抑えられているように見える。
最初の一つを求める時間計算量はO(k^n)程度と見てよいだろう。

本当は最初の10個くらいを求めて単位時間当たりの生成数などで測ったほうがいいのかもしれないが、そこまでやると1週間くらいホストをぶん回す事になりそうなので、この辺でお茶を濁しておく。

領域計算量についてもプロファイルを取るのに時間がかかるので省略。

新橋で飲む

先週の土曜日に前職の知人と五ヶ月ぶりぐらいに新橋で飲んだ。

そもそも外で飲むのも数ヶ月ぶりだったのもあるが、仕事の話なんかで盛り上がりかなりはしゃいでいた気がする。
17:00ぐらいから二軒店を回り、別れた後なじみだったバーに顔を出したらしっかり終電を逃してタクシー帰り;_;。

翌日は見事にダウン。
酒弱くなってるのは自覚してるんだからもうちょっと酒量をコントロールしないとね。

やっぱり気分の浮き沈みをコントロールするのが極端に下手になっているんだろうな。

Haskell::GR-nの生成(その4)

GR-nの判定方法について考える。
その3までは、(g’∈{GR-(n-1)}, x)から一旦リストを作り、それがGR-nか判定していたが、g’の差集合とxとg’の各要素の差から作られる集合の積が空かどうかで判定するように変更してみる。
g’の差集合はスキャンの過程で何度も求めるが、g’は繰り返し同じ値が現れる。二度目以降は最適化により先の結果が使われることが期待できる。これで、判定の計算コストが低減できないか試してみる。

-- grs.hs
import System
import List
main :: IO ()
main = do { args <- getArgs
; let [n, m] = if length args == 2 then map read args else [4,20]
; putStrLn $ unwords $ map show $ take m $ gr n
}
gr :: Int -> [[Int]]
gr n
| n<1         = []
| n==1        = [[0]]
| n==2        = map (\x -> [0, x]) [1..]
| otherwise   = scanline (gr $ n - 1) 1
where
scanline :: [[Int]] -> Int -> [[Int]]
scanline gs m
| m<1             = []
| otherwise       = let {
lm = n * (n - 1) `div` 2
; gs1 = zip [lm..(lm + m -1)] $ map (\y -> gs !! y) $ reverse [0..(m-1)]
; gs2 = filter (\(x, gse) -> last gse < x) gs1
; gs3 = filter (\(x, gse) -> null $ (diff_set gse) `intersect` (map (x -) gse)) gs2
} in (map (\(x, gse) -> gse ++ [x]) gs3) ++ (scanline gs $ m + 1)
where
diff_set :: [Int] -> [Int]
diff_set s = sort $ map (\(x,y) -> (s !! y) - (s !! x)) cs
where
cs = [(x,y)|x<-[0..(n-3)],y<-[1..(n-2)],x<y]--

GR-40の一つ目を求めるのにかかる時間をその3のコードと比較してみる。

その3:

40:[0,1,3,8,12,22,28,46,59,82,99,114,149,175,214,244,292,333,396,453,497,561,623,732,765,817,961,990,1084,1263,1346,1481,1561,1689,1762,1884,2124,2190,2274,2379]      856.42 real       855.50 user         0.79 sys

今回:40:[0,1,3,8,12,22,28,46,59,82,99,114,149,175,214,244,292,333,396,453,497,561,623,732,765,817,961,990,1084,1263,1346,1481,1561,1689,1762,1884,2124,2190,2274,2379]      636.87 real       635.78 user         1.00 sys

それなりに高速化できたということは、予想通りの最適化が行われたと見ていいのかな。

奥歯の治療完了

11月から続けていた奥歯の治療がようやく今日で完了した。
奥歯の土台を金属で形成し、その上に義歯を接着して一体の歯に仕上げてある感じ。
噛み合わせも良くなってとりあえず一段落ついた。

んが、本日先生と相談の上、下の親知らずを両方共抜歯することにした。
上は生えなかったのだが、下は両方共手前の奥歯にひっかかる形でちょこっと頭が見える程度に斜めに生えている。
この状態で放置しておくと、周辺の歯茎を傷めたり手前の奥歯の虫歯の原因になっちゃうねぇと脅されて諭されて、抜歯を決意。

年内中にとりあえず片側に手をつけることに。
苦難は続く。

Haskell::GR-nの生成(その3)

任意のGR-nの要素の最大値の下限について考える。

[0,g1,g2,…,g(n-1)]について定義から隣り合う要素の差は全て異なるので、隣り合う要素の差分の最小のセットとして[1,2,..,n-1]が考えられる。この時、g(n-1)はn*(n-1)/2になる。

以上から、GR-(n-1)とn*(n-1)/2未満の数の組み合わせはGR-nに含まれないことになり、この部分の探索を省くことが出来る。
隣り合わない要素の差についても考慮すればg(n-1)の下限はもっと大きくなるはずだが、それは結局OGRを求めようとするようなもので、あまり現実的でない。これでも、O(n^2)にあたる計算量を削減できることになるはずで、それなりに高速化を期待できる。

で、ちょこっとコードを書き直してみた。

 

-- grs.hs
import System
import List
main :: IO ()
main = do { args <- getArgs
; let [n, m] = if length args == 2 then map read args else [4,20]
; putStrLn $ unwords $ map show $ take m $ gr n
}
gr :: Int -> [[Int]]
gr n
| n<1         = []
| n==1        = [[0]]
| n==2        = map (\x -> [0, x]) [1..]
| otherwise   = scanline (gr $ n - 1) 1
where
scanline :: [[Int]] -> Int -> [[Int]]
scanline gs m
| m<1             = []
| otherwise       = let {
lm = n * (n - 1) `div` 2
; gs1 = zip [lm..(lm + m -1)] $ map (\y -> gs !! y) $ reverse [0..(m-1)]
; gs2 = filter (\(x, gse) -> last gse < x) gs1
; gs3 = map (\(x, gse) -> gse ++ [x]) gs2
} in filter gr_p gs3 ++ (scanline gs $ m + 1)
where
gr_p :: [Int] -> Bool
gr_p ns = let ds = sort $ map (\(x,y) -> (ns !! y) - (ns !! x)) cs
in ds == nub ds
where
cs = [(x,y)|x<-[0..(n-2)],y<-[1..(n-1)],x<y]

その2の時のコードと今回のコードでGR-40の最初の一つ目を見つけるのにかかる時間を比べてみる。

その2:

40:[0,1,3,8,12,22,28,46,59,82,99,114,149,175,214,244,292,333,396,453,497,561,623,732,765,817,961,990,1084,1263,1346,1481,1561,1689,1762,1884,2124,2190,2274,2379]
1208.36 real      1207.24 user         0.93 sys

今回:

40:[0,1,3,8,12,22,28,46,59,82,99,114,149,175,214,244,292,333,396,453,497,561,623,732,765,817,961,990,1084,1263,1346,1481,1561,1689,1762,1884,2124,2190,2274,2379]
856.42 real       855.50 user         0.79 sys

まずまず高速化できたようだ。とはいえ、GR-150とか計算させようとすればまだまだとんでもなく時間がかかりそうだ。