M.Hiroi's Home Page
http://www.geocities.jp/m_hiroi/

Functional Programming

お気楽 Haskell プログラミング入門

[ PrevPage | Haskell | NextPage ]

Applicative

今回は Functor の強化版である「Applicative (アプリカティブ) 」について説明します。

●Applicative とは?

Applicative は Functor と同様に型クラスのひとつで、モジュール Control.Applicative に定義されています。Applicative の定義をコマンド :info で調べると、次のように表示されます。

Prelude> :m Control.Applicative
Prelude Control.Applicative> :i Applicative
class Functor f => Applicative f where
  pure :: a -> f a
  (<*>) :: f (a -> b) -> f a -> f b
  (*>) :: f a -> f b -> f b
  (<*) :: f a -> f b -> f a
        -- Defined in `Control.Applicative'
instance Applicative [] -- Defined in `Control.Applicative'
instance Applicative ZipList -- Defined in `Control.Applicative'
instance Monad m => Applicative (WrappedMonad m)
  -- Defined in `Control.Applicative'
instance Applicative Maybe -- Defined in `Control.Applicative'
instance Applicative IO -- Defined in `Control.Applicative'
instance Applicative (Either e) -- Defined in `Control.Applicative'
instance Applicative ((->) a) -- Defined in `Control.Applicative'

ここで、関数 pure と演算子 <*> に注目してください。この 2 つが Applicative の主な機能です。f は型クラス制約で Functor を指定されているので、Functor と同様に型変数をひとつ取る型構築子になります。関数 pure の型は a -> f a なので、任意のデータを f の中に格納して返す働きをします。

簡単な例を示しましょう。

Prelude Control.Applicative> pure 1 :: Maybe Int
Just 1
Prelude Control.Applicative> pure 1 :: [Int]
[1]
Prelude Control.Applicative> pure 1 :: Either a Int
Right 1

pure の働きは「引数を文脈に入れて返す」と考えることができます。このことを「値を持ち上げる」といいます。引数が 1 とすると、文脈が Maybe であれば Just 1 に、リストであれば [1] に、Either であれば Right 1 になります。

<*> の型は fmap とよく似ていますが、最初の関数が f に格納されているところが異なります。つまり、f に格納されている関数を取り出し、それを f に格納されているデータに適用し、その結果を f に格納して返す、という働きをします。

簡単な実行例を示します。

Prelude Control.Applicative> pure (*2) <*> Just 10
Just 20
Prelude Control.Applicative> pure (*2) <*> Nothing
Nothing
Prelude Control.Applicative> pure (*2) <*> [1,2,3,4,5]
[2,4,6,8,10]
Prelude Control.Applicative> pure (*2) <*> []
[]
Prelude Control.Applicative> pure (*2) <*> Right 10
Right 20
Prelude Control.Applicative> pure (*2) <*> Left "error"
Left "error"
Prelude Control.Applicative> pure reverse <*> getLine
hello, world
"dlrow ,olleh"

pure で関数を持ち上げます。このとき、右辺のデータ型が Maybe であれば関数は Just に格納され、リストであれば関数はリストに、Either であれば関数は Right に格納されます。あとは、fmap と同様に文脈を保ったまま関数を値に適用します。

ところで、リストには複数の関数を格納することができます。この場合、動作は次のようになります。

Prelude Control.Applicative> [(+3),(*2)] <*> [1,2,3,4,5]
[4,5,6,7,8,2,4,6,8,10]

(+3) を適用して得られたリストと (*2) を適用して得られたリストを連結したものになります。

●<*> を複数回使用する

Applicative も関数の部分適用が可能です。たとえば、関数 a -> b -> c は a -> (b -> c) のことなので、これを演算子 <*> に適用すると型は次のようになります。

(<*>) :: f (a -> b) -> f a -> f b
pure (a -> b -> c) <*> => f (a -> (b -> c)) -> f a -> f (b -> c)

ここで、返り値の型は f (b -> c) になることに注目してください。これは演算子 <*> に適用できる型ですね。つまり、Applicative でカリー化関数を評価する場合、次のように引数を <*> でつなげて渡すことができます。

