./index.html ../index.html

無謀にもHaskellに挑戦したときのNote

まず何も言わずにここを読んで下さい。
次はここです。

僕は上記ページ以上の説明をする自信は無いので、全く意味不明だった人はここでさらばです。 上記をカケラでも理解した気になったらこっちでHugsをインストールしてください。

僕は素人です。 それも、情報工学のじの字も知らない素人です。 ここで挙げたURLのどれかひとつでも既に知っていた人にはここでやるような内容は幼稚過ぎます。 しかし読むなとはいいません。 間違いを見つけたら教えて欲しいから。

いちおう枕詞を書いておきますと、オブジェクト指向と言われる最近の言語も、FORTH, Mindのようなスタック型言語も、BASICのような非構造化な手続き型言語も、Pascalのような構造化言語も、すべて逐次実行型であることは疑いようの無い事実です。 コードは上から順に実行されるのです。 …で、アルゴリズムを手順に分解するスキルをもってプログラミングの重要な部分が理解できた!というのが大間違いで… 世の中には上から順に実行されない言語、Prologのような論理記述言語、とか、ここで話題に出すHaskellのような関数型言語、とかがあるわけです。

関数型言語ではクイックソートが2行ですよ!?信じられますか? 話ではC/C++より速い場合すらあるっぽいですし… 数学的な解析が容易っぽいですから、IOに絡まなければ、コンパイル時に複雑な関数呼び出しがバキバキに最適化されることを期待していいみたいです。

でもHaskellは遅延評価故か知りませんが遅いみたいです。 速いのはML系やCleanみたいですね。

まず有名なのはLispですが、何よりあの括弧がメンテナンス性の悪さを物語っていて、使いたく無いです。 で、見かけたのがHaskell。 型付きでコンパイルできる…らしいですし、O'HaskellなんてOOPL拡張も存在する…ようです。 型推論とかいうのがあって、型を書かなくても、これはInteger、これはStringと、文脈からわかる奴は自動で割り振ってくれる…ようです。 文脈からわからない奴は明示する必要があるので型無し言語では無い…みたいです。

MLというものも見かけましたが、僕がHaskellを選んだ理由は名前がカッコイイからです。 …で、このページは、ど素人の僕が、Haskellに挑戦するページなのです。

後になってOCamlを見たのですが、比較が = で代入が := だ!? しかも命名規則がラクダ(Java)なHaskellではなく、word_wordなC++流だ!? …。 OCamlにしといたほうが良かったなあ…。

とりあえず

とりあえず、階乗計算…某掲示板で見かけた例。

factorial 0 = 1
factorial n = n * factorial(n - 1)

Hugs付属のサンプルコードを見て次のように書き直せることを突き止めました。

factorial n | n == 0 = 1
            | n > 0  = n * factorial(n - 1)

型を明示する時は、先にfactorial :: Integer -> Integerと書いておけばいいようですが、0 とか - 1 とかがあるため自動で整数にされているようです。

これをメモ帳で書いてFactorial.hsという名前で保存して…どう実行するのでしょうね? 僕はまずこれで悩みました。 winhugsにDrag&Dropして、プロンプトからfactorial 3みたいに打てば6が出力されました。めでたしめでたし。

…ちょっと待て、おもちゃインタプリタとか研究用とかならともかく、ある程度実用にしようと思えば、コマンドラインから起動できなきゃ意味がないぞ! ってことで、エントリポイント(起動して最初に実行される場所)の書き方を探しました。

module Main (main) where
main = putStr "Hell, World !\n"

これをWinHugsにドロップして読ませて、mainと打てば実行…うーん…。

マニュアルを漁った結果、付属のrunhugs.exeにファイル名を渡せばいいようです。

ついでに、:?のことも書いてましたので、実行すると:で始まる環境への命令群の説明が出て来ました。

module Main whereがPascalのプログラム(又はユニット)ヘッダーのようなもので(main)は最初に実行する関数と推測しました。 嘘書いてました。 module宣言の括弧は、エクスポートする識別子リストです。 module宣言で括弧を書かなかった時は全部公開し、括弧を書いた時は括弧の中の名前だけ公開するという寸法の様です。 でかいmoduleになると、ずらずらと…。 public/privateとか、interface/implementationとか、何かキーワードを用意しとけばいいのに…。

