haskell - Haskell filter out circular permutations

Question

You have a list with N elements You only want to print elements that are not circular permuations of other elements of the same list

To check if two strings are the circular permutations of each other I do this, which works fine :

string1 = "abc"
string2 = "cab"
stringconc = string1 ++ string1
if string2 `isInfixOf` stringconc
then -- it's a circular permuation
else -- it's not

Edit : As one comment pointed that out, this test only work for strings of the same size

Back to the real use case :

checkClean :: [String] -> [String] -> IO String
checkClean [] list = return ""
checkClean (x:xs) list = do
let sequence = cleanInfix x list
  if sequence /= "abortmath"
    then putStr sequence
    else return ()
  checkClean xs list

cleanInfix :

cleanInfix :: String -> [String] -> String
cleanInfix seq [] = seq
cleanInfix seq (x:xs) = do
  let seqconc = x ++ x
  if seq `isInfixOf` seqconc && seq /= x
    then "abortmath"
    else cleanInfix seq xs

However this just outputs... nothing With some research I found out that sequence in checkClean is always "abortmath" Also I'm not quite comfortable with this "flag" abortmath, because if by any chance one element of the list is "abortmath", well..

For example : if I have a list composed of :

NUUNNFFUF
FFUFNUUNN

I should write NUUNNFFUF

标签： haskell

Answer 1

I guess you call your initial code (question) with something like that:

result = ["NUUNNFFUF", "FFUFNUUNN"]
main = do
    checkClean result result

It won't print anything because:

• the first call of cleanInfix has the arguments following arguments: "NUUNNFFUF" and ["NUUNNFFUF", "FFUFNUUNN"]
• in cleanInfix, since seq == x you have a recursive call with the following arguments: "NUUNNFFUF" and ["FFUFNUUNN"]
• now, "NUUNNFFUF" is a real permutation of "FFUFNUUNN": cleanInfix returns "abortmath", and checkClean returns ()
• then you have a recursive call of checkClean with following arguments: "FFUFNUUNN" and ["NUUNNFFUF", "FFUFNUUNN"]
• again, "FFUFNUUNN" is a real permutation of "NUUNNFFUF": cleanInfix returns "abortmath", and checkClean returns ()
• this is the end.

Basically, x is a permutation of y and y is a permutation of x, thus x and y are discarded.

Your answer works, but it is horribly complicated.

I won't try to improve either of your codes, but I will make a general comment: you should (you really should) avoid returning a monad when you don't need to: in the question, checkClean just needs to remove duplicates (or "circular duplicates") from a list. That's totally functional: you have all the information you need. Thus, remove those dos, lets and returns!

Now, let's try to focus on this:

You have a list with N elements You only want to print elements that are not circular permuations of other elements of the same list

Why don't you use your initial knowledge on circular permutations?

isCircPermOf x y = x `isInfixOf` (y ++ y)

Now, you need a function that takes a sequence and a list of sequences, and return only the elements of the second that are not circular permutations of the first :

filterCircDuplicates :: String -> [String] -> [String]
filterCircDuplicates seq [] = []
filterCircDuplicates seq (x:xs) =
    if seq `isCircPermOf` x
    then removeCircDuplicates seq xs
    else x:removeCircDuplicates seq xs

This pattern is well know, and you can use filter to simplify it:

filterCircDuplicates seq l = filter (\x -> !seq `isCircPermOf` x) l

Or better:

filterCircDuplicates seq = filter (not.isCircPermOf seq) 

Note the signature: not.isCircPermOf seq :: String -> Boolean. It returns true if the current element is not a circular permutation of seq. (You don't have to add the list argument.)

Final step: you need a function that takes a list and return this list without (circular) duplicates.

removeCircDuplicates :: [String] -> [String]
removeCircDuplicates [] = []
removeCircDuplicates (x:xs) = x:filterCircDuplicates x (removeCircDuplicates xs)

When your list has a head and a tail, you clean the tail, then remove the duplicates of the first element of the tail, and keep this first element.

Again, you have a well known pattern, a fold:

removeCircDuplicates = foldr (\x acc -> x:filterCircDuplicates x acc) []

It removes the duplicates from right to left.

And if you want a one-liner:

Prelude Data.List> foldr (\x -> ((:) x).filter(not.(flip isInfixOf (x++x)))) [] ["abcd", "acbd", "cdab", "abdc", "dcab"]
["abcd","acbd","abdc"]