01

04

[Haskell] 階段の上がり方が何通りあるか

2013.01.04(17:00)

世界で闘うプログラミング力を鍛える150問
http://www.amazon.co.jp/dp/4839942390/
の問題9.1 をHaskellで解いてみた。

問題 9.1 子供がn段の階段を駆け上がりますが、一歩で1段、2段、もしくは3段を
登ることができます。このとき、考え得る階段の上がり方が何通りあるかを求める
メソッドを実装してください。

何通りあるか数える関数に加えて、上がり方のリストを求める関数も作ってみた。
また、いずれも単純な再帰では遅すぎるので、高速化の工夫もしてみた。

{-# OPTIONS -Wall -Werror #-}

module CountWays where
import Test.HUnit
import Test.QuickCheck

-- | ------------- 世界で闘うプログラミング力を鍛える150問 -----------------
-- | 問題 9.1 子供がn段の階段を駆け上がりますが、一歩で1段、2段、もしくは3段を
-- | 登ることができます。このとき、考え得る階段の上がり方が何通りあるかを求める
-- | メソッドを実装してください。

-- | n段の登り方がいくつあるかを数える
-- | 1段へは  0段から1段登るの1通りだけある。
-- | 2段へは  1段から1段登るのと、0段から2段登るの2通りある。
-- | n段へはn-1段から1段登る登り方と、
-- |       n-2段から2段登る登り方と、
-- |       n-3段から3段登る登り方の3通りがある
countWays :: Int->Int
countWays 0 =  1
countWays 1 =  countWays 0
countWays 2 =  countWays 1 + countWays 0
countWays n =  countWays (n-1) + countWays (n-2) + countWays (n-3)

-- | -------------------------------------------------------
-- | countWays は同じ引数で何度も呼ばれるので非常に効率が悪い
-- | 一度ずつ求めてリストを作っておき、そのリストを使って求めれば速い。
list2 :: Int->[Int]
list2 0 = 1:[]
list2 1 = (x):prev
                  where prev@(x:_) = list2 0
list2 2 = (x+y):prev
                  where prev@(x:y:_) = list2 1
list2 n = (x+y+z):prev
                  where prev@(x:y:z:_) = list2 (n-1)

-- | countWays の改良版
countWays2 :: Int->Int
countWays2 n = head $ list2 n

-- | -------------------------------------------------------
-- | フィボナッチ数列のように、
-- | 自分自身を使って、リストの続きが作れる場合はzipWithが使える。
-- | zipWith3を使って、前から順番に答えをつなげたリストを作る。
list3 :: [Int]
list3 = 1:1:2:zipWith3 (\x y z->x+y+z) list3 (drop 1 list3) (drop 2 list3)

-- | 答えのリストを使って、答えを求める。 countWays の改良版、その2
countWays3 :: Int->Int
countWays3 n = head $ drop n list3

-- | -------------------------------------------------------
-- | n段の登り方をリストアップする
-- | 1段へは  0段から1段登るの1通りだけある。
-- | 2段へは  1段から1段登るのと、0段から2段登るの2通りある。
-- | n段へはn-1段から1段登るのと、
-- |       n-2段から2段登るのと、
-- |       n-3段から3段登るの3通りがある
listWays :: Int->[[Int]]
listWays 0 =    [[]]
listWays 1 =    map (\xs->1:xs) (listWays 0)
listWays 2 =    map (\xs->1:xs) (listWays 1)
             ++ map (\xs->2:xs) (listWays 0)
listWays n =    map (\xs->1:xs) (listWays (n-1))
             ++ map (\xs->2:xs) (listWays (n-2))
             ++ map (\xs->3:xs) (listWays (n-3))

-- | listWays は同じ引数で何度も呼ばれるので非常に効率が悪い
-- | 一度ずつ求めてリストを作っておき、そのリストを使って求めれば速い。
listWaysList :: Int->[[[Int]]]
listWaysList 0 = [[[]]]
listWaysList 1 = (map (\xs->1:xs) x):prev
                 where prev@(x:_) = listWaysList 0
listWaysList 2 = (  map (\xs->1:xs) x
                 ++ map (\xs->2:xs) y):prev
                 where prev@(x:y:_) = listWaysList 1
listWaysList n = (  map (\xs->1:xs) x
                 ++ map (\xs->2:xs) y
                 ++ map (\xs->3:xs) z):prev
                 where prev@(x:y:z:_) = listWaysList (n-1)

-- | listWays の改良版
listWays2 :: Int->[[Int]]
listWays2 n = head $ listWaysList n

-- | ------------------ main ----------------------
main :: IO ()
main = do
       print $ countWays 24
       print $ countWays2 24
       print $ countWays 4
       print $ countWays 5
       print $ listWays 3
       print $ listWays 4
       print $ listWays 5
       _ <- runTestTT countWaysTest
       quickCheck prop_countWays
       quickCheck prop_countWays2
       quickCheck prop_countWays3
       return ()

-- | ------------------ ユニットテスト ----------------------
-- | クイックソート
qsort :: (Ord a) => [a] -> [a]  
qsort []     = []  
qsort (x:xs) = qsort left ++ [x] ++ qsort right
               where left  = filter (< x)  xs  
                     right = filter (>= x) xs  

countWaysTest :: Test
countWaysTest = test [
      countWays (3::Int) ~=? (4::Int),
      countWays (4::Int) ~=? (7::Int),
      countWays (4::Int) ~=? (length $ listWays 4),
      countWays (10::Int) ~=? countWays2 (10::Int),
      countWays (20::Int) ~=? countWays2 (20::Int),
      countWays2 (10::Int) ~=? countWays3 (10::Int),
      countWays2 (20::Int) ~=? countWays3 (20::Int),
      (qsort $ listWays 3) ~=? (qsort [[1,1,1],[1,2],[2,1],[3]]),
      (qsort $ listWays 4) ~=? (qsort [[1,1,1,1],[1,1,2],[1,2,1],[1,3],[2,1,1],[2,2],[3,1]]),
      (qsort $ listWays 3) ~=? (qsort $ listWays2 3),
      (qsort $ listWays 10) ~=? (qsort $ listWays2 10),
      (qsort $ listWays 14) ~=? (qsort $ listWays2 14),
      True ~=? True
  ]

-- | ------------------ quickCheck ----------------------
prop_countWays :: Int->Property
prop_countWays n =
      (n > 0 && n < 15) 
      ==> (countWays n) == (length $ listWays n)
      -- あまり大きな数でやると終わらなくなる

prop_countWays2 :: Int->Property
prop_countWays2 n =
      (n > 0 && n < 24) 
      ==> (countWays n) == (countWays2 n)
      -- あまり大きな数でやると終わらなくなる

prop_countWays3 :: Int->Property
prop_countWays3 n =
      (n > 0 && n < 10) 
      ==> (qsort $ (listWays n)) == (qsort $ (listWays2 n))
      -- あまり大きな数でやると終わらなくなる


実行結果
> :main

Cases: 11  Tried: 0  Errors: 0  Failures: 0
Cases: 11  Tried: 1  Errors: 0  Failures: 0
Cases: 11  Tried: 2  Errors: 0  Failures: 0
Cases: 11  Tried: 3  Errors: 0  Failures: 0
Cases: 11  Tried: 4  Errors: 0  Failures: 0
Cases: 11  Tried: 5  Errors: 0  Failures: 0
Cases: 11  Tried: 6  Errors: 0  Failures: 0
Cases: 11  Tried: 7  Errors: 0  Failures: 0
Cases: 11  Tried: 8  Errors: 0  Failures: 0
Cases: 11  Tried: 9  Errors: 0  Failures: 0
Cases: 11  Tried: 10  Errors: 0  Failures: 0
                                            
Cases: 11  Tried: 11  Errors: 0  Failures: 0
1389537
1389537
7
13
[[1,1,1],[1,2],[2,1],[3]]
[[1,1,1,1],[1,1,2],[1,2,1],[1,3],[2,1,1],[2,2],[3,1]]
[[1,1,1,1,1],[1,1,1,2],[1,1,2,1],[1,1,3],[1,2,1,1],[1,2,2],[1,3,1],[2,1,1,1],[2,1,2],[2,2,1],[2,3],[3,1,1],[3,2]]
*** Gave up! Passed only 21 tests.
*** Gave up! Passed only 22 tests.
*** Gave up! Passed only 21 tests.
it :: ()
(1.08 secs, 197873536 bytes)

ghciで、関数を手動で実行してかかった時間を比べてみた。改良版は10倍~100倍速い。
> :reload
Ok, modules loaded: CountWays.

> countWays 27
8646064
it :: Int
(6.24 secs, 828631292 bytes)
> countWays2 27
8646064
it :: Int
(0.00 secs, 524532 bytes)
> countWays3 27
8646064
it :: Int
(0.00 secs, 0 bytes)

> length $ listWays 25
2555757
it :: Int
(7.04 secs, 3161964732 bytes)
> length $ listWays2 25
2555757
it :: Int
(0.66 secs, 378701184 bytes)

しかし、32ビット符号あり整数で計算すると、37段のところでオーバーフローする。
> countWays2 36
2082876103
it :: Int
(0.00 secs, 585128 bytes)
> countWays2 37
-463960867
it :: Int
(0.00 secs, 0 bytes)
プロフィール

島敏博

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リンクの表示