与えられたリストの順列を列挙する


https://twitter.com/_marony/status/626654108947083266 のお題を拾いました。


# 巡回を使うヴァージョン
```hs:Permutation.hs
import Data.List (intersperse)

permutate :: [a] -> [[a]]
permutate [] = [[]]
permutate (x:xs) = concat $ map circulate $ map (x:) $ permutate xs

circulate :: [a] -> [[a]] -- リストを巡回させたものを列挙する関数
circulate xs = take n $ map (take n) $ iterate tail $ cycle xs where n = length xs


-- 明示的な再帰を書かずに済ませられるようにfoldrで書き換えたのが以下のもの
-- でも、permutateはどう考えても普通に再帰で書いたほうがわかりやすいと思います
-- circulateはlengthを使わずに無限リストを扱えるようにしてみました
{-
permutate :: [a] -> [[a]]
permutate xs = foldr (\x -> concatMap (circulate . (x:))) [[]] xs  

circulate :: [a] -> [[a]]
circulate xs = take' $ map take' $ iterate tail $ cycle xs
    where  take' = zipWith (flip const) xs
-}

main = mapM_ (putStrLn . intersperse ' ') (permutate "12345") 
```

## どう考えるか

素直な再帰で書くには、`permutate (x:xs)`を`permutate xs`から作り上げたい。自明でない再帰を書くときにはまず`n=4`くらいで具体的に考えてみるのが個人的な方針。そこで、`[a,b,c,d]`の順列(`permutate [a,b,c,d]`)を`[b,c,d]`の順列(`permutate [b,c,d]`)を加工して作ることを考える。

まず `[b,c,d]` の順列

```
[b,c,d]
[b,d,c]
[c,b,d]
[c,d,b]
[d,b,c]
[d,c,b]
```

を考える（個数は`3!`）。

これらの頭に`a`をくっつければ`[a,b,c,d]`の順列のうちで頭が`a`であるような`3!`個の相異なった要素が得られる。つまり

```
[a,b,c,d]
[a,b,d,c]
[a,c,b,d]
[a,c,d,b]
[a,d,b,c]
[a,d,c,b]
```

になる。

更にこれらのそれぞれを、たとえば`[a,b,c,d] ⇒ [a,b,c,d][b,c,d,a][c,d,a,b][d,a,b,c]`といったように巡回(`circulate [a,b,c,d]`)させてやれば、相異なった`4*3!=4!`個の順列が得られ、これは4要素のリストの順列の総数(`4!`)だから必要な順列は全部列挙されていることがわかる。

最後にこれらを`concat`してリストを1段階潰せば型が揃う。

この発想を一般化して再帰で書けばご覧のとおり。

```hs
permutate [] = [[]]
permutate (x:xs) = concat $ map circulate $ map (x:) $ permutate xs
```

置換に関する数学的事実を利用すればもっとシンプルで効率的に書ける気がするけれどもひと目で思いついたのはこれ。


ちなみに`circulate`の定義

```hs
circulate xs = take n $ map (take n) $ iterate tail $ cycle xs where n = length xs
```

の仕組みは

```
cycle [a,b,c,d] ⇒

[a,b,c,d,a,b,c,d,...]
```

```
iterate tail (cycle [a,b,c,d]) ⇒

[a,b,c,d,a,b,c,d,...]
[b,c,d,a,b,c,d,a,...]
[c,d,a,b,c,d,a,b,...]
[d,a,b,c,d,a,b,c,...]
[a,b,c,d,a,b,c,d,...]
　　...
　　...
```

```
take 4 . map (take 4) ⇒

[a,b,c,d]
[b,c,d,a]
[c,d,a,b]
[d,a,b,c]
```

というものです。


# 順列を頭から構成していくヴァージョン（結果は辞書順）

```hs:Permutation.hs
import Data.List (delete)

permutate :: [a] -> [[a]]
permutate [] = [[]]
permutate xs = concatMap (\x -> map (x:) (permutate (delete x xs))) xs

```

集合`[a,b,c,d]`の順列を数え上げる際の普通の考え方は、最初の要素は`[a,b,c,d]`の`4`通り、次の要素は最初の要素を除いた`3`通り、次の要素は前2つを除いた`2`通り、というもののはず。この発想を採用して順列を構成しようとするとどうなるか。

## どう考えるか
まず、最初に使える集合は`xs = [a,b,c,d]`である。仮に最初に`b`を使うなら、次に使えるのは`xs`から`b`を除いた集合`delete b xs`になる。よく考えてみると、`b`の後ろにつながるのはこの集合`delete b xs`つまり`[a,c,d]`の順列であることに気がつくから

```hs
map (b:) (permutate (delete b xs))
```

