H-99: Ninety-Nine Haskell Problemsより [21..28]です、以前までのは以下においてあります。

99 Haskell Problems より、[1..10]
99 Haskell Problems より、[11..20]

該当する問題([21..28])はこちら、解答はこちらです。

21. リストの任意の場所へ挿入。

P21> insertAt 'X' "abcd" 2
"aXbcd"

ひとつ目は生で書いただけ、take とdrop で切り取って間に差し込む。
Prob17 のsplit を使っても一緒。

Prob21.lhs


> module Prob21 where

> import Prob17 (split'')

Insert an element at a given position into a list.

> insertAt :: a -> [a] -> Int -> [a]
> -- insertAt x [] n = [x]
> insertAt x xs n = (take (n-1) xs) ++ [x] ++ (drop (n-1) xs)

  *Prob21> let f = \(a,b) x -> a ++ [x] ++ b
  *Prob21> f it 'X'
  "aiXueo"
  *Prob21> split'' "aiueo" 2
  ("ai","ueo")
  *Prob21> f it 'X'
  "aiXueo"

> insertAt' :: a -> [a] -> Int -> [a]
> insertAt' c lst n = helper slst c
>   where helper (a,b) c = a ++ [c] ++ b
>         slst = split'' lst (n-1)

22. (Int の)区間を与えたらその区間内の整数のリストを返すような関数を作れ。

Prelude> range 4 9
[4,5,6,7,8,9]

引数の大小がひっくり返った時の処理に迷う、昇順なら空リストを返したら良いが、逆順なら少し手を加える必要がある。

Prob22.lhs


> module Prob22 where

Create a list containing all integers within a given range.

> range :: Int -> Int -> [Int]
> range n1 n2
>   | n1 <= n2  = take (n2-n1+1) [n1..]
>   | otherwise = take (n1-n2+1) [n1, n1-1..]

Without using a reverse function

  range n m
    | n == m    = [n]
    | n < m     = n:(range (n+1) m)
    | otherwise = n:(range (n-1) m) 

> range' :: Int -> Int -> [Int]
> range' min max
> --  | min > max = []
>   | min > max = [min, min-1 .. max]
>   | otherwise = [min..max]

23. リストから与えられた個数だけランダムに除け。

Prelude System.Random>rnd_select "abcdefgh" 3 >>= putStrLn
eda

Haskell で乱数、つまりはIO が必要。
ちょっとLYH の乱数を再読しました。
ぼんやり考えたらふたつ目の実装みたいなのが思いついたが、まずはひとつ目の写経。
do の一行目で取り出すリストのインデックス用のリストを作っておいて、あとはそのインデックスにそって入力のリストから取ってくるという仕組みです。
実装は素直ですが、replicateM の挙動が最初わからんかった。

二つ目のリスト内包表記がやはり良いですね、こういう高級でわかりやすい書き方好きです（コストは割高でしょうけど）
アイディアとしては、乱数で再度インデックスをつけたリストの先頭から欲しい数だけ取ってくればよい、ということです。
問題は何度呼び出しても結果が同じというところでしょうか。
この辺の挙動がそれぞれ微妙に異なるので注意が必要です。

三つ目はやや、ややこしいアルゴリズムです、あとこの実装では出現順は変わりません、すなわちソートされてるリストはソートされたまま出てきます。
取り除く要素の選別がこの実装の鍵で、else に落ちたら今考えているリストの先頭は二度と出てきません、あと言葉で説明するのは難しいですが、数が足らなくなりそうだと元のリストの後半はそのまま出てきます。

最後のapplicative はnub がミソです。
indices はその名の通りピックアップするリストのインデックスになっていて、作り方は少々乱暴ですが


randomRs (0, (length lst) -1) <$> getStdGen

で作ったインデックスの候補からなる無限リストをnub で重複をなくして最初のn を取ってくるわけです、applicative と無限リストの利用となんともHaskell らしい。

Prob23.lhs


> module Prob23 where

