I was practicing my Haskell and I came across a weird problem which I was unable to find a solution to on the Internet. I decided to solve this problem:
https://www.hackerrank.com/challenges/fibonacci-fp
In as many ways I can think of. One way is to perform recursion with memoization where I want to use State monad as a cache. I have GHC 7.10.2 on my Windows 10 and GHC 7.6.2 on my Ubuntu 14.04. This code below compiles (and runs very well) on 7.6.2 and doesn't compile on 7.10.2 giving error wherever I type 'Map', for example:
Not in scope: type constructor or class: 'Map.Map'
Not in scope: 'Map.lookup'
module Main (
main
) where
import qualified Data.Map as Map
import Control.Monad.State
type CacheState = Map.Map Int Int
type IOState a = StateT CacheState IO a
modNum :: Int
modNum = 100000007
fibsMod :: [Int]
fibsMod = 0 : 1 : zipWith (\x y -> (x + y) mod modNum ) fibsMod (tail fibsMod)
-- | calculate Fibs with memoization in map
memoizedFib :: Int -> IOState Int
memoizedFib n = do
state <- get
let x = Map.lookup n state
case x of
Just y ->
return y
Nothing -> do
n1 <- memoizedFib (n - 1)
n2 <- memoizedFib (n - 2)
let n3 = mod (n1 + n2) modNum
put (Map.insert n n3 state)
return n3
query :: [Int] -> IOState ()
query [] = return ()
query (n:ns) = do
fibNum <- memoizedFib n
liftIO $ print fibNum
query ns
main :: IO ()
main = do
inputdata <- getContents
let intList = (map (read :: String -> Int) . tail . words) inputdata
evalIOState $ query intList
where
initState :: Int -> Map.Map Int Int
initState upTo = Map.fromList $ zip [0 .. upTo] $ take upTo fibsMod
--initState upTo = Map.fromList $ [(0, 0), (1, 1)]
evalIOState :: IOState a -> IO a
evalIOState m = evalStateT m (initState 10001)
Does anybody know why am I facing this problem? It's very disturbing.
Additional question
As you can see I didn't perform exactly recursion with memoization. However leaving one of those lines uncommented can change approach:
initState upTo = Map.fromList $ zip [0 .. upTo] $ take upTo fibsMod
--initState upTo = Map.fromList $ [(0, 0), (1, 1)]
The problem is that using the second line performs terrible. I don't know where I made a mistake, but I think it should run in linear time with memoization. However with this line my algorithm is clearly exponential (I couldn't even get the answer for 50-th Fib number - that long). What did I do wrong in this case?
UPDATE
Thanks to your comments I fixed my code. Obviously there was a problem with mod function (I completely don't know how did this compile on GHC 7.6.2). Also I changed:
import qualified Data.Map as Map
to:
import qualified Data.Map.Strict as Map
and now this code below works as intended:
module Main (
main
) where
import qualified Data.Map.Strict as Map
import Control.Monad.State
type CacheState = Map.Map Int Int
type IOState a = StateT CacheState IO a
modNum :: Int
modNum = 100000007
fibsMod :: [Int]
fibsMod = 0 : 1 : zipWith (\x y -> (x + y) `mod` modNum) fibsMod (tail fibsMod)
-- | calculate Fibs with memoization in map
memoizedFib :: Int -> IOState Int
memoizedFib n = do
state <- get
let x = Map.lookup n state
case x of
Just y ->
return y
Nothing -> do
n1 <- memoizedFib (n - 1)
n2 <- memoizedFib (n - 2)
state <- get
let n3 = mod (n1 + n2) modNum
put (Map.insert n n3 state)
return n3
query :: [Int] -> IOState ()
query [] = return ()
query (n:ns) = do
fibNum <- memoizedFib n
liftIO $ print fibNum
query ns
main :: IO ()
main = do
inputdata <- getContents
let intList = (map (read :: String -> Int) . tail . words) inputdata
evalIOState $ query intList
where
initState :: Int -> Map.Map Int Int
--initState upTo = Map.fromList $ zip [0 .. upTo] $ take upTo fibsMod
initState upTo = Map.fromList [(0, 0), (1, 1)]
evalIOState :: IOState a -> IO a
evalIOState m = evalStateT m (initState 10001)
So now the question comes down to: Why did I need to use Data.Map.Strict, how is it different and why GHC 7.6.2 didn't need it?
Related
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...
I can write the following:
f :: [Int] -> [Int]
f x = 0:(map (+1) x)
g :: [Int] -> [Int]
g x = map (*2) x
a = f b
b = g a
main = print $ take 5 a
And things work perfectly fine (ideone).
However, lets say I want g to do something more complex than multiply by 2, like ask the user for a number and add that, like so:
g2 :: [Int] -> IO [Int]
g2 = mapM (\x -> getLine >>= (return . (+x) . read))
How do I then, well, tie the knot?
Clarification:
Basically I want the list of Ints from f to be the input of g2 and the list of Ints from g2 to be the input of f.
The effectful generalization of lists is ListT:
import Control.Monad
import Pipes
f :: ListT IO Int -> ListT IO Int
f x = return 0 `mplus` fmap (+ 1) x
g2 :: ListT IO Int -> ListT IO Int
g2 x = do
n <- x
n' <- lift (fmap read getLine)
return (n' + n)
a = f b
b = g2 a
main = runListT $ do
n <- a
lift (print n)
mzero
You can also implement take like functionality with a little extra code:
import qualified Pipes.Prelude as Pipes
take' :: Monad m => Int -> ListT m a -> ListT m a
take' n l = Select (enumerate l >-> Pipes.take n)
main = runListT $ do
n <- take' 5 a
lift (print n)
mzero
Example session:
>>> main
0
1<Enter>
2
2<Enter>
3<Enter>
7
4<Enter>
5<Enter>
6<Enter>
18
7<Enter>
8<Enter>
9<Enter>
10<Enter>
38
You can learn more about ListT by reading the pipes tutorial, specifically the section on ListT.
I would like to generate random sequences from a Markov chain. To generate the Markov chain I use the following code.
module Main where
import qualified Control.Monad.Random as R
import qualified Data.List as L
import qualified Data.Map as M
type TransitionMap = M.Map (String, String) Int
type MarkovChain = M.Map String [(String, Int)]
addTransition :: (String, String) -> TransitionMap -> TransitionMap
addTransition k = M.insertWith (+) k 1
fromTransitionMap :: TransitionMap -> MarkovChain
fromTransitionMap m =
M.fromList [(k, frequencies k) | k <- ks]
where ks = L.nub $ map fst $ M.keys m
frequencies a = map reduce $ filter (outboundFor a) $ M.toList m
outboundFor a k = fst (fst k) == a
reduce e = (snd (fst e), snd e)
After collecting the statistics and generating a Markov Chain object I would like to generate random sequences. I could imagine this method could look something like that (pseudo-code)
generateSequence mc s
| s == "." = s
| otherwise = s ++ " " ++ generateSequence mc s'
where s' = drawRandomlyFrom $ R.fromList $ mc ! s
I would greatly appreciate if someone could explain to me, how I should implement this function.
Edit
If anyone's interested it wasn't as difficult as I thought.
module Main where
import qualified Control.Monad.Random as R
import qualified Data.List as L
import qualified Data.Map as M
type TransitionMap = M.Map (String, String) Rational
type MarkovChain = M.Map String [(String, Rational)]
addTransition :: TransitionMap -> (String, String) -> TransitionMap
addTransition m k = M.insertWith (+) k 1 m
fromTransitionMap :: TransitionMap -> MarkovChain
fromTransitionMap m =
M.fromList [(k, frequencies k) | k <- ks]
where ks = L.nub $ map fst $ M.keys m
frequencies a = map reduce $ filter (outboundFor a) $ M.toList m
outboundFor a k = fst (fst k) == a
reduce e = (snd (fst e), snd e)
generateSequence :: (R.MonadRandom m) => MarkovChain -> String -> m String
generateSequence m s
| not (null s) && last s == '.' = return s
| otherwise = do
s' <- R.fromList $ m M.! s
ss <- generateSequence m s'
return $ if null s then ss else s ++ " " ++ ss
fromSample :: [String] -> MarkovChain
fromSample ss = fromTransitionMap $ foldl addTransition M.empty $ concatMap pairs ss
where pairs s = let ws = words s in zipWith (,) ("":ws) ws
sample :: [String]
sample = [ "I am a monster."
, "I am a rock star."
, "I want to go to Hawaii."
, "I want to eat a hamburger."
, "I have a really big headache."
, "Haskell is a fun language."
, "Go eat a big hamburger."
, "Markov chains are fun to use."
]
main = do
s <- generateSequence (fromSample sample) ""
print s
The only tiny annoyance is the fake "" starting node.
Not sure if this is what you're looking for. This compiles though:
generateSequence :: (R.MonadRandom m) => MarkovChain -> String -> m String
generateSequence mc s | s == "." = return s
| otherwise = do
s' <- R.fromList $ rationalize (mc M.! s)
s'' <- generateSequence mc s'
return $ s ++ " " ++ s''
rationalize :: [(String,Int)] -> [(String,Rational)]
rationalize = map (\(x,i) -> (x, toRational i))
All random number generation needs to happen in either the Random monad or the IO monad. For your purpose, it's probably easiest to understand how to do that in the IO monad, using evalRandIO. In the example below, getRandom is the function we want to use. Now getRandom operates in the Random monad, but we can use evalRandIO to lift it to the IO monad, like this:
main :: IO ()
main = do
x <- evalRandIO getRandom :: IO Double
putStrLn $ "Your random number is " ++ show x
Note: The reason we have to add the type signature to the line that binds x is because in this particular example there are no other hints to tell the compiler what type we want x to be. However, if we used x in some way that makes it clear that we want it to be a Double (e.g., multiplying by another Double), then the type signature wouldn't be necessary.
Using your MarkovChain type, for a current state you can trivially get the available transitions in the form [(nextState,probability)]. (I'm using the word "probability" loosely, it doesn't need to be a true probability; any numeric weight is fine). This is what fromList in Control.Monad.Random is designed for. Again, it operates in the Random monad, but we can use evalRandIO to lift it to the IO monad. Suppose transitions is your list of transitions, having the type [(nextState,probability)]. Then, in the IO monad you can call:
nextState <- evalRandIO $ fromList transitions
You might instead want to create your own function that operates in the Random monad, like this:
getRandomTransition :: RandomGen g => MarkovChain -> String -> Rand g String
getRandomTransition currState chain = do
let transitions = lookup currState chain
fromList transitions
Then you can call this function in the IO monad using evalRandIO, e.g.
nextState <- evalRandIO $ getRandomTransition chain
I have the some code that compile and works. And then some that don't.
My concern was that the first version was soooo bloated that it crashed while running on too big arguments, so I wrote a second version with performance in mind.
The second version does't even compile. Please advice.
import System.Environment (getArgs)
import Data.List (nub)
import System.Random
import Control.Applicative ( (<$>) )
import Control.Monad (replicateM)
randomItem :: [a] -> IO a
randomItem xs = (xs!!) <$> randomRIO (0, length xs - 1)
genFromMask :: [String] -> IO String
genFromMask = mapM randomItem
genMeSome :: [String] -> Int -> IO [String]
genMeSome mask n = do
glist <- replicateM (n*10) (genFromMask mask)
return $ take n $ nub glist
writeIt :: FilePath -> Int -> [String] -> IO ()
writeIt fi n mask = do
glist <- genMeSome mask n
writeFile fi $ unlines glist
maj :: String
maj = ['A'..'Z']
numa :: String
numa = ['0'..'9']
-- | Certaines regions n'utilisent aucune des plages libres
genBra :: [String]
genBra = ["VWXYZ",maj,maj," ",numa,numa,numa,numa]
genAus :: [String]
genAus = [maj,maj,maj," ",numa,numa,numa]
main :: IO ()
main = do
args <- getArgs
case args of
(mo:fi:n:_) -> case mo of
"aus" -> writeIt fi (read n) genAus
"bra" -> writeIt fi (read n) genBra
_ -> error "country is not supported"
_ -> error "wrong input, format is: genLicensePlate country file number"
And here is the second:
import System.Environment (getArgs)
import System.Random
import Crypto.Random.AESCtr (makeSystem)
import Control.Applicative ( (<$>) )
import qualified Data.Vector as V
import qualified Data.Text as T
import qualified Data.Text.IO as T
nubV :: V.Vector a -> V.Vector a
nubV va
| V.null va = V.empty
| V.any (== headV) tailV = nubV tailV
| otherwise = headV `V.cons` nubV tailV
where
headV = V.head va
tailV = V.tail va
randomItem :: RandomGen g => g -> V.Vector a -> (a,g)
randomItem g xs =
(xs V.! fst shamble, snd shamble)
where
shamble = randomR (0, V.length xs - 1) g
genFromMask :: RandomGen g => g -> V.Vector (V.Vector a) -> V.Vector a
genFromMask g xs =
if V.null xs
then V.empty
else fst paket `V.cons` genFromMask (snd paket) (V.tail xs)
where
paket = randomItem g (V.head xs)
genMeSome :: RandomGen g => g -> V.Vector (V.Vector a) -> Int -> V.Vector (V.Vector a)
genMeSome g mask n =
V.take n $ nubV $ V.replicateM (n*10) (genFromMask g mask)
writeIt :: RandomGen g => g -> FilePath -> Int -> V.Vector (V.Vector a) -> IO ()
writeIt g fi n mask =
T.writeFile fi $ T.unlines $ T.pack $ V.toList (V.map V.toList $ genMeSome g mask n)
maj = V.fromList ['A'..'Z']
num a = V.fromList ['0'..'9']
vspa = V.fromList " "
vtir = V.fromList "-"
-- | Certaines regions n'utilisent aucune des plages libres
genBra = V.fromList [static,maj,maj,vspa,numa,numa,numa,numa]
where
static = V.fromList "VWXYZ"
genAus = V.fromList [maj,maj,maj,vspa,numa,numa,numa]
main :: IO ()
main = do
g <- makeSystem
args <- getArgs
case args of
(mo:fi:n:_) -> case mo of
"aus" -> writeIt g fi (read n) genAus
"bra" -> writeIt g fi (read n) genBra
_ -> error "country is not supported"
_ -> error "wrong input, format is: genLicensePlate country file number"
I am trying to generate fake licenses plates, to populate an anonymous database.
EDIT1:
Here are the errors:
genLicensePlate.hs:22:12:
No instance for (Eq a)
arising from a use of `=='
In the first argument of `V.any', namely `(== headV)
In the expression: V.any (== headV) tailV
In a stmt of a pattern guard for
an equation for `nubV':
V.any (== headV) tailV
genLicensePlate.hs:48:52:
Couldn't match expected type `Char' with actual type
Expected type: V.Vector Char
Actual type: V.Vector [a]
In the first argument of `V.toList', namely
`(V.map V.toList $ genMeSome g mask n)'
In the second argument of `($)', namely
`V.toList (V.map V.toList $ genMeSome g mask n)'
EDIT2:
So the general idea is to use a mask to generate random Strings.
Like myFunc g [['A'..'Z'],['A'..'Z']] gives AA or ZZ or BA or FG etc...
Then I use this function to make a lot of those strings based on the mask.
After that I removes duplicate and take as many as needed (since I generate 10 times the number asked even with duplicate I am OK).
Finaly I drop it on a file.
I hope it is more clear.
Kind regards,
Sar
nubV needs an Eq constraint, since it compares elements (but you really should use a Set or HashSet or so to get a better algorithm)
nubV :: Eq a => V.Vector a -> V.Vector a
nubV va
| V.null va = V.empty
| V.any (== headV) tailV = nubV tailV
| otherwise = headV `V.cons` nubV tailV
where
headV = V.head va
tailV = V.tail va
And in writeIt, you lack a map,
writeIt :: RandomGen g => g -> FilePath -> Int -> V.Vector (V.Vector a) -> IO ()
writeIt g fi n mask =
T.writeFile fi $ T.unlines $ map T.pack $ V.toList (V.map V.toList $ genMeSome g mask n)
-- ^^^
since you get a list of lists of Char from V.toList (V.map V.toList $ genMeSome g mask n).
That fixes the two reported errors.
I am new to Haskell and I wonder how/if I can make this code more efficient and tidy. It seems unnecessarily long and untidy.
My script generates a list of 10 averages of 10 coin flips.
import Data.List
import System.Random
type Rand a = StdGen -> Maybe (a,StdGen)
output = do
gen <- newStdGen
return $ distBernoulli 10 10 gen
distBernoulli :: Int -> Int -> StdGen -> [Double]
distBernoulli m n gen = [fromIntegral (sum x) / fromIntegral (length x) | x <- lst]
where lst = splitList (randomList (n*m) gen) n
splitList :: [Int] -> Int -> [[Int]]
splitList [] n = []
splitList lst n = take n lst : splitList (drop n lst) n
randomList :: Int -> StdGen -> [Int]
randomList n = take n . unfoldr trialBernoulli
trialBernoulli :: Rand Int
trialBernoulli gen = Just ((2*x)-1,y)
where (x,y) = randomR (0,1) gen
Any help would be appreciated, thanks.
I'd tackle this problem in a slightly different way. First I'd define a function that would give me an infinite sampling of flips from a Bernoulli distribution with success probability p:
flips :: Double -> StdGen -> [Bool]
flips p = map (< p) . randoms
Then I'd write distBernoulli as follows:
distBernoulli :: Int -> Int -> StdGen -> [Double]
distBernoulli m n = take m . map avg . splitEvery n . map val . flips 0.5
where
val True = 1
val False = -1
avg = (/ fromIntegral n) . sum
I think this matches your definition of distBernoulli:
*Main> distBernoulli 10 10 $ mkStdGen 0
[-0.2,0.4,0.4,0.0,0.0,0.2,0.0,0.6,0.2,0.0]
(Note that I'm using splitEvery from the handy split package, so you'd have to install the package and add import Data.List.Split (splitEvery) to your imports.)
This approach is slightly more general, and I think a little neater, but really the main difference is just that I'm using randoms and splitEvery.
EDIT: I posted this too fast and didn't match behavior, it should be good now.
import Control.Monad.Random
import Control.Monad (liftM, replicateM)
KNOWLEDGE: If you like randoms then use MonadRandom - it rocks.
STYLE: Only importing symbols you use helps readability and sometimes maintainability.
output :: IO [Double]
output = liftM (map dist) getLists
Note: I've given output an explicit type, but know it doesn't have to be IO.
STYLE:
1) Its usually good to separate your IO from pure functions. Here I've divided out the getting of random lists from the calculation of distributions. In your case it was pure but you combined getting "random" lists via a generator with the distribution function; I would divide those parts up.
2) Read Do notation considered harmful. Consider using >>= instead of
output = do
gen <- new
return $ dist gen
you can do:
output = new >>= dist
Wow!
dist :: [Int] -> Double
dist lst = (fromIntegral (sum lst) / fromIntegral (length lst))
getLists :: MonadRandom m => Int -> Int -> m [[Int]]
getLists m n= replicateM m (getList n)
KNOWLEDGE In Control.Monad anything ending in an M is like the original but for monads. In this case, replicateM should be familiar if you used the Data.List replicate function.
getList :: MonadRandom m => Int -> m [Int]
getList m = liftM (map (subtract 1 . (*2)) . take m) (getRandomRs (0,1::Int))
STYLE: If I do something lots of times I like to have a single instance in its own function (getList) then the repetition in a separate function.
I'm not sure I understand your code or your question...
But it seems to me all you'd need to do is generate a list of random ones and zeroes, and then divide each of them by their length with a map and add them together with a foldl.
Something like:
makeList n lis = if n /= 0 then
makeList (n-1) randomR(0,1) : lis
else
lis
And then make it apply a Map and Foldl or Foldr to it.
Using the above, I am now using this.
import Data.List
import System.Random
type Rand a = [a]
distBernoulli :: Int -> Int -> StdGen -> [Double]
distBernoulli m n gen = [fromIntegral (sum x) / fromIntegral (length x) | x <- lst]
where lst = take m $ splitList (listBernoulli gen) n
listBernoulli :: StdGen -> Rand Int
listBernoulli = map (\x -> (x*2)-1) . randomRs (0,1)
splitList :: [Int] -> Int -> [[Int]]
splitList lst n = take n lst : splitList (drop n lst) n
Thanks for your help, and I welcome any further comments :)