文字列がC流のエスケープ記法か…嫌ですねー。 いつの日かこのエスケープ文化が消えてくれる日はくるのでしょうか。 (じゃあ改行はどうすればいいって言われそうですが、"ABC"\n"DEF"のよーに外に書いて、\nだけでも改行文字列としての意味を持たせ、隣接する文字列はくっつけるルール…すでにCにある…にすればいいだけですね)

出力の次は入力…putStr getLineがエラーになるので困りました。
尋ねた結果、getLine >>= putStrでいいようですが、僕にその理由はわかりませんでした。 コードで書く時は、doの後に並べていいようです。ここだけ逐次実行型。 逐次実行型で書いたり、入出力が絡んだりすると、数学的に解析できなくなるため、IO型として明示しないといけないようです。 IOは外界との入出力を行うモナドです。 doは単なる構文糖です。

module Main (main) where
main :: IO ()
main = do putStr "Name? "
          c <- getLine
          putStr ("Hell, " ++ c)

調子に乗って計算に挑戦…文字列を数値にする方法がわかりませんでした。 某掲示板の過去ログで発見。

module Main (main) where

strToInt :: String -> Integer
strToInt s = (read :: String -> Integer) s

main :: IO ()
main = do putStr "x = "
          x <- getLine
          putStr "y = "
          y <- getLine
          putStr ("x + y = " ++ show ((strToInt x) + (strToInt y)))

strToIntは僕が付けた名前ですが、型にIOを付けずに通ったということは、strToInt "123"と定数を渡した場合コンパイル時に評価されて実際には単なる整数の123として実行ファイルに埋めこまれる(可能性がある)…ってですか? なんかすごい。 IOはモナドと同時に矛盾無く入出力を行うためのマーキングなので、式がどこまで最適化されるかどうかとは無関係です。 コンパイラの実装次第。 でも、Haskell処理系はコンパイラと同時にインタプリタでもあるので、コンパイル時にコードを実行して…ってのはある程度可能な筈。 少しは最適化に期待していいかも。

課題シリーズ 1

美しいのが好きと称して規格にも沿わないC言語を教える講師の授業で提出してやりたいので、なんとか今週の課題ぐらいは…シリーズ。 本来gcc(とPADという面倒な記法)でやらないといけないのですが、退屈なので無理やりHaskellでやります。
最初のお題は四人家族の平均年齢。 要するに4つの数を入力して足して4で割るだけ。

module Main (main) where

strToInt s = (read :: String -> Int) s
intToReal x = (fromInt :: Int -> Double) x
average a = (intToReal (sum a)) / (intToReal (length a))
getInt = do m <- getLine ; return (strToInt m)

main = do
  putStr "おとうさんのとしは ? "; m1 <- getInt
  putStr "おかあさんのとしは ? "; m2 <- getInt
  putStr "おにいさんのとしは ? "; m3 <- getInt
  putStr "かずちゃんのとしは ? "; m4 <- getInt
  putStr ("へいきんねんれいは" ++ 
          (show (average [m1, m2, m3, m4])) ++ "さいです!")

戸惑ったのはC, Pascalと異なり/演算子が整数を取れないので変換してやることと、a b cの結合は(a b) cなので意図したとおりの関数呼出しをさせるにはやっぱり括弧が必要ということです。 配列の合計を求めるsumもあることですし、Cより楽かも。

課題シリーズ 2

入場券の販売。

module Main (main) where

buy t = do 
  putStr "大人1800(&a)/学生1500(&s)/子供1200(&c)/会計(&p) ? "
  c <- getChar
  putStr "\n"
  case c of
    'a' -> buy (t + 1800)
    'b' -> buy (t + 1500)
    'c' -> buy (t + 1200)
    'p' -> return t
    _   -> (do putStr "再入力: "; buy t)

main = do
  putStr "ヘイらっしゃい\n"
  s <- buy 0
  putStr ("合計" ++ (show s) ++ "円になります\n")
  putStr "まいどあり\n"

