新学期が始まったので温故知新的に再度挑戦、あと少々修正も。

H-99: Ninety-Nine Haskell Problems
から[1..10]

まずは解答を見ないでチャレンジ、そのあと解答を見てみて面白そうな実装があればいろいろ試してみた
解答はこちら

まずは言語の概要をつかめるように、こういう問題集の存在はありがたいと思う。

1. リストの最後の要素を求めよ。

Prelude> myLast [1,2,3,4]
4
Prelude> myLast ['x','y','z']
'z'

last関数を実装したら良い、のでパターンマッチで書き下す。
カリー化されたsnd関数を畳み込むのは面白いと思った。
修正は本質的ではなく、参照しない要素はプレースホルダー(_)を使ったほうが良いということ。

prob01.lhs


Find the last element of a list.

> myLast :: [a] -> a
> myLast [] = error "the input list is empty"
> myLast [x] = x
> myLast (x:xs) = myLast xs
> -- myLast (_:xs) = myLast xs

Use the place holder:

  myLast (_:xs) = myLast xs

An interesting implementation from the solutions:

  curry' :: ((a, b) -> c) -> a -> b -> c
  curry' f x y = f (x, y)

  curry snd :: a -> c -> c

  foldl1 :: (a -> a -> a) -> [a] -> a

> myLast' :: [a] -> a
> -- myLast' = foldl1 $ curry snd
> myLast' = foldl1 (curry snd)

This implementation continuously takes "second" element.
So, this will fail when applied on empty list.
For singleton list, the following behavior is guaranteed by the definition of foldl1:
  
> foldl1' :: (a -> a -> a) -> [a] -> a
> foldl1' f [x]    = x
> foldl1' f (x:xs) = foldl f x xs

So, we get

  myLast' [1] = foldl1 (curry snd) [1]
              = 1

Another interesting implementation is the following:

> myLast'' :: [a] -> a
> myLast'' = foldr1 (const id)

  const :: a -> b -> a
  const id :: b -> a -> a

The same rule holds for singleton list, and for longer list,

  myLast'' [1,2,3] = foldr1 (const id) [1,2,3]
                   = (const id) 1 $ foldr1 (const id) [2,3]
                   = (const id) 1 $ (const id) 2 $ 3
                   = (const id) 1 $ 3
                   = 3

解答のそれとはプライムの数が逆転してしまっているけれど、foldr1 を使った実装も載せてみた。
foldl1 とfoldlr1 のsingleton list における挙動が最初わからなかったけど、よく考えたら頭かおしりの要素をaccumulator として採用するのでそのまま帰るわけですね。

2. リストの最後から２番目の要素を求めよ。

Prelude> myButLast [1,2,3,4]
3
Prelude> myButLast ['a'..'z']
'y'

これも方針はパターンマッチ。
別解は逆順にしたリストの前から２つ目の要素を取り出すという方法。

prob02.lhs

Find the last but one element of a list.

Pattern match

> myButLast :: [a] -> a
> myButLast [x,_]  = x
> myButLast (_:xs) = myButLast xs
> myButLast _      = error "need 2 or more elements"

  *Main> head . tail $ "aiueo"
  'i'

It is always good to use built in functions, but keep in mind that it might fail due to the emptylist.

> myButLast' :: [a] -> a
> myButLast' = head . tail . reverse

基本的には何も変更なし、きちんと(_) で置き直してあとerror が[] と[x] の両方を拾うようにしただけ。

3. リストのK番目の要素を求めよ。

Prelude> elementAt [1,2,3] 2
2
Prelude> elementAt "haskell" 5
'e'

(!!)の実装ということに気がついたら、原点をずらすだけでできるけど。
別解というか例外処理のためにガードで書きなおしただけ。

prob03.lhs

Find the K'th element of a list.
The first element is the list is number 1.

> elementAt :: [a] -> Int -> a
> elementAt (x:_)  1 = x
> elementAt (_:xs) n = elementAt xs (n-1)
> elementAt _      _ = error "Index out of bounds"

Implicitly assumed the number is less than the length of the list!

> elementAt' [] _ = error "Index out of bounds"
> elementAt' (_:xs) n
>   | n <= 0    = error "Index out of bounds"
>   | otherwise = elementAt' xs (n-1)

