Lifting a value in the State monad in Haskell - haskell

I am writing a Sudoku generator/solver in Haskell as a learning exercise.
My solve function takes in a UArray but returns a State Int (UArray ...) so that it can also return the maximum difficulty level that it found while solving.
This is my function so far (still in the very experimental early stage):
import Control.Monad.State (State, put)
import Control.Monad.Trans.Class (lift)
import Data.Array.MArray (thaw)
import Data.Array.ST (runSTUArray)
import Data.Array.Unboxed (UArray)
-- ...
type Cell = Word16
solve :: UArray (Int, Int) Cell -> State Int (UArray (Int, Int) Cell)
solve grid = do
return $ runSTUArray $ do
arr <- thaw grid
lift $ put 42
return arr
It does not really do anything with the mutable array yet. I am simply trying to get it to type check with the put 42, but currently get the following error:
• Couldn't match kind ‘*’ with ‘* -> *’
When matching the kind of ‘ST’
• In a stmt of a 'do' block: lift $ put 42
In the second argument of ‘($)’, namely
‘do arr <- thaw grid
lift $ put 42
return arr’
In the second argument of ‘($)’, namely
‘runSTUArray
$ do arr <- thaw grid
lift $ put 42
return arr’
|
128 | lift $ put 42
| ^^^^^^^^^^^^^

runSTUArray ... is a pure value, it does not know anything about "outer monad". And State cares about how you use it, you cannot pass it opaquely into ST.
What you could do:
Option1: change the whole program to move more logic to ST side. Instead of State you'd use STRef then:
solve :: ST s (STRef Int) -> ST s (UArray (Int, Int) Cell) -> ST s ()
...
Option2: manually extract it and pass it to ST, then get back and put explicitly. But there is complication. runSTUArray does not allow getting another value together with the array. I don't know how it can be done safely with current array functions. Unsafely you could re-implement better runSTUArray which can pass another value. You could also add fake cells and encode the new state there.
The way to export another value exists in the vector package, there is (in new versions) createT function which can take not bare vector but a structure containing it (or even several vectors). So, overall, your example would be like:
import Control.Monad.State (State, put, get)
import Data.Word (Word16)
import qualified Data.Vector.Unboxed as DVU
type Cell = Word16
solve :: DVU.Vector Cell -> State Int (DVU.Vector Cell)
solve grid = do
oldState <- get
let (newState, newGrid) = DVU.createT (do
arr <- DVU.thaw grid
pure (oldState + 42, arr))
put newState
pure newGrid
vectors are one-dimensional only, unfortunately

solve grid has form return $ .... This means that State Int (UArray (Int, Int) Cell) is just specialized Monad m => m (UArray (Int, Int) Cell) - the ... does not have access to the features of this specific monad, it's just a UArray (Int, Int) Cell value that you return.

I was able to get a slight variation to compile and run after changing the State monad to a tuple (Int, Grid):
import Control.Monad.ST (ST, runST)
import Data.Array.MArray (freeze, thaw, writeArray)
import Data.Array.ST (STUArray)
import Data.Array.Unboxed (UArray)
import Data.Word (Word16)
type Cell = Word16
type Grid = UArray (Int, Int) Cell
solve :: Grid -> (Int, Grid)
solve grid =
runST $ do
mut <- thaw grid :: ST s (STUArray s (Int, Int) Cell)
writeArray mut (0, 0) 0 -- test that I can actually write
frozen <- freeze mut
return (42, frozen)
This works fine for my application.

Related

Making Monad type showable

