I'm trying to wrap my head around Cont and callCC, by reducing this function:
s0 = (flip runContT) return $ do
(k, n) <- callCC $ \k -> let f x = k (f, x)
in return (f, 0)
lift $ print n
if n < 3
then k (n+1) >> return ()
else return ()
I've managed to reach this point:
s21 = runContT (let f x = ContT $ \_ -> cc (f, x) in ContT ($(f,0))) cc where
cc = (\(k,n) -> let
iff = if n < 3 then k (n+1) else ContT ($())
in print n >> runContT iff (\_ -> return ()))
And at this point i have no idea what to do with recursive definition of f
What is the best way to finish this reduction?
You can proceed as follows.
s21 = runContT (let f x = ContT $ \_ -> cc (f, x) in ContT ($(f,0))) cc where
cc = (\(k,n) -> let
iff = if n < 3 then k (n+1) else ContT ($())
in print n >> runContT iff (\_ -> return ())
-- runContT is the opposite of ContT
s22 = (let f x = ContT $ \_ -> cc (f, x) in ($(f,0))) cc
where
cc = (\(k,n) -> let
iff = if n < 3 then k (n+1) else ContT ($())
in print n >> runContT iff (\_ -> return ())
-- reordering
s23 = ($(f,0)) cc
where
f x = ContT $ \_ -> cc (f, x)
cc = (\(k,n) -> let
iff = if n < 3 then k (n+1) else ContT ($())
in print n >> runContT iff (\_ -> return ())
s24 = cc (f,0)
where ...
-- beta
s25 = let iff = if 0 < 3 then f (0+1) else ContT ($())
in print 0 >> runContT iff (\_ -> return ())
where ...
-- if, arithmetics
s26 = let iff = f 1
in print 0 >> runContT iff (\_ -> return ())
where ...
s27 = print 0 >> runContT (f 1) (\_ -> return ())
where ...
s28 = print 0 >> runContT (ContT $ \_ -> cc (f, 1)) (\_ -> return ())
where ...
s29 = print 0 >> (\_ -> cc (f, 1)) (\_ -> return ())
where ...
s30 = print 0 >> cc (f, 1)
where ...
-- repeat all the steps s24..s30
s31 = print 0 >> print 1 >> cc (f, 2)
where ...
-- etc.
s32 = print 0 >> print 1 >> print 2 >> cc (f, 3)
where ...
s33 = print 0 >> print 1 >> print 2 >>
let iff = if 3 < 3 then f (3+1) else ContT ($())
in print 3 >> runContT iff (\_ -> return ())
where ...
s34 = print 0 >> print 1 >> print 2 >> print 3 >>
let iff = ContT ($())
in runContT iff (\_ -> return ()))
where ...
s35 = print 0 >> print 1 >> print 2 >> print 3 >>
runContT (ContT ($())) (\_ -> return ())
where ...
s36 = print 0 >> print 1 >> print 2 >> print 3 >>
($()) (\_ -> return ())
where ...
s37 = print 0 >> print 1 >> print 2 >> print 3 >>
return ()
Related
I have the following code
newtype State s a = State { runState :: s -> (s,a) }
evalState :: State s a -> s -> a
evalState sa s = snd $ runState sa s
instance Functor (State s) where
fmap f sa = State $ \s ->
let (s',a) = runState sa s in
(s',f a)
instance Applicative (State s) where
pure a = State $ \s -> (s,a)
sf <*> sa = State $ \s ->
let (s',f) = runState sf s
(s'',a) = runState sa s' in
(s'', f a)
instance Monad (State s) where
sa >>= k = State $ \s ->
let (s',a) = runState sa s in
runState (k a) s'
get :: State s s
get = State $ \s -> (s,s)
set :: s -> State s ()
set s = State $ \_ -> (s,())
bar (acc,n) = if n <= 0
then return ()
else
set (n*acc,n-1)
f x = factLoop
factLoop = get >>= bar >>= f
And
runState factLoop (1,7)
gives ((5040,0),())
I'm trying to write the function
factLoop = get >>= bar >>= f
using the do notation
I tried
factLoop' = do
(x,y) <- get
h <- bar (x,y)
return ( f h)
But that does not give the correct type which should be State (Int, Int) ()
Any idea ?
Thanks!
Just remove the return on the final line :
factLoop' = do
(x,y) <- get
h <- bar (x,y)
f h
There is no return in your original code, so there should be none in the do notation version either. do notation simply "translates" uses of >>=, as you've already done.
>>= is infixl 1 (left-associating binary operator), so what you really have is
f x = factLoop
factLoop = get >>= bar >>= f
= (get >>= bar) >>= f
= (get >>= bar) >>= (\x -> f x)
= do { x <- (get >>= bar)
; f x }
= do { _ <- (get >>= bar)
; factLoop }
= do { _ <- (get >>= (\x -> bar x))
; factLoop }
= do { _ <- do { x <- get
; bar x }
; factLoop }
= do { x <- get
; _ <- bar x
; factLoop }
the last one is because of the monad associativity law ("Kleisli composition forms a category").
Doing this in the principled way you don't need to guess. After a little while you get a feeling for it of course, but until you do, being formal helps.
I want to extract the value of v from the following code into m2.
It is a little difficult to understand these chains. I am trying to understand the flow for a long, couldn't find any specific solution.
m1 <- newEmptyMVar
m2 <- newEmptyMVar
forkIO $ do
g <- view (hasLens . to seed)
let g' = mkStdGen $ fromMaybe (d' ^. defSeed) g
execStateT (evalRandT runCampaign g') (Campaign ((,Open (-1)) <$> ts) c d') where
step = runUpdate (updateTest v Nothing) >> lift u >> runCampaign
runCampaign = use (hasLens . tests . to (fmap snd)) >>= update
update c = view hasLens >>= \(CampaignConf tl q sl _ _) ->
if | any (\case Open n -> n < tl; _ -> False) c -> callseq v w q >> step
| any (\case Large n _ -> n < sl; _ -> False) c -> step
| otherwise -> lift u
Helping functions
runUpdate :: (MonadState x m, Has Campaign x) => ((SolTest, TestState) -> m (SolTest, TestState)) -> m ()
runUpdate f = use (hasLens . tests) >>= mapM f >>= (hasLens . tests .=)
updateTest :: ( MonadCatch m, MonadRandom m, MonadReader x m, Has TestConf x, Has CampaignConf x)
=> VM -> Maybe (VM, [Tx]) -> (SolTest, TestState) -> m (SolTest, TestState)
I tried to include putMVar m1 v as the following in the step line
step = runUpdate (updateTest v Nothing) >> lift u >> putMVar m1 v >> runCampaign
I thought these are just sequencing, putting putMVar m1 v in between produces following error.
parse error (possibly incorrect indentation or mismatched brackets)
|
192 | runCampaign = use (hasLens . tests . to (fmap snd)) >>= update
| ^
Some extra information
campaign u v w ts d = let d' = fromMaybe defaultDict d in fmap (fromMaybe mempty) (view (hasLens . to knownCoverage)) >>= \c -> do
g <- view (hasLens . to seed)
let g' = mkStdGen $ fromMaybe (d' ^. defSeed) g
execStateT (evalRandT runCampaign g') (Campaign ((,Open (-1)) <$> ts) c d') where
step = runUpdate (updateTest v Nothing) >> lift u >> runCampaign
runCampaign = use (hasLens . tests . to (fmap snd)) >>= update
update c = view hasLens >>= \(CampaignConf tl q sl _ _) ->
if | any (\case Open n -> n < tl; _ -> False) c -> callseq v w q >> step
| any (\case Large n _ -> n < sl; _ -> False) c -> step
| otherwise -> lift u
This is the code I'm trying to work on.
Here, I want to declare one variable m1 <- newEmptyMVar and m2.
Then I want to run the code from 2nd line(through the end) on two threads concurrently using forkIO .
I want v to get stored in m1 & m2 from both the threads. So that I can manually check if both threads have the same v
Hope it helps!
I'm trying to pause a computation and later resume it on demand (upon a prompt from the user). It should resemble something like the following, only using the continuation monad.
import Control.Monad.IO.Class (liftIO,MonadIO(..))
import Data.Void
f :: MonadIO m => Int -> Int -> m Void
f x y = do
liftIO (print x)
input <- liftIO getLine
if input /= "pause"
then (f (x+1) y)
else (f' y x)
f' :: MonadIO m => Int -> Int -> m Void
f' x y = do
liftIO (print x)
input <- liftIO getLine
if input /= "pause"
then (f' (x-1) y)
else (f y x)
Example output:
λ> f 5 5
5
6
7
8
pause
5
4
3
2
pause
8
9
10
Interrupted.
Original version of the question:
-- Helpers
cond = fmap (not . (== "pause")) getLine
ch b x y = if b then x else y
ch' :: a -> a -> Bool -> a
ch' = flip . (flip ch)
-- Main code
f i i' = liftIO (print i) >> liftIO cond >>= ch' (f (i+1) i') (f' i' i)
f' i i' = liftIO (print i) >> liftIO cond >>= ch' (f' (i-1) i') (f i' i)
I'm trying to write a prime number generator and utilizing MillerRabin formula check whether or not the number is prime before it returns the number back into me.
Here is my code below:
primegen :: Int -> IO Integer
primegen bits =
fix $ \again -> do
x <- fmap (.|. 1) $ randomRIO (2^(bits - 1), 2^bits - 1)
if primecheck x then return x else again
primesTo100 = [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97]
powerMod :: (Integral a, Integral b) => a -> a -> b -> a
powerMod m _ 0 = 1
powerMod m x n | n > 0 = join (flip f (n - 1)) x `rem` m where
f _ 0 y = y
f a d y = g a d where
g b i | even i = g (b*b `rem` m) (i `quot` 2)
| otherwise = f b (i-1) (b*y `rem` m)
witns :: (Num a, Ord a, Random a) => Int -> a -> IO [a]
witns x y = do
g <- newStdGen
let r = [9080191, 4759123141, 2152302898747, 3474749600383, 341550071728321]
fs = [[31,73],[2,7,61],[2,3,5,7,11],[2,3,5,7,11,13],[2,3,5,7,11,13,17]]
if y >= 341550071728321
then return $ take x $ randomRs (2,y-1) g
else return $ snd.head.dropWhile ((<= y).fst) $ zip r fs
primecheck :: Integer -> IO Bool
primecheck n | n `elem` primesTo100 = return True
| otherwise = do
let pn = pred n
e = uncurry (++) . second(take 1) . span even . iterate (`div` 2) $ pn
try = return . all (\a -> let c = map (powerMod n a) e in
pn `elem` c || last c == 1)
witns 100 n >>= try
I don't understand whats going on with the IO Bool. And I'm getting the following error...
Couldn't match expected type `Bool' with actual type `IO Bool'
In the return type of a call of `primecheck'
In the expression: primecheck x
In a stmt of a 'do' block: if primecheck x then return x else again
If I change the IO Bool to just a normal Bool, they will give me this:
Couldn't match expected type `Bool' with actual type `m0 a0'
Thanks for the help guys! I appreciate it.
if primecheck x then return x else again
is not valid because primecheck x returns a value of type IO Bool. You want to sequence the monad with do notation or something like:
primecheck x >>= (\val -> if val then return x else again)
Since primecheck returns IO Bool, when you call it in primegen, you need to sequence it rather than calling it like a pure function.
primegen :: Int -> IO Integer
primegen bits =
fix $ \again -> do
x <- fmap (.|. 1) $ randomRIO (2^(bits - 1), 2^bits - 1)
success <- primecheck x
if success then return x else again
Can someone provide "for-dummies" example of how to use `MonadRandom'?
Currently I have code that does stuff like passing around the generator variable, all the way from the main function:
main = do
g <- getStdGen
r <- myFunc g
putStrLn "Result is : " ++ show r
--my complicated func
myFunc g x y z = afunc g x y z
afunc g x y z = bfunc g x y
bfunc g x y = cfunc g x
cfunc g x = ret where
(ret, _ ) = randomR (0.0, 1.0) g
Thanks
Basically all the extra g parameters can just be dropped. You then get random numbers using the functions from Control.Monad.Random (such as getRandomR). Here is your example (I added some args to make it compile):
import Control.Monad.Random
main = do
g <- getStdGen
let r = evalRand (myFunc 1 2 3) g :: Double
-- or use runRand if you want to do more random stuff:
-- let (r,g') = runRand (myFunc 1 2 3) g :: (Double,StdGen)
putStrLn $ "Result is : " ++ show r
--my complicated func
myFunc x y z = afunc x y z
afunc x y z = bfunc x y
bfunc x y = cfunc x
cfunc x = do
ret <- getRandomR (0.0,1.0)
return ret
You just run something in the RandT monad transformer with runRandT or evalRandT, and for the pure Rand monad, with runRand or evalRand:
main = do
g <- getStdGen
r = evalRand twoEliteNumbers g
putStrLn $ "Result is: " ++ show r
twoEliteNumbers :: (RandomGen g) => Rand g (Double, Double)
twoEliteNumbers = do
-- You can call other functions in the Rand monad
number1 <- eliteNumber
number2 <- eliteNumber
return $ (number1, number2)
eliteNumber :: (RandomGen g) => Rand g Double
eliteNumber = do
-- When you need random numbers, just call the getRandom* functions
randomNumber <- getRandomR (0.0, 1.0)
return $ randomNumber * 1337