Simulating non-deterministic choice through the List Monad - haskell

I'm trying to write an evaluation function for a language that I am working on in which non-determinism can be permitted within an if-block, called a selection block. What I'm trying to achieve is the ability to pick an if/selection statement from the block whose guard is true and evaluate it but it doesn't matter which one I pick.
From searching, I found an example that performs in a similar way to what I would like to achieve through modelling coinflips. Below is my adapation of it but I'm having issue in applying this logic to my problem.
import Control.Monad
data BranchType = Valid | Invalid deriving (Show)
data Branch = If (Bool, Integer) deriving (Show, Eq)
f Valid = [If (True, 1)]
f Invalid = [If (False, 0)]
pick = [Invalid, Invalid, Valid, Invalid, Valid]
experiment = do
b <- pick
r <- f b
guard $ fstB r
return r
s = take 1 experiment
fstB :: Branch -> Bool
fstB (If (cond, int)) = cond
main :: IO ()
main = putStrLn $ show $ s -- shows first branch which could be taken.
Below is my ADT and what I have been trying to make work:
data HStatement
= Eval HVal
| Print HVal
| Skip String
| Do HVal [HStatement]
| If (HVal, [HStatement])
| IfBlock [HStatement] -- made up of many If
| Select [HStatement] -- made up of many If
deriving (Eq, Read)
fstIf :: HStatement -> Bool
fstIf (If (cond, body)) = if hval2bool cond == True
then True
else False
h :: Env -> HStatement -> IOThrowsError ()
h env sb = do
x <- g env sb
guard $ fstIf x -- Couldn't match expected type ‘HStatement’ with actual type ‘[HStatement]’
-- after guard, take 1 x then evaluate
g :: Env -> HStatement -> IOThrowsError [HStatement]
g env (Select sb) = mapM (\x -> f env x) sb
f :: Env -> HStatement -> IOThrowsError HStatement
f env (If (cond, body)) = evalHVal env cond >>= \x -> case x of
Bool True -> return $ If (Bool True, body)
Bool False -> return $ If (Bool False, body)
The error I receive is the following : Couldn't match expected type ‘HStatement’ with actual type ‘[HStatement]’ at the guard line. I believe the reason as to why the first section of code was successful was because the values were being drawn from List but in the second case although they're being drawn from a list, they're being drawn from a [HStatement], not something that just represents a list...if that makes any sort of sense, I feel like I'm missing the vocabulary.
In essence then what should occur is given a selection block of n statement, a subset of these are produced whose guards are true and only one statement is taken from it.

The error message is pretty clear now that you have some types written down. g returns IOThrowsError [HStatement], so when you bind its result to x in h, you have an [HStatement]. You then call fstIf, which expects a single HStatement, not a list. You need to decide how to handle the multiple results from g.

Related

Executing a function randomly of a list of functions

