前回から間は空いてしまいましたが
H-99: Ninety-Nine Haskell Problems
からお次は[11..20]
まずは解答を見ないでチャレンジ、そのあと解答を見てみて面白そうな実装があればいろいろ試してみた
解答はこちら
11. 前問の改変、もし元がひとつのリストなら（重複がなければ）そのまま返して、２つ以上の重複なら前問と同じかたちでタプルで返せ。
P11> encodeModified "aaaabccaadeeee"
[Multiple 4 'a',Single 'b',Multiple 2 'c',
Multiple 2 'a',Single 'd',Multiple 4 'e']
日本語訳がしんどくなってきた、、、
例によって新しく型を宣言しなくてはいけません。
結果的には解答例とほとんど同じ実装になりました。
面白かったのはリスト内包記法でも書けちゃうところですね、あとはお馴染みのif then else で場合分けしてからそれぞれSingle とMultiple でラップしたら良い、とお手軽です。
prob11.lhs
Modefied run-length encoding.
Modify the result of prob10.lhs in such a way that if an element has no duplicates it is simply copied into the result list.
Only elements with duplicates are transferred as (N, E) lists.
To represent such the list as a Haskel (homogeneous) list, we have to make a new data structure:
> import Data.List (group)
> data ListItem a = Multiple Int a
> | Single a
> deriving (Show)
The following is basically the same as in prob10.lhs:
> 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
>
> listItemizer :: (Int, a) -> ListItem a
> listItemizer (1, x) = Single x
> listItemizer (n, x) = Multiple n x
>
> modefiedEncode :: Eq a => [a] -> [ListItem a]
> modefiedEncode lst = map listItemizer (encode lst)
Essentially the same way in the solution
data ListeItem a = Single a | Multiple Int a
deriving (Show)
encodeModefied :: Eq a => [a] -> [ListItem a]
encodeModefied = map encodeHelper . encode
where encodeHelper (1,x) = Single x
encodeHelper (n,x) = Multiple n x
The ListItem definition contains 'deriving (Show)' so that we can get interactive output.
This problem could also be solved using a list comprehension:
> modifiedEncode xs =
> [y | x <- group xs,
> let y = if (length x) == 1
> then Single (head x)
> else Multiple (length x) (head x)
> ]
12. prob11.lhs でrun-length 化されたリストを元に戻せ。
P12> decodeModified
[Multiple 4 'a',Single 'b',Multiple 2 'c',
Multiple 2 'a',Single 'd',Multiple 4 'e']
"aaaabccaadeeee"
お約束のもとに戻せというやつですね、いくつか中間表現用の小さい関数で実験してからfoldl1 でエイヤッと組み込んでしまいました。
解答例にまたもやconcatMap を使う例が乗っていたので挑戦してみました。
prob12.lhs
Decode a run-length encoded list.
Given a run-length code list generated as specified in prob11.lhs.
Construct its uncompressed version.
> data ListItem a = Multiple Int a
> | Single a
> deriving (Show)
> toTuple :: ListItem a -> (Int, a)
> toTuple (Single a) = (1, a)
> toTuple (Multiple n a) = (n, a)
> toList :: (Int, a) -> [a]
> toList (1,a) = [a]
> toList (n,a) = take n (cycle [a])
> decodeModified :: [ListItem a] -> [a]
> decodeModified lst = foldl1 (++) $ map (toList . toTuple) lst
Another solution can be implemented by using concatMap:
> decodeConcatMap' :: [(Int, a)] -> [a]
> decodeConcatMap' = concatMap (uncurry replicate)
*Main> decodeConcatMap' [(1,'h'),(1,'a'),(1,'s'),(1,'k'),(1,'e'),(2,'l')]
"haskell"
*Main> decodeConcatMap' $ map toTuple [Multiple 4 'a',Single 'b',Multiple 2 'c',Multiple 2 'a',Single 'd',Multiple 4 'e']
"aaaabccaadeeee"
> decodeConcatMap :: [ListItem a] -> [a]
> decodeConcatMap = decodeConcatMap' . map toTuple
11. 12. とQuickCheck
本当は証明したいわけですが、現実的にまずはQuickCheck を使ってみたかったので練習がてら。
QuickCheck の使い方はまずここを見てみました。
とりあえず大文字で始めて、モジュールとして宣言、最初の挑戦で空リストでコケたのでカッコ悪いけどdecodeModified のfoldl1 にヒットする前に空リストは空リストを返すように一行追加。
ここでさらにコード挿入の時に```lang:Prob11.lhs と書いてシンタックスハイライトされないなぁと思っていたのがとてもアホだと気がついて悲しい気持ちになりました。
prop_E_D も試したかったのですが、Arbitrary のインスタンスとして改めて宣言しなくてはいけないらしく(?)よくわからなかったのでコメントアウト。
Prob11.lhs
> module Prob11 where
Modefied run-length encoding.
Modify the result of prob10.lhs in such a way that if an element has no duplicates it is simply copied into the result list.
Only elements with duplicates are transferred as (N, E) lists.
To represent such the list as a Haskel (homogeneous) list, we have to make a new data structure:
> import Data.List (group)
> data ListItem a = Multiple Int a
> | Single a
> deriving (Show)
The following is basically the same as in prob10.lhs:
> 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
>
> listItemizer :: (Int, a) -> ListItem a
> listItemizer (1, x) = Single x
> listItemizer (n, x) = Multiple n x
>
> modefiedEncode :: Eq a => [a] -> [ListItem a]
> modefiedEncode lst = map listItemizer (encode lst)
Essentially the same way in the solution
data ListeItem a = Single a | Multiple Int a
deriving (Show)
encodeModefied :: Eq a => [a] -> [ListItem a]
encodeModefied = map encodeHelper . encode
where encodeHelper (1,x) = Single x
encodeHelper (n,x) = Multiple n x
The ListItem definition contains 'deriving (Show)' so that we can get interactive output.
This problem could also be solved using a list comprehension:
> modifiedEncode xs =
> [y | x <- group xs,
> let y = if (length x) == 1
> then Single (head x)
> else Multiple (length x) (head x)
> ]
Prob12.lhs
> module Prob12 where
> import Prob11
> import Test.QuickCheck
Decode a run-length encoded list.
Given a run-length code list generated as specified in prob11.lhs.
Construct its uncompressed version.
> -- data ListItem a = Multiple Int a
> -- | Single a
> -- deriving (Show)
> toTuple :: ListItem a -> (Int, a)
> toTuple (Single a) = (1, a)
> toTuple (Multiple n a) = (n, a)
> toList :: (Int, a) -> [a]
> toList (1,a) = [a]
> toList (n,a) = take n (cycle [a])
> decodeModified :: [ListItem a] -> [a]
> decodeModified [] = []
> decodeModified lst = foldl1 (++) $ map (toList . toTuple) lst
Another solution can be implemented by using concatMap:
> decodeConcatMap' :: [(Int, a)] -> [a]
> decodeConcatMap' = concatMap (uncurry replicate)
*Main> decodeConcatMap' [(1,'h'),(1,'a'),(1,'s'),(1,'k'),(1,'e'),(2,'l')]
"haskell"
*Main> decodeConcatMap' $ map toTuple [Multiple 4 'a',Single 'b',Multiple 2 'c',Multiple 2 'a',Single 'd',Multiple 4 'e']
"aaaabccaadeeee"
> decodeConcatMap :: [ListItem a] -> [a]
> decodeConcatMap = decodeConcatMap' . map toTuple
Let's check the selfconsistency of decode's.
> prop_D_E xs = (xs == decodeModified (modifiedEncode xs))
> -- prop_E_D xs = (xs == modifiedEncode (decodeModified xs))
*Prob12> quickCheck prop_D_E
+++ OK, passed 100 tests.
13. run-length 変換を直接行え、ここでいう直接とはprob09 のようなダブリのサブリストを作らないで直接リストの長さを数えよ、という意味である。
P13> encodeDirect "aaaabccaadeeee"
[Multiple 4 'a',Single 'b',Multiple 2 'c',
Multiple 2 'a',Single 'd',Multiple 4 'e']
有無、日本語訳が稚拙である。
よくわからんかったので写経した、しかし初期値としてシングルトンを想定しておいてそれを[(Int,a)]型のリストにするのは直接というには、、、という気がする。
それはさておき、初期値が右端で決まるので自然とfoldr で畳み込んだら良いので素直な実装だと思う。
最後っ屁のfunction を使って実装を試みたのだが、挫折。
Prob13.lhs
> module Prob13 where
Run-length encoding of a list (direct solution).
Implement the so-called run-length encoding data compression method directly.
I.e. don't explicitly create tha sublists containing the duplicates, as in prob09.lhs, but only count them.
As in prob11.lhs, simplify the result list by replacing the singleton lists (1, X) by X.
> import Prob11 (ListItem(..))
> encode' :: Eq a => [a] -> [(Int,a)]
> encode' = foldr helper []
> where
> helper x [] = [(1,x)]
> helper x (y@(a,b):ys)
> | x == b = (1+a,x) : ys
> | otherwise = (1,x):y : ys
> encodeDirect :: Eq a => [a] -> [ListItem a]
> encodeDirect = map encodeHelper . encode'
> where
> encodeHelper (1,x) = Single x
> encodeHelper (n,x) = Multiple n x
> encodeDirect' :: Eq a => [a] -> [ListItem a]
> encodeDirect' [] = []
> encodeDirect' (x:xs)
> | count == 1 = (Single x) : encodeDirect' xs
> | otherwise = (Multiple count x) : encodeDirect' rest
> where
> count = 1 + (length matched)
> (matched, rest) = span (== x) xs
> function :: Eq a => [a] -> ([a],[a])
> function = \x -> span (== head x) x
*Prob13> function "haskell"
("h","askell")
14. リストの要素を２つずつにせよ。
> dupli [1, 2, 3]
[1,1,2,2,3,3]
模範解答の後半はおそろしいリストになっている、、、
単純な実装で(++) を使うか(:) を使うか、くらいでしょうか？
リストもなども美しいですね、個人的にはリスト内包表記で書けないかな？と思ったので色々試した結果が最後の。
[1,2] が明示的すぎて少々不格好ですが、ちょっとお気に入り。
Prob14.lhs
> module Prob14 where
Duplicate the elements of a list.
> dupli :: [a] -> [a]
> dupli [] = []
> dupli (x:xs) = [x,x] ++ (dupli xs)
> dupli' :: [a] -> [a]
> dupli' [] = []
> dupli' (x:xs) = x:x:dupli' xs
Or using the list monado:
> dupli'' :: [a] -> [a]
> dupli'' xs = xs >>= (\x -> [x,x])
> dupli''' :: [a] -> [a]
> dupli''' lst = [x| x<- lst, _ <- [1,2]]
15. リストの要素をn 個ずつにせよ。
> repli "abc" 3
"aaabbbccc"
まさか先ほどのリスト内包表記が一番一般化しやすいとは、、、
一個目の実装は以前に解いた時にコピペしたものです。
遅延評価を上手く使ってシングルトンをさばくのを畳み込んでいってるわけですね。
Prob15.lhs
> module Prob15 where
Replicate the elements of a list a given number of times.
> repli :: [a] -> Int -> [a]
> repli [] _ = []
> repli [x] n = take n (cycle [x])
> repli (x:xs) n = (repli [x] n) ++ (repli xs n)
repli xs n = concatMap (replicate n) xs
or, using the list monad:
repli xs n = xs >>= replicate n
Another implementation using list comprehension which is similar to Prob14:
> repli' :: [a] -> Int -> [a]
> repli' lst n = [x | x <- lst, _ <- [1..n]]
16. N 個ごとの要素をリストから削れ。
*Main> dropEvery "abcdefghik" 3
"abdeghk"
最初勘違いしてて例が理解できなかったが、要はエラトステネスのふるいと一緒ですね。
ちまちま実験して小さい関数群を作ってあとはワンライナー、というのは作る側からすれば良いけど後から見るとわけわかめになりやすいですね。
想像以上に模範解答に似ていたので、あとは組み込み関数を使って手直し。
やはりリスト内包表記のはわかりやすい上に、(|) の右側でこんな条件も書けるのねというのが驚き。
Prob16.lhs
> module Prob16 where
Drop every N'th element from a list.
> generator :: Int -> [Int]
> generator n = concat $ repeat [1..n]
*Prob16> zip (generator 3) "abcdefghik"
[(1,'a'),(2,'b'),(3,'c'),(1,'d'),(2,'e'),(3,'f'),(1,'g'),(2,'h'),(3,'i'),(1,'k')]
> isNotNth :: Int -> (Int,a) -> Bool
> isNotNth n (m,_) = not (n == m)
*Prob16> zip (generator 3) "abcdefghik"
[(1,'a'),(2,'b'),(3,'c'),(1,'d'),(2,'e'),(3,'f'),(1,'g'),(2,'h'),(3,'i'),(1,'k')]
*Prob16> filter (isNotNth 3) it
[(1,'a'),(2,'b'),(1,'d'),(2,'e'),(1,'g'),(2,'h'),(1,'k')]
*Prob16> map snd it
"abdeghk"
*Prob16> map snd $ filter (isN
isNaN isNegativeZero isNotNth
*Prob16> map snd $ filter (isNotNth 3) $ zip (generator 3) "abcdefghijk"
"abdeghjk"
> dropEvery :: [a] -> Int -> [a]
> dropEvery lst n = map snd $ filter (isNotNth n) $ zip (generator n) lst
In my implementation,
generator n
is the same as the follwing Prelude function:
cycle [1..n]
In addition
isNotNth n
can be written as
(n /=) . fst
and then we have the following:
> dropEvery' :: [a] -> Int -> [a]
> -- dropEvery' lst n = map snd $ filter (\x -> n /= fst x) $ zip (cycle [1..n]) lst
> dropEvery' lst n = map snd $ filter ((n /=) . fst) $ zip (cycle [1..n]) lst
Using zip and list comprehensions
> dropEvery'' :: [a] -> Int -> [a]
> dropEvery'' xs n = [i| (c,i) <- (zip [1..] xs), (c `mod` n) /= 0]
17. リストを２つに分けよ。
*Main> split "abcdefghik" 3
("abc", "defghik")
最初のは型を間違ったのです、、、
素朴に実装すると(++) を使うことになって効率悪そうと思って模範解答見たらやはり(:) を使った綺麗なのがアリました。
（(++) を左結合で再帰的に呼ぶと、というのは前の投稿でやったやつですね）
これもおそらくBurstall-Darlington transformation ここ に対応してるのでしょうが、どうでしょう？
Prob17.lhs
> module Prob17 where
Split a list into two parts; the length of the first part is given.
Do not use any predefined predicates.
> split :: [a] -> Int -> [[a]]
> split xs 0 = [xs]
> split [] _ = error "OVER"
> split xs n = (take n xs) : (drop n xs) : []
More simply, to tuple:
> split2tuple :: [a] -> Int -> ([a], [a])
> split2tuple xs n = (take n xs, drop n xs)
But these are using predefined predicates.
> split' :: [a] -> Int -> ([a],[a])
> split' lst 0 = ([], lst)
> split' [] _ = ([], [])
> split' lst@(x:xs) n = helper ([], lst) n
> where
> helper (first, second) 0 = (first, second)
> helper (first, (y:ys)) n = helper (first ++ [y], ys) (n-1)
Without using (++),
> split'' :: [a] -> Int -> ([a], [a])
> split'' [] _ = ([], [])
> split'' l@(x:xs) n
> | n > 0 = (x : ys, zs)
> | otherwise = ([], l)
> where
> (ys,zs) = split'' xs (n-1)
*Prob17> split' [1..1000] 500
(0.03 secs, 13,054,408 bytes)
*Prob17> split'' [1..1000] 500
(0.03 secs, 6,765,496 bytes)
A recursive solution constructing the 2-tuple:
> split''' :: [a] -> Int -> ([a], [a])
> split''' [] _ = ([], [])
> split''' (x:xs) n
> | n > 0 = (x : (fst (split''' xs (n-1)))
> ,snd (split''' xs (n-1))
> )
> | otherwise = (fst (split''' xs 0)
> ,x : (snd (split''' xs 0))
> )
This is also efficient.
18. リストを前と後ろで切りましょう。
*Main> slice ['a','b','c','d','e','f','g','h','i','k'] 3 7
"cdefg"
リスト内包表記がやはりいいと思うのだけど、プライムの数が奇数のやつがコスト高めみたい。
プライム二個みたいに先にガードで条件で先に行ってもらえるようにしたら効率よくなりました。
Maybe でラップする解答例も合ったけど、そもそもNothing のケースは空リストを返したら十分な気がしたので割愛。
Prob18.lhs
> module Prob18 where
Extract a slice from a list.
Given two indices, i and k, the slice is the list containing the elements between the i'th and k'th element of the original list (both limit included).
Start counting the elements with 1.
> slice :: [a] -> Int -> Int -> [a]
> slice [] _ _ = []
> slice xs i k
> | i > 0 && i <= k = drop (i-1) (take k xs)
> | otherwise = []
A solution using list comprehension:
> slice' :: [a] -> Int -> Int -> [a]
> slice' xs i k = [x | (x,j) <- zip xs [1..k], i <= j]
For safety, just tried guard:
> slice'' :: [a] -> Int -> Int -> [a]
> slice'' xs i k
> | 0 < i && i <= k = [x | (x,j) <- zip xs [1..k], i <= j]
> | otherwise = []
> slice''' :: [a] -> Int -> Int -> [a]
> slice''' xs i k = fst $ unzip $ filter ((>= i) . snd) $ zip xs [1..k]
*Prob18> slice [1..] 10001 10000
[]
(0.01 secs, 2,096,912 bytes)
*Prob18> slice' [1..] 10001 10000
[]
(0.01 secs, 5,191,224 bytes)
*Prob18> slice'' [1..] 10001 10000
[]
(0.01 secs, 2,069,480 bytes)
*Prob18> slice''' [1..] 10001 10000
[]
(0.01 secs, 5,733,288 bytes)
19. リストを巡回させよ。
*Main> rotate ['a','b','c','d','e','f','g','h'] 3
"defghabc"
*Main> rotate ['a','b','c','d','e','f','g','h'] (-2)
"ghabcdef"
負の引数の処理を最初はリストを逆にしてたが、コストが高い。
再帰的にリストの長さを足していって正になるようにした、おそらくこっちのが効率が良いはず。
Prob17 の結果を使えるのはラッキーであった。
Prob19.lhs
> module Prob19 where
> import Prob17 (split'')
Rotate a list N place to the left.
Hint: Use the predefined functions length and (++).
If n<0, convert the problem to the equivalent problem n>0 by adding the list's length to n.
> rotate :: [a] -> Int -> [a]
> rotate xs n
> | n >= 0 = drop n xs ++ take n xs
> | otherwise = reverse (rotate reversedList (-n))
> where reversedList = reverse xs
> -- rotate' xs n = take (length xs) $ drop (length xs + n) $ cycle xs
Another implementation using split'' in Prob17:
> rotate'' :: [a] -> Int -> [a]
> rotate'' lst n
> | n >= 0 = second ++ first
> | otherwise = rotate'' lst (n + length lst)
> where (first, second) = split'' lst n
20. リストからn 番目の要素を取り除け。
*Main> removeAt 2 "abcd"
('b',"acd")
Maybe でラップするべきだよなーと思って付け足した。
あと負の数の時も処理できるようにした。
いずれにせよ(!!) が便利。
Prob20.lhs
> module Prob20 where
Remove the K'th element from a list.
> removeAt :: Int -> [a] -> (a,[a])
> removeAt n xs
> | n < 0 = error "wrong index"
> | otherwise = (xs !! (n-1), xs')
> where xs' = (take (n-1) xs) ++ (drop n xs)
A simple recursice solution, without error handling:
> removeAt' :: Int -> [a] -> (a, [a])
> removeAt' 1 (x:xs) = (x, xs)
> removeAt' n (x:xs) = (left, x:right)
> where (left, right) = removeAt' (n-1) xs
> removeAtMaybe :: Int -> [a] -> (Maybe a, [a])
> removeAtMaybe _ [] = (Nothing, [])
> removeAtMaybe n lst
> | n < 0 || n > length lst = (Nothing, lst)
> | otherwise = (Just (lst !! (n-1)), lst')
> where lst' = (take (n-1) lst) ++ (drop n lst)