【解答例】Haskell 超入門

Haskell 超入門の解答例です。

フィボナッチ数

パターンマッチ

【問1】任意のn番目のフィボナッチ数を計算する関数fibをパターンマッチで実装してください。

初期値0, 1を基底部とします。

基底部

fib 0 = 0
fib 1 = 1

0, 1, 1, 2, 3, 5, ...よりfib 5について考えます。

具体例

fib 5 = 2 + 3 = fib 3 + fib 4

これをnで一般化すれば再帰部となります。

再帰部

fib n = fib (n - 2) + fib (n - 1)

テストを追加して解答とします。

解答

fib 0 = 0
fib 1 = 1
fib n = fib (n - 2) + fib (n - 1)

main = do
    print $ fib 6

実行結果

8

ガード

【問2】問1で実装した関数をガードで書き直してください。

fib n
    | n == 0    = 0
    | n == 1    = 1
    | otherwise = fib (n - 2) + fib (n - 1)

main = do
    print $ fib 6

実行結果

8

case - of

【問3】問1で実装した関数をcase-ofで書き直してください。無限ループを防ぐためガードを追加してください。

fib n = case n of
    0 -> 0
    1 -> 1
    _ | n > 1 -> fib (n - 2) + fib (n - 1)

main = do
    print $ fib 6

実行結果

8

再実装

【問4】sum, product, take, drop, reverseと同じ機能の関数を再実装してください。関数名には'を付けてください。

sum' []     = 0
sum' (x:xs) = x + sum' xs

product' []     = 1
product' (x:xs) = x * product' xs

take' _ []        = []
take' n _ | n < 1 = []
take' n (x:xs)    = x : take' (n - 1) xs

drop' _ []         = []
drop' n xs | n < 1 = xs
drop' n (_:xs)     = drop' (n - 1) xs

reverse' []     = []
reverse' (x:xs) = reverse' xs ++ [x]

main = do
    print $ sum' [1..5]
    print $ product' [1..5]
    print $ take' 2 [1, 2, 3]
    print $ drop' 2 [1, 2, 3]
    print $ reverse' [1..5]

実行結果

15
120
[1,2]
[3]
[5,4,3,2,1]

• リストが空になるまで順番にたどるため、基底部として[]を定義します。

別解

※ 勉強会で出た意見を反映した項目です。

++を避けた実装です。本文では説明していませんが末尾再帰です。

reverse' xs = f xs []
    where
        f []     ys = ys
        f (x:xs) ys = f xs (x:ys)

階乗

【問5】productを使ってfact（階乗）を実装してください。

fact n = product [1..n]

main = do
    print $ fact 5

実行結果

120

垂線の交点

【問6】点 $(p, q)$ から直線 $ax + by = c$ に下した垂線の交点を求める関数perpPointを作成してください。aとbが両方ゼロになると解なしですが、チェックせずに無視してください。

ax + by = c \cdots (1)

(1)への垂線は

bx - ay = d \cdots (2)

(2)に $(p,q)$ を代入します。

d = bp - aq \cdots (3)

(1)と(2)の連立方程式を解いて(3)を代入すれば交点が求まります。

x=\frac{ac+bd}{a^2+b^2}, y=\frac{bc-ad}{a^2+b^2}

これをコード化します。

解答

perpPoint (p, q) (a, b, c) = (x, y)
    where
        x = (a * c + b * d) / (a * a + b * b)
        y = (b * c - a * d) / (a * a + b * b)
        d = b * p - a * q

main = do
    print $ perpPoint (0, 2) (1, -1, 0)

実行結果

(1.0,1.0)

ROT13

【問7】ROT13を実装してください。

import Data.Char

rot13ch ch
    |  'A' <= ch && ch <= 'M'
    || 'a' <= ch && ch <= 'm' = chr $ ord ch + 13
    |  'N' <= ch && ch <= 'Z'
    || 'n' <= ch && ch <= 'z' = chr $ ord ch - 13
    | otherwise = ch

rot13 ""     = ""
rot13 (x:xs) = rot13ch x : rot13 xs

main = do
    let hello13 = rot13 "Hello, World!"
    print hello13
    print $ rot13 hello13