最大のポイントはreturn tです。 IO Intを返す関数でIntをそのまま返せないんです。 returnを経由すれば返せるという寸法(結局尋ねてしまった)。 このreturncaseから抜けているだけで、結果はcaseの値となり、buy中最後の式であるcaseの値がbuyの結果、となります。嘘書いてました。returnは、単にIO型にするだけです。 脱出はしません。ですからreturnの後に式を続けた場合それが実行されます。 returnが脱出に見えるのは、最後の式の値が制御文do構文を使ったモナド式全体の値となるというだけです。

ちなみにループを末尾再帰で表してます。

末尾再帰による最適化を期待するなら、最初の階乗計算もこうするべきかも。 先の例だと *を自分自身を呼んださらに後で計算する必要があるため末尾になっていませんでした。

factorial_ n r | n == 0 = r
               | n > 0  = factorial_ (n - 1) (r * n)
factorial n = factorial_ n 1

課題シリーズ 3

任意の人数の家族の平均年齢。

module Main (main) where

strToInt s = (read :: String -> Int) s
average a = ((fromInt :: Int -> Double)(sum a)) / 
        ((fromInt :: Int -> Double)(length a))
getInt = do m <- getLine ; return (strToInt m)

input done count result = do
  if done == count 
    then do
      return result 
    else do
      putStr ((show (done + 1)) ++ "人目の年齢は ? ")
      m <- getInt
      input (done + 1) count (m : result)

main = do
  putStr "何人 ? "
  count <- getInt
  m <- input 0 count []
  putStr ("平均年齢は" ++ (show (average m)) ++ "歳です\n")

ポイントはifの構文でしょうね… Haskellは(Pythonみたいに)インデント位置で構文解析しますから… 全部一行に書いたら通るのに、BASICやPascal風にifthenを一行にしてthenの後で改行すると通らないのですから… 試行錯誤の末ようやく受け付けてもらえる形になりました。
…って、後から気付きましたが無理にif使う必要もなくこれでもよかったです。

input done count result
  | done == count = do
    return result
  | done < count = do
    putStr ((show (done + 1)) ++ "人目の年齢は ? ")
    m <- getInt
    input (done + 1) count (m:result)

ガード?による場合分け。

それと、今さらながら、関数呼び出しが、FUNCTION(X, Y, Z)では無くFUNCTION (X) (Y) (Z)になるってのは…新鮮というか何というか。

課題シリーズ 4

200までの内、3と4の公倍数を求める。(12の公倍数では駄目なのでしょうか?)

module Main (main) where

loop i last func = do
  func i
  if i < last
    then loop (i + 1) last func
    else return ()

isMultiple3And4 x = (x `mod` 3 == 0) && (x `mod` 4 == 0)

act x = if isMultiple3And4 x then print x else return ()

main = do
  loop 1 200 act

ハノイの塔

今までハノイの塔が理解できずコンプレックスだったのですが、こないだようやく理解。 結局仮引数名が(昔読んだ本でも授業でも) x y z だったのが諸悪の根源と結論。 変数名は意味のあるものを付けましょう。

module Main (main) where

hp n fromPos toPos = putStrLn ((show n) ++ fromPos ++ toPos)

hanoi n fromPos workPos toPos f =
 if n == 0
 then
  return ()
 else do
  hanoi (n - 1) fromPos toPos workPos f
  f n fromPos toPos
  hanoi (n - 1) workPos fromPos toPos f

main = hanoi 4 "A" "B" "C" hp

課題シリーズ 5

ニュートン法。(アルゴリズムの解説は面倒なので割愛)
関数と演算子の優先順位みたいなものが微妙だ…。

module Main(main) where

newton f fd x accuracy =
  if abs (f x / fd x) <= accuracy 
    then x
    else newton f fd (x - f x / fd x) accuracy

f x = x ** 3 - x * 5 - 7
fd x = x ** 2 * 3 - 5

main = do
  print (newton f fd 3 0.0001)

課題シリーズ 6

バブルソート。
配列のアクセス演算子 !!takedropもWinHugsで探し出しました。 この辺のマニュアルが見つからないってのは…いや、きっと僕が間抜けなだけか。
アルゴリズム自体も力業で、もっと改善できそうです。 しかし関数型言語だとクイックソートの方が遥かに楽…。

module Main(main) where

bubbleSort_swap :: [Int] -> Int -> [Int]
bubbleSort_swap arr j = do
  if arr !! (j - 1) > arr !! j 
    then
      take (j - 1) arr ++ [arr !! j, arr !! (j - 1)] ++ drop (j + 1) arr
    else
      arr

