Merge multiple lists if the condition is true

Question

I have been trying to wrap my head around this for a while, but it seems like my lack of Haskell experience just won't help me with this. I could not find a similar question here in Stackoverflow (most of them are related to combining all subscriptions, without any conditions)

So there it is. Let's say I have a list of such lists:

[[1, 2, 3], [3, 5, 6], [20, 21, 22]] 

Is there an efficient way to combine lists if some condition is true? Let's say I need to combine lists that have at least one element. In the case of an example, the result would be:

 [[1, 2, 3, 3, 5, 6], [20, 21, 22]] 

Another example (when all lists can be combined):

 [[1, 2], [2, 3], [3, 4]] 

And this is the result:

 [[1, 2, 2, 3, 3, 4]] 

Thank you for your help!

Answer 1

I don’t know what to say about efficiency, but we can break what is happening and get at least a few different functions. Certain functionalities can be optimized, but it is important to clarify what exactly is needed.

Let me rephrase the question: for some set X, some binary relation R and some binary operation + produce the set Q = {x + y | x to X, y to X, xRy}. So, for your example, we can have X, which is a set of lists, R - "xRy, if and only if there is at least one element in x and y", and + - ++ .

A naive implementation can simply copy the set-builder notation itself

 shareElement :: Eq a => [a] -> [a] -> Bool shareElement xs ys = or [x == y | x <- xs, y <- ys] v1 :: (a -> a -> Bool) -> (a -> a -> b) -> [a] -> [b] v1 (?) (<>) xs = [x <> y | x <- xs, y <- xs, x ? y] 

then p = v1 shareElement (++) :: Eq a => [[a]] -> [[a]] can achieve what you want. Other than that, probably not.

 Prelude> p [[1], [1]] [[1,1],[1,1],[1,1],[1,1]] 

The most obvious problem is that we get four copies: two from merging lists with ourselves, two from combining lists with each other "in both directions." The problem arises because List does not match Set , so we cannot kill uniques. Of course, this is a simple fix, we just use Set everywhere

 import Data.Set as Set v2 :: (a -> a -> Bool) -> (a -> a -> b) -> Set.Set a -> Set.Set b v2 (?) (<>) = Set.fromList . v1 (?) (<>) . Set.toList 

So, we can try again, p = v2 (shareElement on Set.toList) Set.union with

 Prelude Set> p $ Set.fromList $ map Set.fromList [[1,2], [2,1]] fromList [fromList [1,2]] 

which seems to work. Note that we need to “go through” the List , because Set cannot be an instance of Monad or Applicative due to its Ord constraint.

I would also like to point out that Set lot of lost behavior. For example, we try either to throw out the order information in the list, or to process both x <> y and y <> x when our relation is symmetrical.

Some more convenient versions may be written as

 v3 :: Monoid a => (a -> a -> Bool) -> [a] -> [a] v3 r = v2 r mappend 

and more efficient ones can be constructed if we assume that the relation is, say, an equality relation since then, instead of having the operation O(n^2) , we can do it in O(nd) , where d is the number of sections (adjacencies) of the relationship.

This is usually a really interesting problem.

Answer 2

I just wrote something like this: Finding blocks in arrays

You can simply change it like this (although I'm not too sure about the effectiveness):

 import Data.List (delete, intersect) example1 = [[1, 2, 3], [3, 5, 6], [20, 21, 22]] example2 = [[1, 2], [2, 3], [3, 4]] objects zs = map concat . solve zs $ [] where areConnected xy = not . null . intersect x $ y solve [] result = result solve (x:xs) result = let result' = solve' xs [x] in solve (foldr delete xs result') (result':result) where solve' xs result = let ys = filter (\y -> any (areConnected y) result) xs in if null ys then result else solve' (foldr delete xs ys) (ys ++ result) 

OUTPUT:

 *Main> objects example1 [[20,21,22],[3,5,6,1,2,3]] *Main> objects example2 [[3,4,2,3,1,2]]