I'm trying to write a recursive function that mutates a Data.Vector.Unboxed.Mutable 'Vector', though the question applies to any monadic code, I think.
As a contrived example:
import Data.Vector.Unboxed as U
import Data.Vector.Unboxed.Mutable as M
import Control.Monad
import Control.Monad.ST
import Control.Monad.Primitive
f :: U.Vector Int -> U.Vector Int
f x = runST $ do
y <- U.thaw x
add1 y 0
U.freeze y
add1 :: (PrimMonad m) => MVector (PrimState m) Int -> Int -> m()
add1 v i | i == M.length v = return ()
add1 v i = do
c <- M.unsafeRead v i
M.unsafeWrite v i (c + 1)
add1 v (i+1)
However, v does not change in each recursive call. I would like to be able to remove v as a parameter to the function and inline 'add1' into f, but I need 'y' to be in scope.
I can get one step closer is by changing add1 (and keeping f the same) so that v is not passed in the recursion:
add1 :: (PrimMonad m) => MVector (PrimState m) Int -> m()
add1 v = do add1_ 0
where len = M.length v
add1_ i | i == len = do return ()
add1_ i = do
x <- M.unsafeRead v i
M.unsafeWrite v i (x + 1)
add1_ (i+1)
What I would really like is to totally inline add1 though. Here's a solution that doesn't quite compile yet:
f x = let len = U.length x
y = U.thaw x
add1 i | i == len = return ()
add1 i = do
y' <- y
c <- M.unsafeRead y' i
M.unsafeWrite y' i (c+1)
add1 (i+1)
in runST $ do
add1 0
y' <- y
U.freeze y'
GHC errors:
couldn't match type 'm0' with 'ST s'
couldn't match type 's' with 'PrimState m0'
Errors aside, this isn't optimal yet: I don't want to have to do (y' <- y) in every do statement (especially when add1 is recursive). I'd really like y' (the 'non-monadic' version of y) to just be in scope. Is there any way to do this?
(I apologize if I am horribly misusing monads in some way)
How about this?
f :: U.Vector Int -> U.Vector Int
f x = runST $ do
y <- U.thaw x
let add1 i | i == length x = return ()
| otherwise = do
c <- M.unsafeRead y i
M.unsafeWrite y i (c+1)
add1 (i+1)
add1 0
U.freeze y
Related
I want to convert an enum into Int or vice verse, i.e. implement an bidirectional mapping between the tag of sum type and Int. I have tried fromEnum but it seems not fast enough, and then I tried unsafeCoerce but it doesn't works as expected:
import Data.Time.Clock
import Data.Int
import Unsafe.Coerce
import Control.Monad (replicateM_)
data Color = R | G | B
deriving (Enum)
main = do
printT 1 $ (unsafeCoerce R :: Int8)
printT 1000 $ (unsafeCoerce G :: Int8)
printT 1000000 $ (unsafeCoerce B :: Int8)
printT 1000000000 $ (unsafeCoerce R :: Int8)
printT 1 $ (fromEnum R)
printT 1000 $ (fromEnum G)
printT 1000000 $ (fromEnum B)
printT 1000000000 $ (fromEnum B)
---------- profile tools ------------
printT :: Show a => Int -> a -> IO ()
printT n x = print =<< timeIt n (pure x)
timeIt :: Int -> IO a -> IO a
timeIt n _ | n <= 0 = error "timeIt n | n <= 0"
timeIt n proc = do
t0 <- getCurrentTime
replicateM_ (n-1) proc
x <- proc
t1 <- getCurrentTime
putStrLn ("-- Time Used (repeat " ++ show n ++ " times): " ++ show (t1 `diffUTCTime` t0))
return x
So what is the fastest way to do this?
Is the Enum you actually care about your type, or someone else's? If it's someone else's, then you're not guaranteed any methods you can use besides fromEnum, so you're out of luck. If it's your own type, then you can reimplement it with a newtype and pattern synonyms instead of deriving, so that fromEnum is literally free (provided the compiler can specialize it wherever you use it):
{-# LANGUAGE PatternSynonyms #-}
module ColorEnum (Color(R,G,B)) where
import Data.Coerce (coerce)
newtype Color = UnsafeColor Int
pattern R, G, B :: Color
pattern R = UnsafeColor 0
pattern G = UnsafeColor 1
pattern B = UnsafeColor 2
maxColor :: Int
maxColor = 2
instance Enum Color where
succ (UnsafeColor a)
| a == maxColor = error "succ{Color}: tried to take `succ' of last tag in enumeration"
| otherwise = UnsafeColor (a + 1)
pred (UnsafeColor a)
| a == 0 = error "pred{Color}: tried to take `pred' of first tag in enumeration"
| otherwise = UnsafeColor (a - 1)
toEnum a
| a >= 0 && a <= maxColor = UnsafeColor a
| otherwise = error $ "toEnum{Color}: tag (" ++ show a ++ ") is outside of enumeration's range (0," ++ show maxColor ++ ")"
enumFrom (UnsafeColor a) = coerce [a..maxColor]
enumFromThen (UnsafeColor a) (UnsafeColor b) = coerce [a,b..if a > b then 0 else maxColor]
fromEnum = coerce
Caveats:
This is not an endorsement of how you did your benchmark (in fact, it probably is wrong, as commenters pointed out)
There's a good chance that things other than fromEnum will be made slower by this change
All of that code is just to replace data Color = R | G | B deriving (Enum)
Today I found this post on Quora, which claimed that
factorial(n) = def $ do
assert (n<=0) "Negative factorial"
ret <- var 1
i <- var n
while i $ do
ret *= i
i -= 1
return ret
could be correct Haskell code. I got curious, and ended up with
factorial :: Integer -> Integer
factorial n = def $ do
assert (n >= 0) "Negative factorial"
ret <- var 1
i <- var n
while i $ do
ret *= i
i -= 1
return ret
using var = newSTRef, canonical definitions for def, assert and while, and
a *= b = readSTRef b >>= \b -> modifySTRef a ((*) b)
a -= b = modifySTRef a ((+) (negate b))
However, (*=) and (-=) have different types:
(-=) :: Num a => STRef s a -> a -> ST s ()
(*=) :: Num a => STRef s a -> STRef s a -> ST s ()
So ret -= i wouldn't work. I've tried to create a fitting type class for this:
class (Monad m) => NumMod l r m where
(+=) :: l -> r -> m ()
(-=) :: l -> r -> m ()
(*=) :: l -> r -> m ()
instance Num a => NumMod (STRef s a) (STRef s a) (ST s) where
a += b = readSTRef b >>= \b -> modifySTRef a ((+) b)
a -= b = readSTRef b >>= \b -> modifySTRef a ((+) (negate b))
a *= b = readSTRef b >>= \b -> modifySTRef a ((*) b)
instance (Num a) => NumMod (STRef s a) a (ST s) where
a += b = modifySTRef a ((+) (b))
a -= b = modifySTRef a ((+) (negate b))
a *= b = modifySTRef a ((*) (b))
That actually works, but only as long as factorial returns an Integer. As soon as I change the return type to something else it fails. I've tried to create another instance
instance (Num a, Integral b) => NumMod (STRef s a) b (ST s) where
a += b = modifySTRef a ((+) (fromIntegral $ b))
a -= b = modifySTRef a ((+) (negate . fromIntegral $ b))
a *= b = modifySTRef a ((*) (fromIntegral b))
which fails due to overlapping instances.
Is it actually possible to create a fitting typeclass and instances to get the factorial running for any Integral a? Or will this problem always occur?
The idea
Idea is simple: wrap STRef s a in a new data type and make it an instance of Num.
Solution
First, we'll need only one pragma:
{-# LANGUAGE RankNTypes #-}
import Data.STRef (STRef, newSTRef, readSTRef, modifySTRef)
import Control.Monad (when)
import Control.Monad.ST (ST, runST)
Wrapper for STRef:
data MyRef s a
= MySTRef (STRef s a) -- reference (can modify)
| MyVal a -- pure value (modifications are ignored)
instance Num a => Num (MyRef s a) where
fromInteger = MyVal . fromInteger
A few helpers for MyRef to resemble STRef functions:
newMyRef :: a -> ST s (MyRef s a)
newMyRef x = do
ref <- newSTRef x
return (MySTRef ref)
readMyRef :: MyRef s a -> ST s a
readMyRef (MySTRef x) = readSTRef x
readMyRef (MyVal x) = return x
I'd like to implement -= and *= using a bit more general alter helper:
alter :: (a -> a -> a) -> MyRef s a -> MyRef s a -> ST s ()
alter f (MySTRef x) (MySTRef y) = readSTRef y >>= modifySTRef x . flip f
alter f (MySTRef x) (MyVal y) = modifySTRef x (flip f y)
alter _ _ _ = return ()
(-=) :: Num a => MyRef s a -> MyRef s a -> ST s ()
(-=) = alter (-)
(*=) :: Num a => MyRef s a -> MyRef s a -> ST s ()
(*=) = alter (*)
Other functions are almost unchanged:
var :: a -> ST s (MyRef s a)
var = newMyRef
def :: (forall s. ST s (MyRef s a)) -> a
def m = runST $ m >>= readMyRef
while :: (Num a, Ord a) => MyRef s a -> ST s () -> ST s ()
while i m = go
where
go = do
n <- readMyRef i
when (n > 0) $ m >> go
assert :: Monad m => Bool -> String -> m ()
assert b str = when (not b) $ error str
factorial :: Integral a => a -> a
factorial n = def $ do
assert (n >= 0) "Negative factorial"
ret <- var 1
i <- var n
while i $ do
ret *= i
i -= 1
return ret
main :: IO ()
main = print . factorial $ 1000
Discussion
Making Num instances like this feels a bit hacky, but we don't have FromInteger type class in Haskell, so I guess it's OK.
Another itchy thing is 3 *= 10 which is return (). I think it is possible to use phantom type to indicate whether MyRef is ST or pure and allow only ST on the LHS of alter.
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
I do not understand what the problem is. 'a' is not a bool and should not be a bool. So why is bool expected?
Code:
probablyPrime n 0 = False
probablyPrime n t =
do a <- randomRIO(3, n-1 :: Integer)
let comp = defComp(a,n)
let ret = (not comp) && (probablyPrime n t-1)
return ret
defComp a n = xcon1 && xcon2
where (s,m) = findsm n
x = a^m `mod` n
xcon1 = x /= 1 || x /= n-1
xcon2 = comploop x n s
comploop x n 0 = False
comploop x n s = x1 || (comploop x n (s-1))
where x1 = (x^2 `mod` n) == 1
findsm n = (s,m)
where m = findm n
s = n/m
findm n = m
where f = (logBase 2 n) - (truncate (logBase 2 n))
m' = 2^f
m = m_ify m'
m_ify m | m mod 1 == 0 = m
| otherwise = m_ify (m*2)
Error:
Couldn't match expected type `Bool' against inferred type `IO b'
In a stmt of a 'do' expression:
a <- randomRIO (3, n - 1 :: Integer)
In the expression:
do { a <- randomRIO (3, n - 1 :: Integer);
let comp = defComp ...;
let ret = (not comp) && (probablyPrime n t - 1);
return ret }
In the definition of `probablyPrime':
probablyPrime n t
= do { a <- randomRIO (3, n - 1 :: Integer);
let comp = ...;
let ret = ...;
.... }
probablyPrime n 0 = False
This tells haskell that the return type of probablyPrime is Bool. However in the second case, you're dealing with monads and returning IO Bool, so the types don't match.
Change False to return False and it will work.
You will also have to change
let ret = (not comp) && (probablyPrime n t-1)
to
prob <- probablyPrime n (t-1)
let ret = (not comp) && prob
or something like
ret <- liftM ((not comp) &&) (probablyPrime n (t-1))
as Andrew Jaffe pointed out.
The type of probablyPrime should be IO Bool, so your first pattern match should lift the pure value of False into the IO monad using return function, basically change:
probablyPrime n 0 = False
to
probablyPrime n 0 = return False
You cannot esacpe the IO monad without using unsafe functions but you should not do this unless you know exactly what you're doing.
It's a good idea to avoid IO whenever you can, and using the State monad provides a convenient way to do so here:
import Control.Applicative ((<$>))
import Control.Monad (liftM, replicateM)
import Control.Monad.State (State, evalState, get, put)
import System.Random
probablyPrime :: RandomGen g => Int -> Int -> State g Bool
probablyPrime t = liftM and . replicateM t . checkOnce
where
checkOnce :: RandomGen g => Int -> State g Bool
checkOnce n = do
(a, gen) <- randomR (3, n - 1) <$> get
put gen
return . not $ defComp a n
defComp = undefined
To test whether a number is (probably) prime you do the following (note that I've changed the order of the arguments to probablyPrime, since t is less likely to vary than n):
evalState (probablyPrime 10 7057) <$> newStdGen :: IO Bool
This allows you to avoid stepping into IO until it's absolutely necessary.