G'day all. Quoting oleg@pobox.com: : Since Andrew Bromage wished for that interesting monad, perhaps he has : in mind a good example of its use. We are particularly interested in a : short example illustrating soft-cut (and, perhaps, `once'). No obvious small examples of soft cut spring to mind. (If Fergus is listening, he might have a few suggestions...) In Prolog parlance, there are three types of cut operation: - A "red cut" is anything which prunes away solutions. Red cuts are usually considered bad style because they have no logical interpretation. - A "green cut" is any cut which does not prune solutions, but which may prune different proofs of the same solution. - A "blue cut" prunes neither solutions, nor proofs. It's basically an efficiency hack, where the programmer inserts a cut to tell the Prolog implementation that some piece of code is deterministic when the implementation can't infer that. Green and blue cuts are sometimes collectively called "grue cuts". The most obvious use for "once" (which I may accidentally call "commit") is for blue cuts. This is not so useful in Haskell, but you never know. The second most obvious use is for those times when some goal isn't technically deterministic, but you never actually look at the "output". Mercury automatically inserts these commit operations if it can tell that the output of some goal is never consulted. One situation where you might use this is in negation-as-failure: gnot :: (Logic m) => m a -> m () gnot m = ifte (once m) (const gfail) (gsuccess ()) The point of the "once" is that when the "then" branch fails, the system won't backtrack into m. There's no point, since it's always going to fail. Another example of pruning is any situation where you are doing some kind of search which would normally be intractable, but you have a heuristic. If the heuristic is "safe" (that is, if whenever it can be applied, applying it results in no solutions being lost), then the cut is green. Otherwise it's red. (But that's sometimes okay; if it's an NP-hard problem, for example, you just make do with the approximation provided by the heuristic.) With soft cuts, you can express it like this: optimise curState | isGoalState curState = gsuccess success | otherwise = ifte (tryHeuristic curState) (\h -> do -- "then" case s <- nextStateWithHeuristic h curState optimise s) (do -- "else" case s <- nextState curState optimise s) The soft cut guarantees that you commit to the heuristic if it applies. As an example, here's a simple (though not THAT short) tic-tac-toe game. The solution is highly artificial, since the "next move" computation is effectively deterministic. A better example might be solving Sudoku problems, but that's harder to set up than tic-tac-toe.
{-# OPTIONS -fglasgow-exts #-} {-# OPTIONS -fallow-undecidable-instances #-}
The -fallow-undecidable-instances will be explained in a moment.
module Main where
import Control.Monad import Control.Monad.Trans import LogicT import SFKT import Data.List
OK, now the monad that most of the computation will be done in...
class (Monad m, MonadIO (t m), LogicT t, MonadPlus (t m)) => MyMonT t m instance (Monad m, MonadIO (t m), LogicT t, MonadPlus (t m)) => MyMonT t m
This is the reason for -fallow-undecidable-instances. To make the types not so unwieldy, we would ideally like typeclass synonyms, but Haskell doesn't support them. So this will have to do.
data Value = B | X | O deriving (Show, Eq, Ord) type Player = Value
We're going to overload the Value type with two meanings: It can either mean a value on the tic-tac-toe board, or it can refer to a player (either X or O). Code to switch players:
otherPlayer :: Player -> Player otherPlayer X = O otherPlayer O = X
Code to handle the board:
data Board = Board Value Value Value Value Value Value Value Value Value deriving (Show, Eq, Ord)
blankBoard :: Board blankBoard = Board B B B B B B B B B
-- Return true if the board is a win for player p. win :: Value -> Board -> Bool win p (Board a b c d e f g h i) = (a == b && b == c && a == p) || (d == e && e == f && d == p) || (g == h && h == i && g == p) || (a == d && d == g && a == p) || (b == e && e == h && b == p) || (c == f && f == i && c == p) || (a == e && e == i && a == p) || (c == e && e == g && c == p)
draw :: Board -> Bool draw (Board a b c d e f g h i) = not (any (==B) [a,b,c,d,e,f,g,h,i])
We also need to encode the desirability of a board state. We do this with an enum type such that more desirable states come first in Ord.
data State = Win | Draw | Lose deriving (Show, Eq, Ord)
otherState :: State -> State otherState Win = Lose otherState Lose = Win otherState Draw = Draw
A move is a number from 1 to 9 representing the cell to put your mark in:
type Move = Int
move :: (MonadPlus m) => Move -> Player -> Board -> m Board move 1 p (Board B b c d e f g h i) = return $ Board p b c d e f g h i move 2 p (Board a B c d e f g h i) = return $ Board a p c d e f g h i move 3 p (Board a b B d e f g h i) = return $ Board a b p d e f g h i move 4 p (Board a b c B e f g h i) = return $ Board a b c p e f g h i move 5 p (Board a b c d B f g h i) = return $ Board a b c d p f g h i move 6 p (Board a b c d e B g h i) = return $ Board a b c d e p g h i move 7 p (Board a b c d e f B h i) = return $ Board a b c d e f p h i move 8 p (Board a b c d e f g B i) = return $ Board a b c d e f g p i move 9 p (Board a b c d e f g h B) = return $ Board a b c d e f g h p move _ _ _ = mzero
Utility "axiom of choice" function:
choose :: (MonadPlus m) => [a] -> m a choose = msum . map return
Right, now on to the game. Assume that there's a function: best :: (MyMonT t m) => Player -> Board -> t m (State, Board) where best p b makes the best move for player p on board b, returning the new board as well as an estimate about how good the position is (i.e. whether it's a theoretical win, lose or draw for player p). Then here's how to play a game with the computer playing itself. X moves first.
game :: (MyMonT t m) => t m () game = game' X blankBoard where game' p b | win X b = liftIO (putStrLn "X wins!") | win O b = liftIO (putStrLn "O wins!") | draw b = liftIO (putStrLn "Draw!") | otherwise = do (_,b') <- once (best p b) liftIO (putStrLn $ show b') game' (otherPlayer p) b'
main = observe game
Now all we need to do is write "best". This is a simple problem in AI. Basically, you're trying to do a minimax search. If this is a "goal state" (i.e. an ACTUAL win, lose or draw), then we're done. If not, we examine all of the successor states, assuming that our opponent will make their best move, and we pick the one that's best for us. best :: (MyMonT t m) => Player -> Board -> t m (State, Board) best p b | win p b = return (Win, b) | win (otherPlayer p) b = return (Lose, b) | draw b = return (Draw, b) | otherwise = do wbs <- runN Nothing (do m <- choose [1..9] b' <- move m p b (w,_) <- best (otherPlayer p) b' return (otherState w,b')) let (w,b') = minimum wbs return (w, b') Unfortunately, this is too slow for interactive use. Certainly, I ran out of patience after a minute. However, thankfully there are a couple of safe heuristics which work just fine with tic-tac-toe. The first is that if you can win in this move, you should do so. The second is that if the first heuristic doesn't work, then you should see if there is any move that your opponent could make where they could win on the next move. If so, you should move to block it. The code looks like this:
best :: (MyMonT t m) => Player -> Board -> t m (State, Board) best p b | win p b = return (Win, b) | win (otherPlayer p) b = return (Lose, b) | draw b = return (Draw, b) | otherwise = ifte (once (do m <- choose [1..9] b' <- move m p b guard (win p b) return (Win, b'))) return (ifte (once (do m <- choose [1..9] b' <- move m (otherPlayer p) b guard (win (otherPlayer p) b') return m)) (\m -> do b' <- move m p b (w,_) <- best (otherPlayer p) b' return (w,b')) (do wbs <- runN Nothing (do m <- choose [1..9] b' <- move m p b (w,_) <- best (otherPlayer p) b' return (otherState w,b')) let (w,b') = minimum wbs return (w, b')))
And we're done. Runs nice and fast now. Some of the interesting examples in Prolog are moot in Haskell by virtue of the fact that Haskell is "strongly moded". Having said that, there are three main areas where I find soft-cut useful. The first is directing search. People who liberally use <|> and <?> in Parsec probably know exactly what I mean by this. The second is tailoring failure. A lot of Prolog programs just fail without further comment. There was once a logic language implementation (which I won't name) whose front-end was implemented this way. Imagine if you fed your compiler a program, and the only diagnostic that you got was "Your program contains one or more errors." Soft cut gives you a logical way to specify _why_ some task failed. Well first off, the combination of soft-cut and once gives you a logical negation-as-failure: gnot :: (Logic m) => m a -> m () gnot m = ifte (once m) (\_ -> gfail) (gsuccess ()) That's a useful alternative to "guard". Cheers, Andrew Bromage