Haskell permutations matching criteria

Question

How would one do the following in Haskell:

Return all permutations of a list where one element comes before the another element (cannot assume that elements of the list can be ordered)?

My solution was to do:

sLeftOf l r lss =
 [ ls
 | ls <- lss
 , DL.findIndex (l==) ls <= DL.findIndex (r==) ls
 ]

for somewhere to the left of and

sDirectLeftOf l r lss =
 [ls
 | ls <- lss
 , DL.findIndex (l==) ls == fmap (\x-> x - 1) (DL.findIndex (r==) ls)
 ]

for directly to the left of which works,

*Main Lib> sLeftOf 2 3 (permutations [1..3])
[[1,2,3],[2,1,3],[2,3,1]]
*Main Lib> sDirectLeftOf 2 3 (permutations [1..4])
[[1,2,3,4],[2,3,1,4],[4,2,3,1],[2,3,4,1],[4,1,2,3],[1,4,2,3]]

But I don't like these. The findIndex seems un-Haskelly and the fmap on the result of findIndex feels just wrong. Anyone has better ways to do this? For two lists there is a nice method using guard/zip and elem.

mylist = do
 x <- permutations ["a","b","c"]
 y <- permutations ["1","2","3"]
 leftOf "b" x "3" y
 return $ zip x y
 where
 leftOf x xs y ys = guard $ (x,y) `elem` zip xs (tail ys)
 leftOf' x xs y ys = guard $ (x,y) `elem` (aux xs (tail ys))
 aux a b@(_:ys) = (zip a b) ++ aux a ys
 aux _ [] = []
reqA = (map (map fst )) mylist
reqB = (map (map snd )) mylist
required = zip reqA reqB 

The first leftOf is immediately to left of and the second is somewhere to the left of; but this won't work for a single list.

• jberryman: It's not clear what your criterion is for "better". I think your first solutions are perfectly clear and fine, but they are polynomial time algorithms. If you are concerned about performance I would suggest thinking about the problem by first taking the permutations of all elements except the two you are interested in, and then forming your final set from that. The "direct left of" case then becomes trivial.
• user141259: It's hard to offer concrete suggestions unless you show your imports, particularly what DL is.

Answer 1

The findIndex seems un-Haskelly and the fmap on the result of findIndex feels just wrong.

There's nothing wrong with fmap.

One thing I would advise is replacing (\x -> x - 1) with (minus 1). Also, [ls | ls <- lss, p ls] is probably best rewritten to use filter.

If you format your code more nicely, I think you'd find it reasonably appealing:

g = findIndex . (==)
p l r ls = g l ls <= g r ls
sLeftOf l r lss = filter (p l r) lss
sDirectLeftOf l r lss = filter (p l r) $ fmap (minus 1) (g ls)

The first leftOf is immediately to left of and the second is somewhere to the left of; but this won't work for a single list.

Seems like a fairly contrived solution. elem and zip are still \$O(n)\$ so I don't think this accomplishes what you intended. If you're concerned about performance, I'd suggest using a keyed map so that lookups become \$O(\log n)\$ - searching an array will be \$O(n)\$ just like searching a list.

Also, you define

leftOf' x xs y ys = guard $ (x,y) `elem` (aux xs (tail ys))
aux a b@(_:ys) = (zip a b) ++ aux a ys
aux _ [] = []

which is not used anywhere. Passing the -Wall option to GHC will warn you any time you do something like this.