Haskell::GR-nの生成

先の組み合わせを生成する関数を使って、GR(Golomb Ruler)を生成するコードを書いてみる。
GRについては、最短ゴロム定規(OGR)とは?を参照のこと。結局これがやりたかったんですがね。

-- gr.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
}
comb :: Int -> [[Int]]
comb n
| n<1         = []
| n==1        = map (\x -> [x]) [1..]
| otherwise   = comb_scanline (comb $ n - 1) 1
where
comb_scanline :: [[Int]] -> Int -> [[Int]]
comb_scanline cs m
| m<1             = []
| otherwise       = let {
ss1 = zip [1..m] $ map (\y -> cs !! y) $ reverse [0..(m - 1)]
; ss2 = filter (\(x, ce) -> all (< x) ce) ss1
; ss = map (\(x,ce) -> ce ++ [x]) ss2
} in ss ++ (comb_scanline cs $ m + 1)
gr :: Int -> [[Int]]
gr n
| n<1         = []
| n==1        = [[0]]
| n==2        = map (\x -> [0, x]) [1..]
| otherwise   = filter gr_p $ map (\cs -> 0 : cs) $ comb (n - 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]
--

GR-6まではこのコードでさくさく生成できる。
GR-7になると、途端に最初の一つを見つけるだけでもとんでもなく時間がかかるようになる。

与えられたリストがGRか判定する述語gr_pの記述が直裁すぎるのもあるが、そもそも探索する範囲が広くなりすぎるんだろう。GR-7以上については、より下位のGRから生成するか、先のページにあるようにCDSで生成しないと実用にならないかな。

追記:
Phenom2.4G + ghc 6.8.3 なマシンでGR-7の最初の一つ目を見つけるまでにかかった時間を測ってみた。

% time ./gr 7 1
[0,1,3,7,12,20,30]
8784.349u 3.347s 2:26:29.00 99.9%       654+877k 0+0io 0pf+0w

2.5時間ですか…

Haskell::組み合わせの生成(3要素以上)

2要素の組み合わせの生成の一般系として、3要素以上の組み合わせを生成するコードを書いてみた。

-- comb.hs
import System
main :: IO ()
main = do { args <- getArgs
; let [n, m] = if length args == 2 then map read args else [2,10]
; putStrLn $ unwords $ map show $ take m $ comb n
}
comb :: Int -> [[Int]]
comb n
| n<1         = []
| n==1        = map (\x -> [x]) [1..]
| otherwise   = comb_scanline (comb $ n - 1) 1
where
comb_scanline :: [[Int]] -> Int -> [[Int]]
comb_scanline cs m
| m<1             = []
| otherwise       = let {
ss1 = zip [1..m] $ map (\y -> cs !! y) $ reverse [0..(m - 1)]
; ss2 = filter (\(x, ce) -> all (< x) ce) ss1
; ss = map (\(x,ce) -> ce ++ [x]) ss2
} in ss ++ (comb_scanline cs $ m + 1)
--

やっていることは2要素の場合と同じで、

(n-1)要素の組み合わせをy軸にマッピング -> xy平面を原点からスキャン -> 組み合わせの条件に合うものをフィルタリング

のような感じ。スキャン部分を多少変更しタプルを使うようにしたので、getArgsを除いて全て標準プレリュードの関数で実装できた。

ちなみに、コマンドライン引数を解析する部分はたらいを回すならHaskellのコメントにあったものをそのまま引き写し。このあたりはまだなかなか慣れない。

ブレース構文は行頭にセミコロンを書くように改めてみた。Haskellの流儀らしい。