さかいです。

From: Shin-ichiro HARA <sinara / blade.nagaokaut.ac.jp>
Date: Mon, 22 Dec 2003 18:02:10 +0900

> でも、あまり Ruby プログラムをぼんぼん飛ばすのはまずいですよ。^^;

あ、やっぱり? (^^;)

> Haskell で考えましょう。まず問題設定。
> 
> 【Xn 問題】
> ある集合に不等号 <= が定義されているとき、Pos (partially
>  ordered set) と呼ぶ。 a, b が Pos のとき、power(a, b)
> で b から a への単調増加関数 f〔x <= y なら f(x) <= f(y)〕
> 全体を表す。power(a, b) の要素 f, g に対して、全ての x に
> 対して f(x) <= g(x) となるとき f <= g と不等号を定義する。
> このとき power(a, b) も Pos になる。
> さて、D2 = [0, 1, 2], D0 = [0] を Pos だと思い、
>   X(0) = D0
>   X(n+1) = power(D2, X(n)), n = 0, 1, 2, ...
> と定義するとき、X(3) の個数あるいは更に順序構造を求めよ。
> 
> 
> いつまで経っても自力で Haskell プログラムを書けないので、なんと
> かこれを例題にやりたいなあ。どなたか書けたらお願いします。(い
> きなり人頼みかよ。)

私も普段Haskellをほとんど使っていないので、あまりHaskellっぽくないかも
しれませんが、試しにちょっと書いてみました。とりあえずX(3)までの要素数
を表示するだけです。

data Poset a = Poset [a] (a -> a -> Bool)
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 = p ax []
          le f1 f2 = all (uncurry le_b) (zip (map snd f1) (map snd f2))
          p [] func = [func]
          p (a:ax) func = concat (map (p ax) fx)
              where fx = [(a,b) : func | b <- bx, check a b func]
                    check a b func = all f func
                        where f (c,d) | (le_a c a) = le_b d b
                                      | (le_a a c) = le_b b d
                                      | True = True

omega :: Poset Int
omega = Poset [0,1,2] (<=)

f x = power omega x

x0 = Poset [0] (<=)
x1 = f x0
x2 = f x1
x3 = f x2
x4 = f x3

main :: IO ()
main =
    do printSize "X0" x0
       printSize "X1" x1
       printSize "X2" x2
       printSize "X3" x3
    where printSize name poset = putStrLn (formatMsg name poset)
          formatMsg name (Poset l _) = name ++ " has " ++
                                       (show (length l)) ++ " elements."

--
酒井 政裕 / Masahiro Sakai

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