bubbleSort_ :: [Int] -> Int -> Int -> Int -> [Int]
bubbleSort_ arr i j to =
  if i > to
    then
      arr
    else
      if j < i
        then
          bubbleSort_ arr (i + 1) to to
        else
          bubbleSort_ (bubbleSort_swap arr j) i (j - 1) to

bubbleSort :: [Int] -> [Int]
bubbleSort a = bubbleSort_ a 1 (length a - 1) (length a - 1)

main = do
  print (bubbleSort [1, 2, 3, 4])
  print (bubbleSort [4, 3, 2, 1])
  print (bubbleSort [9, 5, 7, 3, 5, 1])

課題シリーズ 7

1から100まで再帰で足し算…よくこんな課題作るよな…今までで一番楽です。

module Main(main) where

s x
  | x > 0 = x + s (x - 1)
  | x == 0 = 0

main = print (s 100)

課題シリーズ 8

バブルソートとクイックソートの交換回数比較なのですが、今回はさぼらせていただきます。
Haskellでのクイックソートのやり方は知ってはいるのですが、他人のコードの上(探せばきっと見つかると思います)、配列の中から条件にあったのを抜き出してきて結合するというエレガントな式が使われておりこれでどうやったら回数を数えられるのか判りません…
しかも、既に動くコードがあるのに、バブルソートのように下手なコードをごりごり書く気にはなれません…

その講師様のクイックソートと僕が常用している昔Cマガジンに載っていたクイックソートを比べてみたのですが… 比較、交換の回数を出してみると… 講師様の名誉のために伏せておくべきかもしれないと自主規制。 自分で試して下さい。

課題シリーズ 9

バイナリーサーチ。
今回構造体(という名前なのか?)初使用です。
data Point = Pt {pointx, pointy :: Double} という例は見ましたが、なんか型名と生成関数に同じ名前を使ってもいいようです。

書けば書くほど関数内関数が欲しくなってくるこのごろ。関数型にこそ必要な機能のような。それとも、知らないだけで存在するのでしょうか。やっぱ存在しました。後述。

module Main(main) where

getInt = do m <- getLine ; return ((read :: String -> Int) m)

data Table = Table{song, singer :: String, rank, number :: Int}

list :: [Table]
list = [
        Table "ultra soul" "B'z" 1 100450, 
        Table "Pieces of a Dream" "Chemistry" 2 72170,
        Table "Never ever" "Ayumi Hamasaki" 3 70140,  
        Table "Ashita ga arusa" "ULFULS" 4 50430,
        Table "Hitori" "The Gospellers" 5 47610, 
        Table "Can you keep A Secret" "Hikaru Utada" 6 32730,
        Table "Tentai-kansoku" "Bump Of Chiken" 7 28960,
        Table "Baby!Koi ni Knock out!" "puttimoni" 8 26360]

binarySearch list target left right = 
  if rank (list !! ((left + right) `div` 2)) == target
    then
      (left + right) `div` 2
    else
      if rank (list !! ((left + right) `div` 2)) > target
        then
          binarySearch list target left ((left + right) `div` 2 - 1)
        else
          binarySearch list target ((left + right) `div` 2 + 1) right

main :: IO ()
main = do
  putStr "Song: "; n <- getInt
  if n == 0
    then
      return ()
    else do
      t <- return (list !! (binarySearch list n 0 7))
      putStrLn ("[" ++ (show (rank t)) ++ "] " ++ 
              (singer t) ++ " " ++ (song t) ++ " "++ (show (number t)))
      main

課題シリーズ 10

ダイクストラのアルゴリズムなのですけど、面倒なのでHaskell版はさぼりです。

偶然にも、スピード比較のページでPascalとC++でやってますから、そっちも参照。

関数内関数

最後にwhereを続けて、関数内関数を宣言できるみたいです。 先に知ってたらな~、今までのコードは殆ど書き直しですよ。

factorial n = factorial_ n 1
  where
    factorial_ n r | n == 0 = r
                   | n > 0  = factorial_ (n - 1) (r * n)

>>=

モナドを少しだけ。 参考リンクはここ

リスト >>= (\ 要素を受ける名前 -> return 式) で、リストの要素を一括で計算できるらしいです。