I am making a maze generator and wish to visualize the maze by printing. I have a wall type and a function that generates a random maze of those walls.
import qualified Data.Graph.Inductive as Graph
import Data.Graph.Inductive (Gr, prettyPrint)
data WeightedWall = WeightedWall (Int, Int, Int) Orientation deriving (Eq)
weightedGrid :: MonadRandom m => Int -> Int -> Gr () (m WeightedWall)
However, when I call prettyPrint(weightedGrid 10 10), I get this error:
Ambiguous type variable ‘m0’ arising from a use of ‘prettyPrint’
prevents the constraint ‘(Show
(m0 WeightedWall))’ from being solved.
Probable fix: use a type annotation to specify what ‘m0’ should be.
What am I missing in my code to fix this?
You will want your pretty printer to have type:
prettyPrint :: WeightedWall -> String
Then, you will need to pluck a WeightedWall from your MonadRandom instance, pass it to prettyPrint, and then print the String in the IO monad.
The getRandomR function is a member of the MonadRandom typeclass, so it doesn't tell us which MonadRandom instance you are using. I'm going to assume IO since it kills two birds with one stone (the random source and the printing). Your main function could look as follows:
main :: IO ()
main = do
ww <- weightedGrid 10 10 -- pluck weighted wall from MonadRandom instance IO
putStrLn $ prettyPrint ww
I ended up doing:
pp :: WeightedWall -> String
pp (WeightedWall (a, b, c) _) = show a ++ " " ++ show b ++ " " ++ show c
main :: IO ()
main = do
ww <- mapM Data.Graph.Inductive.edgeLabel $ labEdges (weightedGrid 10 10)
forM_ (map pp ww) putStrLn

Creating a random permutation of 1..N with Data.Vector.Unboxed.Mutable

I want to create a list containing a random permutation of the numbers 1 through N. As I understand it, it is possible to use VUM.swap in the runST, but since I need random numbers as well I figured I might do both in the IO monad.
The code below yields:
Expected type: IO (VU.Vector Int), Actual type: IO (VU.Vector
(VU.Vector a0))
for the return statement.
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
import System.Random
randVector :: Int -> IO (VU.Vector Int)
randVector n = do
vector <- VU.unsafeThaw $ VU.enumFromN 1 n
VU.forM_ (VU.fromList [2..VUM.length vector]) $ \i -> do
j <- randomRIO(0, i) :: IO Int
VUM.swap vector i j
return $ VU.unsafeFreeze vector
I'm not quite sure why the return vector is nested. Do I have to use VU.fold1M_ instead?
unsafeFreeze vector already returns IO (VU.Vector Int). Just change the last line to VU.unsafeFreeze vector.
On another note, you should iterate until VUM.length vector - 1, since both [x .. y] and randomRIO use inclusive ranges. Also, you can use plain forM_ here for iteration, since you only care about side effects.
import Control.Monad
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
import System.Random
randVector :: Int -> IO (VU.Vector Int)
randVector n = do
vector <- VU.unsafeThaw $ VU.enumFromN 1 n
forM_ [2..VUM.length vector - 1] $ \i -> do
j <- randomRIO(0, i) :: IO Int
VUM.swap vector i j
VU.unsafeFreeze vector
I looked at the generated code, and it seems that with GHC 7.10.3 forM_ compiles to an efficient loop while VU.forM_ retains the intermediate list and is surely significantly slower (which was my expected outcome for forM_, but I was unsure about VU.forM_).
I would try (note update at end):
import Control.Monad
randVector :: Int -> IO (VU.Vector Int)
randVector n = do
vector <- VU.unsafeThaw $ VU.enumFromN 1 n
forM_ [2..VUM.length vector] $ \i -> do
j <- randomRIO(0, i) :: IO Int
VUM.swap vector i j
return $ VU.unsafeFreeze vector
Edit: as #András Kovács pointed out, you don't want the return at the end so the last line should be:
VU.unsafeFreeze vector

Custom MonadState instance

