Find connected components from lists of edges - haskell

I need to find the connected components of a graph given its edges.
The graph edges are represented as a list of tuples, and the result needs to be a list of lists of vertices representing the connected components,
eg [(1,2), (2,3), (2,6), (5,6) (6,7), (8,9), (9,10)] -> [[1,2,3,5,6,7], [8,9,10]].
There could be any number of connected edges and unconnected graph components in the list. The tuples will always be in ascending order though, if that helps.
I have the signature groupEdges :: [(Int, Int)] -> [[Int]] but I just can't think of how to get from tuples to lists.
I thought of taking one tuple at a time and searching the rest for matching elements, but I don't know how to make this list of sublists.
This question is similar to this question on the CS Stack Exchange, but I don't want to use Data.Graph. I would like to do this without other packages if possible.
-- edit - comments from chepner and ThibautM have given me the first step. I can convert from tuples to lists by calling the function with groupEdges map (\(x,y) -> [x,y]) pairs.
Now I need to take this list of lists and group the connected components eg. [[1,2], [2,3], [2,6], [5,6], [6,7], [8,9], [9,10]] -> [[1,2,3,5,6,7], [8,9,10]]

You mentioned not using packages. The 4 functions I used are relatively easy to implement yourself if you really want. (And I encourage you to either do so or at least lookup their implementation)
Lists are used as set, which is a lot worse in performance than using a dedicated structure e.g. Data.Set. Using a disjoint-set (union-find, merge-find) data structure (referenced in your linked answer) would be even better, but probably not very good as a starting point for understanding
import Data.List (elem, intersect, union, partition)
pairs = [(1,2), (2,3), (2,6), (5,6), (6,7), (8,9), (9,10)]
pairs2 = map (\(x,y) -> [x,y]) pairs
-- add item to list, only if its no already present - using list as set
addItem item list | elem item list = list
| otherwise = item : list
-- used to test whether subgraphs are connected i.e. contain common node
intersects a b = not $ null $ intersect a b
unionAll :: (Eq a) => [[a]] -> [a]
unionAll (x1:x2:xs) = unionAll ((union x1 x2):xs)
unionAll [x] = x
unionAll [] = []
-- find edges that are connected to first edge/subgraph and merge them
groupFirst :: (Eq a) => [[a]] -> [[a]]
groupFirst (x:xs) = (unionAll (x:connected)) : disconnected
where
-- separate 'xs' edges/subgraphs into those that are connected to 'x' and the rest
(connected, disconnected) = partition (intersects x) xs
groupFirst [] = []
-- if no more edges/subgraphs can be connected with first edge, continue with remaining (disconnected) edge/subgraph ([5,6] in second iteration)
groupAll :: (Eq a) => [[a]] -> [[a]]
groupAll (x:xs) = y:(groupAll ys)
where
(y:ys) = groupFirst (x:xs)
groupAll [] = []
-- after first 'groupAll pairs2' - [[1,2,3,6],[5,6,7],[8,9,10]]
-- repeat this process until no more components can be connected together
groupAllRepeat x = if x /= groupAll x then groupAllRepeat (groupAll x) else x
main = print (groupAllRepeat pairs2)

Related

How to list all possible ways to pair up a list?

I'm new to Haskell and need to list all possible ways to pair up (even) lists of Ints.
E.g.
[1,2,3,4] -> [[(1,2),(3,4)], [(2,3),(1,4)], [(1,3),(2,4)], ...]
Generating all possible pairs is easy enough (shown below) but I can't work out how to return only ways to pair up the entire input list.
pairs :: [a] -> [[(a, a)]]
pairs l = [(x,y) | (x:ys) <- tails l, y <- ys]
I recommend writing a function that nondeterministically chooses an element, returning the rest of the values in the list as well. There are a few possible APIs; the one I suggest below is the most general-purpose one, and one I've used on many occasions for apparently unrelated tasks.
zippers :: [a] -> [([a], a, [a])]
Here's an example of what this function does:
> zippers "abcd"
[("", 'a', "bcd"), ("a", 'b', "cd"), ("ba", 'c', "d"), ("cba", 'd', "")]
Once you have that, you can simply repeatedly non-deterministically choose an element from the ever-shrinking list of available options, making a pair after every other choice.
We can make use of a helper function pick that returns a list of 2-tuples with as first element the item picked, and a second element a list of remaining elements:
pick :: [a] -> [(a, [a])]
pick [] = []
pick (x:xs) = (x, xs) : …
where the … part should make a call to pick with the tail of the list, and prepend each second item of the 2-tuples returned with x.
With this pick function we can then construct all combinations with:
pairs :: [a] -> [[(a, a)]]
pairs [] = [[]]
pairs (x:xs) = [(x,y):tl | (y, zs) <- pick xs, tl <- pairs zs]

