I've made a scene graph functional rendering engine in Haskell and am wondering how to add interaction in to the mixture.
At first, I thought I could just have another Handler node which takes in one of the other nodes and then just apply some IORefs to it. For example, if I had
x,y,z <- IORef 0
KeyboardHandler KeyboardCallBack $ Translate x y z $ Object
When traversing, I would have
KeyboardHandler keyboard drawable -> case drawable of
Translate x y z _ -> do
(Char 'q') -> x $~! (-1)
(Char 'w') -> x $~! (+1)
(Char 'a') -> y $~! (-1)
(Char 's') -> y $~! (+1)
(Char 'z') -> z $~! (-1)
(Char 'x') -> z $~! (+1)
render drawable
Is it possible to do something like that or am I going completely the wrong way?
That approach might work, but there are better ways. I particularly liked GLFW-b example that utilized something called TQueue.
TQueue is short for Transactional Queue; it's something you can pass events into from the render thread, and then read them from the drawing thread. That way you can process them as if they were a simple, pure value; a list of events.
In general, Haskell favours pure operation to mutable state. The available rendering frameworks emphasize pure transformation of logical state to stuff on the screen. In this case, something like a State OSG monad would be probably OK, though.
Related
While reading a snipped from Haskell for Great Good I found the following situation:
treeInsert :: (Ord a) => a -> Tree a -> Tree a
treeInsert x EmptyTree = singleton x
treeInsert x (Node a left right)
| x == a = Node x left right
| x < a = Node a (treeInsert x left) right
| x > a = Node a left (treeInsert x right)
Wouldn't it be better for performance if we just reused the given Tree when x == a?
treeInsert :: (Ord a) => a -> Tree a -> Tree a
treeInsert x EmptyTree = singleton x
treeInsert x all#(Node a left right)
| x == a = all
| x < a = Node a (treeInsert x left) right
| otherwise = Node a left (treeInsert x right)
In real life coding, what should I do? Are there any drawbacks when returning the same thing?
Let's look at the core! (Without optimisations here)
$ ghc-7.8.2 -ddump-simpl wtmpf-file13495.hs
The relevant difference is that the first version (without all#(...)) has
case GHC.Classes.> # a_aUH $dOrd_aUV eta_B2 a1_aBQ
of _ [Occ=Dead] {
GHC.Types.False ->
Control.Exception.Base.patError
# (TreeInsert.Tree a_aUH)
"wtmpf-file13495.hs:(9,1)-(13,45)|function treeInsert"#;
GHC.Types.True ->
TreeInsert.Node
# a_aUH
a1_aBQ
left_aBR
(TreeInsert.treeInsert # a_aUH $dOrd_aUV eta_B2 right_aBS)
where reusing the node with that as-pattern does just
TreeInsert.Node
# a_aUI
a1_aBR
left_aBS
(TreeInsert.treeInsert # a_aUI $dOrd_aUW eta_B2 right_aBT);
This is an avoided check that may well make a significant performance difference.
However, this difference has actually nothing to do with the as-pattern. It's just because your first snippet uses a x > a guard, which is not trivial. The second uses otherwise, which is optimised away.
If you change the first snippet to
treeInsert :: (Ord a) => a -> Tree a -> Tree a
treeInsert x EmptyTree = singleton x
treeInsert x (Node a left right)
| x == a = Node x left right
| x < a = Node a (treeInsert x left) right
| otherwise = Node a left (treeInsert x right)
then the difference boils down to
GHC.Types.True -> TreeInsert.Node # a_aUH a1_aBQ left_aBR right_aBS
vs
GHC.Types.True -> wild_Xa
Which is indeed just the difference of Node x left right vs all.
...without optimisations, that is. The versions diverge further when I turn on -O2. But I can't really make out how the performance would differ, there.
In real life coding, what should I do? Are there any drawbacks when returning the same thing?
a == b does not guarantee that f a == f b for all functions f. So, you may have to return new object even if they compare equal.
In other words, it may not be feasible to change Node x left right to Node a left right or all when a == x regardless of performance gains.
For example you may have types which carry meta data. When you compare them for equality, you may only care about the values and ignore the meta data. But if you replace them just because they compare equal then you will loose the meta data.
newtype ValMeta a b = ValMeta (a, b) -- value, along with meta data
deriving (Show)
instance Eq a => Eq (ValMeta a b) where
-- equality only compares values, ignores meta data
ValMeta (a, b) == ValMeta (a', b') = a == a'
The point is Eq type-class only says that you may compare values for equality. It does not guarantee anything beyond that.
A real-world example where a == b does not guarantee that f a == f b is when you maintain a Set of unique values within a self-balancing tree. A self-balancing tree (such as Red-Black tree) has some guarantees about the structure of tree but the actual depth and structure depends on the order that the data were added to or removed from the set.
Now when you compare 2 sets for equality, you want to compare that values within the set are equal, not that the underlying trees have the same exact structure. But if you have a function such as depth which exposes the depth of underlying tree maintaining the set then you cannot guarantee that the depths are equal even if the sets compare equal.
Here is a video of great Philip Wadler realizing live and on-stage that many useful relations do not preserve equality (starting at 42min).
Edit: Example from ghc where a == b does not imply f a == f b:
\> import Data.Set
\> let a = fromList [1, 2, 3, 4, 5, 10, 9, 8, 7, 6]
\> let b = fromList [1..10]
\> let f = showTree
\> a == b
True
\> f a == f b
False
Another real-world example is hash-table. Two hash-tables are equal if and only if their key-value pairs tie out. However, the capacity of a hash-table, i.e. the number of keys you may add before having to re-allocate and rehash, depends on the order of inserts/deletes.
So if you have a function which returns the capacity of hash table, it may return different values for hash-tables a and b even though a == b.
My two cents... perhaps not even about the original question:
Instead of writing guards with x < a and x == a, I would match compare a b against LT, EQ and GT, e.g.:
treeInsert x all#(Node a left right) =
case compare x a of
EQ -> ...
LT -> ...
GT -> ...
I would do this especially if x and a can be complex data structures, since a test like x < a could be expensive.
answer seems to be wrong. I just leave it here, for reference...
With your second function you avoid creating a new node, because the compiler cannot really understand equality (== is just some function.) If you change the first version to
-- version C
treeInsert :: (Ord a) => a -> Tree a -> Tree a
treeInsert x EmptyTree = singleton x
treeInsert x (Node a left right)
| x == a = Node a left right -- Difference here! Changed x to a.
| x < a = Node a (treeInsert x left) right
| x > a = Node a left (treeInsert x right)
the compiler will probably be able to do common subexpression elimination, because the optimizer will be able to see that Node a left right is the same as Node a left right.
On the other hand, I doubt that the compiler can deduce from a == x that Node a left right is the same as Node x left right.
So, I'm pretty sure that under -O2, version B and version C are the same, but version A is probably slower because it does an extra instantiation in the a == x case.
Well, if the first case had used a instead of x as follows, then there's at least the chance that GHC would eliminate the allocation of a new node through common subexpression elimination.
treeInsert x (Node a left right)
| x == a = Node a left right
However, this is all but irrelevant in any non-trivial use case, because the path down the tree to the node is going to be duplicated even when the element already exists. And this path is going to be significantly longer than a single node unless your use case is trivial.
In the world of ML, the fairly idiomatic way to avoid this is to throw a KeyAlreadyExists exception, and then catch that exception at the top-level insertion function and return the original tree. This would cause the stack to be unwound instead of allocating any of the Nodes on the heap.
A direct implementation of the ML idiom is basically a no-no in Haskell, for good reasons. If avoiding this duplication matters, the simplest and possibly best thing to do is to check if the tree contains the key before you insert it.
The downside of this approach, compared to a direct Haskell insert or the ML idiom, is that it involves two traversals of the path instead of one. Now, here is a non-duplicating, single-pass insert you can implement in Haskell:
treeInsert :: Ord a => a -> Tree a -> Tree a
treeInsert x original_tree = result_tree
where
(result_tree, new_tree) = loop x original_tree
loop x EmptyTree = (new_tree, singleton x)
loop x (Node a left right) =
case compare x a of
LT -> let (res, new_left) = loop x left
in (res, Node a new_left right)
EQ -> (original_tree, error "unreachable")
GT -> let (res, new_right) = loop x right
in (res, Node a left new_right)
However, older versions of GHC (roughly 7-10 years ago) don't handle this sort of recursion through lazy pairs of results very efficiently, and in my experience check-before-insert is likely to perform better. I'd be slightly surprised if this observation has really changed in the context of more recent GHC versions.
One can certainly imagine a function that directly constructs (but does not return) a new path for the tree, and decides to return the new path or the original path once it's known whether the element exists already. (The new path would immediately become garbage if it is not returned.) This conforms to the basic principles of the GHC runtime, but isn't really expressible in the source language.
Of course, any completely non-duplicating insertion function on a lazy data structure is going to have different strictness properties than a simple, duplicating insert. So no matter the implementation technique, they are different functions if laziness matters.
But of course, whether or not the path is duplicated may not matter that much. The cases where it would matter the most would be when you are using the tree persistently, because in linear use cases the old path would become garbage immediately after each insertion. And of course, this only matters when you are inserting a significant number of duplicates.
I wanted to write an efficient implementation of the Floyd-Warshall all pairs shortest path algorithm in Haskell using Vectors to hopefully get good performance.
The implementation is quite straight-forward, but instead of using a 3-dimensional |V|×|V|×|V| matrix, a 2-dimensional vector is used, since we only ever read the previous k value.
Thus, the algorithm is really just a series of steps where a 2D vector is passed in, and a new 2D vector is generated. The final 2D vector contains the shortest paths between all nodes (i,j).
My intuition told me that it would be important to make sure that the previous 2D vector was evaluated before each step, so I used BangPatterns on the prev argument to the fw function and the strict foldl':
{-# Language BangPatterns #-}
import Control.DeepSeq
import Control.Monad (forM_)
import Data.List (foldl')
import qualified Data.Map.Strict as M
import Data.Vector (Vector, (!), (//))
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as V hiding (length, replicate, take)
type Graph = Vector (M.Map Int Double)
type TwoDVector = Vector (Vector Double)
infinity :: Double
infinity = 1/0
-- calculate shortest path between all pairs in the given graph, if there are
-- negative cycles, return Nothing
allPairsShortestPaths :: Graph -> Int -> Maybe TwoDVector
allPairsShortestPaths g v =
let initial = fw g v V.empty 0
results = foldl' (fw g v) initial [1..v]
in if negCycle results
then Nothing
else Just results
where -- check for negative elements along the diagonal
negCycle a = any not $ map (\i -> a ! i ! i >= 0) [0..(V.length a-1)]
-- one step of the Floyd-Warshall algorithm
fw :: Graph -> Int -> TwoDVector -> Int -> TwoDVector
fw g v !prev k = V.create $ do -- ← bang
curr <- V.new v
forM_ [0..(v-1)] $ \i ->
V.write curr i $ V.create $ do
ivec <- V.new v
forM_ [0..(v-1)] $ \j -> do
let d = distance g prev i j k
V.write ivec j d
return ivec
return curr
distance :: Graph -> TwoDVector -> Int -> Int -> Int -> Double
distance g _ i j 0 -- base case; 0 if same vertex, edge weight if neighbours
| i == j = 0.0
| otherwise = M.findWithDefault infinity j (g ! i)
distance _ a i j k = let c1 = a ! i ! j
c2 = (a ! i ! (k-1))+(a ! (k-1) ! j)
in min c1 c2
However, when running this program with a 1000-node graph with 47978 edges, things does not look good at all. The memory usage is very high and the program takes way too long to run. The program was compiled with ghc -O2.
I rebuilt the program for profiling, and limited the number of iterations to 50:
results = foldl' (fw g v) initial [1..50]
I then ran the program with +RTS -p -hc and +RTS -p -hd:
This is... interesting, but I guess it's showing that it's accumulating tonnes of thunks. Not good.
Ok, so after a few shots in the dark, I added a deepseq in fw to make sure prev really is evaluted:
let d = prev `deepseq` distance g prev i j k
Now things look better, and I can actually run the program to completion with constant memory usage. It's obvious that the bang on the prev argument was not enough.
For comparison with the previous graphs, here is the memory usage for 50 iterations after adding the deepseq:
Ok, so things are better, but I still have some questions:
Is this the correct solution for this space leak? I am wrong in feeling that inserting a deepseq is a bit ugly?
Is my usage of Vectors here idiomatic/correct? I'm building a completely new vector for every iteration and hoping that the garbage collector will delete the old Vectors.
Is there any other things I could do to make this run faster with this approach?
For references, here is graph.txt: http://sebsauvage.net/paste/?45147f7caf8c5f29#7tiCiPovPHWRm1XNvrSb/zNl3ujF3xB3yehrxhEdVWw=
Here is main:
main = do
ls <- fmap lines $ readFile "graph.txt"
let numVerts = head . map read . words . head $ ls
let edges = map (map read . words) (tail ls)
let g = V.create $ do
g' <- V.new numVerts
forM_ [0..(numVerts-1)] (\idx -> V.write g' idx M.empty)
forM_ edges $ \[f,t,w] -> do
-- subtract one from vertex IDs so we can index directly
curr <- V.read g' (f-1)
V.write g' (f-1) $ M.insert (t-1) (fromIntegral w) curr
return g'
let a = allPairsShortestPaths g numVerts
case a of
Nothing -> putStrLn "Negative cycle detected."
Just a' -> do
putStrLn $ "The shortest, shortest path has length "
++ show ((V.minimum . V.map V.minimum) a')
First, some general code cleanup:
In your fw function, you explicitly allocate and fill mutable vectors. However, there is a premade function for this exact purpose, namely generate. fw can therefore be rewritten as
V.generate v (\i -> V.generate v (\j -> distance g prev i j k))
Similarly, the graph generation code can be replaced with replicate and accum:
let parsedEdges = map (\[f,t,w] -> (f - 1, (t - 1, fromIntegral w))) edges
let g = V.accum (flip (uncurry M.insert)) (V.replicate numVerts M.empty) parsedEdges
Note that this totally removes all need for mutation, without losing any performance.
Now, to the actual questions:
In my experience, deepseq is very useful, but only as quick fix to space leaks like this one. The fundamental problem is not that you need to force the results after you've produced them. Instead, the use of deepseq implies that you should have been building the structure more strictly in the first place. In fact, if you add a bang pattern in your vector creation code like so:
let !d = distance g prev i j k
Then the problem is fixed without deepseq. Note that this doesn't work with the generate code, because, for some reason (I might create a feature request for this), vector does not provide strict functions for boxed vectors. However, when I get to unboxed vectors in answer to question 3, which are strict, both approaches work without strictness annotations.
As far as I know, the pattern of repeatedly generating new vectors is idiomatic. The only thing not idiomatic is the use of mutability - except when they are strictly necessary, mutable vectors are generally discouraged.
There are a couple of things to do:
Most simply, you can replace Map Int with IntMap. As that isn't really the slow point of the function, this doesn't matter too much, but IntMap can be much faster for heavy workloads.
You can switch to using unboxed vectors. Although the outer vector has to remain boxed, as vectors of vectors can't be unboxed, the inner vector can be. This also solves your strictness problem - because unboxed vectors are strict in their elements, you don't get a space leak. Note that on my machine, this improves the performance from 4.1 seconds to 1.3 seconds, so the unboxing is very helpful.
You can flatten the vector into a single one and use multiplication and division to switch between two dimensional indicies and one dimentional indicies. I don't recommend this, as it is a bit involved, quite ugly, and, due to the division, actually slows down the code on my machine.
You can use repa. This has the huge advantage of automatically parallelizing your code. Note that, since repa flattens its arrays and apparently doesn't properly get rid of the divisions needed to fill nicely (it's possible to do with nested loops, but I think it uses a single loop and a division), it has the same performance penalty as I mentioned above, bringing the runtime from 1.3 seconds to 1.8. However, if you enable parallelism and use a multicore machine, you start seeing some benifits. Unfortunately, you current test case is too tiny to see much benifit, so, on my 6 core machine, I see it drop back down to 1.2 seconds. If I up the size back to [1..v] instead of [1..50], the parallelism brings it from 32 seconds to 13. Presumably, if you give this program a larger input, you might see more benifit.
If you're interested, I've posted my repa-ified version here.
EDIT: Use -fllvm. Testing on my computer, using repa, I get 14.7 seconds without parallelism, which is almost as good as without -fllvm and with parallelism. In general, LLVM can just handle array based code like this very well.
I am currently learning Haskell, and there is one thing that baffles me:
When I build a complex expression (whose computation will take some time) and this expression is constant (meaning it is build only of known, hard coded values), the expression is not evaluated at compile time.
Comming from a C/C++ background I am used to such kind of optimization.
What is the reason to NOT perform such optimization (by default) in Haskell / GHC ? What are the advantages, if any?
data Tree a =
EmptyTree
| Node a (Tree a) (Tree a)
deriving (Show, Read, Eq)
elementToTree :: a -> Tree a
elementToTree x = Node x EmptyTree EmptyTree
treeInsert :: (Ord a) => a -> Tree a -> Tree a
treeInsert x EmptyTree = elementToTree x
treeInsert x (Node a left right)
| x == a = Node x left right
| x < a = Node a (treeInsert x left) right
| x > a = Node a left (treeInsert x right)
treeFromList :: (Ord a) => [a] -> Tree a
treeFromList [] = EmptyTree
treeFromList (x:xs) = treeInsert x (treeFromList xs)
treeElem :: (Ord a) => a -> Tree a -> Bool
treeElem x EmptyTree = False
treeElem x (Node a left right)
| x == a = True
| x < a = treeElem x left
| x > a = treeElem x right
main = do
let tree = treeFromList [0..90000]
putStrLn $ show (treeElem 3 tree)
As this will always print True I would expect the compiled programm to print and exit
almost immediately.
You may like this reddit thread. The compiler could try to do this, but it could be dangerous, as constants of any type can do funny things like loop. There are at least two solutions: one is supercompilation, not available as part of any compiler yet but you can try prototypes from various researchers; the more practical one is to use Template Haskell, which is GHC's mechanism for letting the programmer ask for some code to be run at compile time.
The process you are talking about is called supercompilation and it's more difficult than you make it out to be. It is actually one of the active research topics in computing science! There are some people that are trying to create such a supercompiler for Haskell (probably based on GHC, my memory is vague) but the feature is not included in GHC (yet) because the maintainers want to keep compilation times down. You mention C++ as a language that does this – C++ also happens to have notoriously bad compilation times!
Your alternative for Haskell is to do this optimisation manually with Template Haskell, which is Haskells compile-time evaluated macro system.
In this case, GHC can not be sure that the computation would finish. It's not a question of lazy versus strict, but rather the halting problem. To you, it looks quite simple to say that treeFromlist [0..90000] is a constant that can be evaluated at compile time, but how does the compiler know this? The compiler can easily optimize [0..90000] to a constant, but you wouldn't even notice this change.
Most Haskell FRP frameworks like AFRP, Yampa and Reactive-banana make a difference between continuous time-varying functions and discrete ones. Usually they call them behaviors and events.
One exception is Netwire, which uses an inhibition monoid to model events. What are pros and cons of such an approach?
In particular, I'm interested in application of FRP to robot controlling. For example, this paper http://haskell.cs.yale.edu/?post_type=publication&p=182 show a way to encode a task and HSM abstractions in FRP using events. Can this be directly translated to Netwire?
The advantage of events as potentially inhibited signals is that it allows you to encode most even complicated reactive formulas very concisely. Imagine a switch that displays "yes" when pressed and "no" otherwise:
"yes" . switchPressed <|> "no"
The idea is that switchPressed acts like the identity wire if its corresponding event occurs and inhibits otherwise. That's where <|> comes in. If the first wire inhibits, it tries the second. Here is a hypothetical robot arm controlled by two buttons (left and right):
robotArm = integral_ 0 . direction
direction =
((-1) . leftPressed <|> 0) +
(1 . rightPressed <|> 0)
While the robot arm is hypothetical, this code is not. It's really the way you would write this in Netwire.
After some trials I've implemented the behavior I needed. Basically, You write a custom inhibitor type which catches the concept of events you need. In my case it was
data Inhibitor = Done | Timeout | Interrupt deriving Show
Done means normal finishing and the rest constructors signal some kind of an error.
After it, you write any custom combinators you need. In my case I needed a way to stop computations and signal a error further:
timeout deadline w | deadline <= 0 = inhibit Timeout
| otherwise = mkGen $ \dt a -> do
res <- stepWire w dt a
case res of
(Right o, w') -> return (Right o, timeout (deadline - dt) w')
(Left e, _) -> return (Left e, inhibit e)
This is a variant of switchBy which allows you to change the wire once. Note, it passes the inhibition signal of a new wire:
switchOn new w0 =
mkGen $ \dt x' ->
let select w' = do
(mx, w) <- stepWire w' dt x'
case mx of
Left ex -> stepWire (new ex) dt x'
Right x -> return (Right x, switchOn new w)
in select w0
And this is a variant of (-->) which catches the idea of interrupting the task chain.
infixr 1 ~>
w1 ~> w2 = switchOn ( \e -> case e of
Done -> w2
_ -> inhibit e
) w1
I have a little Haskell program that uses the Gtk2Hs bindings. One can draw points (small squares) on the program's window by clicking on a DrawingArea:
[...]
image <- builderGetObject gui castToDrawingArea "drawingarea"
p <- widgetGetDrawWindow image
gc <- gcNewWithValues p (newGCValues { foreground = Color 0 0 0,
function = Copy })
on image buttonPressEvent (point p gc)
set image [ widgetCanFocus := True ]
[...]
point :: DrawWindow -> GC -> EventM EButton Bool
point p gc = tryEvent $ do
(x', y') <- eventCoordinates
liftIO $ do
let x = round x'
let y = round y'
let relx = x `div` 4
let rely = y `div` 4
gcval <- gcGetValues gc
gcSetValues gc (newGCValues { function = Invert })
drawRectangle p gc True (relx * 4) (rely * 4) 4 4
gcSetValues gc gcval
Through the trial-and-error method and after reading the docs at Hackage, I managed to add a button press event to the drawing area, since the widget doesn't provide a signal for this event by default. However, I don't understand the definition and usage of EventM, so I'm afraid I'll have to struggle with the EventM monad if I must add a new event to a widget again. I must say I'm still not proficient enough in Haskell. I somewhat understand how simple monads work, but this one "type EventM t a = ReaderT (Ptr t) IO a" (defined in Graphics.UI.Gtk.Gdk.EventM) seems a mistery to me.
My question is: Could someone please explain the internals of the EventM monad? For example in the case of "buttonPressEvent :: WidgetClass self => Signal self (EventM EButton Bool)".
I am stacked by the similar problem,seems that EventM is a ReadT which will read the EButton and return Bool.