すごいH本 part70

ヒースロー空港からロンドンへ

こんな感じの図がある

A - 50 - (A1) -  5 - (A2) - 40 - (A3) - 10 - (A4)
          |           |           |           |
          30          20          25          0
          |           |           |           |
B - 10 - (B1) - 90 - (B2) -  2 - (B3) -  8 - (B4)

AかBから出発して、(A4)か(B4)にたどり着く最短経路を求めるという問題。

アルゴリズム

1. (A1) までの最短経路を求める
2. (B1) までの最短経路を求める
3. (A2) までの最短経路は、(A1) からの方早いか、(B2) からの方が早いかで調査し、早い方を採用する
4. (B2) についても同じことをする
5. 目的地にまで同じことを繰り返す
6. 目的地まで繰り返したら2つの経路のうち早い方が最短経路となる

道路網をHaskellで表現

3つのデータを1組として表現する。

A のパーツと、Bのパーツ、AとBの橋渡しをしているCのパーツ。

これらをまとめて、Section とする。

data Section = Section { getA :: Int, getB :: Int, getC :: Int }
    deriving (Show)

type RoadSystem = [Section]

道路網(RoadSystem)はSectionのリストであるという型シノニム。 Section を表現するのにトリプルを使えるが、 より複雑なものを表現するには新しい型を作るほうが適切。 型システムに多くの情報をもたせることができるため。 あと、ベクトルの値と混同してしまう可能性がある。

ヒースロー空港からロンドンまでの道は以下のように表現できる。

heathrowToLondon :: RoadSystem
heathrowToLondon = [ Section 50 10 30
                   , Section 5 90 20
                   , Section 40 2 25
                   , Section 10 8 0
                   ]

あとは、最短経路を求めるだけ

道路網を引数にとって、最短経路を返すような型宣言にしたい。 経路もリストとして表現する。

data Label = A | B | C deriving (Show)
type Path = [(Label, Int)]

関数の型宣言はこうなる

optimalPath :: RoadSystem -> Path

結果としては次のようなものを想定している

[(B,10), (C,30), (A,5), (C,20), (B,2), (B,8)]

そしてこの問題も左畳み込みで解ける。

最短経路を見つけるステップを関数にする。

直前のAとBまでの最適経路、 それに現在の道路セクションをもとに新しい最適経路を求めるというステップ。

• スタート地点のAとBまでの最適経路は [] と []
• 現在のセクションは Section 50 10 30
• A1までの最適経路は、[(B,10), (C,30)]
• B1までの最適経路は、[(B,10)]

このステップを繰り返す。

関数は、経路のペアとセクションを引数に取って新しい経路のペアを返す。

roadStep :: (Path, Path) -> Section -> (Path, Path)
roadStep (pathA, pathB) (Section a b c) =
    let timeA = sum (map snd pathA)
        timeB = sum (map snd pathB)
        forwardTimeToA = timeA + a
        crossTimeToA = timeB + b + c
        forwardTimeToB = timeB + b
        crossTimeToB = timeA + a + c
        newPathToA = if forwardTimeToA <= crossTimeToA
                         then (A, a):pathA
                         else (C, c):(B, b):pathB
        newPathToB = if forwardTimeToB <= crossTimeToB
                         then (B, b):pathB
                         else (C, c):(A, a):pathA
    in (newPathToA, newPathToB)

1. timeA と timeB の合計を出して所要時間を算出
2. forwardTimeToA は An 地点 -> An + 1 地点までの所要時間
3. crossTimeToA は Bn 地点 -> An + 1 地点までの所要時間
4. forwardTimeToB は Bn 地点 -> Bn + 1 地点までの所要時間
5. crossTimeToB は An 地点 -> Bn + 1 地点までの所要時間
6. newPathToA と newPathToB は早い経路を適用する
7. newPathToA と newPathToB をペアにして返す

最適経路をリストの先頭に追加していっているのは、処理が速いから。 あとで順番を入れ替える。

この関数を実行してみる

*Main> roadStep ([],[]) (head heathrowToLondon)
([(C,30),(B,10)],[(B,10)])

できている。

メインの関数を実装する

optimalPath :: RoadSystem -> Path
optimalPath roadSystem =
    let (bestAPath, bestBPath) = foldl roadStep ([], []) roadSystem
    in if sum (map snd bestAPath) <= sum (map snd bestBPath)
           then reverse bestAPath
           else reverse bestBPath

実行する

*Main> optimalPath heathrowToLondon
[(B,10),(C,30),(A,5),(C,20),(B,2),(B,8),(C,0)]

入力から道路網を受け取る

標準入力から読み込んだ道路情報をRoadSystem型に変換し、 optimalPath 関数にかけて、経路表示までする。

リストを取り、ある要素数のグループごとに分割する関数を作る。

groupsOf :: Int -> [a] -> [[a]]
groupsOf 0 _ = undefined
groupsOf _ [] = []
groupsOf n xs = taken n xs : groupsOf n (drop n xs)

実行

*Main> groupsOf 3 [1..10]
[[1,2,3],[4,5,6],[7,8,9],[10]]

この関数で入力を分割する。

import Data.List

main = do
    contents <- getContents
    let threes = groupsOf 3 (map read $ lines contents)
        roadSystem = map (\[a,b,c] -> Section a b c) threes
        path = optimalPath roadSystem
        pathString = concat $ map (show . fst) path
        pathTime = sum $ map snd path
    putStrLn $ "The best path to take is: " ++ pathString
    putStrLn $ "Time taken: " ++ show PathTime

txt ファイルを作成する

paths.txt

50
10
30
5
90
20
40
2
25
10
8
0

実行

> ./heathrow < paths.txt
The best path to take is: BCACBBC
Time taken: 75

所感

これ写経してるから書けている気になっているけど、自分で書けないだろうと思う。 副作用があるのが main だけになっていて素晴らしい。

すごいHaskellたのしく学ぼう！