07

04

[Haskell] すごいHaskell楽しく学ぼう 第13章モナドがいっぱい p308 読者への演習問題 解いてみた

2013.07.04(20:11)

すごいHaskell楽しく学ぼう 第13章モナドがいっぱい! p308 読者への演習問題
始点と終点を与えるとどういう経路をとればいいか
教えてくれるよう、この関数を改造してみてください。

{-# OPTIONS -Wall -Werror #-}
-- | すごいHaskell楽しく学ぼう
-- | 第13章モナドがいっぱい!
-- | p308 読者への演習問題
-- | 始点と終点を与えるとどういう経路をとればいいか教えてくれるよう、この関数を改造してみてください。
module Knight where
import Test.HUnit
import Test.QuickCheck
import Control.Monad

-- | 型シノニムの定義  盤の上のKnightの位置
type KnightPos = (Int,Int)

-- | そこが盤の上ならTrueを返す
onBoard :: KnightPos -> Bool
onBoard (c,r) = (c `elem` [1..8] && r `elem` [1..8])

-- | いまいるところから1ステップで次に行けるところ全体をリストモナドで返す
moveKnight :: KnightPos -> [KnightPos]
moveKnight (c,r) = do
                    -- いらないけどいまいるところが盤の上であることをまず確認
                    guard $ onBoard (c,r)
                    (c',r') <- [(c+2,r-1),(c+2,r+1),(c-2,r-1),(c-2,r+1)
                                ,(c+1,r-2),(c+1,r+2),(c-1,r-2),(c-1,r+2)
                                ]
                    -- guard :: MonadPlus m => Bool -> m ()
                    -- guard (c' `elem` [1..8] && r' `elem` [1..8])
                    -- 動かした先も盤の上であることを確認
                    guard $ onBoard (c',r')
                    return (c',r')

-- | いまいるところからnステップで行けるところ全体をリストモナドで返す
inn :: Int -> KnightPos -> [KnightPos]
inn 0 startPos = return startPos
inn n startPos = inn (n-1) startPos >>= moveKnight

-- | いまいるところから3ステップで行けるところ全体をリストモナドで返す
in3,in3',in3'' :: KnightPos -> [KnightPos]
--                 m a             (a -> m a)     (a -> m a)     (a -> m a)
in3'' startPos = return startPos >>= moveKnight >>= moveKnight >>= moveKnight 
in3'  startPos = do first <- moveKnight startPos
                    second <- moveKnight first
                    moveKnight second
in3 = inn 3
-- | 戻り値の[KnightPos]の中には重複もたくさんあるけど気にしない

-- | 始点と終点まで3ステップで到達できるならTrueを返す関数
canReachIn3 :: KnightPos -> KnightPos -> Bool
--                            elem :: Eq a => a -> [a] -> Bool
--                            KnightPos        [KnightPos]
canReachIn3 startPos endPos = endPos `elem` in3 startPos
-- | ここまで教科書といっしょ。
---------------------------------------------------------------
-- | たどった経路を順にリストにためた型、KnightPathを定義する。
type KnightPath = [KnightPos]
-- | 1つの経路をあたえると、そこから1ステップでゆける経路を追加した、経路のリストモナドを返す
-- |                 a    ->   m a
pmoveKnight,pmoveKnight' :: KnightPath -> [KnightPath]
pmoveKnight'         [] = []
pmoveKnight' prev@(x:_) = [(y:prev) | y <- moveKnight x]
--                           経路は少なくとも1個はあること
pmoveKnight   startPath = do guard (length startPath > 0)
                             y <- moveKnight (head startPath)
                             return (y:startPath)
{-- たとえば、
> pmoveKnight [(6,2)]
[[(8,1),(6,2)],[(8,3),(6,2)],[(4,1),(6,2)],[(4,3),(6,2)],[(7,4),(6,2)],[(5,4),(6,2)]]
> pin3 [(6,2)]
[[(8,1),(6,2),(8,1),(6,2)],[(8,3),(6,2),(8,1),(6,2)],..................
--}

-- | いまいるところからnステップで行けるところ全体をリストモナドで返す
pinn :: Int -> KnightPath -> [KnightPath]
pinn 0 startPath = return startPath
pinn n startPath = pinn (n-1) startPath >>= pmoveKnight

-- | 1つの経路をあたえると、そこから3ステップでゆける経路を追加した、経路のリストモナドを返す
-- |          a    ->   m a 
pin3,pin3',pin3'' :: KnightPath -> [KnightPath]
-- |             m a      >>= (a -> m a)  >>= (a -> m a)  >>= (a -> m a)  戻り値は m a 
pin3'' startPath = return startPath >>= pmoveKnight >>= pmoveKnight >>= pmoveKnight
pin3'  startPath = do first <- pmoveKnight startPath
                      second <- pmoveKnight first
                      pmoveKnight second
pin3 = pinn 3

-- | 始点と終点を与えると、3ステップでゆける全経路を返す関数
pcanReachIn3 :: KnightPos -> KnightPos -> [KnightPath]
--                                                    ここは[KnightPath]
--                             filter :: (a -> Bool) -> [a] -> [a]
pcanReachIn3 startPos endPos = filter (\x -> endPos == head x) (pin3 [startPos])

-- | 始点と終点を与えると、nステップでゆける全経路を返す関数
pcanReachInN :: Int -> KnightPos -> KnightPos -> [KnightPath]
pcanReachInN n startPos endPos = filter (\x -> endPos == head x) (pinn n [startPos])

-- | ユニットテスト
pcanReachTests :: Test
pcanReachTests = test [
                  onBoard (0,0) ~?= False,
                  onBoard (1,1) ~?= True,
                  in3 (1,1) ~?= in3'' (1,1),
                  in3 (1,2) ~?= in3' (1,2),
                  pin3 [(6,1)] ~?= pin3'' [(6,1)],
                  pin3 [(6,2)] ~?= pin3' [(6,2)],
                  pcanReachIn3 (6,2) (6,1) ~?= 
  [[(6,1),(7,3),(8,1),(6,2)],[(6,1),(5,3),(4,1),(6,2)],
  [(6,1),(5,3),(7,4),(6,2)],[(6,1),(8,2),(7,4),(6,2)],
  [(6,1),(7,3),(5,4),(6,2)],[(6,1),(4,2),(5,4),(6,2)]],
                  pcanReachIn3 (1,1) (3,4) ~?= 
  [[(3,4),(5,3),(3,2),(1,1)],[(3,4),(1,3),(3,2),(1,1)],
  [(3,4),(4,2),(2,3),(1,1)],[(3,4),(1,5),(2,3),(1,1)]],
                  (length $ pcanReachInN 4 (1,1) (8,8)) ~?= 0,
                  (length $ pcanReachInN 5 (1,1) (8,8)) ~?= 0,
                  (length $ pcanReachInN 6 (1,1) (8,8)) ~?= 108,
                  True ~?= True]

-- | quickCheck
prop_pin3 :: (Int,Int) -> Property
prop_pin3 (c,r) = (onBoard(c,r)) && (True)
                ==> pin3[(c,r)] == pin3'[(c,r)] &&
                    pin3[(c,r)] == pin3''[(c,r)] 
main :: IO ()
main = do
  print $ pcanReachIn3 (6,2) (6,1) 
  _ <- runTestTT pcanReachTests
  quickCheck prop_pin3
  print . length $ pcanReachInN 4 (1,1) (8,8)
  print . length $ pcanReachInN 5 (1,1) (8,8)
  print . length $ pcanReachInN 6 (1,1) (8,8)
  return ()

モナドm aに(a->m b)型の関数がバインドできるうれしさは、毎回aがぬるぽでないことを確認してから関数を適用するっていう、従来型言語のようにめんどくさいことから解放されることにあります。ぬるぽを渡された関数側で処理するのも間違っています。(m a->m b)の関数は書きたくありませんから。

(a->m b)に渡されるaは信じられるaなのです。だからモナドm aに(a->m b)型の関数をバインドして書くとラクで短く書けるのです。

関数型プログラミング言語は、迅速に開発できると言われていますが、その理由のひとつが、ぬるぽでないことを確認するコードを毎回書かなくてよい、ことにあります。
プロフィール

島敏博

Shima Toshihiro 島敏博
信州アルプスハイランド在住。HaskellとElixirが好き。組み込みソフトウェアアーキテクト、C++プログラマ、山歩き、美術館巡り、和食食べ歩き、日本赤十字社救急法指導員、インデックス投資、クラシック音楽、SESSAME会員、状態マシン設計、モデル駆動開発、ソフトウェアプロダクトライン、Rubyist、実践ビジネス英語

■ ツイッター
http://twitter.com/saltheads
■ Facebook
http://www.facebook.com/saltheads
■ Qiita
http://qiita.com/saltheads

印刷する場合は、ブラウザの印刷メニューではなく、このページの上から3cmくらいの青いところにある、「印刷」を押してみてください。少しうまく印刷できます。まだ完全ではないのですが、これで勘弁してください。


カテゴリ
最新記事
月別アーカイブ
最新コメント
検索フォーム
リンク
sessame
RSSリンクの表示