Take symmetrical pairs, of different numbers from list

I have a list like this:
[(2,3),(2,5),(2,7),(3,2),(3,4),(3,6),(4,3),(4,5),(4,7),(5,2),(5,4),(5,6),(6,3),(6,5),(6,7),(7,2),(7,4),(7,6)]
The digits are from [2..7]. I want to take a set where there are any symmetrical pairs. e.g. [(1,2),(2,1)], but those two numbers aren't used again in the set. An example would be:
[(3,6),(6,3),(2,5),(5,2),(4,7),(7,4)]
I wanted to first put symmetric pairs together as I thought it might be easier to work with so i created this function, which actually creates the pairs and puts them in another list
g xs = [ (y,x):(x,y):[] | (x,y) <- xs ]
with which the list turns to this:
[[(3,2),(2,3)],[(5,2),(2,5)],[(7,2),(2,7)],[(2,3),(3,2)],[(4,3),(3,4)],[(6,3),(3,6)],[(3,4),(4,3)],[(5,4),(4,5)],[(7,4),(4,7)],[(2,5),(5,2)],[(4,5),(5,4)],[(6,5),(5,6)],[(3,6),(6,3)],[(5,6),(6,5)],[(7,6),(6,7)],[(2,7),(7,2)],[(4,7),(7,4)],[(6,7),(7,6)]]
Then from here I was hoping to somehow remove duplicates.
I made a function that will look at all of the fst elements of all of the pairs:
flatList xss = [ x | xs <- xss, (x,y) <- xs ]
to use with another function to remove the duplicates.
h (x:xs) | (fst (head x)) `elem` (flatList xs) = h xs
| otherwise = (head x):(last x):(h xs)
which gives me the list
[(3,6),(6,3),(5,6),(6,5),(2,7),(7,2),(4,7),(7,4),(6,7),(7,6)]
which has duplicate numbers. That function only takes into account the first element of the first pair in the list of lists,the problem is when I also take into account the first element of the second pair (or the second element of the first pair):
h (x:xs) | (fst (head x)) `elem` (flatList xs) || (fst (last x)) `elem` (flatList xs) = h xs
| otherwise = (head x):(last x):(h xs)
I only get these two pairs:
[(6,7),(7,6)]
I see that the problem is that this method of deleting duplicates grabs the last repeated element, and would work with a list of digits, but not a list of pairs, as it misses pairs it needs to take.
Is there another way to solve this, or an alteration I could make?
It probably makes more sense to use a 2-tuple of 2-tuples in your list comprehension, since that makes it more easy to do pattern matching, and thus "by contract" enforces the fact that there are two items. We thus can construct 2-tuples that contain the 2-tuples with:
g :: Eq a => [(a, a)] -> [((a, a), (a, a))]
g xs = [ (t, s) | (t#(x,y):ts) <- tails xs, let s = (y, x), elem s ts ]
Here the elem s ts checks if the "swapped" 2-tuple occurs in the rest of the list.
Then we still need to filter the elements. We can make use of a function that uses an accumulator for the thus far obtained items:
h :: Eq a => [((a, a), (a, a))] -> [(a, a)]
h = go []
where go _ [] = []
go seen ((t#(x, y), s):xs)
| notElem x seen && notElem y seen = t : s : go (x:y:seen) xs
| otherwise = go seen xs
For the given sample input, we thus get:
Prelude Data.List> (h . g) [(2,3),(2,5),(2,7),(3,2),(3,4),(3,6),(4,3),(4,5),(4,7),(5,2),(5,4),(5,6),(6,3),(6,5),(6,7),(7,2),(7,4),(7,6)]
[(2,3),(3,2),(4,5),(5,4),(6,7),(7,6)]
after reading a few times your question, I got an elegant solution to your problem. Thinking that if you have a list of pairs without any repeated number, you can get the list of swapped pairs easily, solving your problem. So your problem can be reduce to given a list, get the list of all pairs using each number just one.
For a given list, there are many solutions to this, ex: for [1,2,3,4] valid solutions are: [(2,4),(4,2),(1,3),(3,1)] and [(2,3),(3,2),(1,4),(4,1)], etc... The approach here is:
take a permutation if the original list (say [1,4,3,2])
pick one element for each half and pair them together (for simplicity, you can pick consecutive elements too)
for each pair, create a the swapped pair and put all together
By doing so you end up with a list of non repeating numbers of pairs and its symmetric. More over, looping around all permutaitons, you can get all the solutions to your problem.
import Data.List (permutations, splitAt)
import Data.Tuple (swap)
-- This function splits a list by the half of the length
splitHalf :: [a] -> ([a], [a])
splitHalf xs = splitAt (length xs `quot` 2) xs
-- This zip a pair of list into a list of pairs
zipHalfs :: ([a], [a]) -> [(a,a)]
zipHalfs (xs, ys) = zip xs ys
-- Given a list of tuples, creates a larger list with all tuples and all swapped tuples
makeSymetrics :: [(a,a)] -> [(a,a)]
makeSymetrics xs = foldr (\t l -> t:(swap t):l) [] xs
-- This chain all of the above.
-- Take all permutations of xs >>> for each permutations >>> split it in two >>> zip the result >>> make swapped pairs
getPairs :: [a] -> [[(a,a)]]
getPairs xs = map (makeSymetrics . zipHalfs . splitHalf) $ permutations xs
>>> getPairs [1,2,3,4]
[[(1,3),(3,1),(2,4),(4,2)],[(2,3),(3,2),(1,4),(4,1)] ....

Partition a set in Haskell

I'm trying to write a Haskell program that could return the partition set of a user defined set. The partition of a set S is defined as a set of nonempty, pairwise disjoint subsets of S whose union is S. So, [1,2,3] returns [[[2],[3,1]],[[2,1],[3]],[[3,2,1]],[[1],[3,2]],[[1],[2],[3]]]. I think I can utilize a different program I wrote a while ago that finds the cartesian product from two sets. So, [1,2,3] ['a', 'b'] returns [(1,'a'),(1,'b'),(2,'a'),(2,'b'),(3,'a'),(3,'b')]. However, I'm not sure quite how. I think it would require recursion though, if this can even be adapted properly. Here is the subset code:
type Set a = [a]
isElement :: Eq a => a -> [a] -> Bool
isElement x [] = False
isElement x (y:ys) = if(x==y) then True else isElement x ys
subset :: Eq a => Set a -> Set a -> Bool
subset [] xs = True
subset (y:ys) xs = if(isElement y xs == True)
then do subset ys xs
else do False
The idea is that in order to find all partitions of set X ∪ {x}, we find parritions of X first. Then add x to each of them in every possible way (that is, add x to the first element of a partition, add x to the second element etc) and take a union of the result.
Here's a rather straightforward implementation:
partitions :: [a] -> [[[a]]]
partitions [] = [[]]
partitions (x:xs) = expand x $ partitions xs where
expand :: a -> [[[a]]] -> [[[a]]]
expand x ys = concatMap (extend x) ys
extend :: a -> [[a]] -> [[[a]]]
extend x [] = [[[x]]]
extend x (y:ys) = ((x:y):ys) : map (y:) (extend x ys)
Demo:
https://ideone.com/ClYOoQ
Pseudocode for one recursive algorithm:
If |S| = 1
Return ∅
Otherwise
For each nonempty proper subset X ⊂ S
Let Y = S - X
Add {X, Y} to R
For each Z in {partitionSet(X)}
Add Z ∪ {Y} to R.
Return R
Since “adding” elements to a list isn’t a very functional idiom, you would want to do those steps with a concatMap or a list comprehension. You might also build R as an accumulating parameter to a tail-recursive function, or as a union of the return values of each step. The proper subsets function is in the Haskell standard library as Data.List.subsequences.
If you have a total ordering on all proper subsets of S, you can use symmetry-breaking to add only partitions that are unique up to permutation. That is, if X > Y, you could add only {X,Y} and not {Y,X}, and only {X,Y,Z} and not {Y,X,Z}. Be careful that you still sub-partition every set in your partition exactly once!
This finds only partition sets of S, if ⋃Z = X and X ∪ Y = S, the union of all sets in Z and Y is S, it returns only sets of nonempty proper subsets of S, and every partition and subpartition is a set difference, hence pairwise disjoint.
Any partition set of cardinality two has the form {X, S-X}, and the algorithm finds it because it tries every possible X. Any partition set of cardinality i>2 has the form {a_1, a_2, ..., a_i}, where {a_1, a_2} is a partition set of {a_1 ⋃ a_2} and {{a_1 ⋃ a_2}, ..., a_i} is a partition set of cardinality i-1, and will be found when subpartitioning the parent node of the search tree. Therefore, by induction, the algorithm finds all partition sets of S.
Lately, I was playing again with set partitions and haskell. Even though it might be not the fastest and nicest solution it does the job. I found out that using Data.List and the List Monad greatly reduces the amount of code and extents the readability.
Asking myself if there is a neat way to replace foldl by foldr?
Anyway, here is my solution:
module Main where
import Data.List
main :: IO ()
main = print $ allPart 5
insertFront :: Integer -> [[Integer]] -> [[Integer]]
insertFront k (h:t) = [k:h]++t
insertFront k _ = [[k]]
add :: Integer -> [[Integer]] -> [[[Integer]]]
add k part=zipWith (++) (inits part) (map (insertFront k) (tails part))
allPart k = foldl (>>=) [[]] [add i | i<-[1..k]]
I'm also wondering if there is some very short substitute for insertFront using some of the haskell libraries.

How do I sequence a list of tuples?

I'm trying to sequence a list of (Int, Int) tuples into a list of int lists [[Int]]
Why? I've found many use cases for this. Basically given a list like so:
[(1,5), (2,3), (3,4), (4,5), (6,7), (7,8)]
I want to return a list:
[[1,2,3,4,5],[6,7,8]]
Here's what I have so far:
pieces :: [(Int, Int)]
pieces = [(1,5), (2,3), (3,4), (4,5), (6,7), (7,8)]
linkStep :: [[Int]] -> (Int, Int) -> [[Int]]
linkStep (x:xs) (a, b)
| elem a x = (b : x) : xs
| elem b x = (a : x) : xs
| otherwise = (a : b : x) : xs
-- Now I fold the linkStep function over the list
links :: [(Int, Int)] -> [[Int]]
links list = foldl linkStep [[]] list
However when I call links with pieces I get
links pieces
--[[8,6,7,5,4,2,3,1,5]]
I'm not really sure what I'm doing wrong. The linkStep function is supposed to concatenate a tuple element that is in the resulting list to the target list in the result. If the tuple element is not yet in the resulting list a new list with the tuple element is added. But its not working... Please help!
There are a couple of issues that I see:
In linkStep, you only ever check if your tuple elements are members of the first inner list. From your example, it looks as if you're going to need to check all the lists, not just the first one.
In the cases of linkStep, you always add a, b, or both a and b to the first inner list. Thus all elements will eventually end up in the first list. Maybe you meant to create a new list here instead? But it might also be a good place to consider other lists than the first.
Hopefully this will help you to make progress.

List partitioning implemented recursively

I am a Haskell beginner and I have been experimenting with recursive functions.
I am working on a function:
separate :: [a] -> [[[a]]]
that takes in a list and outputs all of the partitions of that list.
For example 123 becomes:
1|2|3
12|3
1|23
13|2
132
I have only been able to implement a recursive function that creates the 1|2|3 variant:
separate' :: [a] -> [[a]]
separate' (r:rs) = [r]:separate' xs
>separate [1,2,3]
[[1],[2],[3]]
I am stuck with trying to create the other variants with recursion.
You can think of this function as choosing, for each place in between two list elements, whether to include a split there. So for starters, there should be 2n-1 partitions for an n-element list: you can use that as a quick sanity check on a possible solution.
One good way to model non-determinism is with the list monad (or equivalently with list comprehensions), so let's do it that way.
First, let's write the type and a base case:
separate :: [a] -> [[[a]]]
separate [] = [[]]
There is a single way to separate an empty list: the empty list itself, with no possibility of splits. Easy enough.
Now, given we have one element and a list of remaining elements, one thing we'll need for sure is a list of all the ways to split the remaining elements:
separate :: [a] -> [[[a]]]
separate [] = [[]]
separate (x:xs) = let recur = separate xs
in undefined -- TODO
Here's where the interesting stuff starts. As I said, you can view this as choosing, for each item, whether to put a split after it. Two choices means concatenating together two lists, so let's do that:
separate :: [a] -> [[[a]]]
separate [] = [[]]
separate (x:xs) = let recur = separate xs
split = undefined -- TODO
noSplit = undefined -- TODO
in split ++ noSplit
Now, how do we introduce a split after the item x? We do it by, for each partition in recur, adding [x] to the front of it as a new partition:
separate :: [a] -> [[[a]]]
separate [] = [[]]
separate (x:xs) = let recur = separate xs
split = do
partition <- recur
return $ [x] : partition
noSplit = undefined -- TODO
in split ++ noSplit
What about not splitting? Pretty similar! For each partition in recur, we add x to the front of the first sub-partition:
separate :: [a] -> [[[a]]]
separate [] = [[]]
separate (x:xs) = let recur = separate xs
split = do
partition <- recur
return $ [x] : partition
noSplit = do
(y:ys) <- recur
return $ (x:y):ys
in split ++ noSplit
And with that, we're done:
*Temp> separate "123"
[["1","2","3"],["1","23"],["12","3"],["123"]]
A right fold solution would be:
import Control.Applicative ((<$>))
separate :: Foldable t => t a -> [[[a]]]
separate = foldr (\i -> concatMap (inc i)) [[]]
where
inc i [] = [[[i]]]
inc i (x:xs) = ((i:x):xs):((x:) <$> inc i xs)
then:
\> separate [1, 2]
[[[1,2]],[[2],[1]]]
\> separate [1, 2, 3]
[[[1,2,3]],[[2,3],[1]],[[1,3],[2]],[[3],[1,2]],[[3],[2],[1]]]

Resources