Prelude> 2:[1,2,3] >>= (\e -> return (e * 2))
[4,2,4,6]
Prelude> 2:([1,2,3] >>= (\e -> return (e * 2)))
[2,2,4,6]

入力と結果の型が同じである必要は無いようです。

で、理屈はぜんっぜんわかってないのですが、getLine >>= putStrのような書き方でも動くことから、どうやら>>=は、左辺を右辺の関数の第一引数にするらしい、と推測できます。

つーことは、\e -> ...というのは、無名関数の定義でしょうか。->の左が引数で、右が中身。

Prelude> (\e -> e) 10
10
Prelude> (\e -> e * 2) 10
20

当たりっぽいですな。

どこを読んでも、小難しい数学の話ばっかりで、記号の意味するところなんて書かれて無いのですね…いや、よく読めば書かれてるのでしょうけれど、僕にわかるレベルじゃ無え。 とりあえず、一歩前進です。

余談。C++同様HaskellもHTML直書きの敵だなあと改めて思いました。

チュートリアル

有名どころの、「やさしいHaskell入門」(あえてリンクは貼らない)というのは難しすぎます。 入門でも何でもないです。 わかっている人にしか読めませんってば。 で、困ってたのですが、今日Yet Another Haskell Tutorialというのを発見しました。

コンパイラ

GHCへリンク貼っておきます。 以前、Cygwinをベースにしているのでヤだ、と書きましたが、インストールしてみたところ、マニュアルには確かにCygwinに触れられているのですが、コンパイラそのものはMingwのようです。

C:\Program Files\ghc\ghc-5.02.3\bin>ghc --make -o hanoi.exe hanoi.hs
ghc: chasing modules from: hanoi.hs
Compiling Main             ( hanoi.hs, ./hanoi.o )
ghc: linking ...

C:\Program Files\ghc\ghc-5.02.3\bin>dir hanoi.exe
 ドライブ C のボリューム ラベルは SYSTEM です
 ボリューム シリアル番号は 2007-3859 です

 C:\Program Files\ghc\ghc-5.02.3\bin のディレクトリ

2003-06-25  02:40              465,920 hanoi.exe
               1 個のファイル             465,920 バイト
               0 個のディレクトリ   5,541,920,768 バイトの空き領域

C:\Program Files\ghc\ghc-5.02.3\bin>strip hanoi.exe

C:\Program Files\ghc\ghc-5.02.3\bin>dir hanoi.exe
 ドライブ C のボリューム ラベルは SYSTEM です
 ボリューム シリアル番号は 2007-3859 です

 C:\Program Files\ghc\ghc-5.02.3\bin のディレクトリ

2003-06-25  02:41              177,664 hanoi.exe
               1 個のファイル             177,664 バイト
               0 個のディレクトリ   5,542,207,488 バイトの空き領域

C:\Program Files\ghc\ghc-5.02.3\bin>hanoi
1AB
2AC
1BC
3AB
1CA
2CB
1AB
4AC
1BC
2BA
1CA
3BC
1AB
2AC
1BC

C:\Program Files\ghc\ghc-5.02.3\bin>

なお、メインモジュールはmodule Main(main) whereにしないとリンクで失敗します。(悩んだ)

リストから条件に合ったものを取り出す

Prelude> [a | a <- [1,2,3,4], mod a 2 == 0]
[2,4]

非常に数学的。(見かけの記述が)

フィルタ

標準入出力を用いるフィルタを書いてみます。

とりあえず大文字化フィルタ。

module Main(main) where

import IO
import Char

filter = getChar >>= (putChar . toUpper) >> Main.filter

main = catch (Main.filter) (\e -> return())

なんか、いきなり今までの手続き型を無理やり押し込めたような書き方から変化してるって? まあ、言いっこなしです。

importは、HugsですとPreludeに含まれていたものでもコンパイラなGHCでは必要な様子。 どのヘッダーに入っているかはインストールディレクトリの中の*.hiをBGREPすればわかります。 (←相変わらずの力技)