When I do:
cabal sandbox init
cabal update
cabal install hakaru
cabal repl
λ> :l simple.hs
λ> sample test []
with simple.hs containing:
{-# LANGUAGE MultiParamTypeClasses #-}
import Language.Hakaru.ImportanceSampler
import Control.Monad.State
instance MonadState Int Measure
test :: Measure Int
test = put 1 >> get >>= \i -> return i
my computer runs out of memory.
How can I successfully make the Measure monad an instance of MonadState (i.e. have test above return 1)? The Measure type is already an instance of Monad with bind and return defined. Is there some default way I can define MonadState's put and get in terms of lift, bind, and return to make it work? I tried:
get = lift get
put = lift . put
but I couldn't get the (transformer?) types to work out:
simple.hs:6:9:
Couldn't match type ‘t0 m0’ with ‘Measure’
Expected type: Measure Int
Actual type: t0 m0 Int
In the expression: lift get
In an equation for ‘get’: get = lift get
simple.hs:7:9:
Couldn't match type ‘t1 m1’ with ‘Measure’
Expected type: m1 () -> Measure ()
Actual type: m1 () -> t1 m1 ()
In the first argument of ‘(.)’, namely ‘lift’
In the expression: lift . put
Measure is already defined in a following way:
newtype Measure a = Measure { unMeasure :: [Cond] -> Sampler (a, [Cond]) }
You can see that there is no place to store your Int, so you cannot make it a proper instance of MonadState.
If you want to extend Measure to MonadState, you can use StateT monad transformer:
test :: StateT Int Measure Int
test = put 1 >> get >>= \i -> return i
What happened here? StateT s is a monad transformer, which lets you to combine State s monad with any other monad (in this example Measure)
The exact code which ended up working for me is:
import Language.Hakaru.ImportanceSampler
import Language.Hakaru.Distribution
import Control.Monad.State
import System.IO.Unsafe (unsafePerformIO)
test1 :: StateT Int Measure Int
test1 = do
i <- lift $ unconditioned $ categorical [(0,0.25), (1,0.25), (2,0.5)]
j <- lift $ unconditioned $ categorical [(i,0.25), (1,0.25), (2,0.5)]
put (i + j)
k <- get
return k
run_test1 = unsafePerformIO $ empiricalMeasure 10 (evalStateT test1 0) []

Haskell function that works with STUArray

I have a small Haskell function that is supposed to accept an STUArray, modify some of the elements, and then return the changed array. It will be called from another function working in the ST s (STUArray s Int Word32) monad. It part of a fast PBKDF2 function that I am trying to write. This function does SHA-1 padding for a fixed sized message (160-bits).
Here is my code:
padFixed :: STUArray s Int Word32 -> ST s (STUArray s Int Word32)
padFixed block = do
unsafeWrite block 5 0x80000000
unsafeWrite block 15 160
return block
The array will contain the 20 bytes from a previous SHA-1 run, plus 44 bytes of zeros. It will add the required padding as per RFC 3174.
How can I rewrite it so is "takes" the array out of the monad, works on it, and then puts it back? The signature should be padFixed :: ST s (STUArray s Int Word32), without the block parameter.
Is this possible? I could not find any functions in the library that let me extract the array from the monad, but maybe I missed something.
Are there any good tutorials on the STArray?
No, it's not possible; ST doesn't have those semantics. The monad is ST s, and not ST s (STUArray s a). ST s is just a monad for keeping track of mutable state; which structures you choose to allocate and use inside a single ST region are up to you. If you have a bunch of computations which all operate on the same STUArray, you can use ReaderT:
type Hasher s = ReaderT (STUArray s Int Word32) (ST s)
padFixed :: Hasher ()
padFixed = do
block <- ask
unsafeWrite block 5 0x80000000
unsafeWrite block 15 160
The Reader r monad is just a wrapper around r ->; a value of type Reader r a is just a function r -> a. This is essentially a way to compute a while having access to a value of type r. The ReaderT r monad transformer just allows you to provide access to a variable of type r to an arbitrary monadic computation; thus, ReaderT (STUArray s Int Word32) (ST s) is an ST s computation which has access to some array. Note that you don't need to return the array from padFixed; the monad bind will handle all of that.
This'll be a little bit of a pain to write, since we'll have to keep asking for the array. Luckily, we can write some combinators to handle this for us:
{-# LANGUAGE RankNTypes, GeneralizedNewtypeDeriving #-}
import Data.Word
import Control.Applicative
import Control.Monad.Reader
import Control.Monad.ST
import Data.Array.ST (STUArray, runSTUArray)
import qualified Data.Array.Base as A
import Data.Array.Unboxed (UArray)
newtype Hasher s a =
Hasher { getHasher :: ReaderT (STUArray s Int Word32) (ST s) a }
deriving (Functor, Applicative, Monad, MonadReader (A.STUArray s Int Word32))
hasherToST :: Hasher s () -> (Int,Int) -> ST s (STUArray s Int Word32)
hasherToST (Hasher r) bounds = do
block <- A.newArray bounds 0
runReaderT r block
return block
runHasher :: (forall s. Hasher s ()) -> (Int,Int) -> UArray Int Word32
runHasher h bounds = runSTUArray $ hasherToST h bounds
-- Perhaps private to this module, perhaps not
liftST :: ST s a -> Hasher s a
liftST = Hasher . lift
----- We can lift the functions which act on an STUArray -----
getBounds :: Hasher s (Int,Int)
getBounds = liftST . A.getBounds =<< ask
-- I'd recommend against removing the `unsafe` from the name; this function
-- could segfault, after all.
unsafeReadBlock :: Int -> Hasher s Word32
unsafeReadBlock i = do
block <- ask
liftST $ A.unsafeRead block i
unsafeWriteBlock :: Int -> Word32 -> Hasher s ()
unsafeWriteBlock i x = do
block <- ask
liftST $ A.unsafeWrite block i x
----- And then, perhaps in a separate module: -----
padFixed :: Hasher s ()
padFixed = do
unsafeWriteBlock 5 0x80000000
unsafeWriteBlock 15 160
(Note that I couldn't inline hasherToST inside of runHasher, probably because of the higher-rank types blocking inference.)
Basically, we wrap the ReaderT (STUArray s Int Word32) (ST s) into a newtype instead of a type synonym, and lift some basic array primitives up to work on the always-available block. You don't even need to derive MonadReader for the Hasher type if you don't want, as long as you lift all the necessary functions. But once you've done this, your hashing code can talk about the array implicitly.
No, you're confused; that's not possible. Think of STUArray s i e as being a pointer to the beginning of a block of memory. You have to pass that pointer around to anything that needs to modify that block of memory; you can't just conjure it up out of thin air.
But you don't need to return it. Presumably the caller already has the pointer.
You can use the freeze and thaw functions to convert to and from a UArray.
However either this will incur a performance penalty, or you need to use the "unsafe" variants. Since you're already doing unsafe writing, that's probably OK.

Monadic creation of vectors (or: can someone type annotate this for me?)

I came across the following piece of code as part of this Redddit sub-thread discussing an implementation of the Fisher-Yates shuffle:
randomIs g n = fill g 0
where
v = enumFromN 0 n
fill g i = when (i < n) $ do
let (x,g') = randomR (i, n-1) g
G.swap v i x
fill g' (i+1)
(I guess G refers to Data.Vector.Generic.Mutable... right?). Having never created vectors monadically before, I'm struggling to grasp this, especially with no type annotations. Doesn't v have type Data.Vector Int? How come one can pass it to G.swap then? Won't it have to be thawed first?
I might have just misunderstood Data.Vector.Generic, but if someone could clarify the above (by adding type annotations, perhaps?), I'd appreciate it.
Addendum: Here's my own attempt at adding type annotations:
import qualified Data.Vector.Unboxed as UVect
import qualified Data.Vector.Unboxed.Mutable as UMVect
import qualified System.Random as R
import Control.Monad
import Control.Monad.ST
randomPermutation :: forall a. (R.RandomGen a) => a -> Int -> UVect.Vector Int
randomPermutation g n = runST newVect
where
newVect :: ST s (UVect.Vector Int)
newVect = UVect.unsafeThaw (UVect.enumFromN 0 n) >>= \v ->
fill v 0 g >>
UVect.unsafeFreeze v
fill x i gen = when (i < n) $
let (j, gen') = R.randomR (i, n-1) gen in
UMVect.unsafeSwap x i j >>
fill x (i+1) gen'
As you can see, I'm avoiding Data.Vector.Generic to rule out the error source caused by perhaps not understanding it right. I'm also doing things in the ST monad.
In my head, the type of fill should be
UMVect.MVector (ST s (UVect.Vector Int)) Int -> Int -> a -> ST s ()
but GHC objects. Any hints? Again: It typechecks if I don't annotate fill.
Sidenote: I'd also like randomPermutation to return the updated random number generator. Thus, I'd need fill to also handle the generator's state. With my current type confusion, I don't see how to do that neatly. Any hints?
The compile error is telling us:
Expected type: ST s (UMVect.MVector (ST s (UVect.Vector Int)) Int)
Actual type: ST s (UMVect.MVector (Control.Monad.Primitive.PrimState (ST s)) Int)
So, changing the type signature of fill to UMVect.MVector (PrimState (ST s)) Int -> Int -> a -> ST s () (adding import Control.Monad.Primitive too) solves the problem!

Resources