で`b`から始まる順列の全体が得られることがわかる。この操作を`b`だけでなく`[a,b,c,d]`つまり`xs`の全体に対して行ってやればいいから`b`の所を仮引数`x`に置き換えてラムダ式を作ってそれを`xs`に`map`すればいい。つまり

```hs
map (\x -> map (x:) (permutate (delete x xs))) xs
```

で、これは`[[aから始まる順列のリスト],[bから始まる順列のリスト],[cから始まる順列のリスト],[dから始まる順列のリスト]]`と、順列のリストのリストになっているから、`concat`で潰してやれば型が合う（`map`と併せて`concatMap`にすればいい）。その結果が冒頭のコードである

```hs
permutate [] = [[]]
permutate xs = concatMap (\x -> map (x:) (permutate (delete x xs))) xs
```

実は`concatMap f xs`はリストモナドの`xs >>= f`に対応するので

```hs
permutate [] = return []
permutate xs = xs >>=  (\x -> map (x:) (permutate (delete x xs)))
```
つまり

```hs
permutate [] = return []
permutate xs = do
  x <- xs
  map (x:) $ permutate $ delete x xs
```

と書くこともできる。

# 攪乱順列を構成する（ほんのすこし発展）
攪乱順列 (derangement)は、元のリストと同じ位置には同じ要素が決して来ないような、順列のことである（つまり椅子に座っている全員が席替えをする場合のような順列）。たとえば`[1,2,3]`の攪乱順列は`[2,3,1]`と`[3,1,2]`の2つだけである。この攪乱順列も普通の順列の場合と似た方法で一工夫すれば、構成することができる。

```hs:derangement.hs
import Data.List (delete)

derange :: [a] -> [[a]]
derange xs = derange' xs xs
derange' [] _ = [[]]
derange' xs (y:ys) = concatMap (\x -> map (x:) (derange' (delete x xs) ys)) (delete y xs)
```

## どう考えるか
先ほどと同じようにやるのだが、今度は順列を構成している時に、いま自分が元々のリストのどの位置にあたる要素を操作しているかを覚えておかなくてはならない（攪乱順列なので元々のリストのその要素はその位置には入れられない）。覚えて置かなければならない情報は引数に突っ込むのが関数型の基本戦略なのでそうする。構成中にその場面で選んではいけない要素を引数で管理するのである。

```hs
derange xs = derange' xs xs
derange' xs (y:ys) = ?
```

攪乱順列を構成する関数は基本的にこんな感じになるはずだ。`derange' xs (y:ys)`の`(y:ys)`は自分が元々のリストのどの位置に相当する場面まで来ているかを表している（`y`が選ばれないようにしつつ要素をひとつ配置し終わったら`tail`して現在位置を進めていく）。

ここでもまずは`xs`が`[a,b,c,d]`の場合を考えよう。まず最初の要素は`a`以外でなくてはならないから`delete a [a,b,c,d]`から選ぶことになる。`delete a [a,b,c,d]`の中から仮に`d`を選んだとすると、残りの要素は`delete d xs`つまり`[a,b,c]`になる。次の要素を選ぶ手順に入るが、ここで元々のリストの`a`にあたる位置の処理が終わったので、現在の位置を示す`(y:ys)`をひとつ先に進める必要がある(つまり`ys`だ)。`xs`から選んではいけない要素を`ys`を参照して脇にどけつつ順列を作る関数が`derange'`なのだから、`d`の後ろは再帰で作れる

```hs
map (d:) (derange' (delete d xs) ys)
```

この操作と同じことをラムダ式で書いて、それを`delete a [a,b,c,d]`つまり`delete y xs`のそれぞれについて適用してやればいいから、`map`を使って

```hs
map (\x -> map (x:) (derange' (delete x xs) ys)) (delete y xs)
```

で、これを`concat`して潰してやれば型が合うことになる

```hs
derange xs = derange' xs xs
derange' [] _ = [[]]
derange' xs (y:ys) = concatMap (\x -> map (x:) (derange' (delete x xs) ys)) (delete y xs)
```

ここでも敢えてモナド表記をすれば

```hs
derange :: Eq a => [a] -> [[a]]
derange = join derange'
derange' _ [] = return []
derange' (y:ys) xs = do
  x <- delete y xs
  map (x:) $ derange' ys $ delete x xs
```

こんな感じになる。


# 与えられたリストからn個のものを選びだす（これは簡単）

```hs:Combination.hs
choose :: [a] -> Int -> [[a]]
choose [] _ = []
choose xs 1 = map (:[]) xs
choose (x:xs) n = map (x:) (choose xs (n-1)) ++ choose xs n
```

## どう考えるか
見たまんま。