=== Evaluation of HStatement (bar if and selection) ===
evalStatement_ :: Env -> HStatement -> IOThrowsError ()
evalStatement_ env (Do cond expr) = evalVal env cond >>= \x -> case x of
HBool False -> return ()
HBool True -> do
traverse_ (evalStatement_ env) expr
evalStatement_ env (Do cond expr)
evalStatement_ env (Skip skip) = return ()
evalStatement_ env (Print (HString val)) = getVar env val >>= \x -> liftIO $ putStrLn $ show x
evalStatement_ env (Print val) = evalVal env val >>= \x -> liftIO $ putStrLn $ show x
evalStatement_ env (Eval val) = do
result <- evalVal env val
return ()
=== Representation of Selection & If ===
parseIf :: Parser HStatement
parseIf = do
string "("
cond <- parseArith
string ")->"
spaces
expr <- many1 $ parseStatements
spaces
return $ If (cond, expr)
parseSelection :: Parser HStatement
parseSelection = do
_ <- string "if"
spaces
selection <- many1 $ parseIf
spaces
_ <- string "fi"
spaces
return $ Selection selection
N.B : If evaluation of selection is changed to the below, then the program runs and terminates and does give output:
evalStatement_ env (Selection if_ selection fi_ n) = evalStatement_ env (selection !! randIdx n) >>= \res -> if res == ()
then return ()
else return ()
The output however gives varying amounts of the even integers between 1 and 10. For example one output would print all even integers and another prints on the number 6.
tldr; is there a way to execute a random function from a list of functions randomly and if the result is not ideal, reexecute the function to execute a random function until the result is idea?
I'm trying to write a function which executes a random entry in a list of functions. Each entry in the list is constructed in the following way: If (HVal, HStatement) -- If (Guard,Statement) where
HVal:
data HVal
= HInteger Integer
HBool Bool
HString String
HList [HVal]
Length HVal
Arith HVal Op HVal
Assign String HVal
deriving (Eq, Read)
HStatement:
data HStatement
= Eval HVal
| Print HVal
| Do HVal [HStatement]
| If (HVal, [HStatement])
| Selection [HStatement]
deriving (Eq, Read)
What I tried so far was using Asyncs race function as per my question yesterday. My thinking behind this was if there exists a list of n entries in a list that are constructed as If (HVal, HStatement), then running a race function over a list that only contain a list of HStatements whose guards were evaluated to true would return the function that executes the fastest of the true guards.
Trying to incorporate this raceAll behaviour into my code base proved to be too difficult to me due to the constraint of IO. I redid the approach by considering using a random number generator.
So now I'm generating a random index of the list of guard statements pairs. I execute the entry in this list and perform a case analysis. If the output is () then I call the function again otherwise I return the output. To do this I'm using two functions wherein selection represents a list of if's:
evalStatement_ env (If (cond, expr)) = evalVal env cond >>= \x -> case x of
HBool False -> return ()
HBool True -> traverse_ (evalStatement_ env) expr
evalStatement_ env (Selection selection) = evalStatement_ env (selection !! randIdx 1) >>= \res -> case res of -- randIdx produces an index between 0 and 1 representing the two branches in the selection block that could be taken
() -> evalStatement_ env (Selection selection)
_ -> return $ res
randIdx n = unsafePerformIO (getStdRandom (randomR (0, n - 1)))
Take the following program as example:
f := [1 2 3 4 5 6 7 8 9 10]
n := 0
N := len(f)
Do (n < N)->
a := f.n
if ((a % 2) = 0)-> print(a)
((a % 1) = 1)-> print(a)
fi
n := n + 1
Od
What occurs here is that the program gives no output at all and doesn't terminate. What I would have expected to happen was that a random index is generated between 0 and the number of possible branches minus one. Then this would have been evaluated and if it returned a value, this would have been taken otherwise if it was the unit type, a new random index would have been generated and that would have been used.
I can execute the program however if the function definition for selection is traverse_ (evalStatement_ env) selection but I'm just unsure on how to achieve this pseudo randomness. Any help would be appreciated!
You say,
If the output is () then I call the function again otherwise I return the output.
This is a strange thing to say, because there is no "otherwise" -- if your thing returns () sometimes, it can never return anything but (), because there is no other value with the same type! In particular, this means it is impossible to reach the _ branch of your case.
In your language as shown here, statements fundamentally do not compute data. Perhaps you should change your Selection constructor to take an [(HVal, HStatement)] instead of an [HStatement] (representing pairs of the computation that returns something interesting that you can case on together with the statement to execute in some appropriate branch of that case), or modify the type that statements compute to something richer than ().

How to randomly shuffle a list

