すごいHaskell読書会 in 大阪 第２回 練習問題 答案 @akanehara

gistfile1.hs

-- すごいHaskell読書会 in 大阪 第２回
-- 練習問題 答案 @akanehara

import Data.Char

-- 演習1
-- 与えられた文字列を大文字に変換する関数を書きなさい。
upperCase :: String -> String
upperCase [] = []
upperCase (c : cs) = toUpper' c : upperCase cs
  where
    toUpper' n =
      case lookup n table of
        Just c  -> c
        Nothing -> n
    table = zip ['a'..'z'] ['A'..'Z']

-- 与えられた文字列から空白を除去する関数を書きなさい。
removeSpace :: String -> String
removeSpace [] = []
removeSpace (' ' : cs) =     removeSpace cs
removeSpace (c   : cs) = c : removeSpace cs

-- 演習2
-- リスト lst1 が lst2 を含んでいるかどうかを判定する関数を書け。
-- | @akanehara
-- | tailに対するstartWithテストを再帰的に
cover :: Eq a => [a] -> [a] -> Bool
cover [] ys = False
cover xs@(x:xr) ys =
  if xs `startWith` ys
    then True
    else cover xr ys
  where
    startWith :: Eq a => [a] -> [a] -> Bool
    startWith xs [] = True
    startWith (x:xs) (y:ys) =
      if x == y
        then True && startWith xs ys
        else False

-- 演習3
-- 配列から重複する要素を削除する関数を書け。
-- | @akanehara
-- | 演習2と同じような考えかたで、
-- | tailからheadと同じ要素を取りのぞく操作を再帰的に
uniq :: Eq a => [a] -> [a]
uniq [] = []
uniq (x:xs) = x : uniq (remove x xs)
  where
    remove :: Eq a => a -> [a] -> [a]
    remove _ [] = []
    remove x (y:ys) =
      if x == y
        then remove x ys
        else y : remove x ys

-- 演習4
-- 与えられた正数から二進表記の文字列を得る関数を書け。
binExp :: Integer -> String
binExp n = map (intToDigit . fromInteger) $ reverse $ go n
  where
    go 0 = []
    go n = n `mod` 2 : go (n `div` 2)
-- | @akanehara
-- | 末尾再帰で書いてみた
binExp' :: Integer -> String
binExp' n = map (intToDigit . fromInteger) $ go n []
  where
    go 0 cs = cs
    go n cs = go (n `div` 2) (n `mod` 2 : cs)
    -- | @akanehara
    -- | cs で持ち回られるのはたぶん未評価の計算なので、
    -- | この場合は末尾再帰化しても最大使用メモリは
    -- | 小さくならない？教えてえらいひと

-- 演習5
-- ハノイの塔
-- 三つのポール 1 2 3 のうち、ポール1にn個の円盤が
-- 乗っているとし、すべての円盤をポール2に移動する
-- 手順を返す関数を書け。
-- TODO: あとで解く

-- 演習6
-- 第n番目のフィボナッチ数を得る関数を書け。
-- ただし1番目と2番目のフィボナッチ数は1とする。
fib :: Integer -> Integer
fib n = go n 0 1
  where
    go 0 a b = b
    go n a b = go (n - 1) b (a + b)
-- | @akanehara
-- | ちょっとやってみたくなったので無限リスト版
fibs :: [Integer]
fibs = go 0 1
  where
    go a b = b : go b (a + b)

-- 演習7
-- n個の数から重複せずにk個の数を取り出す場合の
-- 数を求める関数を書け。いわゆる nCk。
-- | @akanehara
-- | 悪い例で利用されている公式
-- |   C k = C (n-1) (k-1) + C (n-1) k
-- | の末尾再帰化を考えたけど、自分にはわかりませんでした…
-- | なので別の公式
-- |   C n k = n! / k! * (n - k)!
-- | を使って、せめてfactを末尾再帰で…
combi :: Integer -> Integer -> Integer
combi n k = fact n `div` (fact k * fact (n - k))
-- 階乗
fact :: Integral a => a -> a
fact n = go n 1
  where
    go 0 x = x
    go n x = go (n - 1) (n * x)