実行結果

"Uryyb, Jbeyq!"
"Hello, World!"

バブルソート

【問8】バブルソートを実装してください。

⇒ 詳細説明

bswap [x] = [x]
bswap (x:xs)
    | x > y     = y:x:ys
    | otherwise = x:y:ys
    where
        (y:ys) = bswap xs

bsort [] = []
bsort xs = y : bsort ys
    where
        (y:ys) = bswap xs

main = do
    print $ bswap [4, 3, 1, 5, 2]
    print $ bsort [4, 3, 1, 5, 2]
    print $ bsort [5, 4, 3, 2, 1]
    print $ bsort [4, 6, 9, 8, 3, 5, 1, 7, 2]

実行結果

[1,4,3,2,5]
[1,2,3,4,5]
[1,2,3,4,5]
[1,2,3,4,5,6,7,8,9]

マージソート

【問9】マージソートを実装してください。

• ソートしながら2つのリストをマージする関数mergeを作ります。
• 往路で分割、復路でマージを再帰関数で表現します。

merge xs [] = xs
merge [] ys = ys
merge (x:xs) (y:ys)
    | x < y     = x : merge xs (y:ys)
    | otherwise = y : merge (x:xs) ys

msort []  = []
msort [x] = [x]
msort xs  = merge (msort (take h xs)) (msort (drop h xs))
    where
        h = (length xs) `div` 2

main = do
    print $ msort [4, 6, 9, 8, 3, 5, 1, 7, 2]

実行結果

[1,2,3,4,5,6,7,8,9]

クイックソート

【問10】処理の流れを説明してください。

リスト[4, 6, 9, 8, 3, 5, 1, 7, 2]をソートします。

(n:xs) = 4 : [6, 9, 8, 3, 5, 1, 7, 2]

リストの最初の要素4を基準に3つの部分に分けます。

qsort (n:xs) = qsort lt ++ [n] ++ qsort gteq
    where
        lt   = [x | x <- xs, x <  n]
        gteq = [x | x <- xs, x >= n]

• 4未満: lt = [x | x <- xs, x < n] → [3, 1, 2]
• 4: [x] → [4]
• 4以上: gteq = [x | x <- xs, x >= n] → [6, 9, 8, 5, 7]

ltとgteqをソートして結合します。

実行イメージ

qsort [3, 1, 2] ++ [4] ++ qsort [6, 9, 8, 5, 7]
          ↓                           ↓
      [1, 2, 3] ++ [4] ++       [5, 6, 7, 8, 9]
          ↓                           ↓
      [1, 2, 3,     4,           5, 6, 7, 8, 9]

qsort [3, 1, 2]とqsort [6, 9, 8, 5, 7]の内部では、同様の処理が繰り返されています。

直角三角形の三辺

【問11】三辺の長さが各20以下の整数で構成される直角三角形を列挙してください。並び順による重複を排除する必要はありません。

複数ソースのリスト内包表記に三平方の定理で条件付けします。

main = do
    print [(a, b, c)
          | a <- [1..20], b <- [1..20], c <- [1..20]
          , a * a + b * b == c * c
          ]

実行結果

[(3,4,5),(4,3,5),(5,12,13),(6,8,10),(8,6,10),(8,15,17),(9,12,15),(12,5,13),(12,9,15),(12,16,20),(15,8,17),(16,12,20)]

重複排除

※ 勉強会で出た意見を反映した項目です。

条件 $a<b$ を追加すれば並び順による重複が排除できます。

main = do
    print [(a, b, c)
          | a <- [1..20], b <- [1..20], c <- [1..20]
          , a * a + b * b == c * c, a < b
          ]

実行結果

[(3,4,5),(5,12,13),(6,8,10),(8,15,17),(9,12,15),(12,16,20)]

条件で制限するのではなく、ソースから抜けば計算量が削減できます。

main = do
    print [(a, b, c)
          | a <- [1..20], b <- [a..20], c <- [b..20]
          , a * a + b * b == c * c
          ]

実行結果

[(3,4,5),(5,12,13),(6,8,10),(8,15,17),(9,12,15),(12,16,20)]