pure func <*> 引数1 <*> 引数2 <*> ... <*> 引数N

簡単な実行例を示します。

Prelude Control.Applicative> pure (*) <*> Just 2 <*> Just 10
Just 20
Prelude Control.Applicative> pure (+) <*> Right 2 <*> Right 10
Right 12
Prelude Control.Applicative> pure (,) <*> [1,2,3] <*> [4,5,6]
[(1,4),(1,5),(1,6),(2,4),(2,5),(2,6),(3,4),(3,5),(3,6)]

リストの動作はリスト内包表記で表すと [(x, y) | x <- [1,2,3], y <- [4,5,6]] と同じ [*1] になります。ただし、Applicative ではリスト内包表記の条件節を実現することはできません。(,) はタプルのデータ構築子です。タプルは最大で 62 個の要素を格納できます。データ構築子は (,) だけではなく、(,,) や (,,,) など最大で 61 個のカンマ ( , ) を並べたデータ構築子が用意されています。

簡単な例を示します。

Prelude Control.Applicative> :t (,)
(,) :: a -> b -> (a, b)
Prelude Control.Applicative> :t (,,)
(,,) :: a -> b -> c -> (a, b, c)
Prelude Control.Applicative> :t (,,,)
(,,,) :: a -> b -> c -> d -> (a, b, c, d)
Prelude Control.Applicative> (,) 1 2
(1,2)
Prelude Control.Applicative> (,,) 1 2 3
(1,2,3)
Prelude Control.Applicative> (,,,) 1 2 3 4
(1,2,3,4)

Prelude Control.Applicative> pure (,,) <*> [1,2] <*> [3,4] <*> [5,6]
[(1,3,5),(1,3,6),(1,4,5),(1,4,6),(2,3,5),(2,3,6),(2,4,5),(2,4,6)]
Prelude Control.Applicative> pure (,,,) <*> [1,2] <*> [3,4] <*> [5,6] <*> [7,8]
[(1,3,5,7),(1,3,5,8),(1,3,6,7),(1,3,6,8),(1,4,5,7),(1,4,5,8),(1,4,6,7),(1,4,6,8)
,(2,3,5,7),(2,3,5,8),(2,3,6,7),(2,3,6,8),(2,4,5,7),(2,4,5,8),(2,4,6,7),(2,4,6,8)
]
-- note --------
[*1] リスト内包表記は「リストモナド」の構文糖衣です。モナドの演算子 >>= を使うと次のようになります。
Prelude> [1,2,3] >>= \x -> [4,5,6] >>= \y -> return (x, y)
[(1,4),(1,5),(1,6),(2,4),(2,5),(2,6),(3,4),(3,5),(3,6)]

●<$> と <*> の組み合わせ

pure ではなく Functor の fmap を使って関数を持ち上げることもできます。モジュール Control.Applicative には fmap の別名として <$> が定義されています。簡単な実行例を示します。

Prelude Control.Applicative> :t (<$>)
(<$>) :: Functor f => (a -> b) -> f a -> f b
Prelude Control.Applicative> (*) <$> Just 2 <*> Just 10
Just 20
Prelude Control.Applicative> (*) <$> Just 2 <*> Nothing
Nothing
Prelude Control.Applicative> (*) <$> [2] <*> [1,2,3,4,5]
[2,4,6,8,10]
Prelude Control.Applicative> (*) <$> Right 2 <*> Right 10
Right 20
Prelude Control.Applicative> (*) <$> Right 2 <*> Left "error"
Left "error"
Prelude Control.Applicative> (,) <$> [1,2,3] <*> ['a', 'b', 'c']
[(1,'a'),(1,'b'),(1,'c'),(2,'a'),(2,'b'),(2,'c'),(3,'a'),(3,'b'),(3,'c')]

Functor の演算子 <$> により関数が持ち上げられて f (a -> b) のデータ型が生成され、それが Applicative の演算子 <*> に渡されます。そして、その中て文脈を保ちながら関数 (a -> b) が評価されます。

