I am trying to get my feet wet with Haskell and I have found a few workshop which asks to create a graph data structure. I followed along and created a Binary Tree using map which felt much simpler. I have the following data types given
type Graph a = [(Node a, Edges)]
type Edges = [NodeID]
type NodeID = Int
data Node a = Node
{ getNodeID :: NodeID,
getNodeVal :: a
}
deriving (Show, Eq)
and example node would be as follows
nodeA = Node 0 'A'
and an example graph connected both ways would be
graphA = [(nodeA, [1]), nodeB, [0]]
Now in order to do any kind of insert or remove operation, I would first have to find out what the max NodeID at the moment is. So I am trying to write a maxNodeID as follows
maxNodeID :: Graph a -> Maybe NodeID
maxNodeID [] = Nothing --base case
But I am having a real hard coming up with the next case for this function.
My type definition for insertNode function is as follows
insertNode :: a -> Graph a -> Graph a
-- This is my idea for a base case but I get a parse error at 0
insertNode v [] = [a, []] where a = Node {0, v}
Any help with this and creating a insertNode function would be much appreciated as it would really help me set myself in the right path.
Rather than rolling my own, I would use the maximumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a functrion from Data.List.
maxNodeID :: Graph a -> Maybe NodeID
maxNodeID [] = Nothing --base case
maxNodeID xs = Just $ maximumBy (\a b -> compare (getID a) (getID b)) xs
where getID = getNodeID . fst
For your insertNode function you need
insertNode v [] = [(a, [])] where a = Node 0 v
-- or --
insertNode v [] = [(a, [])] where a = Node {getNodeID = 0, getNodeVal= v}
Edited to add:
If you are not comfortable with type classes yet, you can read the type of maximumBy specialized for Lists as :: (a -> a -> Ordering) -> [a] -> a.
Related
I'm almost there with this code the only difference is instead to adding n1 to the graph, I have to add the edges of n1 to the graph but I can't seem to figure out how.
Question: The file includes a function named insertEdge of type Eq a =>
(NodeID,NodeID) -> Graph a -> Maybe (Graph a) that inserts an
edge from the Node with the given NodeID in the first part of the tuple
to the Node with the given NodeID in the second part of the tuple.
If the edge already exists, it should NOT introduce a duplicate. If
the nodes corresponding to either of the given NodeIDs do not already
exist, the function should return Nothing.
`insertEdge :: Eq a => (NodeID,NodeID) -> Graph a -> Maybe (Graph a)
insertEdge _ (Graph []) = Nothing
insertEdge (n1,n2) g#(Graph graph)
| not containsBothNodes = Nothing
| otherwise = Just(Graph(insertE (n1,n2) graph))
where
containsBothNodes :: Bool
containsBothNodes = case(lookupNode n1 g) of
(Just _)->True
_ -> False
insertE (n1,n2) ((n0,es):graph)=
if (getNodeID n0)==n2
then
if es/=[]
then (n0,es):graph
**else (n0,es++[n1]):graph**
else (n0,es):insertE (n1,n2)graph
Description of the graph
newtype Graph a = Graph [(Node a,[NodeID])]
deriving (Show,Eq)
type NodeID = Int
data Node a = Node { getNodeID :: NodeID,
getNodeVal :: a }
deriving (Show,Eq,Ord)
nodeA,nodeB,nodeC :: Node Char
nodeA = Node 0 'A'
nodeB = Node 1 'B'
nodeC = Node 2 'C'
exGraph :: Graph Char
exGraph = Graph [(nodeA,[1,2])
,(nodeB,[])
,(nodeC,[1,2])]
`
I highlighted the part that I cannot figure out. Instead of adding n1, it should add the edges of n1
I'm trying to insert a node to a graph. I already have a function to find the maximum nodeID so the new nodeID is 1 greater than it but I'm having trouble getting the output as a graph.
newID :: Maybe NodeID -> NodeID
newID Nothing = 1
newID (Just x) = x+1
insertNode :: a -> Graph a -> Graph a
insertNode v (Graph node_list)=
let newNode=Node(newID(maxNodeID (Graph node_list))) v
in (node_list): [[(newNode,[])]]
Description for the graph is:
newtype Graph a = Graph [(Node a,[NodeID])]
deriving (Show,Eq)
type NodeID = Int
data Node a = Node { getNodeID :: NodeID,
getNodeVal :: a }
deriving (Show,Eq,Ord)
nodeA,nodeB,nodeC :: Node Char
nodeA = Node 0 'A'
nodeB = Node 1 'B'
nodeC = Node 2 'C'
exGraph :: Graph Char
exGraph = Graph [(nodeA,[1,2])
,(nodeB,[])
,(nodeC,[1,2])]
I've been stuck for this for 2 hours now. I just want to insert the new node at the end of the graph.
You're almost there, the only things you have to change are:
Use (++) :: [a] -> [a] -> [a] instead of (:) :: a -> [a] -> [a]. The : operator is for inserting things at the front, for adding to the end of a list the simplest way is to use the form xs ++ [x].
Wrap the result in a Graph constructor.
So a working version is:
insertNode :: a -> Graph a -> Graph a
insertNode v (Graph node_list)=
let newNode=Node(newID(maxNodeID (Graph node_list))) v
in Graph (node_list ++ [(newNode,[])])
I am trying to add an edge to a graph in Haskell where the graph data type is defined as:
data Graph a = Graph [(a, [a])]
deriving (Show)
Effectively, my data type is defined as: A Graph is a list of nodes stored as tuples, where the first element is the node value and the second element is a list of its edges (i.e., which other nodes it is connected to).
When inserting an edge between two nodes (u,v), you first have to check that both nodes exist and that the edge does not already exist. That is, that (u, [a,b...n]) and (v,[a,b...n]) their respective lists of edges does not contain u or v. Thus, I have two functions that performs this check. If this check passes and due to that my data type is defined as above mentioned, I must insert u and v in respective node's lists. After this, I must return a new Graph.
addEdge :: Eq a => Graph a -> (a, a) -> Graph a
addEdge g (u, v)
| (existsNode u g) && (existsNode v g) && (not (existsEdge (u, v) g)) = undefined
| otherwise = g
-- Check if an edge between two nodes exists
existsEdge :: Eq a => (a, a) -> Graph a -> Bool
existsEdge (u, v) g = elem u (getEdges (u, v) g) && elem v (getEdges (u, v) g)
getEdges :: Eq a => (a, a) -> Graph a -> [a]
getEdges (u, v) g =
let rightNeighbours = getNodeNeighbours (getNode u g)
leftNeihbours = getNodeNeighbours (getNode v g)
in rightNeighbours ++ leftNeihbours
-- Get a node given its node id
getNode :: Eq a => a -> Graph a -> (a, [a])
getNode y (Graph []) = (y, [])
getNode y (Graph (x : xs))
| y == fst x = x
| otherwise = getNode y (Graph xs)
I need a way to fill the part where undefined is now with something that takes each node u and v, and appends v to u's neighbors list (u,[v]) and vice versa (v, [u]), that results in returning a Graph.
For example, if we have that:
g = (Graph [(1,[2]),(2,[1]), (3,[2])])
And we want to add an edge between nodes 3 and 1. We first see that both nodes exist, and that an edge does not already exist -->
g = (Graph [(1,[2,3]),(2,[1]), (3,[2,1])])
Is there a way to do this in Haskell?
This is a nice example for a common rule of thumb:
Avoid boolean checks and then conditionally doing something. Instead write functions that attempt doing something, and fail if it's not possible.
Your task can be broken down to:
Pick out both of the nodes between which you want the edge (if they exist). You should do this in a way that allows also tweaking them, not just reading out.
Modify the edges-list of one of the nodes, inserting the new edge (if it doesn't exist).
The failure cases should be associated with a Maybe type: if an operation isn't possible, it's typically a bad idea to have it silently fail, instead you should make it clear that the update wasn't applied and then leave it to the caller to ignore it or do something else.
addEdge :: Eq a => Graph a -> (a, a) -> Maybe (Graph a)
Now, what do I mean by “do this in a way that allows also tweaking [the nodes]”? It means that you should return a view into the old version, as well as a function that, given a modified value of the node, reconstructs the corresponding modified version of the entire graph. Specifically, you want to modify the outgoing edges. (Modifying the node's key would require also updating all other nodes that may point to it; we don't need that.)
getNode :: Eq a => a -> Graph a -> Maybe ((a, [a]), [a] -> Graph a)
This signature looks a bit daunting; let's introduce some type synonyms to make it easier:
type Node a = (a, [a])
type NodeView a = (Node a, [a] -> Graph a)
getNode :: Eq a => a -> Graph a -> Maybe (NodeView a)
The main change in implementation is that you need to “remember” the nodes in the list that were skipped because they didn't match. I would do this with an auxiliary function
getNode' :: Eq a => a -> Graph a
-> [Node a] -- ^ The nodes that need to be prepended in the reconstructed graph
-> Maybe (NodeView a)
getNode' _ _ (Graph []) = Nothing -- Node was not found
getNode' y prep (Graph ((x,es):ns))
| x==y -- Node was found, now create a view to it:
= Just ( (x,es)
, \es' -> Graph $ prep ++ (x,es') : xs )
| otherwise -- Not found yet, but maybe later. Add currently tried node to the prep-list.
= getNode' y ((x,es):prep) (Graph ns)
Obs: the above makes a change to the reconstructed graph that may or may not matter for you. Can you spot what it is?
In practice, you shouldn't use getNode' directly, but always call it with empty prep list. In fact you should probably make it a local “loop body” function:
getNode :: Eq a => a -> Graph a -> Maybe (NodeView a)
getNode y = go y []
where go _ _ (Graph []) = Nothing
go y prep (Graph ((x,es):ns)) = ...
For the rest of the task, you can use the NodeView given by this function as a helper to create the whole updated graph.
I'm writing a very simple two-pass assembler in Haskell and I've come across a scenario that I don't yet have the experience to solve. I think the solution is likely to involve monad transformers, which I don't really understand.
The assembler parses the assembly code into a list of Statements, which are either instructions or labels. Some Statements may refer to labels. The assembler needs to convert the Statements into Instructions, which involves eliminating the labels and substituting the label references with an appropriate value.
I have written the first pass of the assembler, which produces a [(String, Int)] representing a map from labels to addresses. I have also written the following function for translating a Statement into an Instruction:
stmtToInstruction :: Int -> [(String, Int)] -> Statement -> Either String [I.Instruction]
stmtToInstruction addr labels stmt = case stmt of
ADD d s1 s2 -> Right [I.ADD d s1 s2]
BEQL s1 s2 l -> case do label <- find (\e -> fst e == l) labels
let labelAddr = snd label
let relativeAddr = I.ImmS $ fromIntegral (labelAddr - addr)
return (I.BEQ s1 s2 relativeAddr) of
Just i -> Right [i]
Nothing -> Left $ "Label " ++ l ++ " not defined"
LABEL _ -> Right []
I've omitted several cases for brevity, but you can see all the possible results here:
ADD always succeeds and produces an instruction
BEQL can either succeed or fail, depending on whether a label is found
LABEL always succeeds, even though it produces no actual instructions
This works as expected. The problem I now have is writing this function:
replaceLabels :: [Statement] -> Either String [I.Instruction]
replaceLabels takes a list of statements, and runs stmtToInstruction on each one. The addr argument to stmtToInstruction must be the length of the [Instruction] accumulated so far. The output may either be a Left String, if one of the label references was invalid, or a Right [I.Instruction], if there were no errors.
mapM :: Monad m => (a -> m b) -> [a] -> m [b] gets us some of the way there, but provides no way to inject the current address into the (a -> m b) function. How do I make this work?
You're right: the StateT monad transformer will do the trick:
imapM :: (Traversable t, Monad m)
=> (Int -> a -> m b) -> t a -> m (t b)
imapM f = flip runStateT 0 .
mapM (\a ->
do
count <- get
put $! count + 1
f count a)
But writing the specialized version for lists might be better:
itraverse :: Applicative f
=> (Int -> a -> f b) -> [a] -> f [b]
itraverse f = go 0 where
go !_ [] = pure []
go !count (x:xs) = (:) <$> f count x <*> go (count + 1) xs
I've implemented a recursive solution that I'm sure is very inefficient. I'd still be interested to see the 'proper' way of doing this.
replaceLabels :: [Statement] -> Either String [I.Instruction]
replaceLabels [] = Right []
replaceLabels stmts#(s:ss) = replaceLabels' labels stmts 0
where labels = process stmts
replaceLabels' :: [(String, Int)] -> [Statement] -> Int -> Either String [I.Instruction]
replaceLabels' _ [] _ = Right []
replaceLabels' labels (s:ss) addr = do
instructions <- stmtToInstruction addr labels s
restInstructions <- replaceLabels' labels ss (addr + length instructions)
return (instructions ++ restInstructions)
I would start by changing
stmtToInstruction :: Int -> [(String, Int)] -> Statement -> Either String [I.Instruction]
into
stmtToInstruction :: [(String, Int)] -> Statement -> Either String (Int -> [I.Instruction])
That is, moving the function that takes the address into the Right branch of the Either. The reason is that label reference errors seem to be independent of addresses, so it's better to handle reference errors first and then worry about the address stuff in isolation.
This function resolves the references:
resolveRefs :: [(String,Int)] -> [Statement] -> Either String [Int -> [Instruction]]
resolveRefs environment = traverse (stmtToInstruction environment)
(traverse is equivalent to mapM but it only requires an Applicative constraint. They are different functions merely for historical reasons.)
Ok, after having handled the errors, lets now focus on the [Int -> [Instruction]] list. It seems that we have to map over it from the left while carrying an accumulated address that we must supply to each function. The mapAccumL function is perfect for this:
resolveAddrs :: [Int -> [Instruction]] -> [Instruction]
resolveAddrs funcs = mconcat . snd $ accumulate funcs
where
accumulate :: [Int -> [Instruction]] -> (Int,[[Instruction]])
accumulate = mapAccumL step 0
step address func = let is = func address in (address + length is,is)
I'm writing a program to allocate pizzas to people; each person will get one pizza, ideally of their favorite type, unless stock has run out, in which case they are given their next favorite type recursively.
My approach is to compute a ((User, Pizza), Int) for the amount a person would like said pizza, sort those, and recurse through using a state monad to keep inventory counts.
The program is written and type checks:
allocatePizzasImpl :: [((User, Pizza), Int)]
-> State [(Pizza, Int)] [(User, Pizza)]
allocatePizzasImpl [] = return []
allocatePizzasImpl ((user, (flavor, _)):ranks) =
do inventory <- get
-- this line is never hit
put $ updateWith inventory (\i -> if i <= 0
then Nothing
else Just $ i - 1) flavor
next <- allocatePizzasImpl $ filter ((/= user) . fst) ranks
return $ (user, flavor) : next
and I have a helper function to extract the result:
allocatePizzas :: [Pizza]
-> [((User, Pizza), Int)]
-> [(User, Pizza)]
allocatePizzas pizzas rank = fst
. runState (allocatePizzasImpl rank)
$ buildQuotas pizzas
but the line indicated by -- this line is never hit is... never hit by any GHCI breakpoints; furthermore, if I break on the return call, GHCI says inventory isn't in scope.
When run, the result is assigning the same pizza (with one inventory count) to all users. Something is going wrong, but I have absolutely no idea how to proceed. I'm new to Haskell, so any comments on style would be appreciated as well =)
Thanks!
PS: For completeness, updateWith is defined as:
updateWith :: (Eq a, Eq b)
=> [(a, b)] -- inventory
-> (b -> Maybe b) -- update function; Nothing removes it
-> a -- key to update
-> [(a, b)]
updateWith set update key =
case lookup key set of
Just b -> replace set
(unwrapPair (key, update b))
(fromMaybe 0 $ elemIndex (key, b) set)
Nothing -> set
where replace :: [a] -> Maybe a -> Int -> [a]
replace [] _ _ = []
replace (_:xs) (Just val) 0 = val:xs
replace (_:xs) Nothing 0 = xs
replace (x:xs) val i = x : (replace xs val $ i - 1)
unwrapPair :: Monad m => (a, m b) -> m (a, b)
unwrapPair (a, mb) = do b <- mb
return (a, b)
I think your function replace is broken:
replace (_:xs) (Just val) 0 = val:xs
This doesn't pay any attention to the value it's replacing. Wasn't your intention to replace just the pair corresponding to key?
I think you want
updateWith [] e k = []
updateWith ((k', v):kvs) e k
| k' == k = case e v of
Just v' -> (k, v'):kvs
Nothing -> kvs
| otherwise = (k', v) : updateWith kvs e k
The issue (ignoring other conceptual things mentioned by the commenters) turned out to be using fst to extract the result from the State would for some reason not cause the State to actually be computed. Running the result through seq fixed it.
I'd be interested in knowing why this is the case, though!
Edit: As Daniel Wagner pointed out in the comments, I wasn't actually using inventory, which turned out to be the real bug. Marking this as accepted.