Given a list like:
[1, 2, 2, 6, 7, 8, 10, 11, 12, 15]
Split it into blandly increasing ranges (maybe equal):
[[1, 2, 2], [6, 7, 8], [10, 11, 12], [15]]
I tried using a recursive approach:
splitRanges [] = [[]]
splitRanges (x:y:xs)
| x `elem` [y, y + 1] = [x, y] : splitRanges xs
| otherwise = xs
So if the item is one less or equal to the item after I fuse them. But it says I am trying to build an infinite type:
Occurs check: cannot construct the infinite type: a0 = [a0]
Expected type: [[a0]]
Actual type: [a0]
But what does [the fact that it is monotone] have to do with how the list is split?
That being strictly increasing would give different results.
Or are you really trying to say something else?
I hope I am not.
Will the list always be monotone?
No, splitting a monotone list means making it into just one sub-list.
If not, how should that affect the results?
If it is not monotone, you will have many sublists.
Is it always brown into groups of three?
No, the groups may contain n elements.
More examples would be good
splitRanges [1, 3] == [[1], [3]]
splitRanges [1, 2, 5] == [[1, 2], [3]]
splitRanges [0, 0, 1] == [[0, 0, 1]]
splitRanges [1, 5, 7, 9] == [[1], [5], [7], [9]]
I appreciate hints rather than full answers, as I would like to improve myself, copy-pasting is not improvement.
Try breaking the problem into more manageable parts.
First, how would you split just one blandly increasing range from the start of a list? Lets guess that should be splitOne :: [Integer] -> ([Integer], [Integer]).
Second, how can you repeatedly apply splitOne to the left-over list? Try implementing splitMany :: [Integer] -> [[Integer]] by using splitOne.
For splitOne, what should you be trying to find? The first position to split at. What are "split positions"? Lets make that up.
split 0 1 2 3 4 …
list [ | x1, | x2, | x3, | x4, | x5, …]
So a split at 0 is ([], [x1,x2,x3,x4,x5,…]), and a split at 3 is ([x1,x2,x3],[x4,x5,…]). What relationship can you see between the split position and the split list?
How do you determine the first split position of the list? Lets say that is implemented as firstSplitPos :: [Integer] -> Integer. What is the first split position of an empty list?
Can you now implement splitOne using firstSplitPos?
One Possible Answer
-- What are the adjacencies for:
-- 1) empty lists?
-- 2) lists with one element?
-- 3) lists with more than one element?
--
-- Bonus: rewrite in point-free form using <*>
--
adjacencies :: [a] -> [(a,a)]
adjacencies xxs = zip xxs (drop 1 xxs)
-- Bonus: rewrite in point-free form
--
withIndices :: [a] -> [(Int,a)]
withIndices xxs = zip [0..] xxs
-- This is the most involved part of the answer. Pay close
-- attention to:
-- 1) empty lists
-- 2) lists with one element
-- 3) lists which are a blandly increasing sequence
--
firstSplitPos :: (Eq a, Num a) => [a] -> Int
firstSplitPos xxs = maybe (length xxs) pos (find q searchList)
where q (_,(a,b)) = a /= b && a + 1 /= b
searchList = withIndices (adjacencies xxs)
-- Why is the split position one more than the index?
pos (i,_) = i + 1
--
-- Bonus: rewrite in point-free form using <*>
--
splitOne :: (Eq a, Num a) => [a] -> ([a],[a])
splitOne xxs = splitAt (firstSplitPos xxs) xxs
splitMany :: (Eq a, Num a) => [a] -> [[a]]
-- What happens if we remove the case for []?
splitMany [] = []
splitMany xxs = let (l, r) = splitOne xxs in l : splitMany r
Another Approach
This is my explanation of Carsten's solution. It is already succinct but I have elected for a variation which does not use a 2-tuple.
We know that Haskell lists are defined inductively. To demonstrate this, we can define an equivalent data type.
data List a = Cons a (List a) -- Cons = (:)
| Nil -- Nil = []
Then ask the question: can we use induction on lists for the solution? If so, we only have to solve two cases: Cons and Nil. The type signature of foldr shows us exactly that:
foldr :: (a -> b -> b) -- Cons case
-> b -- Nil case
-> [a] -- The list
-> b -- The result
What if the list is Nil? Then the only blandly increasing sequence is the empty sequence. Therefore:
nilCase = [[]]
We might want nilCase = [] instead, as that also seems reasonable — i.e. there are no blandly increasing sequences.
Now you need some imagination. In the Cons case we only get to look at one new element at a time. With this new element, we could decide whether it belongs to the right-adjacent sequence or if it begins a new sequence.
What do I mean by right-adjacent? In [5,4,1,2,2,7], 1 belongs to the right-adjacent sequence [2,2].
How might this look?
-- The rest of the list is empty
consCase new [] = [new] : []
-- The right-adjacent sequence is empty
consCase new ([]:ss) = [new] : ss
-- The right-adjacent sequence is non-empty
-- Why `new + 1 == x` and not `new == x + 1`?
consCase new sss#(xxs#(x:_):ss)
| new == x || new + 1 == x = (new:xxs):ss
| otherwise = [new]:sss
Now that we solved the Nil case and the Cons case, we are done!
splitRanges = foldr consCase nilCase
It would be useful and idiomatic to write your function to take a predicate, instead of writing your split condition into the function itself:
splitBy2 :: (a -> a -> Bool) -> [a] -> [[a]]
splitBy2 ok xs = snd $ f xs [] []
where f (a:b:xs) acc_list acc_out_lists | ok a b = ...
I hope you don't mind spoiling part of it, but as the comments are discussing what you want (and I hope I've got it) maybe you are interested in another possible solution?
I don't want to spoil it all but I think you can easily work this out:
blandly :: (Ord a, Num a) => [a] -> [[a]]
blandly = g . foldr f ([],[])
where f x ([],xss) = ([x],xss)
f x (y:ys,xss)
| abs (x-y) <= 1 = undefined
| otherwise = undefined
g (ys,xss) = undefined
you just have to fill in the undefined holes
The idea is just to fold the list from the right, accumulating your inner lists in the first item of the tuple, s long as the elements are not to far away; and if they are: to push it to the second item.
If done correctly it will yield:
λ> blandly [1,3]
[[1],[3]]
λ> blandly [1,2,5]
[[1,2],[5]]
λ> blandly [0,0,1]
[[0,0,1]]
λ> blandly [1,5,7,9]
[[1],[5],[7],[9]]
which seems to be what you want
1 hour later - I think I can post my solution - just stop reading if you don't want to get spoiled
blandly :: (Ord a, Num a) => [a] -> [[a]]
blandly = uncurry (:) . foldr f ([],[])
where f x ([],xs) = ([x],xs)
f x (y:ys,xs)
| abs (x-y) <= 1 = (x:y:ys,xs)
| otherwise = ([x],(y:ys):xs)
maybe I have a slight misunderstanding here (the examples did not specify it) - but if you want on only monotonic increasing inner lists you just have to change the abs part:
blandly :: (Ord a, Num a) => [a] -> [[a]]
blandly = uncurry (:) . foldr f ([],[])
where f x ([],xss) = ([x],xss)
f x (y:ys,xss)
| 0 <= y-x
&& y-x <= 1 = (x:y:ys,xss)
| otherwise = ([x],(y:ys):xss)
Related
On Hackage I see that groupBy's implementation is this:
groupBy :: (a -> a -> Bool) -> [a] -> [[a]]
groupBy _ [] = []
groupBy eq (x:xs) = (x:ys) : groupBy eq zs
where (ys,zs) = span (eq x) xs
which means that the predicate eq holds between any two elements of each group. Examples:
> difference_eq_1 = ((==1).) . flip (-)
> first_isnt_newline = ((/= '\n').) . const
>
> Data.List.groupBy difference_eq_1 ([1..10] ++ [11,13..21])
[[1,2],[3,4],[5,6],[7,8],[9,10],[11],[13],[15],[17],[19],[21]]
>
> Data.List.groupBy first_isnt_newline "uno\ndue\ntre"
["uno\ndue\ntre"]
What if instead I want to group elements such that the predicate holds between any pair of consecutive elements, so that the above results would be as follows?
[[1,2,3,4,5,6,7,8,9,10,11],[13],[15],[17],[19],[21]]
["uno\n","due\n","tre"]
I wrote it myself, and it looks a bit ugly
groupBy' :: (a -> a -> Bool) -> [a] -> [[a]]
groupBy' p = foldr step []
where step elem [] = [[elem]]
step elem gs'#((g'#(prev:g)):gs)
| elem `p` prev = (elem:g'):gs
| otherwise = [elem]:gs'
So I was wandering if such a function exists already and I just don't find it.
As regards the second usage, Data.List.groupBy first_isnt_newline, where the binary predicate basically ignores the second argument and applies a unary predicate to the first, I've just found that Data.List.HT.segmentAfter unary_predicate does the job, where unary_predicate is the negation of the unary predicate in which const's output is forwarded. In other words Data.List.groupBy ((/= '\n').) . const === Data.List.HT.segmentAfter (=='\n').
There is a groupBy package that does exactly that.
But here’s another way of implementing it:
Zip the list with its tail to test the predicate on adjacent elements
Generate a “group index” by scanning the result and incrementing the group whenever the predicate is false
Group by the index
Remove the indices
groupByAdjacent :: (a -> a -> Bool) -> [a] -> [[a]]
groupByAdjacent p xs
= fmap (fmap fst)
$ groupBy ((==) `on` snd)
$ zip xs
$ scanl' (\ g (a, b) -> if p a b then g else succ g) 0
$ zip xs
$ drop 1 xs
For an input like [1, 2, 3, 10, 11, 20, 30], the predicate will return [True, True, False, True, False, False] and the resulting group indices will be [0, 0, 0, 1, 1, 2, 3].
The scan can also be written pointfree as scanr (bool succ id . uncurry p) 0, since the scan direction doesn’t matter (although the group indices will be reversed). The group index might be handy or just more readable to keep as an integer, but it could be a Bool instead, because the minimum size of a group is 1: the functional argument of the scan would be bool not id . uncurry p, which can be simplified to (==) . uncurry p. And several of these parts could be factored into reusable functions, like zipNext = zip <*> drop 1, but I’ve inlined them for simplicity’s sake.
How can I write a powerList function in Haskell like the following? I would like it to build such a list with n multiply operations, where each element is a simple multiple of the previous element, not n exponent operations.
Ideally, the implementation is clean, idiomatic Haskell, and reasonably efficient.
-- powerList x n -> [1, x, x^2, ..., x^n]
-- For example:
-- powerList 2 0 -> [1]
-- powerList 2 1 -> [1, 2]
-- powerList 2 2 -> [1, 2, 4]
-- powerList 2 3 -> [1, 2, 4, 8]
-- powerList 2 4 -> [1, 2, 4, 8, 16]
powerList :: forall a. Integral a => a -> a -> [a]
powerList _ 0 = [1]
powerList x n = [] -- ???
For a list where each element is a function of the previous element, you can use iterate:
iterate :: (a -> a) -> a -> [a]
iterate f x returns an infinite list of repeated applications of f to x:
iterate f x == [x, f x, f (f x), ...]
Prelude> powerList x n = take (n + 1) $ iterate (* x) 1
Prelude> powerList 2 0
[1]
Prelude> powerList 2 4
[1,2,4,8,16]
If you wanted to not use iterate or take for practice, I'd start by looking at how iterate is implemented:
iterate f i = i : iterate f (f i)
To do something similar, our recursive function will need an additional parameter i. This is a pretty common technique when writing recursive functions.
-- powerList x n = [ 1, x, x^2, ..., x^n ]
powerList x n = powerList' n 1
where
-- powerList' n i = [ i, i*x, i*x^2, ..., i*x^n ]
powerList' 0 i = [ i ]
powerList' n i = i : powerList' (n - 1) (i * x)
List comprehensions are often a shorthand for generators. Generators are used in other functions for many purposes. List comprehensions are often succinct enough to include in-line in a function. The following is a list comprehension version of your powerList function. It is simply named p. I'm lazy.
Two values in the result are a Cartesian product of each with each. The constant that is also the first parameter is needed only once. Go figure.
Prelude> p i j = [(k ^ n) | k <- [i], n <- [0..j]]
Prelude> p 2 16
[1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384,32768,65536]
LOL a glaring fact, the i or k is a constant and a parameter, ready to use.
p i j = [(i ^ n) | n <- [0..j] ]
What I find most remarkable about Haskell is that functions like above are specifications rather than directives. Many Haskell functions tell the computer what is wanted instead of what to do to get it, that is, it's greatly declarative which is what is most wanted in a language.
Edit 4/5/2018
I am so sorry. Your specification to multiply the last value by a factor was not met by my last functions. Your specification is literally recursive. "where each element is a simple multiple of the previous element, not n exponent operations." The following function does exactly that.
pow l = l ++ pow [(last l) * 2]
But like iterate, is infinite. Use take x $ pow [1] to not have it run forever.
Chris's answer is most likely what you're looking for.
If you'd like to do it without the use of iterate, you can use the following code.
Edit : to avoid appending to the tail of the list (which takes linear time), one can use an auxiliary function powerList' to first compute the list in reverse then reverse the output of that function to correct the order.
powerList' :: Integral a => a -> a -> [a]
powerList' _ 0 = [1]
powerList' x n = do { let l = go x (n - 1)
; [x * (head l)] ++ l
}
powerList :: Integral a => a -> a -> [a]
powerList x n = reverse (powerList' x n)
I am trying to construct a tree from pre/postoreder traversals . My tree type is below:
data Tree = Emptytree | Node Integer [Tree]
I am new in functional programming. So I come across with some difficulties while tying construct my base cases and recursion.My function will be something like this:
ListToTree :: [Integer] -> [Integer] -> Tree
I construct some algorithms but I can not make it to fit to Language requirements.
My algorithm is quite simple:I take each element of first list (preorder traversal list) then I check it position in the second list. Let me give an example:
1
/ \
2 5
/ \
3 4
Preorder of this Tree traversal is as you know [1,2,3,4,5]
Postorder of this Tree traversal is as you know [3,4,2,5,1]
Firstly I look to the first element of first list it is 1 then I look it is position it in 2nd list it is last so I add this to my tree. Then I check next element of tree it is 2 in the second list it on the left of 1 it means it is child of it. Then 3 is on the left of 2 (in the second list) it means it is also the son of 2 then i look to 4 it is on the left of 2 it is son of 2, and lastly 5 it is on the left of 1 it is child of one (because it is on the right of 2 it is not a child of 2).
I tried to implement it . I write helper function which determines if Node has a child or not. I use also counter in my function So actually my function is like this:
ListToTree :: Integer -> [Integer] -> [Integer] -> Tree
{-First Stands for counter ,2nd preorder, 3rd postorder-}
MY base condition are:
1. is about if list are Emptytree return Emptytree
2. is about if counter== length-1 return Node element [Emptytree]
My main problematic part is in my recursive part:
ListToTree counter a b
| hasChild b counter == 1 = Node ( Element ) [ListToTree (1+counter) a b]
| hasChild b counter == 0 = Node ( Element ) [Emptytree]
{-My problematic part if node has no Child what I must change here-}
{-Or what are your suggestions-}
I need help in improving my algorithm Any kind of help or comments will be highly appreciated.
The beautiful thing about haskell is that you don't usually need a counter. It is usually sufficient to just do patter matching.
I will give the solution for [Tree] since that requires less cases. If you want a solution for a single Tree you can just introduce some cases in a wrapper function.
listToTree :: [Integer] -> [Integer] -> [Tree]
listToTree [] [] = []
listToTree (x:xs) ys = go where
fstSubTreePost = takeWhile (/=x) ys -- all the elems of 1. subtree except x
fstSubTreeLength = length fstSubTreePost
fstSubTreePre = take fstSubTreeLength xs
-- this will recursively compute the first subtree
fstTree = Node x (listToTree fstSubTreePre fstSubTreePost)
-- the next line will recursively compute the rest of the subtrees
rest = listToTree (drop fstSubTreeLength xs) (drop (fstSubTreeLength+1) ys)
go = fstTree : rest
Given the pre-order and post-order are [Integer], there may be zero or one or many trees that returns these traversals. For instances the traversals [1,1,1] and [1,1,1] have two possible trees. With 'mLast' and 'splits' helper function, it is possible to define a short 'listToTrees' which handles possible 'Forest' parsings. Then it is easy to define 'listToTree' as a special case that produces possible single 'Tree' parsings.
module PPT where
import Data.List
data Tree a = Emptytree | Node a (Forest a)
deriving Show
-- | A list of sibling trees, in left to right order
type Forest a = [Tree a]
-- | Returns a list of all valid trees that produce the given pre-order and post-order traversals.
--
-- If the input cannot be parsed into a Tree then results is an empty list.
listToTree :: [Integer] -> [Integer] -> [Tree Integer]
listToTree [] [] = [Emptytree] -- base case
listToTree [] _ = [] -- detect length mismatch
listToTree (x:xs) yAll = case mLast yAll of
Just (ys, y) | x==y -> map (Node x) (listToTrees xs ys) -- pre-order start == post-order end
_ -> []
-- | Given pre-order and post-order traversals of a forest, return a list of possible parsings.
listToTrees :: [Integer] -> [Integer] -> [Forest Integer]
listToTrees [] [] = [ [] ] -- base case
listToTrees [] _ = [] -- detect length mismatch
listToTrees (x:xs) ys = concatMap build (splits x ys) -- for each copy of 'x' in ysAll
where
build (belowX', _x', rightOfX') =
let (belowX, rightOfX) = splitAt (length pre) xs
in [ Node x kids : sibs
| kids <- listToTrees belowX belowX'
, sibs <- listToTrees rightOfX rightOfX' ]
-- | Safely split a non-empty into the initial portion and the last portion
mLast :: [a] -> Maybe ([a], a)
mLast [] = Nothing
mLast ys = Just (init ys, last ys)
-- | At each position for the given element 'x', split the input list 'ys' into (pre, x, post)
-- portions. The output has a tuple for each copy of 'x' in the input list 'ys'.
--
-- This could be better optimized to avoid (++), or changed to a zipper
splits :: Eq a => a -> [a] -> [ ([a], a, [a]) ]
splits x ysIn = unfoldr go ([], ysIn)
where
go (pres, ys) =
case span (x /=) ys of
(_, []) -> Nothing
(pre, x':post) -> Just ((pres ++ pre, x', post), (pres++pre++[x'], post))
-- | test1 has a single possible parsing
test1 :: ([Integer], [Integer])
test1 = ( [1, 2, 3, 4, 5]
, [3, 4, 2, 5, 1] )
-- | test2 has two possible parsings
test2 :: ([Integer], [Integer])
test2 = ( [1, 2, 1, 2]
, [2, 1, 2, 1] )
main :: IO ()
main = do
mapM_ print (uncurry listToTree test1)
mapM_ print (uncurry listToTree test2)
There is a clear way to convert binary recursion to tail recursion for sets closed under a function, i.e. integers with addition for the Fibonacci sequence:
(Using Haskell)
fib :: Int -> Int
fib n = fib' 0 1 n
fib' :: Int -> Int -> Int
fib' x y n
| n < 1 = y
| otherwise = fib' y (x + y) (n - 1)
This works because we have our desired value, y, and our operation, x + y, where x + y returns an integer just like y does.
However, what if I want to use a set that is not closed under a function? I want to take a function that splits a list into two lists and then does the same to those two lists (i.e. like recursively creating a binary tree), where I stop when another function magically says when to stop when it looks at the resulting split:
[1, 2, 3, 4, 5] -> [[1, 3, 4], [2, 5]] -> [[1, 3], [4], [2], [5]]
That is,
splitList :: [Int] -> [[Int]]
splitList intList
| length intList < 2 = [intList]
| magicFunction x y > 0 = splitList x ++ splitList y
| otherwise = [intList]
where
x = some sublist of intList
y = the other sublist of intList
Now, how can this binary recursion be converted to tail recursion? The prior method won't explicitly work, as (Int + Int -> Int is the same as the inputs) but (Split [Int] -/> [[Int]] is not the same as the input). As such, the accumulator would need to be changed (I assume).
There is a general trick to make any function tail recursive: rewrite it in continuation-passing style (CPS). The basic idea behind CPS is that every function takes an additional parameter--a function to call when they're done. Then, instead of returning a value, the original functions calls the function that was passed in. This latter function is called a "continuation" because it continues the computation on to its next step.
To illustrate this idea, I'm just going to use your function as an example. Note the changes to the type signature as well as the structure of the code:
splitListCPS :: [Int] -> ([[Int]] -> r) -> r
splitListCPS intList cont
| length intList < 2 = cont [intList]
| magicFunction x y > 0 = splitListCPS x $ \ r₁ ->
splitListCPS y $ \ r₂ ->
cont $ r₁ ++ r₂
| otherwise = cont [intList]
You can then wrap this up into a normal-looking function as follows:
splitList :: [Int] -> [[Int]]
splitList intList = splitListCPS intList (\ r -> r)
If you follow the slightly convoluted logic, you'll see that these two functions are equivalent. The tricky bit is the recursive case. There, we immediately call splitListCPS with x. The function \ r₁ -> ... that tells splitListCPS what to do when it's done--in this case, call splitListCPS with the next argument (y). Finally, once we have both results, we just combine the results and pass that into the original continuation (cont). So at the end, we get the same result we had originally (namely splitList x ++ splitList y) but instead of returning it, we just use the continuation.
Also, if you look through the above code, you'll note that all the recursive calls are in tail position. At each step, our last action is always either a recursive call or using the continuation. With a clever compiler, this sort of code can actually be fairly efficient.
In a certain sense, this technique is actually similar to what you did for fib; however, instead of maintaining an accumulator value we sort of maintain an accumulator of the computation we're doing.
You don't generally want tail-recursion in Haskell. What you do want, is productive corecursion (see also this), describing what in SICP is called an iterative process.
You can fix the type inconsistency in your function by enclosing initial input in a list. In your example
[1, 2, 3, 4, 5] -> [[1, 3, 4], [2, 5]] -> [[1, 3], [4], [2], [5]]
only the first arrow is inconsistent, so change it into
[[1, 2, 3, 4, 5]] -> [[1, 3, 4], [2, 5]] -> [[1, 3], [4], [2], [5]]
which illustrates the process of iteratively applying concatMap splitList1, where
splitList1 xs
| null $ drop 1 xs = [xs]
| magic a b > 0 = [a,b] -- (B)
| otherwise = [xs]
where (a,b) = splitSomeHow xs
You want to stop if no (B) case was fired at a certain iteration.
(edit: removed the intermediate version)
But it is much better to produce the portions of the output that are ready, as soon as possible:
splitList :: [Int] -> [[Int]]
splitList xs = g [xs] -- explicate the stack
where
g [] = []
g (xs : t)
| null $ drop 1 xs = xs : g t
| magic a b > 0 = g (a : b : t)
| otherwise = xs : g t
where (a,b) = splitSomeHow xs
-- magic a b = 1
-- splitSomeHow = splitAt 2
Don't forget to compile with -O2 flag.
I've been trying to wrap my head around this for a while now, but it seems like my lack of Haskell experience just won't get me through it. I couldn't find a similar question here on Stackoverflow (most of them are related to merging all sublists, without any condition)
So here it goes. Let's say I have a list of lists like this:
[[1, 2, 3], [3, 5, 6], [20, 21, 22]]
Is there an efficient way to merge lists if some sort of condition is true? Let's say I need to merge lists that share at least one element. In case of example, result would be:
[[1, 2, 3, 3, 5, 6], [20, 21, 22]]
Another example (when all lists can be merged):
[[1, 2], [2, 3], [3, 4]]
And it's result:
[[1, 2, 2, 3, 3, 4]]
Thanks for your help!
I don't know what to say about efficiency, but we can break down what's going on and get several different functionalities at least. Particular functionalities might be optimizable, but it's important to clarify exactly what's needed.
Let me rephrase the question: For some set X, some binary relation R, and some binary operation +, produce a set Q = {x+y | x in X, y in X, xRy}. So for your example, we might have X being some set of lists, R being "xRy if and only if there's at least one element in both x and y", and + being ++.
A naive implementation might just 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]] might achieve what you want. Except it probably doesn't.
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 the lists with themselves, two from merging the lists with each other "in both directions". The problem occurs because List isn't the same as Set so we can't kill uniques. Of course, that's an easy fix, we'll 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 (shareElementonSet.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 have to "go through" List because Set can't be made an instance of Monad or Applicative due to its Ord constraint.
I'd also note that there's a lot of lost behavior in Set. For instance, we fight either throwing away order information in the list or having to handle both x <> y and y <> x when our relation is symmetric.
Some more convenient versions can be written like
v3 :: Monoid a => (a -> a -> Bool) -> [a] -> [a]
v3 r = v2 r mappend
and more efficient ones can be built if we assume that the relationship is, say, an equality relation since then instead of having an O(n^2) operation we can do it in O(nd) where d is the number of partitions (cosets) of the relation.
Generally, it's a really interesting problem.
I just happened to write something similar here: Finding blocks in arrays
You can just modify it so (although I'm not too sure about the efficiency):
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 x y = 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]]