Extract a given number of randomly selected elements from a list.

> import System.Random
> import Control.Monad (replicateM)
> -- replicateM :: Monad m => Int -> m a -> m [a]
> import Data.List (nub)

> rnd_select :: [a] -> Int -> IO [a]
> rnd_select [] _ = return [] 
> rnd_select ls n
>   | n < 0     = error "N must be greater than zero."
>   | otherwise = do 
>       pos <- replicateM n $ 
>                getStdRandom $ randomR (0, (length ls)-1)
>       return [ls !! p | p <- pos]
  
  *Prob23 System.Random Control.Monad> rnd_select [1..100] 1
  [50]
  (0.00 secs, 1,034,720 bytes)
  *Prob23 System.Random Control.Monad> rnd_select [1..100] 1
  [10]
  (0.00 secs, 1,034,736 bytes)
  *Prob23 System.Random Control.Monad> rnd_select [1..100] 1
  [23]

A more elegant solution using
  *Prob23> :t randomR
  randomR :: (RandomGen g, Random a) => (a, a) -> g -> (a, g)

> rnd_select' :: [a] -> Int -> IO [a]
> rnd_select' xs n = do
>   gen <- getStdGen
>   return $ take n [xs !! x | x <- randomRs (0, (length xs)-1) gen]

  *Prob23 System.Random Control.Monad> rnd_select' [1..100] 1
  [95]
  (0.01 secs, 1,549,800 bytes)
  *Prob23 System.Random Control.Monad> rnd_select' [1..100] 1
  [95]
  (0.00 secs, 1,032,432 bytes)
  *Prob23 System.Random Control.Monad> rnd_select' [1..100] 1
  [95]
  (0.00 secs, 1,033,624 bytes) 

