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)]
Related
As a newbie to Haskell, thinking in a way that's idiomatic is a challenge. I have a list of dyads. I want to weight dyad members according to two maps, one indicating the direction of the weighting and the other providing the weighting itself. In the following code 1 indicates that the bottom member of the dyad receives the weight; -1 the top member of the dyad receives the weight; 0 that both members receive the weight. In all cases it is the difference between dyad members that determines the weight and direction
My question is how can I re-use the definitions for top and bottom weight allocation in the case where the weighting is equal? Every source I have consulted so far seems to indicate that guards can have only one outcome - which I suspect is the proper Haskell way...
allocateWeight :: [[Integer]] -> (Integer, Integer, Maybe Double)
allocateWeight [x, y]
|direction <= Just 1 = assignBottom
|direction <= Just (-1) = assignTop
|direction <= Just 0 = (?? assignBottom and assignTop ??)
where diff = (abs(x!!1 - y!!1))
direction = Map.lookup diff getWeightDirection
weight = Map.lookup diff schemaCAT
assignBottom = (head x, last x, weight)
assignTop = (head y, last y, weight)
Okay Ive been asked to clarify further. Ill cut the non essentials as they will only cloud the issue.
Stage 1: start with a list of values eg: [6, 3, 8, 11, 2] : values constrained between 1 and 12.
Stage 2: permutate them into dyads: [(6,3),(6,8), (6,11), (6,2), (3, 8), (3, 11),(3, 2),(8, 11)(8, 2),(11,2)]
Stage 3: Get the absolute difference of each pair:[(3),(2),(5),(4),(5), (8), (1), (3), (6),(9)]
Stage 4: According to the difference between them ONE member of each dyad (with 6 being the exception) will receive a weighting; this is pre-determined in the following map:
getWeightDiretion :: Map.Map Integer Integer -- determine weight direction
getWeightDirection = Map.fromList $
[(1, -1),
(2, -1),
(3, 1),
(4, 1),
(5, -1),
(6, 0),
(7, 1),
(8, -1),
(9, -1),
(10, 1),
(11, 1),
(12, 1))]
As stated if the value of map lookup is 1 weight goes to bottom; -1 to top. The problem is when looking up key is 6 when neither of the dyad members are weighted more than the other: that is, they receive weight equally. The weightings are also predetermined by looking keys up in this map:
schemaCAT :: Map.Map Integer Double --Cross-At-Tail weighting scheme
schemaCAT = Map.fromList $
[(12, 0.985),
(11, -0.7),
(10, 0.2),
(9, 0.4),
(8, 0.6),
(7, 0.9),
(6, 0.08),
(5, 0.8),
(4, 0.7),
(3, 0.5),
(2, 0.1),
(1, -0.8),
(999, 0.25)]
The input to the allocateWeights function is in the form [[(-1, 6), (0, 3)], [.... where the first member of each tuple in each sub-list is a transposing factor - which is not relevant here; the second is one of a permutation pair. Each sub-list in the input represents one permutation. The allocateWeights function operates on x!!1 of each tuple in each sub-list directly.
After applying the above I should end up with a list a tuples [(-1, 3, 0.5)....] The second tuple member is the member of the tuple that receives the weight and the third is the weight itself (I'll leave out what the first member of the tuple is as is not important. The same with key 999 which is a special case).
As far as I understand it I have two problems. First, maps return Maybes and using these values in guards is problematic, Second, is the issue of using two definitions on the right hand side of an expression in a guard. Still struggling with 'Justs' and 'Maybes' :(
THX....
I’m not sure how you intend to combine the results when you write “assignBottom and assignTop”, but I can offer a few suggestions that may help.
When you find yourself in a situation like this, with a tangle of primitive types that are frustrating to work with, it’s usually a sign that you’re trying to do too many things at once in a single function, and that you need to introduce auxiliary functions or data types and compose them to solve the problem. When I look at this code:
allocateWeight :: [[Integer]] -> (Integer, Integer, Maybe Double)
allocateWeight' [x, y]
|direction <= Just 1 = assignBottom
|direction <= Just (-1) = assignTop
|direction <= Just 0 = (?? assignBottom and assignTop ??)
where diff = (abs(x!!1 - y!!1))
direction = Map.lookup diff getWeightDirection
weight = Map.lookup diff schemaCAT
assignBottom = (head x, last x, weight)
assignTop = (head y, last y, weight)
What jumps out at me are the following:
Is it allocateWeight or allocateWeight'?
The input is [[Integer]], but you say that the inner lists are known to be “dyads”, so this list probably wants to be a list of pairs [(Integer, Integer)].
Furthermore, allocateWeight assumes that there are only two elements in the outer list with the pattern [x, y]. Is this function meant to operate on the whole list, or each pair in the list?
The result type (Integer, Integer, Maybe Double), doesn’t explain its meaning; it would benefit from being a data type.
A series of guards direction <= Just … suggests that you want to first pattern-match on the Maybe value and then compare its range.
Your guard values are overlapped. Guards are checked in order, Nothing compares less than Just x for any x, and Just x <= Just y if x <= y. So if the value isn’t found, Nothing will compare less than Just 1 and the first guard will be taken; and if the value compares less than or equal to Just (-1) or Just 0, then it must already have compared less than or equal to Just 1, so the other two guards will never fire.
diff = (abs(x!!1 - y!!1)) again suggests that these don’t want to be lists; the indexing operator !! is best avoided in ordinary code. (It does have some use in cases where, for example, you’re using a list for memoisation, but that’s for another time.)
The weight directions are always -1, 0, or 1, which is asking to be a data type.
The returned weight probably shouldn’t be wrapped in a Maybe.
So just in terms of code organisation, here’s how I would approach this:
-- A pair of a value with a weight.
data Weighted a = Weighted a Double
deriving (Show)
-- The direction in which to weight a pair.
data WeightDirection
= WeightBottom
| WeightTop
| WeightBoth
-- Use data type instead of integer+comment.
getWeightDirection :: Map.Map Integer WeightDirection
getWeightDirection = Map.fromList
[ (1, WeightTop)
, (2, WeightTop)
, (3, WeightBottom)
, (4, WeightBottom)
, (5, WeightTop)
, (6, WeightBoth)
-- …
]
-- Allocate weights for a single pair.
allocateWeight :: (Integer, Integer) -> [Weighted Integer]
allocateWeight (x, y) = case Map.lookup diff getWeightDirection of
Just direction -> case Map.lookup diff schemaCAT of
Just weight -> case direction of
WeightBottom -> [Weighted x weight]
WeightTop -> [Weighted y weight]
WeightBoth -> [Weighted x weight, Weighted y weight]
-- What do you want to do in this case?
Nothing -> error ("direction for " ++ show diff ++ " not found")
-- What do you want to do if the difference isn’t found?
-- Raise an error like this, or return a default?
Nothing -> error ("weight for " ++ show diff ++ " not found")
where
diff = abs (x - y)
I’ve guessed that when you want to allocate weight “equally” to both values, that you want to include both values in the result, each with their own weight, so I’ve changed allocateWeight to return a list. If you want to combine the weights in a different way, say, (x * weight / 2 + y * weight / 2) or something like that, then you may not need that. Using lists, as to your particular question, you could also write: bottom = [Weighted x weight] and top = [Weighted y weight], and then return bottom, top, or their concatenation bottom ++ top as needed.
But this illustrates what I want to show: with this function for operating on a single pair, you can compute the results for a whole list of pairs by mapping it over the input list and concatenating the results, using those functions separately or using concatMap:
allocateWeight :: (Integer, Integer) -> [Weighted Integer]
map allocateWeight :: [(Integer, Integer)] -> [[Weighted Integer]]
concatMap allocateWeight :: [(Integer, Integer)] -> [Weighted Integer]
You may be asking: what happened to the “extra” values you were keeping alongside each pair? The answer is that this function shouldn’t be concerned with them; generally the approaches are to extract the portions you need (with map or similar) and recombine the results (e.g. using zipWith prior to concat), or parameterise this function so it can only see the portions of a value that it needs, e.g.:
allocateWeightBy :: (a -> Integer) -> (a, a) -> [Weighted a]
allocateWeightBy getValue (x, y) = …
-- Since ‘x’ has a polymorphic type, it enforces that
-- the only thing you can do with it is call ‘getValue’
-- or return it in the list of weighted values.
The other thing is that if you’re struggling with Maybe results from looking up keys that may not be present in a Map, you may just need practice, but you could also benefit from trying different approaches, like:
Use case wherever you have a lookup to explicitly handle the absence of a value. It’s verbose but it works and can be made more idiomatic later.
If the Nothing case should raise an error, use the unsafe indexing operator (Data.Map.!). (Like !! this can be a sign of poor data structuring, and can bite you later.)
If you just want to provide a default value, use functions like fromMaybe found in Data.Maybe, e.g. fromMaybe (defaultWeight :: Double) (maybeWeight :: Maybe Double) :: Double.
Use a function instead of a Map, with a fallthrough case for a key that’s not found.
First of all, I have a board (10 x 10) and a list of specific coordinates, I'm trying to write a function that gets a certain coordinate and a list of specific coordinates and counts how many squares from that list is connected. e.g. let's say I send coordinate ('C', 5) and list [('C', 5), ('D', 5), ('D', 6), ('A', 4)], the function should return [('C', 5), ('D', 5), ('D', 6)] because all of the coordinates are connected. It would seem easy at object orientated programming but I cant figure a way to do that in functional programming.
something like this?
connected p = map fst . filter ((<=1).snd) . map (liftA2 (,) id (dist p))
where dist (a,x) (b,y) = max (abs (fromEnum a - fromEnum b)) (abs (y-x))
find the elements where max axis distance is less or equal to one, that is the cell itself or immediate neighbors. Perhaps can be written in a shorter way.
> connected ('C',5) [('C', 5), ('D', 5), ('D', 6), ('A', 4)]
should return
[('C',5), ('D',5), ('D',6)]
It's possible to use applicative style to generate the neighborhood then filter with elem. I used pred and succ to handle Enum instances (e.g. Integer, and Char):
filterConn :: (Char,Integer) -> [(Char,Integer)] -> [(Char,Integer)]
filterConn (r,c) = filter (`elem` genNeighborhood)
where
genNeighborhood = (,) <$> [pred r, r, succ r] <*> [pred c, c, succ c]
Furthermore, to obey bounds like a 10x10 board, I would define custom myPred, mySucc functions that only increment or decrement while obeying the bounds (note there will be duplicates when near a bound):
myPred :: (Enum a, Ord a) => a -> a -> a
myPred bound val = if pred val >= bound then pred val else val
mySucc :: (Enum a, Ord a) => a -> a -> a
mySucc bound val = if succ val <= bound then succ val else val
Then just drop in myPred and mySucc to genNeighborhood with their respective bounds like so:
genNeighborhood = (,) <$> [myPred 'A' r, r, mySucc 'J' r] <*> [myPred 1 c, c, mySucc 10 c]
Finally, use length to count how many squares are connected:
countConn s sqs = length $ filterConn s sqs
References: LYAH, Prelude
This question is based on to the 11th advent of code task. It basically is a more general version of the river crossing puzzle, you can go up and down floors while carrying one or two items each step. The goal is to bring up all items to the 4th floor.
This is fairly straightforward to solve with an A* search but finding the neighboring states is somewhat annoying.
When solving the puzzle originally I just created masks for all items on the current floor and then used the list monad to generate the combinations - slow and awkward but it works. I figured that there would be an elegant solution using lenses, though.
An easy solution could use a function that returns all options of moving a single item from floor x to floor y. Is there a way to get all combinations of applying a function to a single element using lenses? i.e. f 1 2 [(1, 0), (1, 2)] = [[(2, 0) (1, 2)], [(1, 0), (2, 2)]]
For the sake of reference, this is the best I could come up with so far, slightly simplified:
import Control.Lens
import Data.List (sort)
import Data.Set (fromList, Set)
type GenFloor = Int
type ChipFloor = Int
type State = [(GenFloor, ChipFloor)]
neighborStates :: Int -> State -> Set State
neighborStates currentFloor state = finalize $ createStatesTowards =<< [pred, succ]
where
createStatesTowards direction = traverseOf (traverse . both) (moveTowards direction) state
moveTowards direction i
| i == currentFloor = [direction i, i]
| otherwise = [i]
finalize = fromList . map sort . filter valid
valid = (&&) <$> validCarry <*> validFloors
validCarry = (`elem` [1..2]) . carryCount
carryCount = length . filter (uncurry (/=)) . zip state
validFloors = allOf (traverse . each) (`elem` [1..4])
An easy solution could use a function that returns all options of moving a single item from floor x to floor y. Is there a way to get all combinations of applying a function to a single element using lenses? i.e. f 1 2 [(1, 0), (1, 2)] = [[(2, 0) (1, 2)], [(1, 0), (2, 2)]]
holesOf can do that. Quoting the relevant simplified signature from the documentation:
holesOf :: Traversal' s a -> s -> [Pretext' (->) a s]
Given a traversal, holesOf will generate a list of contexts focused on each element targeted by the traversal. peeks from Control.Comonad.Store can then be used to, from each context, modify the focused target and recreate the surrounding structure:
import Control.Lens
import Control.Comonad.Store
-- allMoves :: Int -> Int -> State -> [State]
allMoves :: (Traversable t, Eq a) => a -> a -> t (a, b) -> [t (a, b)]
allMoves src dst its = peeks (changeFloor src dst) <$> holesOf traverse its
where
-- changeFloor :: Int -> Int -> (Int, Int) -> (Int, Int)
changeFloor src dst = over both (\x -> if x == src then dst else x)
GHCi> allMoves 1 2 [(1,0),(1,2)]
[[(2,0),(1,2)],[(1,0),(2,2)]]
I am writing a function in Haskell that takes a Point and a Double that represent the center and side length of a cube, respectively.
A Point is type Point = [Double].
The function signature is getCubeFaces :: Cube -> [Face] where a Face is data Face = Face [Point] and a Cube is data Cube = Cube Point Double.
My question is, how do I go about doing this? I've tried the naive approach of
[ Face [ [-1, 1, 1], [1, 1, 1] ...
and listing all the 6 faces as described by their 8 points - but this is really ugly.
Is there a more intuitive / patterned way to go about this (without having access to a normal vector)?
First let
type Vector = Point
a <+> b = zipWith (+) a b --vector addition
a <*> b = map (*b) a --vector scalar multiplication
Then, I suggest two methods. The cubes are centered at 0, 0, 0, with side length of 2. You can later map (\face -> map (\point -> point <*> sideLength/2 <+> center). First
face :: Vector -> Vector -> Vector -> Face
face x y z = [x <+> (y <*> i) <+> (z <*> j) | i <- [-1, 1], j <- [-1, 1]]
cube :: [Face]
cube = let
axes = [[1, 0, 0], [0, 1, 0], [0, 0, 1]]
directions = zipWith (\ds i -> map (<*>i) ds) (permutations axes) (cycle [1, -1])
in map (\[x, y, z] -> face x y z) directions
And second,
cube' :: [Face]
cube' = let
points = [[x, y, z] | x <- [-1, 1], y <- [-1, 1], z <- [-1, 1]]
pair i = partition (\x -> x !! i > 0) points
in map pair [0..2] >>= (\(a, b) -> [a, b])
While the second is shorter, note that the first allows you more flexibility when you figure out that you actually wanted type Face = [Triangle].
I'm reading through the Gentle Introduction and am wondering why in a list comprehension with two generators, the rightmost generator is iterated "the fastest" (i.e. compiles to the innermost loop, I guess). Observe the following GHCi output:
*Main> concat [[(x,y) | x <- [0..2]] | y <- [0..2]]
[(0,0),(1,0),(2,0),(0,1),(1,1),(2,1),(0,2),(1,2),(2,2)]
*Main> [(x,y) | x <- [0..2], y <- [0..2]]
[(0,0),(0,1),(0,2),(1,0),(1,1),(1,2),(2,0),(2,1),(2,2)]
If the leftmost generator were iterated fastest, the above two expressions would have the same value, which I think makes choosing this convention more natural somehow.
So does anyone know why the opposite convention was chosen? I notice Python has the same convention as Haskell (maybe even borrowed it from Haskell?), and in Python world the word seems to be that the ordering was chosen "because that's the order in which you'd write a for loop", but I gather that thinking in terms of for loops is not exactly what most Haskell programmers do...
Thoughts?
From my comment on Louis Wasserman's answer below:
I guess here the order corresponding to an imperative-style explication of the comprehension was considered more natural than having it correspond with nesting the list. So in essence the Haskell explanation for this is the same as the Python explanation I linked in the question, after all, it seems.
So that things scope in a sane way.
[(x, y) | x <- [1..10], y <- [1..x]]
makes sense -- x is in scope for the comprehension on y -- but
[(x, y) | y <- [1..x], x <- [1..10]]
makes somewhat less sense.
Additionally, this way it's consistent with the do monad syntax:
do x <- [1..10]
y <- [1..x]
return (x, y)
It may make more sense if you expand the list comprehension first into do notation and then into monadic binds. Let's say we want to write a comprehension where we refer back to names that are already bound:
[ (x,y) | x <- [1,2,3], y <- [x+1,x+2] ]
This expands to
do x <- [1,2,3]
y <- [x+1,x+2]
return (x,y)
which expands to
[1,2,3] >>= \x ->
[x+1,x+2] >>= \y ->
return (x,y)
which makes it clear that x is in scope exactly when it needs to be.
If the expansion into do notation happened right-to-left instead of left-to-right, then our original expression would expand into
[x+1,x+2] >>= \y ->
[1,2,3] >>= \x ->
return (x,y)
which is clearly nonsensical - it refers to the value of x in a scope where x is not yet bound. So we'd have to write our original comprehension as
[ (x,y) | y <- [x+1,x+2], x <- [1,2,3] ]
to get the result we wanted, which seems unnatural - at the time your eye scans over the phrase y <- [x+1,x+2] you don't actually know what x is. You'd have to read the comprehension backwards to find out.
So it'd didn't need to be the case that the right-most binding is unrolled into the "inner loop" but it makes sense when you consider that humans are going to have to read the resulting code.
Actually Python uses the same scope structure as Haskell for list comprehensions.
Compare your Haskell:
*Main> concat [[(x,y) | x <- [0..2]] | y <- [0..2]]
[(0,0),(1,0),(2,0),(0,1),(1,1),(2,1),(0,2),(1,2),(2,2)]
*Main> [(x,y) | x <- [0..2], y <- [0..2]]
[(0,0),(0,1),(0,2),(1,0),(1,1),(1,2),(2,0),(2,1),(2,2)]
with this Python:
>>> from itertools import chain
>>> list(chain(*[[(x,y) for x in range(3)] for y in range(3)]))
[(0, 0), (1, 0), (2, 0), (0, 1), (1, 1), (2, 1), (0, 2), (1, 2), (2, 2)]
>>> [(x,y) for x in range(3) for y in range(3)]
[(0, 0), (0, 1), (0, 2), (1, 0), (1, 1), (1, 2), (2, 0), (2, 1), (2, 2)]
>>>