Bit-rotted text adventure EDSL free to a good home

In early 2008 I started working on a Haskell embedded domain-specific language for authoring text adventure games. It didn’t get all that far since I didn’t know a whole lot about either text adventure games or Haskell. But I think there were some interesting ideas there: the most fundamental interesting idea is that everything is done with continuations, so you are not tied down to working within any particular framework. Although the library provides combinators for working within a default “standard text adventure” framework (with locations, objects, an inventory, movement…) you are free to insert arbitrary Haskell at any point, say if you wanted to stick some little mini-game in the middle of your text adventure game, or whatever.

It has become apparent that I am never going to pick it up again, but it would be a shame to just let it rot on my hard drive. So I’ve made the darcs repo publicly available, licensed under a Creative Commons CC0 license. If you are at all interested feel free to fork off your own copy and play around with it (your copy, of course, does not have to be public domain). I guarantee it will not compile but it probably wouldn’t be that hard to get it working again.

Themes on Streams, Part II

In a previous post I claimed that comonad structures on R -> a are in one-to-one correspondence with monoid structures on R. In this post and the next I’ll justify that claim.

Characterizing comonads on R -> a

Suppose we have a comonad structure on R -> a. What could it possibly look like? Well, we must have two functions

extract   :: (R -> a) -> a
duplicate :: (R -> a) -> (R -> (R -> a))

(these are the duals of return and join for monads). Furthermore, extract and duplicate must satisfy some laws; we’ll get to those in a minute. For now, let’s just think a bit about these functions and their implementations. How would you implement them? They seem awfully constrained. For example, look at the type of extract: it takes a function of type R -> a and must somehow return an a. Intuitively, the only way it could do this is by applying the function to some distinguished value of type R. Similarly, duplicate takes a function R -> a as input and must produce a function of type R -> R -> a. How could this output function behave? It takes two R values and then must produce an a. The only place to get an a is from the argument to duplicate, which must be passed an R; the only possibility is to somehow combine its two R values into one.

Hmm… a distinguished value of type R… combining two R values into one… this should sound familiar! But how do we formalize all of this?

Any time we talk about the way a function’s type constrains its behavior we should immediately think of parametricity (aka free theorems). Using the very nice free theorem generator (using T0 in place of R) we can automatically generate some theorems about extract and duplicate based on their types. I’ve taken the liberty of specializing and alpha-varying them a bit. First, here’s the free theorem for extract:

Now watch what happens when we set q = g and p = id (so a = R). The left-hand side of the implication becomes g . id = g which is trivially satisfied. Hence the right-hand side must hold:

What does this give us? Well, flipping it around, it tells us that applying extract to an arbitrary function g is equivalent to applying g to some value of type R (in particular, the value we get when applying extract to the identity function). In other words, up to behavioral equivalence, the only possible implementation of extract g is the one which applies g to some distinguished R value — which is exactly what our intuition told us before! extract is completely determined by the chosen value of R; let’s call it r.

Similarly, here’s the free theorem for duplicate:

Again setting q = g and p = id gives us

Writing for gives us

that is, the only possible implementation of duplicate g y z is to pass some combination of y and z as an argument to g.

So now we know that for some value and some binary function ,

But in order to form a valid comonad instance, these functions must satisfy a few laws. In another post, I’ll show what these laws tell us about and (you can probably already guess, and might want to try working out the proof yourself… =)

Tic-tac-toe maps with diagrams

Inspired by Randall Munroe, here are some handy guides to optimal tic-tac-toe play, created with the diagrams EDSL. Click the images to open (zoomable) PDF versions.

I hacked this up in just a few hours. How did I do it? First, some code for solving tic-tac-toe (no graphics involved here, just game trees and minimax search):

