赤玉4個、白玉3個、黒玉2個の順列を考えるとき、 隣り合う色が互いに異なるような並べ方の総数を求めよ。
これは、結構難しい問題ですが、計算機に計算させた方が実際に並べ方が観察できて面白いです。 というわけで、 PermuTation で作ったプログラムを流用して作りました。
pGen :: String -> [String]
pGen s
| length s == 1 = [s]
| otherwise =
concat [addOneChar c (pGen (dropOnlyOneChar c s)) | c <- mSet s ]
addOneChar :: Char -> [String] -> [String]
addOneChar c ls = [c : s | s <- ls]
isElement :: Char -> String -> Bool
isElement c s = length [ch | ch <- s,ch == c] /= 0
dropOnlyOneChar :: Char -> String -> String
dropOnlyOneChar c s
| c == (head s) = tail s
| otherwise = (head s) : (dropOnlyOneChar c (tail s))
mSet :: String -> String
mSet s
| (length s) <= 1 = s
| isElement (head s) (tail s) =
(head s):(mSet (dropOneChar (head s) (tail s)))
| otherwise = (head s):(mSet (tail s))
dropOneChar :: Char -> String -> String
dropOneChar c s = [ ch | ch<-s, ch /= c]
isDifferent :: String -> Bool
isDifferent s
| (length s) == 1 = True
| (head s) /= (head (tail s)) = isDifferent (tail s)
| otherwise = False
stagger :: [String] -> [String]
stagger l = [s | s <- l, isDifferent s]
使い方は、次の通りです。
*Main> stagger(pGen "aaaabbbcc") ["abababcac","ababacabc","ababacacb","ababacbac","ababacbca","ababcabac","ababca bca","ababcacab","ababcacba","ababcbaca","abacababc","abacabacb","abacabcab","ab acabcba","abacacbab","abacbabac","abacbabca","abacbacab","abacbacba","abacbcaba" ,"abcababac","abcababca","abcabacab","abcabacba","abcabcaba","abcacabab","abcacb aba","abcbabaca","abcbacaba","acabababc","acababacb","acababcab","acababcba","ac abacbab","acabcabab","acabcbaba","acacbabab","acbababac","acbababca","acbabacab" ,"acbabacba","acbabcaba","acbacabab","acbacbaba","acbcababa","bababacac","bababc aca","babacabac","babacabca","babacacab","babacacba","babacbaca","babcabaca","ba bcacaba","bacababac","bacababca","bacabacab","bacabacba","bacabcaba","bacacabab" ,"bacacbaba","bacbabaca","bacbacaba","bcababaca","bcabacaba","bcacababa","cababa bac","cabababca","cababacab","cababacba","cababcaba","cabacabab","cabacbaba","ca bcababa","cacababab","cacbababa","cbababaca","cbabacaba","cbacababa"] *Main> length(stagger(pGen "aaaabbbcc")) 79
79通りでした。