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.
Related
In an attempt to use Haskell for a graphical application, I've had a lot of trouble getting the GUI to evaluate in an eager fashion.
For example, I sometimes attempt to create widgets somewhere in the program, package it and send it to other components of my program.
This doesn't work out that well, usually never resulting in the widget getting displayed due to lazy evaluation discarding the widget before it gets a chance to be put on the screen.
So I wanted to know, other than putting in a bunch of seq and other variations to encourage eager evaluation, can/how does one deal with this issue?
I've searched for an answer, but couldn't really find anything related to this line of questioning.
EDIT: sample code
The code below produced an empty window.
{-# LANGUAGE RecursiveDo #-}
-- allows recursive do notation
-- mdo
-- ...
import Control.Monad
import Control.Monad.IO.Class
import qualified Data.Map.Strict as Map
import qualified Data.List as List
import System.Random
import Graphics.UI.WX hiding (Event)
import Graphics.UI.WXCore as WXCore
import Reactive.Banana
import Reactive.Banana.WX
boardWidth, boardHeight :: Int
boardWidth = 41
boardHeight = 81
main :: IO ()
main = start tetris
tetris = do
ff <- frame [text := "Tetris"
,bgcolor := white
,resizeable:= False]
p <- panel ff []
set ff [ layout := minsize (sz 100 100) $ widget p]
pps <- return $ Map.fromList $ map (\l#(x,y) -> (l, button p []))
[(x,y) | x <- [1..(boardWidth `div` 2)], y <- [1..(boardHeight `div` 2)]]
-- p <- pps Map.! (1,2)
d <- return $ map (\(x,y_m) -> y_m >>= (\y -> set ff [ color := white, layout := minsize (sz 300 300) $ widget y ])) $ Map.toList pps
-- let networkDescription :: Moment IO ()
return ff
The line p <- pps Map.! (1,2) results in the tile at 1, 2 to display without the proper size.
This doesn't work out that well, usually never resulting in the widget getting displayed due to lazy evaluation discarding the widget before it gets a chance to be put on the screen.
As Thomas M. DuBuisson suggests, that is a misdiagnosis: the issue here doesn't have to do with lazy evaluation (and in any case lazy evaluation wouldn't discard a value you actually tried to use). Let's have a look at the line at which you'd supposedly add the buttons to the panel:
d <- return $ map (\(x,y_m) ->
y_m >>= (\y -> set ff [ color := white, layout := minsize (sz 300 300) $ widget y ]))
$ Map.toList pps
The type of Map.toList pps is [((Int, Int), IO (Button ())]. Your use of map changes it into [IO ()] (cf. the type of set), a list of IO actions. In effect, you are setting up the actions that add the buttons, but you never actually run them. To do that, you want traverse_ from Data.Foldable instead of map:
traverse_ (\(x,y_m) ->
y_m >>= (\y -> set ff [ color := white, layout := minsize (sz 300 300) $ widget y ]))
$ Map.toList pps
(For more on traverse_ and its cousin traverse, see this answer, as well as the other answers to the parent question.)
Note that, unless I'm badly misreading the WX-specific code, this still won't do what you want. As each IO action you generate for a list element resets the layout of the frame, you'll end up with only the last button in the frame. To get a sensible layout, you'll have to actually use the coordinate values, as well as the WX layout combinators to set up a single layout with all buttons. Cf. the Graphics.UI.WX.Layout documentation.
On a final note, code like this in a do-block...
bar <- return foo
... is always redundant: it can be replaced by:
let bar = foo
In your case, doing that would have made it much more obvious that you weren't actually running the actions.
(Your uses of Map.fromList and Map.toList are also redundant, but I guess you already suspected that.)
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
Is there a way I can make a structure for 2 different functions using the same where clauses?
My code:
bonusColBullet :: Bonus -> Bullet -> World -> World
bonusColBullet bn#(Bonus{bnpos=pos}) b w#(World{bullets=bs, bonuses=bns, score=s})
| doBoxesCollide bnlp bnrp blp brp = w{bullets=delete b bs, bonuses=delete bn bns, score=incVal s}
| otherwise = w
where
blp = bpos' - bSizeH --bullet corners
brp = bpos' + bSizeH
bnlp = pos - bnSizeH --bonus obj corners
bnrp = pos + bnSizeH
bpos' = bpos b
incVal s#(Score{sval=sv, multiplier}) = s{sval=sv+multiplier}
enemyColBullet :: Enemy -> Bullet -> World -> World
enemyColBullet e#(Enemy{epos=pos}) b w#(World{bullets=bs, enemies=es, score=s})
| doBoxesCollide elp erp blp brp = w{bullets=delete b bs, enemies=delete e es, score=incVal s}
| otherwise = w
where
blp = bpos' - bSizeH -- bullet corners
brp = bpos' + bSizeH
elp = pos - eSizeH -- enemy corners
erp = pos + eSizeH
bpos' = bpos b
incVal s#(Score{sval=sv, multiplier}) = s{sval=sv+multiplier}
Because like this it looks very inefficient to me, so I figured there should be a way to only have to write the where clause ones and to somehow make it includeable for both functions?
If anyone could help me out on this it'd be much appreciated!
Best regards,
Skyfe.
Yep! You're right that this can be factored out. One cool feature in Haskell which may help you is ambiguity. Haskell has two sorts of ambiguity, and you can use either one in this case. The first sort of ambiguity is called parametric types, for example the list type [x] exists for all x no matter what x is, so there are actually a lot of different functions reverse :: [x] -> [x], one for every type which you can put inside those lists. The only problem is that sometimes you want a constraint on these parameters, so that you can do stuff with them (reverse is constrained by the total ambiguity; it can't do anything to the elements but can only reorder them and possibly drop or repeat them). The constrained ambiguity is a feature called type classes. Here's how I'd use them to fit your case:
type Size = ____ -- fill this in with whatever that type actually is.
class Sprite s where
kill :: s -> World -> World
position :: s -> Size
size :: s -> Size
instance Sprite Bullet where
kill b w = w{bullets = delete b (bullets w)}
position = bpos
size = const bSizeH -- constant for all bullets, right?
instance Sprite Bonus where
kill bn w = w{bonuses = delete bn (bonuses w)}
position = bnpos
size = const bnSizeH
instance Sprite Enemy where
kill e w = w{enemies = delete e (enemies w)}
position = epos
size = const eSizeH
Now you can write something more generic:
collides :: (Sprite x, Sprite y) => x -> y -> Bool
collides x y = doBoxesCollide (px - sx) (px + sx) (py - sy) (py + sy)
where px = position x
py = position y
sx = size x
sy = size y
addScore :: World -> World
addScore w = w{score = s{sval = sval s + multiplier s}} where s = score w
killCollision :: (Sprite x, Sprite y) => x -> y -> World -> World
killCollision x y = if collides x y then addScore . kill x . kill y else id
We've gone up from your 22 lines up to 27 lines, but we now have a lot of smaller parts interacting in clearer ways, and no repeating ourselves. It's an artistic choice whether this is worth it or not -- it often helps longer-term maintenance of a program, but if you're just trying to get a program out there often copy-paste is faster.
So now where you would have written bonusColBullet bn b w you can just write killCollision bn b w and it does the same thing, and so does killCollision e b w for enemies e. But you've got a little more power. Suppose you want to have enemies eat bonuses that they collide with: but you do not get a score for that. Then that would be if collides e bn then kill bn else id. Or you might decide that different sprites have different points which they are worth; then you add to the Sprite class points :: x -> Points (where Points is whatever Num type your points are -- presumably Integer but I didn't want to assume). You modify addScore to become:
addScore :: (Sprite x, Sprite y) => x -> y -> World -> World
addScore x y w = w{score = s{sval = newscore}
where s = score w
newscore = sval s + multiplier s * (points x + points y)
and you modify killCollision by replacing addScore with addScore x y. That's it. Now different enemies or bonuses can be worth different amounts. With a little more work, you can have an enemy who eats a bonus get the points from that bonus (so that if you kill them you still get the bonus points). Stuff like that.
Is there a way I can make a structure for 2 different functions using the same where clauses
where gives you a binding with local scope. So to share that between two functions, they have to be "inside" the where scope.
Easier is to float the where clause out. E.g. calculate it once and pass x and y to your functions.
main = do
let x = func a - c
y = func' b - c
someFunc x y
someOtherFunc x y
How would you make the folowing code functional with the same speed? In general, as an input I have a list of objects containing position coordinates and other stuff and I need to create a 2D array consisting those objects.
let m = Matrix.Generic.create 6 6 []
let pos = [(1.3,4.3); (5.6,5.4); (1.5,4.8)]
pos |> List.iter (fun (pz,py) ->
let z, y = int pz, int py
m.[z,y] <- (pz,py) :: m.[z,y]
)
It could be probably done in this way:
let pos = [(1.3,4.3); (5.6,5.4); (1.5,4.8)]
Matrix.generic.init 6 6 (fun z y ->
pos |> List.fold (fun state (pz,py) ->
let iz, iy = int pz, int py
if iz = z && iy = y then (pz,py) :: state else state
) []
)
But I guess it would be much slower because it loops through the whole matrix times the list versus the former list iteration...
PS: the code might be wrong as I do not have F# on this computer to check it.
It depends on the definition of "functional". I would say that a "functional" function means that it always returns the same result for the same parameters and that it doesn't modify any global state (or the value of parameters if they are mutable). I think this is a sensible definition for F#, but it also means that there is nothing "dis-functional" with using mutation locally.
In my point of view, the following function is "functional", because it creates and returns a new matrix instead of modifying an existing one, but of course, the implementation of the function uses mutation.
let performStep m =
let res = Matrix.Generic.create 6 6 []
let pos = [(1.3,4.3); (5.6,5.4); (1.5,4.8)]
for pz, py in pos do
let z, y = int pz, int py
res.[z,y] <- (pz,py) :: m.[z,y]
res
Mutation-free version:
Now, if you wanted to make the implementation fully functional, then I would start by creating a matrix that contains Some(pz, py) in the places where you want to add the new list element to the element of the matrix and None in all other places. I guess this could be done by initializing a sparse matrix. Something like this:
let sp = pos |> List.map (fun (pz, py) -> int pz, int py, (pz, py))
let elementsToAdd = Matrix.Generic.initSparse 6 6 sp
Then you should be able to combine the original matrix m with the newly created elementsToAdd. This can be certainly done using init (however, having something like map2 would be maybe nicer):
let res = Matrix.init 6 6 (fun i j ->
match elementsToAdd.[i, j], m.[i, j] with
| Some(n), res -> n::res
| _, res -> res )
There is still quite likely some mutation hidden in the F# library functions (such as init and initSparse), but at least it shows one way to implement the operation using more primitive operations.
EDIT: This will work only if you need to add at most single element to each matrix cell. If you wanted to add multiple elements, you'd have to group them first (e.g. using Seq.groupBy)
You can do something like this:
[1.3, 4.3; 5.6, 5.4; 1.5, 4.8]
|> Seq.groupBy (fun (pz, py) -> int pz, int py)
|> Seq.map (fun ((pz, py), ps) -> pz, py, ps)
|> Matrix.Generic.initSparse 6 6
But in your question you said:
How would you make the folowing code functional with the same speed?
And in a later comment you said:
Well, I try to avoid mutability so that the code would be simple to paralelize in the future
I am afraid this is a triumph of hope over reality. Functional code generally has poor absolute performance and scales badly when parallelized. Given the huge amount of allocation this code is doing, you're not likely to see any performance gain from parallelism at all.
Why do you want to do it functionally? The Matrix type is designed to be mutated, so the way you're doing it now looks good to me.
If you really want to do it functionally, though, here's what I'd do:
let pos = [(1.3,4.3); (5.6,5.4); (1.5,4.8)]
let addValue m k v =
if Map.containsKey k m then
Map.add k (v::m.[k]) m
else
Map.add k [v] m
let map =
pos
|> List.map (fun (x,y) -> (int x, int y),(x,y))
|> List.fold (fun m (p,q) -> addValue m p q) Map.empty
let m = Matrix.Generic.init 6 6 (fun x y -> if (Map.containsKey (x,y) map) then map.[x,y] else [])
This runs through the list once, creating an immutable map from indices to lists of points. Then, we initialize each entry in the matrix, doing a single map lookup for each entry. This should take total time O(M + N log N) where M and N are the number of entries in your matrix and list respectively. I believe that your original solution using mutation takes O(M+N) time and your revised solution takes O(M*N) time.
I have a function which is constant to its argument, for example
let is_prime x = (test)
But it's pretty large and slow. So I want the result of it to be calculated only once while I'm calling it as often as I want.
I've tried to do it in a way I did it in not functional languages:
let _is_prime x = (test)
let mutable _is_prime_primes = []
let mutable _is_prime_tested = []
let is_prime x =
if List.exists (fun el -> el = x) _is_prime_primes then
true
else
if List.exists (fun el -> el = x) _is_prime_tested then
false
else
let result = _is_prime x
if result then _is_prime_primes <- x :: _is_prime_primes
_is_prime_tested <- x :: _is_prime_tested
result
But I think I'm deeply wrong. Caching such result must be something very common and simple for functional languages.
Here is the Internet Archive link.
I'm having trouble testing this in FSI, but it should be fine in a normal F# project.
let cache f =
let dict = new Dictionary<_,_>()
fun n ->
if dict.ContainsKey(n) then dict.[n]
else
let r = f n
dict.[n] <- r
r
Its signature is ('a->'b) -> ('a->'b) when 'a : equality. It takes non-curried function and returns another with an identical signature. The function given is only called once for each unique argument that is passed to it. This makes it good for expensive pure functions. This cache function however is not pure, and not thread-safe. Here's an example of its usage:
let slow n = // 'a -> 'a
System.Threading.Thread.Sleep(1000)
n
let fast = cache slow // 'a -> 'a
Calling fast 1 will cause a second of sleep the first time you call it. Each successive call with the same parameter will return the value instantly.