> {-# LANGUAGE PatternGuards, ViewPatterns #-}
> 
> module Solve where
> 
> import Data.Array
> import Data.Tree
> import Data.Function (on)
> import Data.List (groupBy, maximumBy)
> import Data.Maybe (isNothing, isJust)
> import Data.Monoid
> import Control.Applicative (liftA2)
> import Control.Arrow ((&&&))
> import Control.Monad (guard)
> 
> data Player = X | O
>   deriving (Show, Eq, Ord)
> 
> next X = O
> next O = X
> 
> data Result = Win Player Int [Loc] -- ^ This player can win in n moves
>             | Cats                 -- ^ Tie game
>   deriving (Show, Eq)
> 
> compareResultsFor :: Player -> (Result -> Result -> Ordering)
> compareResultsFor X = compare `on` resultToScore
>     where resultToScore (Win X n _) = (1/(1+fromIntegral n))
>           resultToScore Cats        = 0
>           resultToScore (Win O n _) = (-1/(1+fromIntegral n))
> compareResultsFor O = flip (compareResultsFor X)
> 
> type Loc = (Int,Int)
> type Board = Array Loc (Maybe Player)
> 
> emptyBoard :: Board
> emptyBoard = listArray ((0,0), (2,2)) (repeat Nothing)
> 
> showBoard :: Board -> String
> showBoard = unlines . map showRow . groupBy ((==) `on` (fst . fst)) . assocs
>   where showRow = concatMap (showPiece . snd)
>         showPiece Nothing  = " "
>         showPiece (Just p) = show p
> 
> data Move = Move Player Loc
>   deriving Show
> 
> makeMove :: Move -> Board -> Board
> makeMove (Move p l) b = b // [(l, Just p)]
> 
> data Game = Game Board           -- ^ The current board state.
>                  Player          -- ^ Whose turn is it?
>                  [Move]          -- ^ The list of moves so far (most
>                                  --   recent first).
>   deriving Show
> 
> initialGame = Game emptyBoard X []
> 
> -- | The full game tree for tic-tac-toe.
> gameTree :: Tree Game
> gameTree = unfoldTree (id &&& genMoves) initialGame
> 
> -- | Generate all possible successor games from the given game.
> genMoves :: Game -> [Game]
> genMoves (Game board player moves) = newGames
>   where validLocs = map fst . filter (isNothing . snd) . assocs $ board
>         newGames  = [Game (makeMove m board) (next player) (m:moves)
>                       | p <- validLocs
>                       , let m = Move player p
>                     ]
> 
> -- | Simple fold for Trees.  The Data.Tree module does not provide
> --   this.
> foldTree :: (a -> [b] -> b) -> Tree a -> b
> foldTree f (Node a ts) = f a (map (foldTree f) ts)
> 
> -- | Solve the game for player @p@: prune all but the optimal moves
> --   for player @p@, and annotate each game with its result (given
> --   best play).
> solveFor :: Player -> Tree Game -> Tree (Game, Result)
> solveFor p = foldTree (solveStep p)
> 
> -- | Given a game and its continuations (including their results),
> --   solve the game for player p.  If it is player p's turn, prune all
> --   continuations except the optimal one for p. Otherwise, leave all
> --   continuations.  The result of this game is the result of the
> --   optimal choice if it is p's turn, otherwise the worst possible
> --   outcome for p.
> solveStep :: Player -> Game -> [Tree (Game, Result)] -> Tree (Game, Result)
> solveStep p g@(Game brd curPlayer moves) conts
>   | Just res <- gameOver g = Node (g, res) []
> 
>   | curPlayer == p = let c   = bestContFor p conts
>                          res = inc . snd . rootLabel $ c
>                      in  Node (g, res) [c]
>   | otherwise      = Node (g, bestResultFor (next p) conts) conts
> 
> bestContFor :: Player -> [Tree (Game, Result)] -> Tree (Game, Result)
> bestContFor p = maximumBy (compareResultsFor p `on` (snd . rootLabel))
> 
> bestResultFor :: Player -> [Tree (Game, Result)] -> Result
> bestResultFor p = inc . snd . rootLabel . bestContFor p
> 
> inc :: Result -> Result
> inc (Win p n ls) = Win p (n+1) ls
> inc Cats         = Cats
> 
> -- | Check whether the game is over, returning the result if it is.
> gameOver :: Game -> Maybe Result
> gameOver (Game board _ _)
>   = getFirst $ mconcat (map (checkWin board) threes) `mappend` checkCats board
> 
> checkWin :: Board -> [Loc] -> First Result
> checkWin board = First
>                . (>>= winAsResult)      -- Maybe Result
>                . mapM strength          -- Maybe [(Loc, Player)]
>                . map (id &&& (board!))  -- [(Loc, Maybe Player)]
> 
> winAsResult :: [(Loc, Player)] -> Maybe Result
> winAsResult (unzip -> (ls,ps))
>   | Just p <- allEqual ps = Just (Win p 0 ls)
> winAsResult _ = Nothing
> 
> checkCats :: Board -> First Result
> checkCats b | all isJust (elems b) = First (Just Cats)
>             | otherwise            = First Nothing
> 
> allEqual :: Eq a => [a] -> Maybe a
> allEqual = foldr1 combine . map Just
>   where combine (Just x) (Just y) | x == y = Just x
>                                   | otherwise = Nothing
>         combine Nothing _         = Nothing
>         combine _ Nothing         = Nothing
> 
> strength :: Functor f => (a, f b) -> f (a,b)
> strength (a, f) = fmap ((,) a) f
> 
> threes :: [[Loc]]
> threes = rows ++ cols ++ diags
>   where rows     = [ [ (r,c) | c <- [0..2] ] | r <- [0..2] ]
>         cols     = [ [ (r,c) | r <- [0..2] ] | c <- [0..2] ]
>         diags    = [ [ (i,i) | i <- [0..2] ]
>                    , [ (i,2-i) | i <- [0..2] ]
>                    ]

Once we have a solved game tree, we can use it to generate a graphical map as follows.

> {-# LANGUAGE NoMonomorphismRestriction #-}
> 
> -- Maps of optimal tic-tac-toe play, inspired by similar maps created
> -- by Randall Munroe, http://xkcd.com/832/
> 
> import Diagrams.Prelude hiding (Result)
> import Diagrams.Backend.Cairo.CmdLine
> 
> import Data.List.Split (chunk)                   -- cabal install split
> import Data.Maybe (fromMaybe, catMaybes)
> import qualified Data.Map as M
> import Data.Tree
> import Control.Arrow (second, (&&&), (***))
> import Data.Array (assocs)
> 
> import Solve
> 
> type D = Diagram Cairo R2
> 
> x, o :: D
> x = (stroke $ fromVertices [P (-1,1), P (1,-1)] <> fromVertices [P (1,1), P (-1,-1)])
>   # lw 0.05
>   # lineCap LineCapRound
>   # scale 0.4
>   # freeze
>   # centerXY
> o = circle
>   # lw 0.05
>   # scale 0.4
>   # freeze
> 
> -- | Render a list of lists of diagrams in a grid.
> grid :: Double -> [[D]] -> D
> grid s = centerXY
>        . vcat' with {catMethod = Distrib, sep = s}
>        . map (hcat' with {catMethod = Distrib, sep = s})
> 
> -- | Given a mapping from (r,c) locations (in a 3x3 grid) to diagrams,
> --   render them in a grid, surrounded by a square.
> renderGrid :: M.Map Loc D -> D
> renderGrid g
>   = (grid 1
>   . chunk 3
>   . map (fromMaybe (phantom x) . flip M.lookup g)
>   $ [ (r,c) | r <- [0..2], c <- [0..2] ])
> 
>     `atop`
>     square # lw 0.02 # scale 3 # freeze
> 
> -- | Given a solved game tree, where the first move is being made by
> --   the player for whom the tree is solved, render a map of optimal play.
> renderSolvedP :: Tree (Game, Result) -> D
> renderSolvedP (Node (Game _ p _, _) [])   -- cats game, this player does not
>     = renderPlayer (next p) # scale 3     -- get another move; instead of
>                                           -- recursively rendering this game
>                                           -- just render an X or an O
> renderSolvedP (Node (Game board player1 _, _)
>                     [g'@(Node (Game _ _ (Move _ loc : _), res) conts)])
>     = renderResult res <>    -- Draw a line through a win
>       renderGrid cur   <>    -- Draw the optimal move + current moves
>       renderOtherP g'        -- Recursively render responses to other moves
> 
>   where cur = M.singleton loc (renderPlayer player1 # lc red)  -- the optimal move
>               <> curMoves board                                -- current moves
> 
> renderSolvedP _ = error "renderSolvedP should be called on solved trees only"
> 
> -- | Given a solved game tree, where the first move is being made by the
> --   opponent of the player for whom the tree is solved, render a map of optimal
> --   play.
> renderOtherP :: Tree (Game, Result) -> D
> renderOtherP (Node _ conts)
>     -- just recursively render each game arising from an opponent's move in a grid.
>   = renderGrid . M.fromList . map (getMove &&& (scale (1/3) . renderSolvedP)) $ conts
>   where getMove (Node (Game _ _ (Move _ m : _), _) _) = m
> 
> -- | Extract the current moves from a board.
> curMoves :: Board -> M.Map Loc D
> curMoves = M.fromList . (map . second) renderPlayer . catMaybes . map strength . assocs
> 
> -- | Render a line through a win.
> renderResult :: Result -> D
> renderResult (Win _ 0 ls) = winLine # freeze
>   where winLine :: D
>         winLine = stroke (fromVertices (map (P . conv) ls))
>                           # lw 0.2
>                           # lc blue
>                           # lineCap LineCapRound
>         conv (r,c) = (fromIntegral $ c - 1, fromIntegral $ 1 - r)
> renderResult _ = mempty
> 
> renderPlayer X = x
> renderPlayer O = o
> 
> xMap = renderSolvedP . solveFor X $ gameTree
> oMap = renderOtherP  . solveFor O $ gameTree
> 
> main = defaultMain (pad 1.1 xMap)
>        -- defaultMain (pad 1.1 oMap)

Announcing diagrams preview release

I am extremely pleased to announce a "developer preview" release of the diagrams framework for declarative drawing. This is a well-thought-out, well-documented, working release with all core functionality in place, but with many planned features still missing (for example, support for rendering text and higher-level tools for constructing curves). If you are interested in

• trying out a new way of producing vector graphics,
• providing feedback to help drive ongoing development, or
• getting involved and contributing some code yourself,

please give it a try! On the other hand, if you are looking for a complete, full-featured package that will let you jump right into producing the graphics you need, you may want to wait for the 1.0 release.

If you are familiar with the diagrams package already on Hackage, this is a complete rewrite which has been in the works for over a year and a half.

What is it?

Diagrams is an embedded domain-specific library (EDSL) for creating diagrams, illustrations, and other sorts of vector graphics. The overall vision is for diagrams to become a viable alternative to systems like MetaPost, Asymptote, and PGF/TikZ.

Diagrams is:

• Declarative: you specify what a diagram is, not how to draw it.

• Compositional: diagrams can be combined in many ways to produce more complex diagrams. Diagrams are scale- and translation-invariant, so you never have to worry about a "global" coordinate system, only "local" ones.

• Embedded: the full power of Haskell, including every library on Hackage, is available to help construct and manipulate diagrams.

• Extensible: extending diagrams with additional or higher-level functionality is as simple as writing a Haskell module.

• Flexible: diagrams is designed from the ground up to be as generic and flexible as possible. Features include:

  • Pluggable rendering backends — creating a new rendering backend is as simple as writing a type class instance.

  • Arbitrary vector spaces — the core diagrams library data types and primitives work for any vector space, so given a suitable rendering backend you can produce diagrams of any dimension, or even more exotic things…

Cool, how can I try it out?

Start by reading the quick tutorial, which has detailed information about how to install the necessary packages and will introduce you to the fundamentals of the framework.

Or, for the truly impatient:

cabal install diagrams-core diagrams-lib diagrams-cairo

How can I contribute?

There are lots of ways you can contribute! First, you may want to subscribe to the project mailing list, and/or come hang out in the #diagrams IRC channel on freenode.org.

• Cairo is the only well-supported backend at the moment, but you might create another backend or contribute to an existing project.

• The standard library is in need of additional features. Visit the Google Code site for a list of open tickets.

• Create a higher-level module built on top of the diagrams framework (e.g. tree or graph layout, generating Turing machine configuration diagrams, Penrose tilings … your imagination is the only limit!) and submit it for inclusion in a special diagrams-contrib package which will be created for such higher-level user-contributed modules.

• Use diagrams to create some cool graphics and submit them for inclusion in a gallery of examples (to be created soon).

• Start your own project built on top of diagrams and let us know how it goes!

• Last but certainly not least, just try it out for your pet graphics generation needs and contribute your bug reports and feature requests.

Happy diagramming!

Brought to you by the diagrams team:

• Brent Yorgey
• Ryan Yates

with contributions from:

• Sam Griffin
• Vilhelm Sjöberg
• Luite Stegeman
• Kanchalai Suveepattananont
• Scott Walck

trapd

Themes on Streams

> {-# LANGUAGE DeriveFunctor, FlexibleInstances #-}

Recall that a stream is a countably infinite sequence of values:

> data Stream a = a :> Stream a
>   deriving (Functor, Show)
> 
> sHead (a :> _) = a
> sTail (_ :> s) = s

Streams are lovely things (especially in a lazy language) with many nice properties.

> type Theme = String
> type Consciousness = Stream Theme

The remainder of this blog post (in two parts) will be of type Consciousness.

Theme 1: Stream is a monad

The other day I read Jeremy Gibbons’s blog post about the stream monad, proving the monad laws for the version of join that diagonalizes nested streams:

> instance Monad Stream where
>   return a       = a :> return a
>   s >>= f        = sJoin (fmap f s)
> 
> sJoin (s :> ss) = sHead s :> sJoin (fmap sTail ss)

sJoin takes a stream of streams, and outputs a stream with the first element of the first stream, the second element of the second stream, … the nth element of the nth stream.

I recommend reading his post, it’s a very cool example of using universal properties and equational reasoning.

Theme 2: Streams are (isomorphic to) functions

In a comment on Jeremy’s post, Patai Gergely noted that insight into this issue can be gained by observing that Stream a is isomorphic to Nat -> a: there is one item in a stream at every natural number index.

Of course, (->) Nat is a monad: in fact, (->) e is a monad (the "reader monad") for any type e. And what does join for the (->) e monad do? Why, it duplicates an argument:

> rJoin :: (e -> (e -> a)) -> (e -> a)
> rJoin s e = s e e

A little thought shows that this corresponds exactly to the diagonalizing join on Streams: rJoin s e = s e e can be read as "the eth element of rJoin s is the eth element of the eth stream in the stream of streams s." See?

So I told my officemate Daniel about this, and it occurred to us that there’s nothing special here about Nat at all! rJoin is polymorphic in e; R -> a is a monad for any type R.

Functors which are isomorphic to (->) R for some concrete type R are called representable; so what this means is that all representable functors are monads. (Not that we were the first to think of this.)

Theme 3: Streams are comonads

Hmm, but Stream is a comonad too, right?

> class Comonad w where
>   extract   :: w a -> a
>   duplicate :: w a -> w (w a)
> 
> instance Comonad Stream where
>   extract                = sHead
>   duplicate s@(hd :> tl) = s :> duplicate tl

And since Stream is isomorphic to (->) Nat, that type must be a comonad too. What is the corresponding comonad instance for (->) Nat?

> type Nat = Integer   -- just pretend, OK?
> 
> instance Comonad ((->) Nat) where

Extracting from a stream just returns its head element, that is, the element at index 0. So extracting from a Nat -> a applies it to 0.

>   extract = ($0)

Duplicating a stream gives us a stream of streams, where the nth output stream contains consecutive elements from the original stream beginning with the nth. Put another way, the jth element from the ith stream in the output is the (i+j)th element of the original stream:

>   duplicate s i j = s (i + j)

Neat. Unlike the implementation of join for the monad instance, however, this is definitely making use of the particular structure of Nat. So this throws some cold water on our hopes of similarly generalizing this to all representable functors.

…or does it?

Theme 4: Comonads for representable functors

In the previous paragraph I said "this is definitely making use of the particular structure of Nat", but I was being deliberately obtuse. Nat has lots and lots of structure, surely we weren’t using all of it! In fact, we only mentioned the particular natural number 0 and the addition operation. Hmm… zero and addition… what’s interesting about them? Well, zero is the identity for addition, of course, and addition is associative — that is, the natural numbers form a monoid under addition with zero as the identity. So just as a wild guess, perhaps it’s the monoid structure of Nat which makes the comonad instance possible?

In fact… yes! It turns out that comonad structures on R -> a are in one-to-one correspondence with monoid structures on R. To prove this, we can… oh, darn, looks like we’re out of time! (Read: this blog post is getting too long and if I don’t publish something soon I never will.) I’ll continue in another post, but in the meantime you might fancy trying to prove this yourself.