1. bra_cat_ket

    Posted

    bra_cat_ket
Changes in title
+99 Haskell Problems より、[1..10]
Changes in tags
Changes in body
Source | HTML | Preview

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

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

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

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

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

Have to use the place holder:
myLast (_:xs) = myLast xs

A interesting implementation from the solutions.
curry :: ((a, b) -> c) -> a -> b -> c
curry snd :: a -> c -> c
foldl1 :: (a -> a -> a) -> [a] -> a

> myLast' = foldl1 $ curry snd

This continues taking the binary-second element due to foldl1.

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

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

prob02.lhs
Find the last but one element of a list.

Pattern match

> myButLast :: [a] -> a
> myButLast [] = error "empty!"
> myButLast [x] = error "singleton"
> myButLast [x,y] = x
> myButLast (x:xs) = myButLast xs

Have to use the place holder, again!
myButLast [x,_] = x
myButLast (_:xs) = myButLast xs

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

> myButLast' = head . tail . reverse

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

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

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)

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)

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

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 = 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 = fst . last . zip [1..] 

リストを逆順にせよ。

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

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

prob05.lhs
Reverse a list.

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

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

reverse = foldl (flip (:)) []

Using accumulator,

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

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

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

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

> -- isPalindrome :: [a] -> Bool
> isPalindrome :: Eq a => [a] -> Bool
> isPalindrome lst = (myReverse lst == lst)
> 
> myReverse :: [a] -> [a]
> myReverse [] = []
> myReverse (x:xs) = (myReverse xs) ++ [x] 

myReverse is from prob05.lhs

Here's one that does half as many compares:

> 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

ネストされたリストを解け。

flatten の訳語がいまいちわからなかった。
注にも書いてあったけど、Haskellのリストは同じ型のみ許されるので新しいデータ型を用意する必要がある。
さっぱりわからなかったので解答をコピペ。
再起でネストを1つずつ解いていくアルゴリズムなので自然に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.
(++) :: [a] -> [a] -> [a]

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

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))

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

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

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

前問の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.

> encode :: Eq a => [a] -> [(Int, a)]
> encode lst = map encode' (pack lst)
>   where encode' (x:xs) = (length (x:xs), 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