Another implementation which uses O(N) algorithm (I'm not sure):

> rnd_select'' :: [a] -> Int -> IO [a]
> rnd_select'' _      0 = return []
> rnd_select'' (x:xs) n = do
>   r <- randomRIO (0, length xs)
>   if r < n 
>     then do
>       rest <- rnd_select'' xs (n-1)
>       return (x : rest)
>     else
>       rnd_select'' xs n

  *Prob23> rnd_select "aiueo" 5
  "uooie"
  *Prob23> rnd_select' "aiueo" 5
  "oaiuo"
  *Prob23> rnd_select'' "aiueo" 5
  "aiueo"

Using aplicative:

> rnd_select''' :: [a] -> Int -> IO [a]
> rnd_select''' lst n = map (lst !!) <$> indices
>   where
>     indices = take n . nub . randomRs (0, (length lst) -1) <$> getStdGen

24. [1..m] からn 個の異なる数を引け。

Prelude System.Random>diff_select 6 49
Prelude System.Random>[23,1,17,33,21,37]

Haskell らしく型だけ合わせてみるを試してみた、まずはProb23 があるので

*Prob24> :type (`rnd_select'''` 2)
(`rnd_select'''` 2) :: [a] -> IO [a]
*Prob24> :type (\n -> (`rnd_select'''` n))
(\n -> (`rnd_select'''` n)) :: Int -> [a] -> IO [a]

が思いついた。
次に[1..m] をこれに"引いて"貰えれば良いので、素朴に思いつくのはやはりbind(>>=) でしょう。

*Prob24> :type return [1..9]
return [1..9] :: (Enum t, Monad m, Num t) => m [t]
*Prob24> :type (\m -> return [1..m])
(\m -> return [1..m]) :: (Enum t, Monad m, Num t) => t -> m [t]

あとはreturn で包んだ[1..m] をセクション(rd_select''' n) に渡したら良さそう、という感じです。

*Prob24> return [0..9] >>= (`rnd_select'''` 3)
[9,6,7]

とここまで高説を垂れたのですが、モナド則から簡略化できるしこんなアホなことせんでよいと気がついたあーぁ、、、

解答例からはData.List のnub を使った大変美しい例を。
これもProb23 のと同じ方針ですね、1からm までの乱数を無限リストにランダムに配置して、nub で重複を潰します。
そのあとほしい数だけtake で取ってくるという、何度見てもHaskell らしい”高級”な書き方です。

Prob24.lhs


> module Prob24 where

Lotto: Draw N different random numbers from the set 1..M.

> import System.Random
> import Prob23 (rnd_select''')
> import Data.List (nub)

  *Prob24> return [0..9] >>= (`rnd_select'''` 8)
  [9,6,7,3,2,8,4,5]

> diff_select :: Int -> Int -> IO [Int]
> diff_select n m 
>   | m > 0     = return [1..m] >>= (`rnd_select'''` n)
>   | otherwise = return []

Above implementation is the same as the following due to the monad law (left identity (return x >>= f == f x)):

> diff_select' :: Int -> Int -> IO [Int]
> diff_select' n m = rnd_select''' [1..m] n

The following implementation will return different values when called several times.

> diff_select'' :: Int -> Int -> IO [Int]
> diff_select'' n to = ds n [1..to]
>   where
>     ds :: Int -> [Int] -> IO [Int]
>     ds 0 _  = return []
>     ds _ [] = return []
>     ds n xs = do
>       r <- randomRIO (0, length xs -1)
>       let remaining = take r xs ++ drop (r+1) xs
>       rest <- ds (n-1) remaining
>       return ((xs !! r) : rest)

Alternative solution, this much easier to understand:

> diff_select''' :: Int -> Int -> IO [Int]
> diff_select''' n m = do
>   gen <- getStdGen
>   return (take n $ randomRs (1, m) gen)

Note that this does NOT solve the problem, since it does not generate distinct numbers.

Using nub from Data.List, and applicative:

> diff_select'''' :: Int -> Int -> IO [Int]
> diff_select'''' n m = take n . nub . randomRs (1, m) <$> getStdGen

25. 与えられたリストに対して要素をランダムに巡回させよ。

Prelude System.Random>rnd_permu "abcdef"
Prelude System.Random>"badcef"

前の設問から使えるものをひっぱてくるのが定石なんでしょうが、、、
インデックスに対応する乱数リストでもって、与えられたリストへ(!!) でアクセスしようと思いリスト内包表記を試しましたがIO が邪魔で普通に書いたら出来ませんでした。

結果前問と同じ方針で、Applicative を使ってという形に落ち着きました。

二つ目は解答例から、ぜんぜん異なる乱数の使い方を。
ナマの再帰のほうが追いやすいかもしれません、rand なる乱数でもって与えられたリストの先頭を再帰的にrand の場所に置いていく、という形で実装してます、なかなか凝ってますね。

Prob25.lhs


> module Prob25 where

Generate a random permutation of the elements of a list.

> import System.Random
> import Data.List (nub)

Using the same method of Prob23:

> rnd_permu :: [a] -> IO [a]
> rnd_permu lst = map (lst !!) <$> randomIndices (length lst)

> randomIndices :: Int -> IO [Int]
> randomIndices n = take n . nub . randomRs (0, n-1) <$> getStdGen

We can generate the permutation recursively:

> rnd_permu' :: [a] -> IO [a]
> rnd_permu' [] = return []
> rnd_permu' (x:xs) = do
>   rand <- randomRIO (0, (length xs))
>   rest <- rnd_permu xs
>   return $ let (ys,zs) = splitAt rand rest
>            in  ys ++ (x : zs)

  *Prob25> splitAt 3 [0..9]
  ([0,1,2],[3,4,5,6,7,8,9])

26. N 個のリストからK 個を選んで取り出せ。

> combinations 3 "abcdef"
["abc","abd","abe",...]

色々な記法があるがC(N, K) のリストのリストになるわけです。
自分の思考を洗ってみたけど本質的に再帰になっていることが分かったので書けると思ったのだけど、実は再帰の下にもう一枚再帰という二重構造になっていてどう書いたもんか、、、
要は

combinations :: Int -> [a] -> [[a]]
combinations 3 "aiueo"

と呼ばれた時にまず(3-1)=2個の要素を頭から取り残りをおしりにつけていく

["abc", "abd", "abe"

末尾まで行ったら最初選んだ2個の要素の一番後ろを一つ後ろに動かして

, "acd", "ace". "ade"

と、このように最初の要素とそれ以外は全部後ろの要素というリストになったら最初の二個の要素の後ろから二個目（この場合は先頭の'a'）を一つ後ろにして

, "bcd", "bce", "dce"]

となり最後の3要素になったらおしまい。

さて、これをどうして実装したもんか書いては消してを繰り返して諦めたので写経。

本質的に再帰なのでどのコードも大変美しいです、とくにリスト内包表記。
Data.List のtails を知ってると先頭の要素を１つずつ後ろにずらしていくという作業を再帰とtails で簡単に実装できてます。
糖衣構文という意味ではdo 記法もリスト内包表記と変わらないのが面白いですね、モナドモナド。

tails を使わないしばりのcombinations''' が上記のアルゴリズムに忠実なものだと思います。
まずは先頭の要素を(!!) で順繰りアクセス、残りを再帰的にくっつける、なるほどこう書くのか。

Prob26.lhs


> module Prob26 where

Generate the combinations of K distinct objects chosen from the the N elements of a list.

> import Data.List (tails, subsequences)

List comprehensions:

> combinations :: Int -> [a] -> [[a]]
> combinations 0 _ = [[]]
> combinations n lst 
>   = [ y:ys | y:xs' <- tails lst
>            , ys <- combinations (n-1) xs']

do-notation:

> combinations' :: Int -> [a] -> [[a]]
> combinations' 0 _ = return []
> combinations' n lst = do
>   y:xs <- tails lst
>   ys <- combinations (n-1) xs
>   return (y:ys) 

Without using tails:

> combinations'' :: Int -> [a] -> [[a]]  
> combinations'' _ []     = [[]]
> combinations'' 0 _      = [[]]
> combinations'' n (x:xs) = (map (x:) lstWithout_x) ++ rest
>   where
>     lstWithout_x = combinations'' (n-1) xs
>     rest = combinations n xs 

> combinations''' :: Int -> [a] -> [[a]]
> combinations''' _ [] = [[]]
> combinations''' 0 _  = [[]]
> combinations''' n xs 
>   = [ (xs !! i) : x | i <- [0.. (length xs)-1]
>                     , x <- combinations''' (n-1) (drop (i+1) xs)]

Using subsequences in Data.List, but this is super slow:

> combinations4 :: Int -> [a] -> [[a]]
> combinations4 k ns = filter ((k==) . length) (subsequences ns)

  *Prob26> combinations 3 [1..100]
  (9.99 secs, 1,730,114,288 bytes)
  *Prob26> combinations' 3 [1..100]
  (9.87 secs, 1,746,911,976 bytes)
  *Prob26> combinations'' 3 [1..100]
  (10.28 secs, 1,730,618,824 bytes)
  *Prob26> combinations''' 3 [1..100]
  (11.37 secs, 1,786,674,056 bytes)

27. 与えられた数のリスト[Int] にそってリスト[a] を非交差なサブリストのリスト[[a]] に分けよ。

P27> group [2,3,4] ["aldo","beat","carla","david","evi","flip","gary","hugo","ida"]
[[["aldo","beat"],["carla","david","evi"],["flip","gary","hugo","ida"]],...]
(altogether 1260 solutions)
 
27> group [2,2,5] ["aldo","beat","carla","david","evi","flip","gary","hugo","ida"]
[[["aldo","beat"],["carla","david"],["evi","flip","gary","hugo","ida"]],...]
(altogether 756 solutions)

これも実装は再帰が二重になってますね、結構じっくり考えたけどわからなかったのでやはりコピペ、前問が使えそうな気がしましたが直接は使えません。

まずは前問のに似たcombination を実装します。
違いといえば返すリストはタプルになっていてn 個の組み合わせと残りの組み合わせを返します、入力(x:xs) の頭の要素x がどこにあるかで２つのリストに分けて再帰、最後に(++) で返す、というわけです。

これをつかってgroup を作ります、group も再帰です。
n 個のサブリストはcombination で作ったタプルの一つ目で、残りはgroup 本体の再帰呼び出しで作ってつなげています。
見たら明らか、しかも美しいのに書けない、26と27くらいがちょうど私の境目みたいですね。

Prob27.lhs


> module Prob27 where

Group the elements of a set into disjoint subsets.
a) In how many ways can a group of 9 people work in 3 disjoint subgroups of 2,3 and 4 persons?
Write a function that generates all the possibilities and return them in a list.

b) Generalize the above predicate in a way that we can specify a list of group sizes and the predicate will return a list of groups.

> combination :: Int -> [a] -> [([a], [a])]
> combination 0 xs = [([], xs)]
> combination n [] = []
> combination n (x:xs) = ts ++ ds
>   where
>     ts = [(x:ys, zs) | (ys, zs) <- combination (n-1) xs]
>     ds = [(ys, x:zs) | (ys, zs) <- combination n     xs]

> group :: [Int] -> [a] -> [[[a]]]
> group []     _  = [[]]
> group (n:ns) xs =
>   [ g:gs | (g, rs) <- combination n xs
>          , gs      <- group ns rs ]

28. リストのリストを２つの方法でソートせよ a) サブリストの長さに関して b) 長さの出現順に関して。

Prelude>lsort ["abc","de","fgh","de","ijkl","mn","o"]
Prelude>["o","de","de","mn","abc","fgh","ijkl"]

lfsort ["abc", "de", "fgh", "de", "ijkl", "mn", "o"]
["ijkl","o","abc","fgh","de","de","mn"]

最後にソートくらいは解きたいと思って頑張ってみた。
両方共どこかで見たクイックソートで、where でそれぞれの定義を書くスタイルになりました。
ひとつ目は簡単で、length で重みをつけて比較していくだけです。

二個目はアイヤ困った。
補助関数を考えつくのにお時間少々頂きました、出現回数を数える関数frequency はサブリストの長さしか見ません。
あとはこの補助関数で重みを付けて、というふうに実装したのでlsort とlfsort の見かけはそっくりになりました。

Prob28.lhs


> module Prob28 where

Sorting a list of lists according to length of sublists.
a) We suppose that a list contains that are lists themselves.
The objective is to sort the elements of this list according to their length.

> import Data.List (sort, group)

> lsort :: (Ord a) => [[a]] -> [[a]]
> lsort []     = []
> lsort (x:xs) = shorter ++ (x : longer)
>   where
>     shorter = lsort [y | y <- xs, not (isLongerThan_x y)]
>     longer  = lsort [y | y <- xs, isLongerThan_x y]
>     isLongerThan_x y
>       | length y >= length x = True
>       | length y < length x = False
>       | otherwise = error "lsort:" 

b) Again, we suppose that a list contains elements that are lists themselves.
But this time the objective is to sort the elements of this list according to their length frequency; i.e., in the default, where sorting is done ascendingly, lits with rare length are placed first, others with a more frequent length come later.

> frequency :: [[a]] -> [a] -> Int
> frequency xs x
>   = length $ filter ((== length x) . length) xs

> lfsort :: (Ord a) => [[a]] -> [[a]]
> lfsort [] = []
> lfsort lst@(x:xs) = shorter ++ (x : longer)
>   where
>     shorter = lfsort [y | y <- xs, not (isFreqThan_x y)]
>     longer  = lfsort [y | y <- xs, isFreqThan_x y]
>     isFreqThan_x y 
>       | frequency lst y >= frequency lst x = True
>       | frequency lst y < frequency lst x = False
>       | otherwise = error "lfsrt:"

  *Prob28> length $ filter ((==3) . length) ["abc", "de", "fgh", "de", "ijkl", "mn", "o"]
  2