>>=は上で書いたように左辺を右辺の第一引数に。 >>は左辺を先に、右辺を後からって具合に順序を付けるだけです。 両方とも、doで書いた方が遥かに簡単ですが、使ってみたかったと言う奴です。 (putChar . toUpper)は合成関数というやつ。 Main.filterは、filterだけですとPreludeのやつと被りますので限定の為の修飾です。 酔ってMain.と付けたら上手くいきました。 フィルタはCtrl+Zで終了するのですが、getCharが例外を挙げるので、受け止めてやります。

やっぱ、まともな入門を読んだ後は違いますねぇ。

Windows APIを呼ぶ

コンパイラならAPIを呼びたいのは当然ですよね?

foreign import stdcall "外部名" 関数名 :: 型

これ用の型として、C言語の型に相当するCCharとかCDoubleとか、ビット数を指定したInt8とかあるようです。 で、返り値型は、副作用をともなう場合は、IOを付けること。 (IOってばつまるところ内部的には副作用を分離するための単なるマーキングらしい)

コンパイル時に-fglasgow-extsオプションが必要です。

間違い直し

文章の間違い直し。 コードは素人の書いたものとして意味があると自己弁護して手を加えてません。

無限リスト

以前の課題シリーズとは別のやつです。

フローショップ問題というやつなんですが、微妙に間違ってるかも。 それはそれとて、無限リストを使ってみました。 無限リストを返す関数も、遅延評価なら書けるんですよね。 ここではモナドを使ってません。 答えを延々と計算するのに状態なんか要らないんです。 オブジェクト指向だと、こんなものでも「計算を再開するために」状態が導入されてしまうんですね…結局のところメインルーチン以外は全部受動的に書いて、再開のために状態を取っておくのがオブジェクト指向なわけで…手続き型言語ですと実行の流れは一本しか無いのですから当然に思えますが、受動的なコードを書くのは疲れるんですね…しかし、遅延評価があると、ほとんど全部のルーチンを能動的に書けるのですね…。 (外部に対して受け身でなければならない場合はやむをえませんが…GUIとか)

module Main(main) where

import Random

-- n/2/F/Fmax問題
-- アニーリング法

data Job = Job (Char,[Int]) | Done deriving Show

instance Eq Job where
  (==) (Job (a,_)) (Job (b,_)) = a == b

p :: Job -> Int -> Int
p Done _ = 0
p (Job (_,t)) i = t !! i

data Solution = Solution [Job] deriving Show

fmax :: Solution -> Int
fmax (Solution a) = process 0 (drop 1 a) (a !! 0) Done
  where
    next :: [Job] -> Job
    next [] = Done
    next (x:xs) = x
    process :: Int -> [Job] -> Job -> Job -> Int
    process time [] Done Done = time
    process time [] Done m2 = process (time + p m2 1) [] Done Done
    process time a m1 m2 = 
      if (p m1 0) < (p m2 1) 
      then process (time + p m2 1) (drop 1 a) (next a) m1
      else process (time + p m1 0) (drop 1 a) (next a) m1

evaluate :: Solution -> Int
evaluate a = fmax a

jobs :: [Job]
jobs = [
  Job ('A', [ 5,  2]),
  Job ('B', [ 1,  6]),
  Job ('C', [ 9,  7]),
  Job ('D', [ 3,  8]),
  Job ('E', [10,  4]),
  Job ('F', [20, 13]),
  Job ('G', [12, 19]),
  Job ('H', [18, 11]),
  Job ('I', [16, 15]),
  Job ('J', [14, 17])];

----------------------------------------------------------

randomSort [] rs = ([], rs)
randomSort (x:xs) (r:rs) = 
  let (xs', rs') = randomSort xs rs in
  let i = r `mod` (1 + length xs') in
  ((take i xs') ++ [x] ++ (drop i xs'), rs')

delta :: Solution -> Solution -> Double -> Double
delta x x' t = 
  let ex = evaluate x in
  let ex' = evaluate x' in
  if ex >= ex' then 1.0 else exp (fromInteger (toInteger (ex - ex')) / t)

swap :: Solution -> Int -> Int -> Solution
swap (Solution a) r1 r2 = 
  let i1 = r1 `mod` (length a) in
  let i2s = r2 `mod` ((length a) - 1) in
  let i2 = if i2s >= i1 then i2s + 1 else i2s in
  let f = min i1 i2 in
  let l = max i1 i2 in
  Solution 
    ((take f a) ++ [a !! l] ++ (drop (f + 1) (take l a)) ++ [a !! f] ++ (drop (l + 1) a))