I have random number generator
rand :: Int -> Int -> IO Int
rand low high = getStdRandom (randomR (low,high))
and a helper function to remove an element from a list
removeItem _ [] = []
removeItem x (y:ys) | x == y = removeItem x ys
| otherwise = y : removeItem x ys
I want to shuffle a given list by randomly picking an item from the list, removing it and adding it to the front of the list. I tried
shuffleList :: [a] -> IO [a]
shuffleList [] = []
shuffleList l = do
y <- rand 0 (length l)
return( y:(shuffleList (removeItem y l) ) )
But can't get it to work. I get
hw05.hs:25:33: error:
* Couldn't match expected type `[Int]' with actual type `IO [Int]'
* In the second argument of `(:)', namely
....
Any idea ?
Thanks!
Since shuffleList :: [a] -> IO [a], we have shuffleList (xs :: [a]) :: IO [a].
Obviously, we can't cons (:) :: a -> [a] -> [a] an a element onto an IO [a] value, but instead we want to cons it onto the list [a], the computation of which that IO [a] value describes:
do
y <- rand 0 (length l)
-- return ( y : (shuffleList (removeItem y l) ) )
shuffled <- shuffleList (removeItem y l)
return y : shuffled
In do notation, values to the right of <- have types M a, M b, etc., for some monad M (here, IO), and values to the left of <- have the corresponding types a, b, etc..
The x :: a in x <- mx gets bound to the pure value of type a produced / computed by the M-type computation which the value mx :: M a denotes, when that computation is actually performed, as a part of the combined computation represented by the whole do block, when that combined computation is performed as a whole.
And if e.g. the next line in that do block is y <- foo x, it means that a pure function foo :: a -> M b is applied to x and the result is calculated which is a value of type M b, denoting an M-type computation which then runs and produces / computes a pure value of type b to which the name y is then bound.
The essence of Monad is thus this slicing of the pure inside / between the (potentially) impure, it is these two timelines going on of the pure calculations and the potentially impure computations, with the pure world safely separated and isolated from the impurities of the real world. Or seen from the other side, the pure code being run by the real impure code interacting with the real world (in case M is IO). Which is what computer programs must do, after all.
Your removeItem is wrong. You should pick and remove items positionally, i.e. by index, not by value; and in any case not remove more than one item after having picked one item from the list.
The y in y <- rand 0 (length l) is indeed an index. Treat it as such. Rename it to i, too, as a simple mnemonic.
Generally, with Haskell it works better to maximize the amount of functional code at the expense of non-functional (IO or randomness-related) code.
In your situation, your “maximum” functional component is not removeItem but rather a version of shuffleList that takes the input list and (as mentioned by Will Ness) a deterministic integer position. List function splitAt :: Int -> [a] -> ([a], [a]) can come handy here. Like this:
funcShuffleList :: Int -> [a] -> [a]
funcShuffleList _ [] = []
funcShuffleList pos ls =
if (pos <=0) || (length(take (pos+1) ls) < (pos+1))
then ls -- pos is zero or out of bounds, so leave list unchanged
else let (left,right) = splitAt pos ls
in (head right) : (left ++ (tail right))
Testing:
λ>
λ> funcShuffleList 4 [0,1,2,3,4,5,6,7,8,9]
[4,0,1,2,3,5,6,7,8,9]
λ>
λ> funcShuffleList 5 "#ABCDEFGH"
"E#ABCDFGH"
λ>
Once you've got this, you can introduce randomness concerns in simpler fashion. And you do not need to involve IO explicitely, as any randomness-friendly monad will do:
shuffleList :: MonadRandom mr => [a] -> mr [a]
shuffleList [] = return []
shuffleList ls =
do
let maxPos = (length ls) - 1
pos <- getRandomR (0, maxPos)
return (funcShuffleList pos ls)
... IO being just one instance of MonadRandom.
You can run the code using the default IO-hosted random number generator:
main = do
let inpList = [0,1,2,3,4,5,6,7,8]::[Integer]
putStrLn $ "inpList = " ++ (show inpList)
-- mr automatically instantiated to IO:
outList1 <- shuffleList inpList
putStrLn $ "outList1 = " ++ (show outList1)
outList2 <- shuffleList outList1
putStrLn $ "outList2 = " ++ (show outList2)
Program output:
$ pickShuffle
inpList = [0,1,2,3,4,5,6,7,8]
outList1 = [6,0,1,2,3,4,5,7,8]
outList2 = [8,6,0,1,2,3,4,5,7]
$
$ pickShuffle
inpList = [0,1,2,3,4,5,6,7,8]
outList1 = [4,0,1,2,3,5,6,7,8]
outList2 = [2,4,0,1,3,5,6,7,8]
$
The output is not reproducible here, because the default generator is seeded by its launch time in nanoseconds.
If what you need is a full random permutation, you could have a look here and there - Knuth a.k.a. Fisher-Yates algorithm.

Haskell: Exception <<loop>> on recursive data entry

So I'm trying to make a little program that can take in data captured during an experiment, and for the most part I think I've figured out how to recursively take in data until the user signals there is no more, however upon termination of data taking haskell throws Exception: <<loop>> and I can't really figure out why. Here's the code:
readData :: (Num a, Read a) => [Point a] -> IO [Point a]
readData l = do putStr "Enter Point (x,y,<e>) or (d)one: "
entered <- getLine
if (entered == "d" || entered == "done")
then return l
else do let l = addPoint l entered
nl <- readData l
return nl
addPoint :: (Num a, Read a) => [Point a] -> String -> [Point a]
addPoint l s = l ++ [Point (dataList !! 0) (dataList !! 1) (dataList !! 2)]
where dataList = (map read $ checkInputData . splitOn "," $ s) :: (Read a) => [a]
checkInputData :: [String] -> [String]
checkInputData xs
| length xs < 2 = ["0","0","0"]
| length xs < 3 = (xs ++ ["0"])
| length xs == 3 = xs
| length xs > 3 = ["0","0","0"]
As far as I can tell, the exception is indication that there is an infinite loop somewhere, but I can't figure out why this is occurring. As far as I can tell when "done" is entered the current level should simply return l, the list it's given, which should then cascade up the previous iterations of the function.
Thanks for any help. (And yes, checkInputData will have proper error handling once I figure out how to do that.)
<<loop>> basically means GHC has detected an infinite loop caused by a value which depends immediately on itself (cf. this question, or this one for further technical details if you are curious). In this case, that is triggered by:
else do let l = addPoint l entered
This definition, which shadows the l you passed as an argument, defines l in terms of itself. You meant to write something like...
else do let l' = addPoint l entered
... which defines a new value, l', in terms of the original l.
As Carl points out, turning on -Wall (e.g. by passing it to GHC at the command line, or with :set -Wall in GHCi) would make GHC warn you about the shadowing:
<interactive>:171:33: warning: [-Wname-shadowing]
This binding for ‘l’ shadows the existing binding
bound at <interactive>:167:10
Also, as hightlighted by dfeuer, the whole do-block in the else branch can be replaced by:
readData (addPoint l entered)
As an unrelated suggestion, in this case it is a good idea to replace your uses of length and (!!) with pattern matching. For instance, checkInputData can be written as:
checkInputData :: [String] -> [String]
checkInputData xs = case xs of
[_,_] -> xs ++ ["0"]
[_,_,_] -> xs
_ -> ["0","0","0"]
addPoint, in its turn, might become:
addPoint :: (Num a, Read a) => [Point a] -> String -> [Point a]
addPoint l s = l ++ [Point x y z]
where [x,y,z] = (map read $ checkInputData . splitOn "," $ s) :: (Read a) => [a]
That becomes even neater if you change checkInputData so that it returns a (String, String, String) triple, which would better express the invariant that you are reading exactly three values.