Using an infix operator !!,

> elementAt'' :: [a] -> Int -> a
> elementAt'' lst n = lst !! (n-1)

Let's take a moment,

  *Main> zip [1..] "haskell"
  [(1,'h'),(2,'a'),(3,'s'),(4,'k'),(5,'e'),(6,'l'),(7,'l')]
  *Main> filter (\(n,c) -> n == 5) it
  [(5,'e')]
  *Main> snd . head $ it
  'e'

> elementAt''' lst n = snd . head $ filter (\(m,_) -> m == n) $ zip [1..] lst

せっかくだから別解を作ろうと思って考えたのが最後の実装、1 から始まるインデックスならzip [1..] が思いついたのでなんとか使えないかなと。
ワンライナーで書くと分かりにくいきもするけど、実験結果の貼り合わせだからまぁ良しとする。

4. リストの要素数を求めよ。

Prelude> myLength [123, 456, 789]
3
Prelude> myLength "Hello, world!"
13

lengthの再実装。
フィボナッチ数列の問題か何かで累算器を使ったのを覚えていたので。
最初のアイディアは単純再起で、途中の計算をサンクに溜めないようにしただけ。
畳み込みを使うのは良いけど、コンパイルでエラーが見つけにくいとどこかで読んだ気がするからか、なんとなくラムダ式で書くのははばかられる気がする。
個人的にzipを使うのはややスマートで良いと思った。

prob04.lhs

Find the number of elements of a list.

> myLength :: [a] -> Int
> myLength lst = myLength' lst 0 
>   where myLength' []     n = n
>         myLength' (_:xs) n = myLength' xs (n+1)

This n is so-called the accumulator.

> myFoldlLength :: [a] -> Int
> myFoldlLength = foldl (\n _ -> n+1) 0

  *Main> zip [1..] "aiueo"
  [(1,'a'),(2,'i'),(3,'u'),(4,'e'),(5,'o')]
  *Main> fst . last $ it
  5

> myZipLength :: [b] -> Int
> myZipLength = fst . last . zip [1..] 

> my1Length :: [a] -> Int
> my1Length = sum . map (\_ -> 1)

この辺でfold を使った実装に型注釈が無いとghci が文句言うのに気がついてきた、なんとなくリストのみ考えているからいけないわけでFoldable のリストインスタンスのみに限って実装してるのを意識しないといけない。

5. リストを逆順にせよ。

Prelude> myReverse "A man, a plan, a canal, panama!"
"!amanap ,lanac a ,nalp a ,nam A"
Prelude> myReverse [1,2,3,4]
[4,3,2,1]

reverseの再実装。
一文字ずつ後ろにするので再起で。
コメントにもあるけど、効率は良くないらしい。

効率はわからないけど、Preludeにおける実装は見事。
要はcons(:)の引数をひっくり返して空リストに先頭から畳み込みながら入れなおすと逆順になるというアイディア。

prob05.lhs

Reverse a list.

> myReverse :: [a] -> [a]
> myReverse [] = []
> myReverse (x:xs) = (myReverse xs) ++ [x] 

This definition is more waseful than the standard definition in Prelude.
The standard definition, found in the prelude, is concise but not very readble:

reverse = foldl (flip (:)) []

Using accumulator, we can dramatically reduce the order from O(n^2) to O(n)!

> myReverse' :: [a] -> [a]
> myReverse' lst = myReverse' lst []
>   where myReverse' []     tsl = tsl
>         myReverse' (x:xs) tsl = myReverse' xs (x:tsl)

This is so-called Bustall-Darlington transformation, see 4.1.5 of Algorithms: A Functional Programming Approach (Fethi Rabhi, Guy Lapalme).

上では効率は分からないと書いたが、ラフな見積もりでもO(n^2) からO(n) となる、ここの4.1.5該当部分に書いてあるので興味ある方はどうぞ。

6. リストが回分かどうか判定せよ。

*Main> isPalindrome [1,2,3]
False
*Main> isPalindrome "madamimadam"
True
*Main> isPalindrome [1,2,4,8,16,8,4,2,1]
True

単純にはひっくり返したリストと元のリストが同じか判定させる。

余談だが、このときのリストの同値判定は要素の同値判定からの演算子のオーバーロードというやつらしい、リストの外延性公理というやつだろうか。
別解のアルゴリズムはとても賢く感じる、ようはリストの前半分と後ろ半分を比較したら十分というわけで、reverseをリストの半分分だけしか使わない。
pの最初の引数はリストが逆順に積まれていって、２つ目の引数はリストの後ろの方だけが残っていく。
最後の引数は二個ずつ減っていって、最終的にはリストの要素の偶奇判定に、再起の終了条件に使っている。

prob06.lhs

Find out whether a list is a palindrome.
A palindrome can be read forward or backward; e.d. (xamax).

> isPalindrome :: Eq a => [a] -> Bool
> -- isPalindrome lst = (myReverse lst == lst)
> isPalindrome lst = (myReverse' lst == lst)
> 
> myReverse' :: [a] -> [a]
> myReverse' xs = helper xs []
>   where helper []     y = y
>         helper (x:xs) y = helper xs (x : y)

myReverse is from prob05.lhs

A nicer implementation is the following, it only flips the half:

> isPalindrome' xs = p [] xs xs
>   where p rev (x:xs) (_:_:ys) = p (x:rev) xs ys
>         p rev (x:xs) [_]      = rev == xs
>         p rev xs     []       = rev == xs

  rotor
  p [] rotor rotor
  p r otor tor
  p or tor r
  ==> r==r = True

  boneanob
  p [] boneanob boneanob
  p b oneanob neanob
  p ob neanob anob
  p nob eanob ob
  p enob anob []
  ==> enob /= anob = False

修正というかO(n) のreverse に取り替えただけ。

7. ネストされたリストを解(ほど）け。

 data NestedList a = Elem a | List [NestedList a]
*Main> flatten (Elem 5)
[5]
*Main> flatten (List [Elem 1, List [Elem 2, List [Elem 3, Elem 4], Elem 5]])
[1,2,3,4,5]
*Main> flatten (List [])
[]

flatten の訳語がいまいちわからなかった。
注にも書いてあったけど、Haskellのリストは同じ型のみ許されるので新しいデータ型を用意する必要がある。
さっぱりわからなかったので解答をコピペ。
再起でネストを１つずつ解いていくアルゴリズムなので自然にfoldでも書ける、らしい。

prob07.lhs


Flatten a nested list structure.

We have to define a new data type, because lists in Haskell are homogeneous.

> data NestedList a = Elem a 
>                   | List [NestedList a]
> 
> myFlatten :: NestedList a -> [a]
> myFlatten (List [])     = []
> myFlatten (Elem x)      = [x]
> myFlatten (List (x:xs)) = myFlatten x ++ myFlatten (List xs)
> -- myFlatten (List [])     = []

Just a copy and paste of the solutions.

Simple implementation using 
  concatMap :: Foldable t => (a -> [b]) -> t a -> [b] 
is the following: 

> myFlatten' :: NestedList a -> [a]
> myFlatten' (Elem x) = [x]
> myFlatten' (List x) = concatMap myFlatten' x

If you know the Monad,

> myFlatten'' :: NestedList a -> [a]
> myFlatten'' (Elem x) = return x
> -- myFlatten'' (List x) = myFlatten'' =<< x
> myFlatten'' (List x) = x >>= myFlatten''

  flatten3 :: NestedList a -> [a]
  flatten3 (Elem x ) = [x]
  flatten3 (List xs) =  foldr (++) [] $ map flatten3 xs

モナドを使った実装はややトリッキーである、というのも明示的にNestedList がモナドのインスタンスかどうかは書いてないのであるが、実際中身はHaskell のリストなので、というところだろうか。

8. リストのうち連続して同じものがあれば一つを残してそれ以外を取り除け。

> compress "aaaabccaadeeee"
"abcade"

dropWhileを思いつかなかった。
リストに関する備え付けの関数は一度は触る価値がありそう、と思いこのへんからMiran Lipovacaを読み出す。
アルゴリズムはすなわち、かぶりがあれば先頭だけ残して残りを落としたリストにcons(:)でくっつけていく再起。
したがってfoldrでも書ける、と思う。

prob08.lhs

Eliminate consecutive duplicates of list elements.
If a list contains repeated elements they should be replaced with a single copy of the element. 
The order of the elements should not be changed.

> compress :: Eq a => [a] -> [a]
> compress [] = []
> compress (x:xs) = x : (compress (dropWhile (== x) xs))

This is also copy and paste.
It's nice to use dropWhile

  dropWhile :: (a -> Bool) -> [a] -> [a]
  dropWhile _ [] = []
  dropWhile p xs@(x:xs')
    | p x        = dropWhile p xs'
    | otherwise  = xs

 compress' [] = []
 compress' [x] = [x]
 compress' (x:y:ys) 
  | x == y    = x : (compress' ys)
  | otherwise = x : (compress' (y:ys)) 

This does not work correctly, but I can fix it:

> compress'' :: Eq a => [a] -> [a]
> compress'' [] = []
> compress'' [x] = [x]
> compress'' (x:y:ys)
>   | x == y    = compress'' (y:ys)
>   | otherwise = x : (compress'' (y:ys))

リストを使った集合の実装の際に使えそうな下処理である、すなわち外延性公理から集合の要素のダブリは集合同士の等号には効かないので、ダブリがないものを選べる、という話である。
これまた再度読みなおしただけ。

9. リスト内に連続した重複あればサブリストにまとめよ。

*Main> pack ['a', 'a', 'a', 'a', 'b', 'c', 'c', 'a', 
             'a', 'd', 'e', 'e', 'e', 'e']
["aaaa","b","cc","aa","d","eeee"]

dropWhileを使ったのでtakeWhileも使いましょうという感じだろうか？
結果的に模範解答そっくりになった。
dropWhileは(==x)の判定が擬になった時点で止まるので、連続していなければ落とされずに済む。

prob09.lhs

Pack consecutive duplicates of list elements into sublists.
If a list contains repeated elements they should be placed in separate sublists.

> pack :: Eq a => [a] -> [[a]]
> pack [] = []
> pack (x:xs) = (x:front) : pack rear
>   where front = takeWhile (== x) xs
>         rear  = dropWhile (== x) xs   

Slightly modifed version of the solution.

  takeWhile :: (a -> Bool) -> [a] -> [a]
  takeWhile _ [] =  []
  takeWhile p (x:xs)
    | p x        = x : takeWhile p xs
    | otherwise  = []

  dropWhile :: (a -> Bool) -> [a] -> [a]
  dropWhile _ [] =  []
  dropWhile p xs@(x:xs')
    | p x        = dropWhile p xs'
    | otherwise  = xs

これもまた特にネタなし、解答例にも面白いの無いなぁ。。。

10. リスト内の重複とその数を数えよ。

encode "aaaabccaadeeee"
[(4,'a'),(1,'b'),(2,'c'),(2,'a'),(1,'d'),(4,'e')]

前問のpackで前処理したリストに要求された返り値を持つ関数をmapするだけ。
やはり高階関数のmapは便利である。

prob10.lhs

Run-length encoding of a list.
Use the result of prob09.lhs to implement the so-called run-length encoding data compression method.
Consecutive duplicates of elements are encoded as lists (N, E) where N is the number of duplicates of the element E.

> import Data.List (group)

> encode :: Eq a => [a] -> [(Int, a)]
> encode lst = map encode' (pack lst)
>   where encode' xx@(x:xs) = (length xx, x)
>
> pack :: Eq a => [a] -> [[a]]
> pack [] = []
> pack (x:xs) = (x:front) : pack rear
>   where front = takeWhile (== x) xs
>         rear  = dropWhile (== x) xs

pack is in prob09.lhs

Or writing it pointfreestyle (Note that the type signature is essential here to avoid hitting the Monomorphism Restriction):

  *Main Data.List> group "aaaabccaadeeee"
  ["aaaa","b","cc","aa","d","eeee"]
  *Main Data.List> map (\x -> (length x, head x)) it
  [(4,'a'),(1,'b'),(2,'c'),(2,'a'),(1,'d'),(4,'e')]

> pointfreeEncode :: Eq a => [a] -> [(Int, a)]
> pointfreeEncode = map (\x -> (length x, head x)) . group

Data.List のgroup を知っていると簡単な実装が出来ますね、注意書きの Monomorphism Restriction の件が分からないところですが。