さかいです。

From: Shin-ichiro HARA <sinara / blade.nagaokaut.ac.jp>
Date: Wed, 24 Dec 2003 11:26:35 +0900

> 原です。

> 初心者にとってはこんなふうに main のある動くプログラムはありが
> たいです。勉強になります。
> 
> むむ。以外に簡潔に書けるものですねえ。しかも速い。やっぱり Haskell 
> はリストの計算は大得意なんだなあ。
> 
> 内包表現と fold 系を使うと Hakell っぽいという(俗?)説に従って
> 少し書き換え、graphviz への dot 出力も加えてみました。

おぉ。Haskellっぽく見えます (^^;)

> data Poset a = Poset [a] (a -> a -> Bool)
> instance Show a => Show (Poset a) where
>     show (Poset x _) = concat [(show v) ++ "\n" | v <- x]
> type MonotonicFunction a b = [(a,b)]
> 
> power :: (Poset b) -> (Poset a) -> (Poset (MonotonicFunction a b))
> power (Poset bx le_b) (Poset ax le_a) = Poset set le where
>     set = foldr extend [[]] ax
>     extend a funcs = [(a,b):func | func <- funcs, b <- bx, check a b func]
>     check a b func = and [not(le_a a c) || (le_b b d) | (c, d) <- func ]
>     le f1 f2 = and [le_b b d | ((_, b), (_, d)) <- zip f1 f2]

今回の問題に特化するなら、not(le_a a c) || (le_b b d) は
順番を逆にしたほうが効率的ですよ。

> やはり x4 は無理みたいです。

私も先のプログラムを丸一日動かしていたのですが、x4はさっぱりでした。

それにしても、
3^126 = 1310020508637620352391208095712502073964245732475093456566329 個
の関数のうち、いったいどれだけの関数が単調なんでしょうね。
少なくとも一千万個以上はありそう……


ところで、これを原さんのRuby版と同様にコマンドライン引数を受け取るように
変更しようと思ったのですが、思うように書くことが出来ませんでした。
コマンドライン引数を扱う際の定石みたいなものってあるのでしょうか?

{-
以下のコードは forall を使っているので、
GHCなら-fglasgow-extsが、Hugsなら-98が必要です。
-}

import System

data Poset = forall a. Poset [a] (a -> a -> Bool)

power :: Poset -> Poset -> Poset
power (Poset bx le_b) (Poset ax le_a) = Poset set le where
    set = foldr extend [[]] ax
    extend a funcs = [(a,b):func | func <- funcs, b <- bx, check a b func]
    check a b func = and [(le_b b d) || not(le_a a c) | (c, d) <- func ]
    le f1 f2 = and [le_b b d | ((_, b), (_, d)) <- zip f1 f2]

showGraph :: Poset -> String
showGraph x = "digraph G {\nrankdir=TB;\n" ++ pointshow x ++ graphshow x ++ "}"
    where 
    pointshow (Poset v _) = concat ["x" ++ show i ++ ";\n" |
                                    (_, i) <- zip v [0..]]
    graphshow (Poset u le) = concat ["x"++show i++" -> "++"x"++show j++";\n"
                                     | pairs <- graph le (zip u [0..]), (i, j) <- pairs]
    graph le ui = [[(snd fi, snd gj) | gj <- foldr (extend_graph le fi) [] ui]
                   | fi <- ui]
    extend_graph le (f, i) (g, j) fs
        | i == j = fs
        | (or [le g h | (h, _) <- fs]) = fs
        | (le g f) = (filter (\(h, _) -> not (le h g)) fs) ++ [(g, j)]
        | True = fs

main :: IO ()
main =
    do args <- getArgs
       (n,args) <- return (scanArg 3 args)
       (o,args) <- return (scanArg 2 args)
       putStrLn (showGraph ((chain o) !! n))
    where scanArg defaultValue []     = (defaultValue, [])
          scanArg defaultValue (x:xs) = (read x, xs)
          chain o = iterate (power omega) (Poset [0::Int] (<=))
              where omega = Poset (take (o+1) [(0::Int) ..]) (<=)

--
酒井 政裕 / Masahiro Sakai

--
ML: haskell-jp / quickml.com
使い方: http://QuickML.com/