annealing :: [Job] -> [Int] -> [Solution]
annealing a rs = 
  let (initial, rs') = makeRandomSolution a rs in
  run initial 10.0 rs'
  where
    makeRandomSolution :: [Job] -> [Int] -> (Solution, [Int])
    makeRandomSolution a rs = 
      let (a', rs') = randomSort a rs in
      (Solution a', rs')
    run :: Solution -> Double -> [Int] -> [Solution]
    run initial temperature (r1:r2:r3:rs) =
      let new = swap initial r1 r2 in
      if (delta initial new temperature) > 
        ((fromInteger (toInteger (r3 `mod` 1000))) / 1000.0)
      then initial : run new (temperature * 0.99) rs
      else initial : run initial (temperature * 0.99) rs

time = 1000 :: Int -- 何回探索するか

loop n (result:results) = 
  if n == time 
  then 
    return ()
  else do
    --putStr "Result " >> print (n + 1)
    --print result
    --putStr "Fmax = " >> print (evaluate result)
    print (evaluate result)
    loop (n + 1) results

main = do
  rg <- newStdGen
  loop 0 (annealing jobs (randoms rg))

プレゼント交換会

n組の男女ペアが一旦バラバラになり再びランダムにペアを組むとする。このとき、

1.元のペアが一組もできない確率P(n)を求めよ。
2.lim(n→∞) P(n)を求めよ。

f(2)=1/2
f(n)=1-(1+Σ(i=2..n-1)nCi×i!×f(i))/n!

どうやってこの式に辿り着いたかは、まあ、割愛。 列挙してバツ付けて…って泥臭い事をやらざるを得ない程度の貧弱な数学力ですよ私は。 それにしても、もうちょっと簡単にならないかなあ…。 これだと問2を求めるのに、コンピュータの力を借りることになりそうですし…。

import Prelude

factorial n | n == 0 = 1
            | n >  0 = factorial (n - 1) * n

sigma i n f | i == n = f i
            | i <  n = (f i) + (sigma (i + 1) n f)

combination n 1 = n
combination n m = (combination (n - 1) (m - 1)) * n / m

f 2 = 1 / 2
f n = 1 - (1 + (sigma 2 (n - 1) (\i -> (combination n i) * (factorial i) * f(i)))) / factorial(n)

ここであっさりあきらめてコードを書き始めるところが、私と数学者の違い。 それにしてもWinHugs遅ぇ…。 f 100程度で、CPU100%のまま何分も待たされている…。

とりあえずf 10の結果0.367879464285714で満足しておいてやろう… できれば分数で欲しいな…答え…。

そして、これを書きながら、Thebeの色分けバグに直撃している…。 再現性がありそうでわからん…。

どなたか、数学的正解を教えてくれたら、飯ぐらい奢らせていただきやす。 問題作った本人に問い合わせるのは…最後の手段だ。 (相手余所の大学の教授だしなあ…)

プレゼント交換会、その後

shinichiro.hさん先生の日記にて、sin-x先生のコメントにて解決をみた…ようなのですが…私には…理解不能だ。

一応理系の端くれとして、勉強し直さねば…。

ところで、一応弁明しておきますと、先のHaskellコードは、純関数型言語の特性(IOを伴わない関数に同じ引数を渡したら常に同じ値が返ってくる)から、インタプリタが計算済みの部分をキャッシュしてくれることを期待していたのですが、どうもWinHugsはそんなことはしていないらしい、という見込み違いがありました。 富豪的なのかもしれませんが、私がWinHugsを見る目は「それまで作りかけてた電卓ソフトがごみに思えるほどの超高機能&高性能プログラム電卓ソフト」ですので、それくらいやって欲しいなあと… (←勝手な事を^^)

丁寧にまとめまで書いてくださった… まとめられてみると、信頼性工学にて、包除原理とはまた別の名前で習った気がする。 なんでしたっけね…。

IORef

便利そうなの見つけた。 メモ。

module Main (main) where
import Prelude;
import Data.IORef;
main :: IO ()
main = do
  x <- newIORef 1
  value <- readIORef x
  print value
  writeIORef x 2
  value <- readIORef x
  print value
  return ()

間違い直し2

紹介されてしまったため若干手直し…