Related
I facing difficulties implementing prim's algorithm, my logic is quite wrong, this is what I got so far:
import Data.Array
import Data.Function (on)
import Data.List (sortBy, delete)
type Vertex = Int
type Weight = Int
type Graph = Array Vertex [(Vertex, Weight)]
type Bounds = (Vertex, Vertex)
type Edge = (Vertex, Vertex, Weight)
g1 = mkGraph (1, 4) [(1, 2, 1), (1, 3, 10), (1, 4, 3), (2, 3, 4), (2, 4, 10), (3, 4, 1)] -- 5
g2 = mkGraph (1, 5) [(1, 2, 15), (1, 3, 10), (2, 3, 1), (3, 4, 3), (2, 4, 5), (4, 5, 20)] -- 34
mkGraph :: Bounds -> [Edge] -> Graph
mkGraph bounds edges = accumArray (\xs x -> x:xs) [] bounds [ (x, (y, w)) | (x, y, w) <- edges]
--[(1,[(4,3),(3,10),(2,1)]),(2,[(4,10),(3,4)]),(3,[(4,1)]),(4,[])]
prim :: Graph -> Vertex -> [(Vertex, Weight)]
prim graph start = prim' (sortBy (compare `on` snd) (graph ! start)) [start] []
where
prim' [] _ mst = mst
prim' (x:xs) visited mst
| elem (fst x) visited = prim' xs visited mst
| otherwise = prim' (delete x $ sortBy (compare `on` snd) ((graph ! (fst x)) ++ xs)) ((fst x):visited) (x:mst)
My idea was, if I put every edge that is possible to reach from the vertice start (let's say that is 1) pick the minimum (in this case is the first element from that list, because it's sorted), pick it's first element from the tuple and use that as an index and also make all edges reachable from that vertice while adding the vertices reachable from the previous vertice too.
While doing this keeping track of the vertices visited, the problem is that if it reach the final vertice (it will be empty) then it will stop adding the edges and will use just the edges that was added already.
But this will not work either, because the way that I'm keeping tracking the visited vertices will skip something like [(1, 3, 10) (2, 3, 1)], because it will mark the vertice 3 as visited.
I think the issue is that your Graph representation as an array is implicitly "directed", so you need to take your input undirected graph and tabulate edges in both directions:
mkGraph :: Bounds -> [Edge] -> Graph
mkGraph bounds edges = accumArray (\xs x -> x:xs) [] bounds
[(x, (y, w)) | (x', y', w) <- edges, (x, y) <- [(x', y'), (y', x')]]
Now, the invariant for the recursion is that in:
prim' outgoing visited mst
the argument outgoing is the list of (vertex, weight) pairs of all directed, outgoing arrows from anywhere in the visited set to some other vertex (possibly including some arrows pointing to vertexes already in the visited set).
At each recursive step, you skip any such outgoing arrows to vertexes you've already visited, and when you find an unvisited vertex with minimum weight, you add that edge to your mst, add the unvisited vertex to those visited, and augment the set of outgoing arrows with any arrows outgoing from the newly visited vertex.
(In your code, you delete x, though there's no technical need to do this, as it'll be filtered out as part of the "already visited" check.)
With the above change to mkGraph, your prim seems to work correctly on g1, g2, and the graph:
g3 = mkGraph (1,3) [(1,3,10), (2,3,1)]
module Sample where
lastPeg = 15
leftCol = [1, 2, 4, 7 , 11]
rightCol = [1, 3, 6, 10, 15]
rowData = []
makeRowData :: Integer-> Integer-> [Integer]
makeRowData row pos =
if (pos <= lastPeg) then
if (pos >= leftCol !! (fromIntegral row-1)) &&
(pos <= rightCol !! (fromIntegral row-1)) then
do
rowData ++ [row]
makeRowData row (pos + 1)
else
makeRowData (row+1) (pos)
else
rowData
What I am essentially trying to do is make a triangle-shaped vector
represented as a single vector. Given a position within the triangle
I want to return the row containing that position.
For example:
rowData [6] = 4 (Represented as the 7th position in the triangle)
desired result: rowData = [1, 2, 2, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5, 5]
actual result: rowData = []
What am I doing wrong? Thanks.
Your central issue is in this part of the code:
do
rowData ++ [row]
makeRowData row (pos + 1)
I wonder if someone explained the operator (++) :: [a] -> [a] -> [a] to you as “appends a list to another list”, giving you the impression that an expression like xs ++ ys modifies xs. The first problem is that this isn’t the case; in reality this operator returns a new list consisting of the two inputs concatenated together, e.g. in GHCi:
> xs = [1, 2, 3]
> ys = [4, 5]
> xs ++ ys -- Append the lists.
[1, 2, 3, 4, 5]
> xs -- The original lists aren’t modified.
[1, 2, 3]
> ys
[4, 5]
The second problem is that the do block here has misled you: it’s operating on lists, so it doesn’t do the sequencing like IO that you seem to expect. do notation can be used with lists because the list type has an instance of the Monad typeclass, but instead of sequencing like IO, the list Monad instance does iteration, exactly like a list comprehension.
A full tutorial on monads and do notation is beyond the scope of this answer, but for example, all of these are equivalent:
-- List comprehension:
[x * y | x <- [2, 3], y <- [3, 5]]
-- Equivalent ‘do’ notation:
do { x <- [2, 3]; y <- [3, 5]; pure (x * y) }
-- Desugared ‘do’ notation:
[2, 3] >>= (\ x -> [3, 5] >>= (\ y -> pure (x * y)))
-- Instances of ‘Monad’ & ‘Applicative’ for lists:
concatMap (\ x -> concatMap (\ y -> [x * y]) [3, 5]) [2, 3]
-- Result of all of the above:
[6, 10, 9, 15]
So what your do block is doing is iterating over the list rowData ++ [row], which is always the single element row, because rowData is always the empty list [], by its definition. = means equal! In that single “loop” iteration, there’s a recursive call to makeRowData, and these calls continue, counting up with the pos parameter until it reaches lastPeg, at which point the function returns rowData, which is, again, just another name for [].
There are simpler and more idiomatic ways to solve the problem, but for the sake of learning, if you want to make as small a modification as possible and keep essentially this same explicit recursive structure, then the general principle of the solution is this:
Add a helper function with an “accumulator” parameter that keeps track of your intermediate state
Call this function from makeRowData with the initial state
If necessary, perform some final processing on the result before returning it from makeRowData
For example:
makeRowData :: Integer -> Integer -> [Integer]
makeRowData initialRow initialPos
-- Start the “loop” with an initial ‘rowData’ of ‘[]’.
= makeRowDataHelper [] initialRow initialPos
makeRowDataHelper :: [Integer] -> Integer -> Integer -> [Integer]
makeRowDataHelper rowData row pos =
if (pos <= lastPeg) then
if (pos >= leftCol !! (fromIntegral row-1)) &&
(pos <= rightCol !! (fromIntegral row-1)) then
-- To “modify” the state for the next iteration,
-- recursively call ‘go’ with different values.
makeRowDataHelper (rowData ++ [row]) row (pos + 1)
else
makeRowDataHelper rowData (row+1) (pos)
else
-- To exit the iteration, just return a value.
rowData
I haven’t tested whether your logic is actually correct here, but at least this should help you get unstuck.
Beyond that, there are also a few performance and style improvements you could make here:
Appending linked lists with ++ is slow; each iteration of go above, ++ must traverse the entire left hand side to construct its result, and that argument grows with each recursive call, so this function ends up taking quadratic time O(n2) in the length of the input. That doesn’t matter so much for small lists like this, but quickly becomes too inefficient to use with larger inputs.
A common way to solve this is to instead prepend elements to the accumulator parameter using the “cons” operator (element : list) in reverse order instead of appending them (list ++ [element]), then reverse the result afterward if necessary, since this is only linear O(n).
Instead of if … then … else … at the top level of a definition, it’s generally considered more idiomatic to use guards, for example:
go rowData row pos
| pos > lastPeg
= rowData
| pos >= leftCol !! (fromIntegral row-1)
, pos <= rightCol !! (fromIntegral row-1)
= …
| otherwise
= …
You’re repeatedly using !! on lists, which also takes linear time O(n) in the value of the index to traverse the list. Consider using a different data structure, such as Data.Array or Data.Vector which have constant-time O(1) indexing, or a different algorithm that doesn’t require random-access indexing into the lists. (E.g. look into the replicate function.)
It's signature has to look like this:
groupBy :: (a -> a -> Bool) -> [a] -> [[a]]
My function should group the input list's elements to output lists based on whether the elements are equal or there's a strictly monotonous incrementing partlist in it.
Examples for termination:
-- groupBy (==) groups the equal elements
groupBy (==) [0, 0, 1, 1, 2, 2] == [[0, 0], [1, 1], [2, 2]]
groupBy (==) [0, 1, 2] == [[0], [1], [2]]
-- groupBy (<) returns the strictly monotonous incrementing partlists
groupBy (<) [0, 1, 2, 1, 2, 3] == [[0,1,2],[1,2,3]]
groupBy (<) [3, 4, 5] == [[3, 4, 5]]
groupBy (>=) [3, 3, 1, 5] == [[3,3,1],[5]] --- monotonous decrementing
-- partlists, where the consecutive elements' difference is 1:
groupBy (\x y -> abs (x - y) == 1) [0, 1, 3, 4] == [[0, 1], [3, 4]]
groupBy (\x y -> abs (x - y) == 1) [1, 2, 3, 2, 1, 10, 11] == [[1,2,3,2,1],[10,11]]
Thanks for your help in advance :)
Look at the comparisons that have to happen here. You're providing a function f :: a -> a -> Bool that will group each item as long as it remains true, in other words:
groupBy (>=) [3, 3, 1, 5, 4]
[3]
3 >= 3 = True [3, 3] -- add RHS value
3 >= 1 = True [3, 3, 1]
1 >= 5 = False -- new group!
[5]
5 >= 4 = True [5, 4]
This looks like recursion to me. Your inner function should keep an accumulator, look at each element of the list and decide to either A) include it in the current accumulator or B) give the accumulator back and start a new one based on the results of f.
It's probably helpful to define groupBy as a wrapper around some helper function that does the real work.
groupBy :: (a -> a -> Bool) -> [a] -> [[a]]
groupBy f (x:xs) = go f [x] xs
where
-- base case: no values left to check
go _ acc [] = [acc]
-- recursive case
go f acc#(y:_) (x:xs)
| y `f` x = go f (x:acc) xs -- add to current group
| otherwise = acc : go f [x] xs -- start a new group
Note that the above has a subtle bug that I left in for illustrative purposes (and also because I wrote it this way first, so you might, too!)
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]]