permutation.hs

module Main where
import Data.List (iterate, cycle)


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

circulate :: [a] -> [[a]] -- リストからその巡回を列挙する補助関数
circulate xs = take n $ map (take n) $ iterate tail $ cycle xs where n = length xs


{-

[a,b,c,d]の順列(permute [a,b,c,d])を
[b,c,d]の順列(permute [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であるような相異なった要素が得られる

つまり

[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][b,c,d,a][c,d,a,b][d,a,b,c]といったように
巡回(circulate [a,b,c,d])させてやれば相異なった4*3!=4!個の順列が得られ、
これは4要素のリストの順列の総数(4!)だから
必要な順列は全部列挙されていることがわかる。
最後にこれらをconcatしてリストを1段階潰せば型が揃う。

この発想を一般化して再帰で書けばご覧のとおり。
置換に関する数学的事実を利用すればもっとシンプルで
効率的に書ける気がするけれどもひと目で思いついたのはこれ。

ちなみにcirculateの定義の仕組みは

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,...]
　　...
　　...
　　
take 4 . map (take 4)
==> [a,b,c,d]
    [b,c,d,a]
    [c,d,a,b]
    [d,a,b,c]

というものですが、もっと単純に

circulate' :: [a] -> [[a]]
circulate' xs = take (length xs) $ iterate (\(x:xs)->xs++[x]) xs

で十分な気がします（でもすぐに思いついたのは最初の方）。

-}