●ZipList

ところで、Applicative におけるリストの動作はリスト内包表記と同じですが、関数 zipWith のように動作してほしい場合もあります。zipWith の動作を示します。

Prelude> :t zipWith
zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
Prelude> :t zipWith3
zipWith3 :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]

Prelude> zipWith (,) "abc" [1,2,3]
[('a',1),('b',2),('c',3)]
Prelude> zipWith3 (,,) "abc" [1,2,3] "def"
[('a',1,'d'),('b',2,'e'),('c',3,'f')]

Applicative でも同様の動作を行うため、Control.Applicative には ZipList というデータ型が定義されています。コマンド :info で ZipList を調べてみましょう。

Prelude Control.Applicative> :i ZipList
newtype ZipList a = ZipList {getZipList :: [a]}
        -- Defined in `Control.Applicative'
instance Functor ZipList -- Defined in `Control.Applicative'
instance Applicative ZipList -- Defined in `Control.Applicative'

ZipList はリストを格納しているだけです。リストは Applicative のインスタンスになっています。それとは異なる動作をさせるため、ZipList という新しいデータ型を定義して Applicative のインスタンスに設定します。newtype はあとで説明します。なお、ZipList は Show のインスタンスではないので、インタプリタ ghci で表示する場合は関数 getZipList を使って ZipList からリストを取り出してください。

簡単な実行例を示します。

Prelude Control.Applicative> getZipList $ ZipList [1,2,3,4]
[1,2,3,4]
Prelude Control.Applicative> getZipList $ (,) <$> ZipList "abc" <*> ZipList [1,2,3]
[('a',1),('b',2),('c',3)]
Prelude Control.Applicative> getZipList $ (,,) <$> ZipList "abc" <*> ZipList [1,2,3] <*> ZipList "def"
[('a',1,'d'),('b',2,'e'),('c',3,'f')]

関数を ZipList に格納して、演算子 <*> で評価することもできます。

Prelude Control.Applicative> getZipList $ ZipList [(*2), (+10)] <*> ZipList [1,2]
[2,12]
Prelude Control.Applicative> getZipList $ ZipList [(*), (+)] <*> ZipList [1,2] <*> ZipList [3,4]
[3,6]

最初の例では 1 * 2 と 2 + 10 が評価されて [2, 12] になります。次の例では 1 * 3 と 2 + 4 が評価されて [3, 6] になります。

●newtype

newtype は data 宣言のように新しいデータ型を定義することができます。たとえば、ZipList を data 宣言で書き直して比較してみましょう。

newtype ZipList a = ZipList [a]
newtype ZipList a = ZipLIst {getZipList :: [a]}

data ZipList a = ZipList [a]
data ZipList a = ZipList {getZipList :: [a]}

data が newtype に変わっただけで、あとは同じですね。実際、data 宣言で ZipList を定義しても問題なく動作します。ただし、data 宣言を使って定義すると、Haskell が ZipList にリストを格納する処理や ZipList からリストを取り出す処理を行うことになります。これは当然のことですが、今回のようにリストとは異なるデータ型だけが必要な場合、Haskell が ZipList をリストと同じように操作できると効率的です。

newtype はこのようなときのために用意された機能です。このため、newtype ではデータ構築子は一つだけしか定義できず、そのデータ構築子の型式も一つだけしか持つことができません。そのかわり、newtype で定義された新しいデータ型は、元のデータ型と同じように一手間かけず効率的に処理することができます。

●自分で Applicative を定義する

それではここで Applicative の理解を深めるため、私たちで Applicative を定義してみましょう。型クラスの名前は Mapplicative とします。Mapplicative の定義は次のようになります。

リスト : Mapplicative の定義

class Mfunctor f => Mapplicative f where
  pure  :: a -> f a
  (<*>) :: f (a -> b) -> f a -> f b

Mapplicative は型クラスの名前が異なるだけで、pure と <*> の定義は Applicative と同じです。

次は Maybe、Either, IO, リスト を Mapplicative のインスタンスに設定します。次のリストを見てください。

リスト : インスタンスの設定

-- Maybe
instance Mapplicative Maybe where
  pure x = Just x
  Nothing <*> _ = Nothing
  (Just f) <*> x = f <$> x

-- Either
instance Mapplicative (Either a) where
  pure x = Right x
  (Left x) <*> _ = Left x
  (Right f) <*> x = f <$> x

-- IO
instance Mapplicative IO where
  pure x = return x
  action1 <*> action2 = do
    f <- action1
    x <- action2
    return (f x)

-- リスト
instance Mapplicative [] where
  pure x = [x]
  fs <*> xs = concatMap (<$> xs) fs

どのデータ型でも pure の定義は簡単ですね。Maybe であれば Just x、Either であれば Right x、IO であれば return x、リストであれば [x] を返します。<*> の定義も簡単です。Maybe は左辺が Nothing であれば Nothing を返します。そうでなければ、左辺 Just f から関数 f を取り出して f <$> x を評価します。f は Mfunctor なので、演算子 <$> を使用することができます。Either の場合も同じです。

IO の場合は左辺の I/O アクション action1 から関数 f を取り出し、右辺の I/O アクション action2 から引数 x を取り出します。あとは return (f x) を返すだけです。リストの場合はちょっと複雑です。左辺 fs に格納されている関数を取り出して、右辺のリスト xs に適用し、その結果を連結しないといけません。この処理は関数 concatMap を使うとうまくいきます。

それでは実際に試してみましょう。

*Main> pure (*2) <*> Just 10
Just 20
*Main> pure (*2) <*> Nothing
Nothing
*Main> Nothing <*> Just 10
Nothing
*Main> pure (*2) <*> Right 10
Right 20
*Main> pure (*2) <*> Left "error"
Left "error"
*Main> Left "error" <*> Right 10
Left "error"
*Main> [(+3), (*2)] <*> [1,2,3,4,5]
[4,5,6,7,8,2,4,6,8,10]
*Main> [(+3), (*2)] <*> []
[]
*Main> [] <*> [1,2,3,4,5]
[]
*Main> pure reverse <*> getLine
hello, world
"dlrow ,olleh"

もちろん、前回作成した型クラス Mfunctor の演算子 <$> と組み合わせることもできます。

*Main> (*) <$> Just 2 <*> Just 10
Just 20
*Main> (+) <$> Right 2 <*> Right 10
Right 12
*Main> (^) <$> [2,3] <*> [1..5]
[2,4,8,16,32,3,9,27,81,243]
*Main> (++) <$> getLine <*> getLine
hello,
world
"hello,world"

●関数も Applicative になる

Functor で説明したように -> は中置演算子で、関数の型は (->) r a と書くこともできます。(->) r を型コンストラクタと考えると、関数の Applicative の定義を導くことができます。

<*> :: f (a -> b) -> f a -> f b
=> ((->) r (a -> b)) -> ((->) r a) -> ((->) r b)
=> (r -> a -> b) -> (r -> a) -> (r -> b)

f <*> g は関数 f :: r -> a -> b と g :: r -> a を受け取って、関数 r -> b を返します。f は r と a から b を求めます。引数 a は関数 g から求めることができるので、<*> が返す関数をラムダ式で書くと \r -> f r (g r) と表すことができます。

このあと、さらに <*> をつなげて関数を合成することができます。f <*> g で生成される関数の型は r -> b なので、最初に与えた引数 r が次の関数にも伝播していくことに注意してください。

プログラムは次のようになります。

リスト : インスタンスの設定 (2)

instance Mapplicative ((->) r) where
  pure x = \_ -> x
  f <*> g = \x -> f x (g x)

pure はラムダ式 (クロージャ) に x を格納して返します。<*> は定義どおりにプログラムしただけです。そうはいっても、これだけでは何ができるのかよくわかりませんね。具体的な例を示しましょう。

*Main> :t pure (+)
pure (+) :: (Num a, Mapplicative f) => f (a -> a -> a)
*Main> :t pure (+) <*> (+10)
pure (+) <*> (+10) :: Num a => a -> a -> a
*Main> (pure (+) <*> (+10)) 1 2
13
*Main> (pure (+) <*> (*10)) 1 2
12

pure (+) <*> (+10) は 2 つの数値を引数に取る関数になります。その動作は 1 を (+10) に適用して、その結果と 2 を足し算する、つまり 2 + (1+10) = 13 となります。(*10) の場合は 2 + (1*10) = 12 になります。

*Main> :t pure (+) <*> (+10) <*> (*10)
pure (+) <*> (+10) <*> (*10) :: Num b => b -> b
*Main> :t pure (+) <*> (+10) <*> (*10) $ 10
pure (+) <*> (+10) <*> (*10) $ 10 :: Num b => b
*Main> pure (+) <*> (+10) <*> (*10) $ 10
120

次に、<*> (*10) を追加しましょう。すると、合成された関数は引数が 1 つの関数になります。その動作は引数 10 を (+10) と (*10) に適用して、その結果を足し算する、つまり (10 + 10) + (10 * 10) = 120 になります。

pure のかわりに <$> を使っても同じように動作します。

*Main> (+) <$> (+10) <*> (*10) $ 10
120

●ZipList の定義

もちろん、ZipList も定義することができます。次のリストを見てください。

リスト : ZipList の定義

newtype ZipList a = ZipList {getZipList :: [a]}

instance Mfunctor ZipList where
  f <$> (ZipList xs) = ZipList (map f xs)

instance Mapplicative ZipList where
  pure x = ZipList (repeat x)
  ZipList fs <*> ZipList xs = ZipList (zipWith id fs xs)

プログラムは Haskell のモジュール Data.Applicative とほとんど同じです。Functor の演算子 <$> の定義は簡単ですね。Applicative の演算子 <*> は zipWith を使うと簡単です。id には fs の要素 fi と xs の要素 xi が次のように渡されます。

id f x => (id fi) xi => fi xi

つまり、xs の要素 xi に fs の要素 (関数) fi を適用していくことになります。関数 pure はちょっと変わっていますね。repeat x は x の無限リストを生成する関数です。ここで、リスト [x] を返すと、各リストの先頭要素だけに x を適用することになるので、長さが 1 のリストしか生成されません。リストの各要素に関数 x を適用するため、repeat で無限リストを生成しています。

簡単な実行例を示します。

*Main> getZipList $ pure (*) <*> ZipList [1..5] <*> ZipList [11..15]
[11,24,39,56,75]
*Main> getZipList $ (*) <$> ZipList [1..5] <*> ZipList [11..15]
[11,24,39,56,75]
*Main> getZipList $ ZipList [(+1), (+2), (+3)] <*> ZipList [10,11,12]
[11,13,15]
*Main> getZipList $ (,,) <$> ZipList [1..5] <*> ZipList [11..15] <*> ZipList "abcde"
[(1,11,'a'),(2,12,'b'),(3,13,'c'),(4,14,'d'),(5,15,'e')]

●liftA2

pure や <*> のほかにも、モジュール Control.Applicative には便利な関数 liftA2 が用意されています。関数 liftA2 を Mapplicative で定義すると次のようになります。

リスト : liftA2

liftA2 :: Mapplicative f => (a -> b -> c) -> f a -> f b -> f c
liftA2 f a b = f <$> a <*> b

プログラムは簡単ですね。実行例を示します。

*Main> liftA2 (+) (Just 1) (Just 2)
Just 3
*Main> liftA2 (:) (Just 1) (Just [2])
Just [1,2]
*Main> liftA2 (+) [1,2,3,4] [5,6,7,8]
[6,7,8,9,7,8,9,10,8,9,10,11,9,10,11,12]

また、簡単な入出力 で説明した関数 sequence のような関数を作ることもできます。名前は 参考文献 1 と同じく sequenceA としました。

リスト : sequenceA

sequenceA :: Mapplicative f => [f a] -> f [a]
sequenceA [] = pure []
sequenceA (x:xs) = (:) <$> x <*> sequenceA xs

-- 別解
sequenceA :: Mapplicative f => [f a] -> f [a]
sequenceA = foldr (liftA2(:)) (pure [])

sequenceA の型を見ればおわかりのように、リストに格納されている f a から a を取り出して、それをリストに格納した [a] を作り、それを f に格納して返します。プログラムは簡単にみえますが、Functor と Applicative が働いていることに注意してください。<$> で x からデータを取り出し、それを sequeceA の返り値のリストに追加します。また、別解のように foldr と liftA2 を組み合わせてプログラムすることもできます。

簡単な実行例を示します。

*Main> sequenceA [Just 1, Just 2, Just 3]
Just [1,2,3]
*Main> sequenceA [Just 1, Just 2, Just 3, Nothing]
Nothing
*Main> sequenceA [Right 1, Right 2, Right 3]
Right [1,2,3]
*Main> sequenceA [Right 1, Right 2, Left "error", Right 3]
Left "error"
*Main> sequenceA (map print [1,2,3,4,5])
1
2
3
4
5
[(),(),(),(),()]

I/O アクションも Mapplicative なので、sequenceA を使うとリストに格納された I/O アクションを実行することができます。

リストの場合、動作がもっと複雑になります。次の例を見てください。

*Main> sequenceA [[1,2],[3,4]]
[[1,3],[1,4],[2,3],[2,4]]

これは次のように動作します。

*Main> (:) <$> [3,4] <*> [[]]
[[3],[4]]
*Main> (:) <$> [1,2] <*> [[3],[4]]
[[1,3],[1,4],[2,3],[2,4]]

リストの場合、pure [ ] は [[ ]] のことなので、3 : [ ], 4 : [ ] が評価されて、それがリストに格納されます。次に、1 と [3], [4] が結合され、2 と [3], [4] が結合され、それらがリストに格納されるので、返り値は [[1,3],[1,4],[2,3],[2,4]] になります。

sequenceA はリストに格納された関数に引数を渡して評価することもできます。

*Main> :t sequenceA [(+3), (*4), (^2)]
sequenceA [(+3), (*4), (^2)] :: Num a => a -> [a]
*Main> sequenceA [(+3), (*4), (^2)] $ 5
[8,20,25]

●Applicative の規則

Applicative にも満たすべき規則があります。まず大前提として、pure f <*> x = f <$> x を満たす必要があります。この規則を満たさないと Functor と Applicative を組み合わせて使うことができません。

それでは実際に試してみましょう。

*Main> pure (+10) <*> Just 10
Just 20
*Main> (+10) <$> Just 10
Just 20
*Main> pure (+10) <*> Right 10
Right 20
*Main> (+10) <$> Right 10
Right 20
*Main> pure (+10) <*> [1,2,3,4,5]
[11,12,13,14,15]
*Main> (+10) <$> [1,2,3,4,5]
[11,12,13,14,15]
*Main> getZipList $ (+10) <$> ZipList [1,2,3,4,5]
[11,12,13,14,15]
*Main> getZipList $ pure (+10) <*> ZipList [1,2,3,4,5]
[11,12,13,14,15]

正しく動作していますね。

このほかに、Haskell の Data.Applicative のマニュアルによると、次の 4 つの規則があるそうです。

  1. pure id <*> v = v
  2. pure (.) <*> u <*> v <*> w = u <*> (v <*> w)
  3. puer f <*> pure x = pure (f x)
  4. u <*> pure y = pure ($ y) <*> u

規則の詳しい説明は本稿の範囲を超えるので (M.Hiroi の力不足なので)、ここでは Maybe を使って、規則が成り立っていることを示すだけにとどめます。これらの規則の意味は shelarcy さんの 本物のプログラマは Haskell を使う 第51回 FunctorとMonadの間にあるApplicative で詳しく説明されています。そちらをお読みくださいませ。

Prelude Control.Applicative> pure id <*> Just 10
Just 10
Prelude Control.Applicative> pure (.) <*> Just (*2) <*> Just (+5) <*> Just 10
Just 30
Prelude Control.Applicative> Just (*2) <*> (Just (+5) <*> Just 10)
Just 30
Prelude Control.Applicative> pure (*2) <*> Just 10
Just 20
Prelude Control.Applicative> pure ((*2) 10) :: Maybe Int
Just 20
Prelude Control.Applicative> Just (*2) <*> pure 10
Just 20
Prelude Control.Applicative> pure ($ 10) <*> Just (*2)
Just 20

経路の探索 (2)

経路の探索 の続きです。今回は「反復深化」というアルゴリズムを説明します。

●反復深化

幅優先探索は最短手数を求めるのに適したアルゴリズムですが、生成する局面数が多くなると大量のメモリを必要とします。このため、メモリが不足するときは、幅優先探索を使うことができません。深さ優先探索の場合、メモリの消費量は少ないのですが、最初に見つかる解が最短手数とは限らないという問題点があります。

それでは、大量のメモリを使わずに最短手数を求める方法はないのでしょうか。実は、とても簡単な方法があるのです。それは、深さ優先探索の「深さ」に上限値を設定し、解が見つかるまで上限値を段階的に増やしていく、という方法です。

たとえば、1 手で解が見つからない場合は、2 手までを探索し、それでも見つからない場合は 3 手までを探索する、というように制限値を 1 手ずつ増やしていくわけです。このアルゴリズムを「反復深化 (iterative deeping) 」といいます。

反復深化は最短手数を求めることができるアルゴリズムですが、幅優先探索と違って局面を保存する必要が無いため、必要となるメモリは深さ優先探索と同程度で済みます。また、プログラムも深さ優先探索と同じくらい簡単に作成することができます。ただし、同じ探索を何度も繰り返すため実行時間が増大するという欠点があります。ようするに、使用するメモリは少ないが実行時間が長くなるアルゴリズムなのです。

●反復深化のプログラム

それでは、同じ経路図を使って反復深化を具体的に説明しましょう。

    B------D------F
  /│      │          
A  │      │          
  \│      │          
    C------E------G

      図 :経路図

反復深化のプログラムはとても簡単です。設定した上限値まで深さ優先探索を行う関数を作り、上限値を1手ずつ増やしてその関数を呼び出せばいいのです。プログラムは次のようになります。

リスト : 反復深化

-- 隣接リスト
adjacent :: [[Int]]
adjacent =
  [[1,2],
   [0,2,3],
   [0,1,4],
   [1,4,5],
   [2,3,6],
   [3],
   [4]]

-- 次の頂点へ進む
nextPath :: [Int] -> [[Int]]
nextPath path@(x:xs) = [y:path | y <- adjacent !! x, y `notElem` xs]

-- 反復深化
ids :: Int -> Int -> IO ()
ids start goal = iter 1 where
  dfs n m path@(x:xs)
    | n == m    = if x == goal then print (reverse path) else return ()
    | otherwise = mapM_ (dfs (n + 1) m) $ nextPath path
  iter 7 = return ()
  iter m = do
    dfs 0 m [start]
    iter (m + 1)

-- リストに格納する
ids' :: Int -> Int -> [[Int]]
ids' start goal = iter 1 where
  dfs n m ys path@(x:xs)
    | n == m    = if x == goal then reverse path : ys else ys
    | otherwise = foldl (dfs (n + 1) m) ys $ nextPath path
  iter 7 = []
  iter m = dfs 0 m [] [start] ++ iter (m + 1)

局所関数 iter で上限値を増やしていき、局所関数 dfs で深さ優先探索を行います。引数 n が経路長、引数 m が上限値を表します。n が m に達したら探索を打ち切ります。このとき、ゴールに到達したかチェックします。あとは、m の値を増やしながら dfs を呼び出せばいいわけです。関数 ids' は見つけた解をリストに格納して返します。

それでは実行結果を示しましょう。

*Main> ids 0 6
[0,2,4,6]
[0,1,2,4,6]
[0,1,3,4,6]
[0,2,1,3,4,6]
*Main> ids 6 0
[6,4,2,0]
[6,4,2,1,0]
[6,4,3,1,0]
[6,4,3,1,2,0]
*Main> ids' 0 6
[[0,2,4,6],[0,1,3,4,6],[0,1,2,4,6],[0,2,1,3,4,6]]
*Main> ids' 6 0
[[6,4,2,0],[6,4,3,1,0],[6,4,2,1,0],[6,4,3,1,2,0]]

結果を見ればおわかりのように、最初に見つかる解が最短手数になります。このプログラムでは全ての経路を求めましたが、最短手数を求めるだけでよい場合は、解が見つかった時点で探索を終了すればいいでしょう。

●探索の一般化

ところで、深さ優先探索と幅優先探索は高階関数を使うと一般化することができます。次のリストを見てください。

リスト : 探索の一般化

-- 解をリストに格納して返す
search :: (a -> Bool) -> (a -> b) -> (b -> [a] -> [a]) -> [a] -> [a]
search _ _ _ [] = []
search isGoal nextState combine (x:xs) =
  if isGoal x then x : search isGoal nextState combine xs
  else search isGoal nextState combine (combine (nextState x) xs)

-- 解を一つだけ求める
search' :: (a -> Bool) -> (a -> b) -> (b -> [a] -> [a]) -> [a] -> Maybe a
search' _ _ _ [] = Nothing
search' isGoal nextState combine (x:xs) =
  if isGoal x then Just x 
  else search' isGoal nextState combine (combine (nextState x) xs)

関数 search はまだ調べていない局面 (state) を格納したリスト (stateList) を受け取り、その先頭から局面を取り出して新しい局面を生成することで探索を進めます。isGoal はゴールに到達したか調べる述語、nextState は現在の局面から新しい局面を生成してリストに格納して返す関数、combine は新しく生成した局面を stateList に連結する関数、最後の引数が stateList です。

最初に、stateList が空リストであれば、空リストを返して探索を終了します。次に、先頭の局面 x を取り出して、ゴールに到達しているか isGoal でチェックします。isGoal が True であれば x を search の返り値 (リスト) に追加します。そうでなければ、search を再帰呼び出しします。このとき、x に nextState を適用して新しい局面を生成し、combine で xs に追加します。チェックした局面 x は stateList から取り除くことに注意してください。

解を一つ求めるだけでよければ、関数 search' のように isGoal の返り値が True であれば Just x を返して、ここで探索を打ち切ります。解が見つからない場合は Nothing を返します。

深さ優先探索は経路を先へ先へと進めていく探索なので、stateList の先頭に新しい局面を追加することで実現できます。combine にはリストを連結する関数を渡します。演算子 ++ をカッコで囲めばカリー化関数として渡すことができます。幅優先探索はすべての経路を並行に探索していくので、stateList の末尾に新しい局面を追加することで実現できます。combine には flip (++) を渡します。ただし、演算子 ++ を使う場合、たくさんの局面が生成されると効率は悪くなります。

それでは、実際に経路の探索を行ってみましょう。

*Main> map reverse $ search (\x -> head x == 6) nextPath (++) [[0]]
[[0,1,2,4,6],[0,1,3,4,6],[0,2,1,3,4,6],[0,2,4,6]]
*Main> map reverse $ search (\x -> head x == 6) nextPath (flip (++)) [[0]]
[[0,2,4,6],[0,1,2,4,6],[0,1,3,4,6],[0,2,1,3,4,6]]
*Main> fmap reverse $ search' (\x -> head x == 6) nextPath (++) [[0]]
Just [0,1,2,4,6]
*Main> fmap reverse $ search' (\x -> head x == 6) nextPath (flip (++)) [[0]]
Just [0,2,4,6]

経路が逆順になるので reverse で反転しています。深さ優先探索と幅優先探索どちらも正常に動作していますね。


Copyright (C) 2013 Makoto Hiroi
All rights reserved.

[ PrevPage | Haskell | NextPage ]