Starting from the Counter example in Reactive Banana Wx that uses a normal Int to keep the counter status:
let networkDescription :: forall t. Frameworks t => Moment t ()
networkDescription = do
eup <- event0 bup command
edown <- event0 bdown command
let
counter :: Behavior t Int
counter = accumB 0 $ ((+1) <$ eup) `union` (subtract 1 <$ edown)
sink output [text :== show <$> counter]
network <- compile networkDescription
actuate network
how can I replace and update the Int counter with a more generic data like:
data Counter = Counter {
count :: Int
} deriving (Show)
let
counter :: Behavior t Counter
counter = accumB Counter { count = 0 } $ ??????
sink output [text :== show <$> count counter]
I don't know how to refer to the internal count function with something like this:
count = count mycounter + 1
Any idea?
The type of accumB is:
accumB :: a -> Event t (a -> a) -> Behavior t a
So if you want to define a Behavior t Counter with it you need to use events that carry Counter -> Counter functions:
-- For the sake of convenience...
overCount :: (Int -> Int) -> Counter -> Counter
overCount f c = c { count = f (count c) }
counter = accumB Counter { count = 0 } $
(overCount (+1) <$ eup) `union` (overCount (subtract 1) <$ edown)
Related
Duplicating this from github as per #HeinrichApfelmus's suggestion:
This may be just a usage error on my part, but I am noticing a strange phenomenon when trying to set up conditional visibility/layout for dynamically created UI elements (in WX of course). As somewhat of a toy-example, I tried to create a widget that created StaticText elements on the fly and allowed the user to "browse" through these elements through '<' '>' buttons.
The problem I am noting is that all labels are invisible until a new one is created, at which point the current widget in focus becomes visible. Whether this is a bug or just a paradigm I am misusing, or a subtlety with reactive frameworks, I am unsure as to how to resolve this. Here is the code I have at this point, which exhibits the problem:
{-# LANGUAGE RecursiveDo #-}
module Test.Adder where
import Reactive.Banana
import Reactive.Banana.WX
import Graphics.UI.WX.Attributes
import Graphics.UI.WX hiding (Event, newEvent, empty, Identity)
import Graphics.UI.WXCore hiding (Event, Timer, empty, Identity, newEvent)
import Graphics.UI.WXCore.Frame
-- | Combine Unit-Events
anyEvent :: [Event ()] -> Event ()
anyEvent = foldl1 (unionWith (\_ _ -> ()))
-- | Unsugared if-then-else function
if_ :: Bool -> a -> a -> a
if_ True x _ = x
if_ False _ y = y
-- | Apply a function to the value at an index, or return a default value
-- if the index is out of range
(!?) :: (a -> b) -> b -> Int -> ([a] -> b)
(f!? ~y) n xs
| n < 0 = y
| otherwise = case drop n xs of
x:_ -> f x
[] -> y
main :: IO ()
main = start test
create :: Window w -> Int -> Behavior Int -> Event Int -> Event () -> MomentIO (StaticText ())
create t i bi ei eRef = do
let tx = replicate i '\t' ++ show i
x <- liftIO $ staticText t [ text := tx ]
let beq = (==i) <$> bi
let eMe = filterE (==i) ei
sink x [ visible :== beq ]
reactimate (refresh x <$ anyEvent [ eRef, () <$ eMe ])
return x
test :: IO ()
test = do
f <- frame [text := "Test"]
add <- button f [ text := "+" ]
prv <- button f [ text := "<" ]
cur <- staticText f []
nxt <- button f [ text := ">" ]
tab <- panel f [ clientSize := sz 200 300 ]
deb <- staticText f []
ref <- button f [ text := "refresh" ]
let networkDescription :: MomentIO ()
networkDescription = mdo
eAdd <- event0 add command
eRef <- event0 ref command
let bNotFirst = (>0) <$> bCur
bNotLast = (<) <$> bCur <*> bNext
sink prv [ enabled :== bNotFirst ]
sink cur [ text :== show <$> bCur ]
sink nxt [ enabled :== bNotLast ]
ePrev <- event0 prv command
eNext <- event0 nxt command
let eDelta :: Enum n => Event (n -> n)
eDelta = unions [ pred <$ whenE bNotFirst ePrev
, succ <$ whenE bNotLast eNext ]
eChange = flip ($) <$> bCur <#> eDelta
bCur <- stepper 0 $ eChange
(eIndex, bCount) <- mapAccum 0 ((\x -> (x, succ x)) <$ eAdd)
let bView = (\n i -> if_ (n==0) (0) i) <$> bCount <*> bCur
bNext = pred <$> bCount
eCreate = (\n -> create tab n bView eChange $ anyEvent [eRef,eAdd]) <$> eIndex
reCreate <- execute eCreate
bItemer <- accumB id $ flip (.) . (:) <$> reCreate
let bItems = ($[]) <$> bItemer
bThis = (widget!?(nullLayouts!!0)) <$> bCur <*> bItems
sink tab [ layout :== bThis ]
liftIO $ set f [ layout := column 5 [ margin 10 $ row 5 [ widget add
, widget prv
, widget cur
, widget nxt
, widget ref
]
, fill $ widget tab
]
]
network <- compile networkDescription
actuate network
>
I'm attempting to write a function that will continually loop checking if a randomly generated int is less than 5, if it is less than 5 then "e" is appended to a string, once "eee" is generated then exit out of the loop.
This Haskell code prints if a random value between 1 - 10 is less than 5 :
useInt :: Int -> Int
useInt x = x
test :: IO ()
test = do
let l = "eee";
int <- randomRIO (1, 10) :: IO Int
if(int < 5) then
putStrLn "less"
else
putStrLn "greater"
test
But I'm unsure how to modify a string without introducing mutable state.
To achieve this using pseudo haskell code can use :
var mutableString = "" :
useInt :: Int -> Int
useInt x = x
test :: IO ()
test = do
let l = "eee";
int <- randomRIO (1, 10) :: IO Int
while(mutableString != "eee"){
if(mutableString == "eee")
break out of loop
else
if(int < 5) then
mutableString = mutableString + "e"
putStrLn "less"
else
putStrLn "greater"
}
test
Any pointers to translate above pseudo code to valid Haskell ?
Use recursion:
test :: IO ()
test = let
loop "eee" = putStrLn "ending" -- end of the "loop"
loop l = do -- "loop" iteration
int <- randomRIO (1, 10) :: IO Int
if int < 5
then do
putStrLn "less"
loop l -- same value for l
else do
putStrLn "greater"
loop ('e':l) -- updated value for l
in loop "" -- "loop" start with initial value for l
The idea is that loop l takes as a parameter the current value of the "mutable" l. When we recurse, we pass the new value of l. In the then branch above we pass the same value since we don't want to modify it. In the else branch we prepend an 'e' character.
I have the following code. The M prefix designates functions from Data.Map.Strict, and Table is a type alias for Data.Map.Strict.Map Mapping Bool, where Mapping is an arbitrary opaque structure.
computeCoverage :: Table -> Expr -> Maybe Coverage
computeCoverage t e = go t True M.empty
where go src flag targ
| null src = if flag
then Nothing
else Just (M.size t, targ)
| otherwise = let ((m, b), rest) = M.deleteFindMin src
result = interpret e m
flag' = result && flag in
go rest flag' (if b == result then targ else M.insert m b targ)
I would like to be able to use Control.Parallel to perform this with as much parallelism as possible. However, I'm not sure how to do this. Based on reading Data.Map.Strict, it seems what you're supposed to do is call splitRoot, then do whatever parallel stuff you want on the resulting list, then recombine (I guess?). Have I basically got the right idea? If not, what should I do instead to parallelize the code above?
Here's a contrived example. You just use parMap over M.splitRoot m:
import qualified Data.Map.Strict as M
import Control.Parallel.Strategies
import System.Environment
fib 0 = 0
fib 1 = 1
fib n = fib (n-2) + fib (n-1)
theMap :: Int -> M.Map Int Int
theMap n = M.fromList [ (x, 33 + mod x 3) | x <- [1..n] ]
isInteresting n = mod (fib n) 2 == 0
countInteresting :: M.Map Int Int -> Int
countInteresting m = length $ filter isInteresting (M.elems m)
doit :: Int -> [Int]
doit n = parMap rseq countInteresting (M.splitRoot $ theMap n)
main :: IO ()
main = do
( arg1 : _) <- getArgs
let n = read arg1
print $ doit n
Note, however these caveats:
the splits may not be of equal size
use splitRoot if working with a Map is helpful for your computation; this particular example doesn't benefit from the Map structure of root - it could have just parMapped over the elements.
I'm new to Haskell and trying to write simple program to find maximal element and it's index from intput. I receive values to compare one by one. Maximal element I'm holding in maxi variable, it's index - in maxIdx. Here's my program:
loop = do
let maxi = 0
let maxIdx = 0
let idx = 0
let idxN = 0
replicateM 5 $ do
input_line <- getLine
let element = read input_line :: Int
if maxi < element
then do
let maxi = element
let maxIdx = idx
hPutStrLn stderr "INNER CHECK"
else
hPutStrLn stderr "OUTER CHECK"
let idx = idxN + 1
let idxN = idx
print maxIdx
loop
Even though I know elements coming are starting from bigger to smaller (5, 4, 3, 2, 1) program enters INNER CHECK all the time (it should happen only for the first element!) and maxIdx is always 0.
What am I doing wrong?
Thanks in advance.
Anyway, let's have fun.
loop = do
let maxi = 0
let maxIdx = 0
let idx = 0
let idxN = 0
replicateM 5 $ do
input_line <- getLine
let element = read input_line :: Int
if maxi < element
then do
let maxi = element
let maxIdx = idx
hPutStrLn stderr "INNER CHECK"
else
hPutStrLn stderr "OUTER CHECK"
let idx = idxN + 1
let idxN = idx
print maxIdx
loop
is not a particularly Haskelly code (and as you know is not particularly correct).
Let's make if Haskellier.
What do we do here? We've an infinite loop, which is reading a line 5 times, does something to it, and then calls itself again for no particular reason.
Let's split it:
import Control.Monad
readFiveLines :: IO [Int]
readFiveLines = replicateM 5 readLn
addIndex :: [Int] -> [(Int, Int)]
addIndex xs = zip xs [0..]
findMaxIndex :: [Int] -> Int
findMaxIndex xs = snd (maximum (addIndex xs))
loop :: ()
loop = loop
main :: IO ()
main = do xs <- readFiveLines
putStrLn (show (findMaxIndex xs))
snd returns the second element from a tuple; readLn is essentially read . getLine; zip takes two lists and returns a list of pairs; maximum finds a maximum value.
I left loop intact in its original beauty.
You can be even Haskellier if you remember that something (huge expression) can be replaced with something $ huge expression ($ simply applies its left operand to its right operand), and the functions can be combined with .: f (g x) is the same as (f . g) x, or f . g $ x (see? it's working for the left side as well!). Additionally, zip x y can be rewritten as x `zip` y
import Control.Monad
readFiveLines :: IO [Int]
readFiveLines = replicateM 5 readLn
addIndex :: [Int] -> [(Int, Int)]
addIndex = (`zip` [0..])
findMaxIndex :: [Int] -> Int
findMaxIndex = snd . maximum . addIndex
main :: IO ()
main = do xs <- readFiveLines
putStrLn . show . findMaxIndex $ xs
As for debug print, there's a package called Debug.Trace and a function traceShow which prints its first argument (formatted with show, hence the name) to stderr, and returns its second argument:
findMaxIndex :: [Int] -> Int
findMaxIndex = snd . (\xs -> traceShow xs (maximum xs)) . addIndex
That allows you to tap onto any expression and see what's coming in (and what are the values around — you can show tuples, lists, etc.)
I think alf's answer is very good, but for what it's worth, here's how I would interpret your intention.
{-# LANGUAGE FlexibleContexts #-}
module Main where
import System.IO
import Control.Monad.State
data S = S { maximum :: Int
, maximumIndex :: Int
, currentIndex :: Int }
update :: Int -> Int -> S -> S
update m mi (S _ _ ci) = S m mi ci
increment :: S -> S
increment (S m mi ci) = S m mi (ci+1)
next :: (MonadIO m, MonadState S m) => m ()
next = do
S maxi maxIdx currIdx <- get
input <- liftIO $ getLine
let element = read input :: Int
if maxi < element
then do
modify (update element currIdx)
liftIO $ hPutStrLn stderr "INNER CHECK"
else
liftIO $ hPutStrLn stderr "OUTER CHECK"
modify increment
run :: Int -> IO S
run n = execStateT (replicateM_ n next) (S 0 0 0)
main :: IO ()
main = do
S maxi maxIdx _ <- run 5
putStrLn $ "maxi: " ++ (show maxi) ++ " | maxIdx: " ++ (show maxIdx)
This uses a monad transformer to combine a stateful computation with IO. The get function retrieves the current state, and the modify function lets you change the state.
For an assignment for FP we have to write a function that runs a state monadic computation given an initial state, and then returns the computed value and the number of operations counted.
Counts looks like this:
data Counts = Counts {
binds :: Int,
returns :: Int,
gets :: Int,
puts :: Int
} deriving (Eq, Show)
Where oneBind = Counts 1 0 0 0 (for example).
There was also an mempty and <*> defined, but I wasn't able to use "mempty" instead of "Counts 0 0 0 0" with initCounts.
The States are defined as:
newtype State' s a = State' { runState' :: (s, Counts) -> (a, s, Counts) }
So far this is what I have got, but I've been stuck at about the same level for a few hours now.
run :: State' s a -> s -> (a, Counts)
run s ns = do
initState <- return ns
initCounts <- return (Counts 0 0 0 0)
newState <- return (runState' s (initState, initCounts))
newCounts <- return (runState' (retCounts newState) (newState, initCounts))
let st = let (a,_,_) = newState
in a
let count = let (c,_,_) = newCounts
in c
return (count)
retCounts :: State' s a -> State' s Counts
retCounts st = State' (\ (s, count) -> (calcCounts st, s, count))
calcCounts :: State' s a -> Counts
calcCounts st = undefined
I assume I have to use pattern matching in calcCounts to somehow actually count all the operators/functions, but right now I'm getting a type matching error:
Assignment4.hs:236:47:
Couldn't match expected type ‘State' (a, s, Counts) a0’
with actual type ‘(a, s, Counts)’
Relevant bindings include
newState :: (a, s, Counts) (bound at Assignment4.hs:235:5)
initState :: s (bound at Assignment4.hs:233:5)
ns :: s (bound at Assignment4.hs:232:7)
s :: State' s a (bound at Assignment4.hs:232:5)
run :: State' s a -> s -> (a, Counts)
(bound at Assignment4.hs:232:1)
In the first argument of ‘retCounts’, namely ‘newState’
In the first argument of ‘runState'’, namely ‘(retCounts newState)’
If I could get any help on how I could solve this type error and some hints to go from here, it would be highly appreciated.
PS: I realize it might be a good idea to rename calcCounts to something like calcFunctions
[EDIT: I'm also getting a different error when I work around this one by supplying a dummy value:
Assignment4.hs:233:5:
No instance for (Monad ((,) a)) arising from a do statement
In a stmt of a 'do' block: initState <- return ns
In the expression:
do { initState <- return ns;
initCounts <- return (Counts 0 0 0 0);
newState <- return (runState' s (initState, initCounts));
newCounts <- return (runState' retCounts (newState, initCounts));
.... }
In an equation for ‘run’:
run s ns
= do { initState <- return ns;
initCounts <- return (Counts 0 0 0 0);
newState <- return (runState' s (initState, initCounts));
.... }
]
There are a few problems here.
There was also an mempty and <*> defined...
Do you mean <> = mappend? <*> is the application operator for applicative functors.
run :: State' s a -> s -> (a, Counts)
run s ns = do
initState <- return ns
initCounts <- return (Counts 0 0 0 0)
newState <- return (runState' s (initState, initCounts))
newCounts <- return (runState' (retCounts newState) (newState, initCounts))
let st = let (a,_,_) = newState
in a
let count = let (c,_,_) = newCounts
in c
return (count)
Firstly, think about what the type of your do block is. It has the same type as run s ns, which according to your type signature for run is (a, Counts). As you know, do notation only works with monads. (a, Counts) (or more accurately ((,) a)) is not a monad, which is one of the reasons GHC is getting confused.
Next, you should note that in a do block:
initState <- return ns
is identical to
let initState = ns
If we rewrite run to reflect this, we get the following:
run s ns = do
let initState = ns
initCounts = Counts 0 0 0 0
newState = runState' s (initState, initCounts)
newCounts = runState' (retCounts newState) (newState, initCounts)
let st = let (a,_,_) = newState
in a
let count = let (c,_,_) = newCounts
in c
return count
Now we can see the next big problem: you aren't actually binding any monadic variables in your do block! In fact, by manually using newState etc you are circumventing the entire point of a state monad -- to keep track of state for us.
The fact is that all this is not so complicated as you might believe; we don't actually even need to use do notation. I advise that you think about this a little more before looking at the text below, to see if you can find the solution. As a hint: the function can be written simply in one line.
Here's how I might write run:
run :: State' s a -> s -> (a, Counts)
run s ns = let (a, _, counts) = runState' s (ns, Counts 0 0 0 0) in (a, counts)