Haskell - guard inside case statement

I am going through Learn you a haskell book, and in Chapter 8 there is a snippet of code which looks like this
data LockerState = Taken | Free deriving (Eq, Show)
type Code = String
type LockerMap = Map.Map Int (LockerState, Code)
lookup' :: Int -> LockerMap -> Either String Code
lookup' num_ map_ =
case (Map.lookup num_ map_) of
Nothing -> Left $ "LockerNumber doesn't exist!"
Just (state, code) -> if state == Taken
then Left $ "LockerNumber already taken!"
else Right $ code
This works. However, I wanted to convert if/else block to guard statements like this:
lookup' :: Int -> LockerMap -> Either String Code
lookup' num_ map_ =
case (Map.lookup num_ map_) of
Nothing -> Left $ "LockerNumber doesn't exist!"
Just (state, code) ->
| state == Taken = Left $ "LockerNumber already taken!"
| otherwise = Right $ Code
This doesn't compile. It seems that usage of guards in Haskell is very restrictive/non intuitive. SO Ex1 SO Ex2. Is there a definite source which I can read which tells at which places I can use guards?
There are two places guards are allowed: function definitions and case expressions. In both contexts, guards appear after a pattern and before the body, so you use = in functions and -> in case branches, as usual:
divide x y
| y == 0 = Nothing
--------
| otherwise = Just (x / y)
-----------
positively mx = case mx of
Just x | x > 0 -> Just x
-------
_ -> Nothing
Guards are simply constraints for patterns, so Just x matches any non-Nothing value, but Just x | x > 0 only matches a Just whose wrapped value is also positive.
I suppose the definitive reference is the Haskell Report, specifically §3.13 Case Expressions and §4.4.3 Function and Pattern Bindings, which describe the syntax of guards and specify where they’re allowed.
In your code, you want:
Just (state, code)
| state == Taken -> Left "LockerNumber already taken!"
| otherwise -> Right code
This is also expressible with patterns alone:
Just (Taken, _) -> Left "LockerNumber already taken!"
Just (_, code) -> Right code

State transformer: need a Nothing in a (Maybe Bool)

This is from the nicta course (hence List = [], Optional = Maybe, ...), so I'm not looking for a full solution, but I am stuck on a State Transformer question. The aim is to filter duplicates from a List and completely fail if passed any number > 100.
-- filtering :: Applicative f => (a -> f Bool) -> List a -> f (List a)
distinctF :: (Ord a, Num a) => List a -> Optional (List a)
distinctF lst = case runStateT (filtering go lst) S.empty of
Full (val, _) -> Full val
Empty -> Empty
where
--go :: a -> StateT (S.Set a) Optional Bool
go x = do
s <- getT
if x > 100 then do
return *?*Empty / False*?*
This typechecks while go = undefined, but I'm struggling to put Empty into as return wraps e.g. False in a Full/Just. fail gets me someway forward but I don't think that is the solution.
In practice I am probably missing a more important issue and would welcome enlightenment.
If the goal is to write function making both: unique filtering and failing on large input at the same time, you got the skeleton quite right:
distinctF :: (Ord a, Num a) => List a -> Optional (List a)
distinctF lst = evalStateT (go lst) S.empty -- evalStateT is your case runStateT part
where -- on empty input we just return empty list
go [] = return []
-- otherwise
go (x:xs)
-- we check whether we should 'fail'
-- for that we *lift* the value from underlying monad (Optional) into our StateT Optional
| x > 100 = lift $ Empty
| otherwise = do
-- the stuff to do
-- get the state, do nothing if x is in there
-- otherwise add x to the state and recurse
So for your question, you need to lift Empty, not return it.
OK, so I finally found a way, by realising that I could construct the precisely correct return type, rather than trying to rely on return
go x = do
if x > 100 then
StateT (\_ -> Empty) -- `return` a fail
else do
st <- getT
However, I am still not quite sure how <- unwraps both the StateT and the inner monadic container

Resources