Running the NonDet effect once in Polysemy - haskell

I'm relatively new to Polysemy, and I'm trying to wrap my head around how to use NonDet correctly. Specifically, let's say I've got this computation
generate :: Member NonDet r => Sem r Int
generate = msum $ fmap pure [0..]
computation :: (Member NonDet r, Member (Final IO) r) => Sem r ()
computation = do
n <- generate
guard (n == 100)
embedFinal $ print n
It's a horribly inefficient way to print the number 100, but it demonstrates the problem I'm having. Now, I want to run this effect only insofar as to get the first success. That is, I want to run this effect long enough to "find" the number 100 and print it, and then I want to stop.
My first attempt
attempt1 :: IO ()
attempt1 = void . runFinal . runNonDet #[] $ computation
This one fails to short-circuit. It prints 100 but then hangs forever, looking for the number 100 again. That makes sense; after all, I didn't actually tell it I only wanted one solution. So let's try that.
My second attempt
runNonDetOnce :: Sem (NonDet ': r) a -> Sem r (Maybe a)
runNonDetOnce = fmap listToMaybe . runNonDet
attempt2 :: IO ()
attempt2 = void . runFinal . runNonDetOnce $ computation
All we're doing here is discarding all but the head of the list. Understandably, this didn't change anything. Haskell already wasn't evaluating the list, so discarding an unused value changes nothing. Like attempt1, this solution hangs forever after printing 100.
My third attempt
attempt3 :: IO ()
attempt3 = void . runFinal . runNonDetMaybe $ computation
So I tried using runNonDetMaybe. This one, unfortunately, just exits without printing anything. Figuring out why that is took a bit, but I have a theory. The documentation says
Unlike runNonDet, uses of <|> will not execute the second branch at all if the first option succeeds.
So it's greedy and doesn't backtrack after success, basically. Thus, it runs my computation like this.
computation = do
n <- generate -- Ah yes, n = 0. Excellent!
guard (n == 100) -- Wait, 0 /= 100! Failure! We can't backtrack, so abort.
embedFinal $ print n
Non-Solutions
In this small example, we could just alter the computation a bit, like so
computation :: (Member NonDet r, Member (Final IO) r) => Sem r ()
computation = msum $ fmap (\n -> guard (n == 100) >> embedFinal (print n)) [0..]
So rather than generate a number and then check it later, we simply move generate inside of computation. With this computation, attempt3 succeeds, since we can get to the "correct" answer without backtracking. This works in this small example, but it's infeasible for a larger codebase. Unless someone has a good systematic way of avoiding backtracking, I don't see a good way to generalize this solution to computations that span over multiple files in a large program.
The other non-solution is to cheat using IO.
computation :: (Member NonDet r, Member (Final IO) r) => Sem r ()
computation = do
n <- generate
guard (n == 100)
embedFinal $ print n
embedFinal $ exitSuccess
Now attempt1 and attempt2 succeed, since we simply forcibly exit the program after success. But, aside from feeling incredibly sloppy, this doesn't generalize either. I want to stop running the current computation after finding 100, not the whole program.
So, to summarize, I want the computation given in the first code snippet above to be run using Polysemy in some way that causes it to backtrack (in NonDet) until it finds one successful value (in the example above, n = 100) and then stop running side effects and end the computation. I tried delving into the source code of runNonDetMaybe and co in this hopes of being able to reproduce something similar to it that has the effect I want, but my Polysemy skills are not nearly to the level of understanding all of the Weaving and decomp shenanigans happening there. I hope someone here who has more expertise with this library than I do can point me in the right direction to running NonDet with the desired effects.

Now attempt1 and attempt2 succeed, since we simply forcibly exit the program after success. But, aside from feeling incredibly sloppy, this doesn't generalize either. I want to stop running the current computation after finding 100, not the whole program.
Rather than exitSuccess, a closely related idea is to throw an exception that you can catch in the interpreter.

Related

moeb traverse non-termination

I've recently stumbled upon loeb and moeb functions here and I'm trying to explore what it can do.
I'm trying to achieve spreadsheet-like behaviour with possibility to perform IO in some "cells". I was thinking that moeb traverse seemed like good candidate do do this, but any non-trivial (ie. other than const $ return something) function in list I used caused the entire call to run forever. After this I tried to test it in State monad:
moeb f x = fix $ \g -> f ($g) x
foo v = do
x <- get
vs <- v
put (x + 3)
return (x + (vs!!0))
test = [
const $ return 7,
foo,
fmap length
]
main = print $ runState (moeb traverse test) 5
The result was this:
([7,12,3],moeb.hs: out of memory
Why does this happen? foo both gets and sets state, but it evaluates fine, while evaluation of final state hangs.
And how can i achieve spreadsheet-with-IO behavior that terminates?
moeb traverse test :: State Int [Int] is an action to produce a list of integers.
If you unfold the definition of moeb, you get
moeb traverse test
= traverse ($ moeb traverse test) test
meaning that each element f the spreadsheet is passed the action moeb traverse test to be run, from scratch, instead of using the result of the action recursively.
Generalizing moeb using mfix might help but I doubt the result will be worth the trouble.

IO in Haskell not visible

I have a little interactive game program. The interactive part looks like this,
main :: IO ()
main = playGame newGame
where
playGame :: Game -> IO ()
playGame game =
do putStr $ show game
putStr $ if gameOver game then "Another game? (y or n) > "
else show (whoseMove game) ++ " to play (row col) > "
moveWords <- fmap (words . fmap cleanChar ) getLine
if stopGame game moveWords
then return ()
else playGame $ if gameOver game then newGame else makeMove game moveWords
This works fine. It displays the game state, asks for the next move, applies that move to the state, displays the new state, etc.
Then I saw a video by Moss Collum in which he showed a game that uses the following strategy for interacting with the user.
...
userInput <- getContents
foldM_ updateScreen (12, 40) (parseInput userInput) where
...
I couldn't find a reference to foldM_ but assuming it was some sort of fold I tried this. (I actually tried a number of things, but this seems clearest.)
main' :: IO ()
main' = do
moveList <- fmap (map words . lines . map cleanChar) getContents
let states = scanl makeMove newGame moveList
foldl (\_ state -> putStr . show $ state) (return ()) states
When I run it, I never get the game state printed out until after hitting end-of-file, at which point the correct final game state is printed. Before that, I can enter moves, and they are processed properly (according to the final game state), but I never see the intermediate states. (The idea is that lazy evaluation should print the game states as they become available.)
I'd appreciate help understanding why I don't see the intermediate states and what, if anything, I can do to fix it.
Also, after entering end-of-file (^Z on Windows) the program refuses to play again, saying that the handle has been closed. To play again I have to restart the program. Is there a way to fix that?
First, let's start with foldM:
foldM :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m b
a is the type of things in our container, and b is our result type. It takes a b (the value we've accumulated so far in our fold, ana(then ext thing in the list, and returns an m b, meaning it returns a b and does some monadic actions in the monad m.
Then it takes an initial value, a container of a's, and it returns an
This is basically like a normal fold function, but each step of the fold is monadic, and the final result is monadic. So the actions will actually be performed if you use foldM.
Now let's look at foldM_:
foldM_ :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m ()
Source
This is the same, but the final result is m (). This is for the case where we don't care about the final result. We keep the intermediate results and use them to perform monadic actions at each step, but when we finish, we only care about what we did in the monad, so we throw away the result.
In your case, t would be List, and m would be IO. So foldM_ iterates through the list, doing the selected IO actions at each stage, then throws away the final result.
fold doesn't actually sequence the actions together, it just folds over your list normally, even if your final result is IO. So your foldl creates an IO action, namely putStr . show $ state, then passes it to the next step of the fold. But, you ignore the first argument of your fold, so it throws the IO away without ever doing anything with it!
This is a tricky thing in Haskell. A value of type IO Something doesn't actually do the action when you create it. It just creates an IO value, which is just an instruction to the runtime of what to do when it runs main. If you throw it away, and it never gets sequenced into an IO that your main performs, then the side-effect will never happen.

Haskell Timeout diverging computation

I'm trying to write a safe timing-out evaluation function in Haskell. The code goes as follows
import System.Timeout
compute, compute' :: Int -> Int
compute i = sum [1..300000 + i]
compute' i = last $ repeat i
timedComp :: Int -> a -> IO (Maybe a)
timedComp timeLeft toCompute =
timeout timeLeft go
where
go = toCompute `seq` return toCompute
main = do
res <- timedComp 10000 (compute 0)
print res
res' <- timedComp 10000 (compute' 0)
print res'
(I know that I only evaluate to WHNF.)
When I run main, I get only one Nothing on output and then the program hangs. I tried to compile and run the program multi-threaded but it doesn't help. Tried on both GHC 7.6.3 and 7.8.3. Any suggestions?
There's a limitation in the GHC implementation of Haskell threads: context switches occur only during allocation. As a consequence, tight loops which perform no allocation at all can prevent the scheduler to run, switching to other threads.
This is one of such examples: compute' i = last $ repeat i looks as if it's allocating list cells, but unfortunately GHC is able to optimize it as a trivial infinite loop, removing all allocation -- GHC Core looks roughly as f x = f x. This triggers the scheduler shortcoming.
Reid Barton suggests the option -fno-omit-yields to work around this. This will cause GHC not to optimize so much.

Breaking out of monad sequence

Is it possible to break out of a monad sequence?
For instance, if I want to break out of a sequence earlier based on some condition calculated in the middle of the sequence. Say, in a 'do' notation I bind a value and based on the value I want to either finish the sequence or stop it. Is there something like a 'pass' function?
Thanks.
Directly using if
You could do this directly as Ingo beautifully encapsulated, or equivalently for example
breakOut :: a -> m (Either MyErrorType MyGoodResultType)
breakOut x = do
y <- dosomethingWith x
z <- doSomethingElseWith x y
if isNoGood z then return (Left (someerror z)) else do
w <- process z
v <- munge x y z
u <- fiddleWith w v
return (Right (greatResultsFrom u z))
This is good for simply doing something different based on what values you have.
Using Exceptions in the IO monad
You could use Control.Exception as Michael Litchard correctly pointed out. It has tons of error-handling, control-flow altering stuff in it, and is worth reading if you want to do something complex with this.
This is great if your error production could happen anywhere and your code is complex. You can handle the errors at the top level, or at any level you like. It's very flexible and doesn't mess with your return types. It only works in the IO monad.
import Control.Exception
Really I should roll my own custom type, but I can't be bothered deriving Typable etc, so I'll hack it with the standard error function and a few strings. I feel quite guilty about that.
handleError :: ErrorCall -> IO Int
handleError (ErrorCall msg) = case msg of
"TooBig" -> putStrLn "Error: argument was too big" >> return 10000
"TooSmall" -> putStrLn "Error: argument was too big" >> return 1
"Negative" -> putStrLn "Error: argument was too big" >> return (-1)
"Weird" -> putStrLn "Error: erm, dunno what happened there, sorry." >> return 0
The error handler needs an explicit type to be used in catch. I've flipped the argument to make the do block come last.
exceptOut :: IO Int
exceptOut = flip catch handleError $ do
x <- readLn
if (x < 5) then error "TooSmall" else return ()
y <- readLn
return (50 + x + y)
Monad transformers etc
These are designed to work with any monad, not just IO. They have the same benefits as IO's exceptions, so are officially great, but you need to learn about monad tranformers. Use them if your monad is not IO, and you have complex requirements like I said for Control.Exception.
First, read Gabriel Conzalez's Breaking from a loop for using EitherT to do two different things depending on some condition arising, or MaybeT for just stopping right there in the event of a problem.
If you don't know anything about Monad Transformers, you can start with Martin Grabmüller's Monad Transformers Step by Step. It covers ErrorT. After that read Breaking from a Loop again!
You might also want to read Real World Haskell chapter 19, Error handling.
Call/CC
Continuation Passing Style's callCC is remarkably powerful, but perhaps too powerful, and certainly doesn't produce terribly easy-to-follow code. See this for a fairly positive take, and this for a very negative one.
So what I think you're looking for is the equivalent of return in imperative languages, eg
def do_something
foo
bar
return baz if quux
...
end
Now in haskell this is doesn't work because a monadic chain is just one big function application. We have syntax that makes it look prettier but it could be written as
bind foo (bind bar (bind baz ...)))
and we can't just "stop" applying stuff in the middle. Luckily if you really need it there is an answer from the Cont monad. callCC. This is short for "call with current continuation" and generalizes the notation of returns. If you know Scheme, than this should be familiar.
import Control.Monad.Cont
foo = callCC $ \escape -> do
foo
bar
when baz $ quux >>= escape
...
A runnable example shamelessly stolen from the documentation of Control.Monad.Cont
whatsYourName name =
(`runCont` id) $ do
response <- callCC $ \exit -> do
validateName name exit
return $ "Welcome, " ++ name ++ "!"
return response
validateName name exit = do
when (null name) (exit "You forgot to tell me your name!")
and of course, there is a Cont transformer, ContT (which is absolutely mind bending) that will let you layer this on IO or whatever.
As a sidenote, callCC is a plain old function and completely nonmagical, implementing it is a great challenge
So I suppose there is no way of doing it the way I imagined it originally, which is equivalent of a break function in an imperative loop.
But I still get the same effect below based in Ingo's answer, which is pretty easy (silly me)
doStuff x = if x > 5
then do
t <- getTingFromOutside
doHeavyHalculations t
else return ()
I don't know though how it would work if I need to test 't' in the example above ...
I mean, if I need to test the bound value and make an if decision from there.
You can never break out of a "monad sequence", by definition. Remember that a "monad sequence" is nothing else than one function applied to other values/functions. Even if a "monad sequence" gives you the illusion that you could programme imperative, this is not true (in Haskell)!
The only thing you can do is to return (). This solution of the practical problem has already been named in here. But remember: it gives you only the illusion of being able to break out of the monad!

Overflow problems in dealing with IO and MonadRandom and chained computations

So basically I have a computation step that takes in a previous result and outputs a Rand g Path, where Path is a custom data type (think of it like a traveling salesman kind of problem). I'm letting MonadRandom handle all of the generator passing and stuff.
I want to find the, say, nth composition of this computation upon itself. Right now I'm using
thecomputation :: (RandomGen g) => Rand g Path
thecomputation = (iterate (>>= step) (return startingPath)) !! n
And then to print it out I would run
main = do
res <- evalRandIO thecomputation
print res
However, I have a problem
If I pick a high enough n (i need on the order of 10^6), I get a stack overflow.
I've managed to track the problem to the fact that thecomputation is actually a heavily composed (nested?) IO object. It's a series of IO computations and so ghc has to keep track of all of those layers of nested IO's, and after enough layers, it gives up.
How am I supposed to deal with this? In an imperative language there really isn't much to this. But what should I do here? Should I force some of the IO's to evaluate or ...?
There is a similar question on this site but I wasn't able to get anything helpful out of the accepted answer so I'm still pretty lost
Concrete Example
import System.Random
import Control.Monad.Random
import Control.Monad
data Path = DoublePath Double deriving Show
step :: (RandomGen g) => Path -> Rand g Path
step (DoublePath x) = do
dx <- getRandom
return (DoublePath ((x + dx)/x))
thecomputation :: (RandomGen g) => Rand g Path
thecomputation = (iterate (>>= step) (return (DoublePath 10.0))) !! 1000000
main = do
result <- evalRandIO thecomputation
print result
does overflow on my computer
You are bitten by lazyness: Everytime you call step on some value x, GHC is creating a thunk step x that is not evaluated until the final value is required.
A simple fix is to make step strict in its argument, e.g. by pattern-matching on DoublePath !x (and using -XBangPatterns) or inserting x `seq` before the body of the function. Then your code finished without stack overflow (heh).
It is enough to make the type strict. This ought to be second nature especially for numerical and other 'unboxable' parameters and doesn't require a language extension.
data Path = DoublePath !Double deriving Show
-- $ ghc -O2 doublepath.hs
-- ...
-- $ time ./doublepath
-- DoublePath 1.526581416150007
-- real 0m2.516s
-- user 0m2.307s
-- sys 0m0.092s

Resources