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]
isDerange :: String -> String -> Bool
isDerange s1 s2 = [(c1,c2)|(c1,c2)<-(zip s1 s2), c1 == c2] == []
derangeGen :: String -> [String]
derangeGen s = [s1 | s1 <- pGen s , isDerange s1 s]
実行結果は以下の通りです。
*Main> derangeGen "abc" ["bca","cab"] *Main> derangeGen "abcd" ["badc","bcda","bdac","cadb","cdab","cdba","dabc","dcab","dcba"] *Main> derangeGen "abcde" ["badec","baecd","bcaed","bcdea","bcead","bdaec","bdeac","bdeca","beacd","bedac" ,"bedca","cabed","cadeb","caebd","cdaeb","cdbea","cdeab","cdeba","ceabd","cebad" ,"cedab","cedba","dabec","daebc","daecb","dcaeb","dcbea","dceab","dceba","deabc" ,"deacb","debac","debca","eabcd","eadbc","eadcb","ecabd","ecbad","ecdab","ecdba" ,"edabc","edacb","edbac","edbca"] *Main> derangeGen "abcdef" ["badcfe","badefc","badfce","baecfd","baefcd","baefdc","bafcde","bafecd","bafedc ","bcaefd","bcafde","bcdafe","bcdefa","bcdfae","bceafd","bcefad","bcefda","bcfad e","bcfead","bcfeda","bdacfe","bdaefc","bdafce","bdeafc","bdecfa","bdefac","bdef ca","bdface","bdfcae","bdfeac","bdfeca","beacfd","beafcd","beafdc","bedafc","bed cfa","bedfac","bedfca","befacd","befadc","befcad","befcda","bfacde","bfaecd","bf aedc","bfdace","bfdcae","bfdeac","bfdeca","bfeacd","bfeadc","bfecad","bfecda","c abefd","cabfde","cadbfe","cadefb","cadfbe","caebfd","caefbd","caefdb","cafbde"," cafebd","cafedb","cdabfe","cdaefb","cdafbe","cdbafe","cdbefa","cdbfae","cdeafb", "cdebfa","cdefab","cdefba","cdfabe","cdfbae","cdfeab","cdfeba","ceabfd","ceafbd" ,"ceafdb","cebafd","cebfad","cebfda","cedafb","cedbfa","cedfab","cedfba","cefabd ","cefadb","cefbad","cefbda","cfabde","cfaebd","cfaedb","cfbade","cfbead","cfbed a","cfdabe","cfdbae","cfdeab","cfdeba","cfeabd","cfeadb","cfebad","cfebda","dabc fe","dabefc","dabfce","daebfc","daecfb","daefbc","daefcb","dafbce","dafcbe","daf ebc","dafecb","dcabfe","dcaefb","dcafbe","dcbafe","dcbefa","dcbfae","dceafb","dc ebfa","dcefab","dcefba","dcfabe","dcfbae","dcfeab","dcfeba","deabfc","deacfb","d eafbc","deafcb","debafc","debcfa","debfac","debfca","defabc","defacb","defbac"," defbca","defcab","defcba","dfabce","dfacbe","dfaebc","dfaecb","dfbace","dfbcae", "dfbeac","dfbeca","dfeabc","dfeacb","dfebac","dfebca","dfecab","dfecba","eabcfd" ,"eabfcd","eabfdc","eadbfc","eadcfb","eadfbc","eadfcb","eafbcd","eafbdc","eafcbd ","eafcdb","ecabfd","ecafbd","ecafdb","ecbafd","ecbfad","ecbfda","ecdafb","ecdbf a","ecdfab","ecdfba","ecfabd","ecfadb","ecfbad","ecfbda","edabfc","edacfb","edaf bc","edafcb","edbafc","edbcfa","edbfac","edbfca","edfabc","edfacb","edfbac","edf bca","edfcab","edfcba","efabcd","efabdc","efacbd","efacdb","efbacd","efbadc","ef bcad","efbcda","efdabc","efdacb","efdbac","efdbca","efdcab","efdcba","fabcde","f abecd","fabedc","fadbce","fadcbe","fadebc","fadecb","faebcd","faebdc","faecbd"," faecdb","fcabde","fcaebd","fcaedb","fcbade","fcbead","fcbeda","fcdabe","fcdbae", "fcdeab","fcdeba","fceabd","fceadb","fcebad","fcebda","fdabce","fdacbe","fdaebc" ,"fdaecb","fdbace","fdbcae","fdbeac","fdbeca","fdeabc","fdeacb","fdebac","fdebca ","fdecab","fdecba","feabcd","feabdc","feacbd","feacdb","febacd","febadc","febca d","febcda","fedabc","fedacb","fedbac","fedbca","fedcab","fedcba"]