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
Related
I implemented the following function:
iterateState :: Int -> (a -> State s a) -> (a -> State s [a])
iterateState 0 f a = return []
iterateState n f a = do
b <- f a
xs <- iterateState (n - 1) f b
return $ b : xs
My primary use case is for a = Double. It works, but it is very slow. It allocates 528MB of heap space to produce a list of 1M Double values and spends most of its time doing garbage collection.
I have experimented with implementations that work on the type s -> (a, s) directly as well as with various strictness annotations. I was able to reduce the heap allocation somewhat, but not even close to what one would expect from a reasonable implementation. I suspect that the resulting ([a], s) being a combination of something to be consumed lazily ([a]) and something whose WHNF forces the entire computation (s) makes optimization difficult for GHC.
Assuming that the iterative nature of lists would be unsuitable for this situation, I turned to the vector package. To my delight, it already contains
iterateNM :: (Monad m, Unbox a) => Int -> (a -> m a) -> a -> m (Vector a)
Unfortunately, this is only slightly faster than my list implementation, still allocating 328MB of heap space. I assumed that this is because it uses unstreamM, whose description reads
Load monadic stream bundle into a newly allocated vector. This function goes through a list, so prefer using unstream, unless you need to be in a monad.
Looking at its behavior for the list monad, it is understandable that there is no efficient implementation for general monads. Luckily, I only need the state monad, and I found another function that almost fits the signature of the state monad.
unfoldrExactN :: Unbox a => Int -> (b -> (a, b)) -> b -> Vector a
This function is blazingly fast and performs no excess heap allocation beyond the 8MB needed to hold the resulting unboxed vector of 1M Double values. Unfortunately, it does not return the final state at the end of the computation, so it cannot be wrapped in the State type.
I looked at the implementation of unfoldrExactN to see if I could adjust it to expose the final state at the end of the computation. Unfortunately, this seems to be difficult, as the stream constructed by
unfoldrExactN :: Monad m => Int -> (s -> (a, s)) -> s -> Stream m a
which is eventually expanded into a vector by unstream has already forgotten the state type s.
I imagine I could circumvent the entire Stream infrastructure and implement iterateState directly on mutable vectors in the ST monad (similarly to how unstream expands a stream into a vector). However, I would lose all the benefits of stream fusion, as well as turning a computation that is easily expressed as a pure function into imperative low-level mush just for performance reasons. This is particularly frustrating while knowing that the existing unfoldrExactN already calculates all the values I want, but I have no access to them.
Is there a better way?
Can this function be implemented in a purely functional way with reasonable performance and no excess heap allocations? Preferably in a way that ties into the vector package and its stream fusion infrastructure.
The following program has 12MB max residency on my computer when compiled with optimizations:
import Data.Vector.Unboxed
import Data.Vector.Unboxed.Mutable
iterateNState :: Unbox a => Int -> (a -> s -> (s, a)) -> (a -> s -> (s, Vector a))
iterateNState n f a0 s0 = createT (unsafeNew n >>= go 0 a0 s0) where
go i a s arr
| i >= n = pure (s, arr)
| otherwise = do
unsafeWrite arr i a
case f a s of
(s', a') -> go (i+1) a' s' arr
main = id
. print
. Data.Vector.Unboxed.sum
. snd
$ iterateNState 1000000 (\a s -> (s+1, a+s :: Int)) 0 0
(It continues to have a nice low residency even when the final two 0s are read from input dynamically.)
My specific problem is like this:
Given an Event t [a] and an Event t () (let's say it's a tick event), I want to produce an Event t a, that is, an event that is giving me consecutive items from input list for every occurence of tick event.
Reflex has following helper:
zipListWithEvent :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> c) -> [a] -> Event t b -> m (Event t c)
which is doing exactly what I want, but does not take an event as an input, but just a list. Given that I have an Event t [a], I thought I could produce an event containing event and just switch, but the problem is that zipListWithEven operates in monadic context, therefore I can get:
Event t (m (Event t a))
which is something that switch primitive does not accept.
Now, maybe I'm approaching it in wrong way, so here's my general problem. Given an event that's producing list of coordinates and tick event, I want to produce an event that I can "use" to move an object along the coordinates. So each time tick fires, the position is updated. And each time I update the coordinates list, it begins to produce positions from that new list.
I'm not entirely sure if I understand the semantics of your desired functions correctly, but in the reactive-banana library, I would solve the problem like this:
trickle :: MonadMoment m => Event [a] -> Event () -> Event a
trickle eadd etick = do
bitems <- accumB [] $ unions -- 1
[ flip (++) <$> eadd -- 2
, drop 1 <$ etick -- 3
]
return $ head <$> filterE (not . null) (bitems <# etick) -- 4
The code works as follows:
The Behavior bitems records the current lists of items.
Items are added when eadd happens, ...
... and one item is removed when etick happens.
The result is an event that happens whenever etick happens, and that contains the first element of the (previously) current list whenever that list is nonempty.
This solution does not seem to require any fancy or intricate reasoning.
Naming the parts:
coords :: Event t [Coord]
ticks :: Event t ()
If we want to remember the most recent Coord until the next firing of ticks, then we necessarily have to be in the some monad Reflex m. This is the monad that allow the transient Event to be persisted.
The core thing you'd like to remember is a stack of Coord. Let's try this:
data Stack a = CS {
cs_lastPop :: Maybe a
, cs_stack :: [a]
} deriving (Show)
stack0 = CS Nothing []
pop :: Stack a -> Stack a
pop (CS _ [] ) = CS Nothing []
pop (CS _ (x:xs)) = CS (Just x) xs
reset :: [a] -> Stack a -> Stack a
reset cs (CS l _) = CS l cs
Nothing reactive there yet, two functions that tweak the Stack Coord in the way you mention in your question.
The reflex code to drive this would build a Dynamic t (Stack Coord), by specifying its initial state and all the things that modify it:
coordStack <- foldDyn ($) stack0 (leftmost [
reset <$> coords
, pop <$ ticks
])
The leftmost here takes a list of Stack Coord -> Stack Coord functions, which are applied in turn to stack0 by foldDyn ($) (as long as coords and ticks never occur in same frame).
Driving all this in main:
main :: IO ()
main = mainWidget $ do
t0 <- liftIO getCurrentTime
-- Some make up 'coords' data, pretending (Coord ~ Char)
coordTimes <- tickLossy 2.5 t0
coords <- zipListWithEvent (\c _ -> c) ["greg","TOAST"] coordTimes
ticks <- tickLossy 1 t0
coordStack <- foldDyn ($) stack0 (leftmost [
reset <$> coords
, pop <$ ticks
])
display coordStack
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.
I have a very large decision tree. It is used as follows:
-- once per application start
t :: Tree
t = buildDecisionTree
-- done several times
makeDecision :: Something -> Decision
makeDecision something = search t something
This decision tree is way too large to fit in memory. But, thanks to lazy evaluation, it is only partially evaluated.
The problem is, that there are scenarios where all possible decisions are tried causing the whole tree to be evaluated. This is not going to terminate, but should not cause a memory overflow either. Further, if this process is aborted, the memory usage does not decrease, as a huge subtree is still evaluated already.
A solution would be to reevaluate the tree every time makeDecision is called, but this would loose the benefits of caching decisions and significantly slow down makeDecision.
I would like to go a middle course. In particular it is very common in my application to do successive decisions with common path prefix in the tree. So I would like to cache the last used path but drop the others, causing them to reevaluate the next time they are used. How can I do this in Haskell?
It is not possible in pure haskell, see question Can a thunk be duplicated to improve memory performance? (as pointed out by #shang). You can, however, do this with IO.
We start with the module heade and list only the type and the functions that should make this module (which will use unsafePerformIO) safe. It is also possible to do this without unsafePerformIO, but that would mean that the user has to keep more of his code in IO.
{-# LANGUAGE ExistentialQuantification #-}
module ReEval (ReEval, newReEval, readReEval, resetReEval) where
import Data.IORef
import System.IO.Unsafe
We start by defining a data type that stores a value in a way that prevents all sharing, by keeping the function and the argument away from each other, and only apply the function when we want the value. Note that the value returned by unsharedValue can be shared, but not with the return value of other invocations (assuming the function is doing something non-trivial):
data Unshared a = forall b. Unshared (b -> a) b
unsharedValue :: Unshared a -> a
unsharedValue (Unshared f x) = f x
Now we define our data type of resettable computations. We need to store the computation and the current value. The latter is stored in an IORef, as we want to be able to reset it.
data ReEval a = ReEval {
calculation :: Unshared a,
currentValue :: IORef a
}
To wrap a value in a ReEval box, we need to have a function and an argument. Why not just a -> ReEval a? Because then there would be no way to prevent the parameter to be shared.
newReEval :: (b -> a) -> b -> ReEval a
newReEval f x = unsafePerformIO $ do
let c = Unshared f x
ref <- newIORef (unsharedValue c)
return $ ReEval c ref
Reading is simple: Just get the value from the IORef. This use of unsafePerformIO is safe becuase we will always get the value of unsharedValue c, although a different “copy” of it.
readReEval :: ReEval a -> a
readReEval r = unsafePerformIO $ readIORef (currentValue r)
And finally the resetting. I left it in the IO monad, not because it would be any less safe than the other function to be wrapped in unsafePerformIO, but because this is the easiest way to give the user control over when the resetting actually happens. You don’t want to risk that all your calls to resetReEval are lazily delayed until your memory has run out or even optimized away because there is no return value to use.
resetReEval :: ReEval a -> IO ()
resetReEval r = writeIORef (currentValue r) (unsharedValue (calculation r))
This is the end of the module. Here is example code:
import Debug.Trace
import ReEval
main = do
let func a = trace ("func " ++ show a) negate a
let l = [ newReEval func n | n <- [1..5] ]
print (map readReEval l)
print (map readReEval l)
mapM_ resetReEval l
print (map readReEval l)
And here you can see that it does what expected:
$ runhaskell test.hs
func 1
func 2
func 3
func 4
func 5
[-1,-2,-3,-4,-5]
[-1,-2,-3,-4,-5]
func 1
func 2
func 3
func 4
func 5
[-1,-2,-3,-4,-5]
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.