Haskell IORef - an answer vs. a function to get an answer - haskell

I'm trying to understand how IORefs are really used, and I'm having trouble following the sample code I found on https://www.seas.upenn.edu/~cis194/spring15/lectures/12-unsafe.html
newCounter :: IO (IO Int)
newCounter = do
r <- newIORef 0
return $ do
v <- readIORef r
writeIORef r (v + 1)
return v
printCounts :: IO ()
printCounts = do
c <- newCounter
print =<< c
print =<< c
print =<< c
When printCounts executes "c <- newCounter", why doesn't c get the result of doing the work in the newCounter "return $ do" block, which seems like it should get assigned to the constant "IO 0" the first time it is called and then never change? Instead, c seems to get assigned the function defined in that "return $ do" block, which is then executed anew every time printCounts gets to another "print =<< c." It seems that the answer somehow lies in newCounter having the double nested "IO (IO Int)" type, but I can't follow why that makes c a function to be re-executed when called instead of a constant evaluated just once.

You can think of IO as a type of programs. newCounter :: IO (IO Int) is a program that outputs a program. More precisely, newCounter allocates a new counter, and returns a program that, when run, increments the counter and returns its old value. newCounter doesn't execute the program it returns. It would if you wrote instead:
newCounter :: IO (IO Int)
newCounter = do
r <- newIORef 0
let p = do -- name the counter program p
v <- readIORef r
writeIORef r (v + 1)
return v
p -- run the counter program once
return p -- you can still return it to run again later
You can also use equational reasoning to unfold printCounts into a sequence of primitives. All versions of printCounts below are equivalent programs:
-- original definition
printCounts :: IO ()
printCounts = do
c <- newCounter
print =<< c
print =<< c
print =<< c
-- by definition of newCounter...
printCounts = do
c <- do
r <- newIORef 0
return $ do
v <- readIORef r
writeIORef r (v + 1)
return v
print =<< c
print =<< c
print =<< c
-- by the monad laws (quite hand-wavy for brevity)
-- do
-- c <- do
-- X
-- Y
-- .....
-- =
-- do
-- X
-- c <-
-- Y
-- .....
--
-- (more formally,
-- ((m >>= \x -> k x) >>= h) = (m >>= (\x -> k x >>= h)))
printCounts = do
r <- newIORef 0
c <-
return $ do
v <- readIORef r
writeIORef r (v + 1)
return v
print =<< c
print =<< c
print =<< c
-- c <- return X
-- =
-- let c = X
--
-- (more formally, ((return X) >>= (\c -> k c)) = (k X)
printCounts = do
r <- newIORef 0
let c = do
v <- readIORef r
writeIORef r (v + 1)
return v
print =<< c
print =<< c
print =<< c
-- let-substitution
printCounts = do
r <- newIORef 0
print =<< do
v <- readIORef r
writeIORef r (v + 1)
return v
print =<< do
v <- readIORef r
writeIORef r (v + 1)
return v
print =<< do
v <- readIORef r
writeIORef r (v + 1)
return v
-- after many more applications of monad laws and a bit of renaming to avoid shadowing
-- (in particular, one important step is ((return v >>= print) = (print v)))
printCounts = do
r <- newIORef 0
v1 <- readIORef r
writeIORef r (v1 + 1)
print v1
v2 <- readIORef r
writeIORef r (v2 + 1)
print v2
v3 <- readIORef r
writeIORef r (v3 + 1)
print v3
In the final version, you can see that printCounts quite literally allocates a counter and increments it three times, printing each intermediate value.
One key step is the let-substitution one, where the counter program gets duplicated, which is why it gets to run three times. let x = p; ... is different from x <- p; ..., which runs p, and binds x to the result rather than the program p itself.

Related

Factorial using imperative-style programming

I have the following code:
while :: IO Bool -> IO () -> IO ()
while test body =
do b <- test
if b
then do {body ; while test body} -- same-line syntax for do
else return ()
I need to implement the factorial function using imperative-style programming. what I have to do is to create and initialize variables using newIORef, modify their values using a while loop with readIORef and writeIORef, then have the IO action return a pair consisting of the input n and the final result.
This is what I have done so far:
fact :: Integer -> IO (Integer, Integer)
fact n = do r <- newIORef n --initialize variable
while
(do {v <- readIORef n; n})
(do {v <- readIORef r; writeIORef (...)) --modify the value (?)
readIORef r
This is my attempt to write the factorial function. This is obviously does not work. Any help would be appreciated.
I think maybe it's time to give you some working version:
fact :: Integer -> IO (Integer, Integer)
fact n = do
i <- newIORef 1
acc <- newIORef 1
while (lessOrEqualN i) (step i acc)
acc' <- readIORef acc
return $ (n, acc')
where
lessOrEqualN iRef = do
i' <- readIORef iRef
return $ i' <= n
step iRef accRef = do
i' <- readIORef iRef
acc' <- readIORef accRef
writeIORef accRef (acc' * i')
writeIORef iRef (i'+1)
as you can see I used an loop reference i and an accumulator reference acc always reading, writing the changing values.
To make this (hopefully) a bit more readable I extracted the test and the body of the while into lessOrEqualN and step.
Of course there are easier ways to do this (modifyIORef) but I guess you have to use those.
PS: you play with it a bit - maybe you want to handle negative values differently or whatever
this might be a bit cleaner (putting both mutables into the same ref):
fact :: Integer -> IO (Integer, Integer)
fact n = do
ref <- newIORef (1,1)
while (lessOrEqualN ref) (step ref)
(_,acc) <- readIORef ref
return $ (n, acc)
where
lessOrEqualN ref = do
(i,_) <- readIORef ref
return $ i <= n
step ref = do
(i,acc) <- readIORef ref
writeIORef ref (i+1, acc * i)
I think Carsten's answer can be made a bit cleaner like this:
{-# LANGUAGE TupleSections #-}
import Control.Monad
import Data.IORef
fact :: Integer -> IO (Integer, Integer)
fact n = do
counter <- newIORef 1
result <- newIORef 1
while (fmap (<=n) (readIORef counter)) $ do
i <- postIncrement counter
modifyIORef result (*i)
fmap (n,) (readIORef result)
while :: IO Bool -> IO () -> IO ()
while test body =
do b <- test
if b
then do {body ; while test body} -- same-line syntax for do
else return ()
postIncrement :: Enum a => IORef a -> IO a
postIncrement ref = do
result <- readIORef ref
modifyIORef ref succ
return result
What I'm doing here is:
Using modifyIORef to cut down on the number of paired readIORef/writeIORef calls.
Using fmap to reduce the need for auxiliary functions to test the contents of an IORef.
Write a generic, reusable postIncrement function and use that to shorten fact further.
But frankly, I think your instructor's insistence that you use this while function is a bit silly. It doesn't make for clean code. If I was told to write an imperative factorial with IORef I'd first write this, just using the forM_ loop from the library:
factorial :: Integer -> IO (Integer, Integer)
factorial n = do
result <- newIORef 1
forM_ [2..n] $ \i -> do
modifyIORef result (*i)
fmap (n,) (readIORef result)
And that's because I was too dumb to remember replicateM_ :: Monad m => Int -> m a -> m () right away...

Haskell STM : Main thread will not exit until child thread completes execution

In the following program, I want that main thread will not exit until all its child threads complete execution. Please note that I have used bang patterns to evaluate the Fibonacci call so that it returns an evaluated thunk to main thread.
{-# LANGUAGE BangPatterns #-}
module Main
where
import Control.Concurrent.STM
import Control.Concurrent
import System.IO
nfib :: Int -> Int
nfib n | n <= 2 = 1
| otherwise = (n1 + n2 )
where n1 = nfib (n-1)
n2 = nfib (n-2)
type TInt = TVar Int
updateNum :: TInt -> Int -> STM()
updateNum n v = do writeTVar n v
updateTransaction :: TInt -> Int -> IO ()
updateTransaction n v = do
atomically $ do
updateNum n v
main :: IO ()
main = do
n <- newTVarIO 10
forkIO $ do
let v = 30
let !x = nfib v
updateTransaction n x
forkIO $ do
let v = 15
let !x = nfib v
updateTransaction n x
forkIO $ do
let v = 25
let !x = nfib v
updateTransaction n x
nv <- readTVarIO n
putStrLn ("Fib number of " ++ " = " ++ (show nv))
nv <- readTVarIO n
putStrLn ("Fib number of " ++ " = " ++ (show nv))
nv <- readTVarIO n
putStrLn ("Fib number of " ++ " = " ++ (show nv))
I have tired to solve this problem as per [link] (Haskell MVar : How to execute shortest job first?). I don't know whether approach is correct not not and also getting an error when try to print the value of TMVar.
Here is the code :- (nfib is same as above)
type TMInt = TMVar Int
updateNum1 :: TMInt -> Int -> STM()
updateNum1 n v = do putTMVar n v
updateTransaction1 :: TMInt -> Int -> IO ()
updateTransaction1 n v = do
atomically $ do
updateNum1 n v
main1 :: IO ()
main1 = do
n <- newTMVarIO 0
forkIO $ do
let v = 30
let !x = nfib v
updateTransaction1 n x
forkIO $ do
let v = 15
let !x = nfib v
updateTransaction1 n x
forkIO $ do
let v = 25
let !x = nfib v
updateTransaction1 n x
-- t <- takeTMVar n
-- putStrLn( "result: " ++ (show t))
** Error is as follows:-
Couldn't match type `STM' with `IO'
Expected type: IO Int
Actual type: STM Int
In the return type of a call of `takeTMVar'
In a stmt of a 'do' block: t <- takeTMVar n
Please help. Thanks.
main1 is in IO but takeTMVar returns an STM Int. You need to run the transaction:
t <- atomically $ takeTMVar n
putStrLn( "result: " ++ (show t))

Haskell STM : How to store ThreadID as per their execution sequence

In the following program Fibonacci number is generated from a given integer (generated randomly) and that value is stored into a TVar. As the execution time for generating the Fibonacci is different for different number, thus threads will not run sequentially. I want to store theadID, may be in a list, to check their execution pattern.
Please help me. Thanks in advance.
module Main
where
import Control.Parallel
import Control.Concurrent.STM
import Control.Concurrent
import System.Random
import Control.Monad
import Data.IORef
import System.IO
nfib :: Int -> Int
nfib n | n <= 2 = 1
| otherwise = par n1 (pseq n2 (n1 + n2 ))
where n1 = nfib (n-1)
n2 = nfib (n-2)
type TInt = TVar Int
updateNum :: TInt -> Int -> STM()
updateNum n v = do x1 <- readTVar n
let y = nfib v
x2 <- readTVar n
if x1 == x2
then writeTVar n y
else retry
updateTransaction :: TInt -> Int -> IO ()
updateTransaction n v = do atomically $ updateNum n v
incR :: IORef Int -> Int -> IO ()
incR r x = do { v <- readIORef r;
writeIORef r (v - x) }
main :: IO ()
main = do
n <- newTVarIO 10
r <- newIORef 40;
forM_ [1..10] (\i -> do
incR r i
;v <- readIORef r
;forkIO (updateTransaction n v)
)
I want to store [TreadID,FibNo] into a List for all the threads as per their execution. Suppose T1 has executed Fib30, T2 Fib35, T3->32 and T4->40. And if the commit sequence of threads like T1,T3, T2 and T4 then I want to store T1-35,T3-32,t2-35,t4-40 in a list.
Edit:
As suggested by #MathematicalOrchid, I have modified updateTrasaction as follows:-
updateTransaction :: MVar [(ThreadId, Int)] -> TInt -> Int -> IO ()
updateTransaction mvar n v = do
tid <- myThreadId
atomically $ updateNum n v
list <- takeMVar mvar
putMVar mvar $ list ++ [(tid, v)]
Now I am trying to print the values from that list in main
main :: IO ()
main = do
...
...
m <- newEmptyMVar
...
...
mv <- readMVar m
putStrLn ("ThreadId, FibVal : " ++ " = " ++ (show mv))
At the time of execution. MVar values couldn't be read and generates error
Exception: thread blocked indefinitely in an MVar operation
What to do? Thank in advance.
Did you want something like
updateTransaction :: TInt -> Int -> IO ()
updateTransaction n v = do
tid <- myThreadId
putStrLn $ "Start " ++ show tid
atomically $ updateNum n v
putStrLn $ "End " ++ show tid
Or perhaps something like
updateTransaction :: TInt -> Int -> IO ThreadId
updateTransaction n v = do
atomically $ updateNum n v
myThreadId
and change forM_ to forM?
Also, this part:
do
x1 <- readTVar n
...
x2 <- readTVar n
if x1 == x2 ...
If x1 /= x2 then GHC will automatically abort and restart your transaction. You do not need to manually check this yourself. Indeed, the else-branch can never execute. That's kind of the point of STM; it will appear to your transaction that nobody else changes the data you're looking at, so you don't ever have to worry about concurrent writes.
Edit: If you want to record the actual order in which the transactions committed, you're going to need some more inter-thread communication. Obviously you could do that with STM, but just for a list of stuff, maybe this could work?
updateTransaction :: MVar [(ThreadId, Int)] -> TInt -> Int -> IO ()
updateTransaction mvar n v = do
tid <- myThreadId
fib <- atomically $ updateNum n v
list <- takeMVar mvar
putMVar mvar $ list ++ [(tid, fib)]
(Obviously you have to make updateNum return the number it calculated.)

How to use MonadRandom?

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

How do I define the initial state in the State Monad?

I found this partially on http://www.haskell.org/haskellwiki/State_Monad
but it is not clear to me how I would define the initial state of c and f.
It works with IORefs though but I do not need global mutable data.
increment :: StateT Integer IO Integer
increment = do
n <- get
put (n+1)
return n
plusOne :: Integer -> IO Integer
plusOne n = execStateT increment n
printTChan mtch = do
forever $ do
m <- atomically $ readTChan mtch
case m of
"ping" -> plusOne c
_ -> plusOne f
print (c)
When working with StateT, you can think of run/eval/execStateT as marking the scope of the state, so what you have there is just a fancy way of writing this:
plusOne n = return (n+1)
Since you're ignoring the result of these actions, this has no effect whatsoever.
If you want to carry the state across your entire computation, you need to structure your code so that the whole thing runs in StateT:
printTChan mtch = flip evalStateT (c0, f0) $ do
forever $ do
m <- liftIO . atomically $ readTChan mtch
case m of
"ping" -> modify incrementC
_ -> modify incrementF
(c, f) <- get
liftIO $ print c
incrementC (c, f) = (c+1, f)
incrementF (c, f) = (f, c+1)
Now, you can fill in the initial state values in place of (c0, f0).

Resources