CSE301

Project: a text adventure game on and around trees

Contents

Quick summary

The goal of this project is to write a single-player text adventure game on the broad theme of “trees”. Most of the design elements of the game are up to you, including its overall style and objectives. The only hard requirements are that

  1. the game should involve navigating within a tree, which is either fixed or potentially evolves over time;

  2. the game must have a text-based interface, taking input from the user in (rudimentary) natural language;

  3. all or the majority of the code should be written in Haskell.

An implementation of a very simple game, Binary Tree World, is provided for you as an example, and is explained in detail below. You are free to adapt any of this template code if you like (or write your game from scratch).

Binary Tree World

In Binary Tree World, you are a solitary character climbing up and down a binary tree, without any particular goal other than to gain a better understanding of your environment. At any point in time you can only see the node where you are located, and you never get a full view of the tree until you quit the game. Occasionally, you stop to meditate on your surroundings. A run of the game might look like this:

Welcome to Binary Tree World.

You are at the root of an ancient binary tree.
You see a binary node.
> climb left
You see a binary node.
> climb left
You see a leaf.
> climb down
You see a binary node.
> meditate for three seconds
You close your eyes and focus on your surroundings.
You open your eyes.
You see a binary node.
> climb right
You see a leaf.
> quit
Okay.
You ended the game over here:

B
|
+- B
|  |
|  +- L
|  |
|  `- @ <--you
|
`- B
   |
   +- L
   |
   `- L

Goodbye.

The implementation of Binary Tree World, which may be downloaded here, consists of four Haskell files:

All of these are explained below.

Bin.hs

At the very top of the file, we see

module Bin where

which declares a module named “Bin”. Note that GHC requires the name of a module to match its file name. (“Bin” also happens to be the name of a data type defined in “Bin”, but there is no conflict since module names and types live in separate name spaces.)

Next we have a library import:

import Data.Tree

Note that all library imports have to go at the top of the module, before any other definitions. Here we import Data.Tree because we are going to use it later for pretty-printing.

After this prelude, the module begins with our usual data type of unlabelled binary trees.

data Bin = L | B Bin Bin

And next it introduces a data type of one-hole contexts for binary trees.

data BinCxt = Hole
            | B0 BinCxt Bin
            | B1 Bin BinCxt

A one-hole context may be thought of as an inductive description of a binary tree with a “hole” into which another tree may be plugged. Plugging a one-hole context with a binary tree to produce a binary tree is accomplished by the following function.

plug :: BinCxt -> Bin -> Bin
plug Hole      t = t
plug (B0 c t2) t = plug c (B t t2)
plug (B1 t1 c) t = plug c (B t1 t)

Under this definition of the plugging function, values of type BinCxt are interpreted “inside-out” as describing paths from the hole to the root, recording whether we go down from a left child (B0) or a right child (B1), as well as the siblings we encounter along the path. Alternatively, we could interpret contexts “outside-in” as describing paths from the root to the hole, in which case we would use the following plugging function.

plug' :: BinCxt -> Bin -> Bin
plug' Hole      t = t
plug' (B0 c t2) t = B (plug' c t) t2
plug' (B1 t1 c) t = B t1 (plug' c t)

But we’re going to stick to the inside-out representation since it is more useful for navigating through trees using zippers.

A zipper is just a pair of a one-hole context and a tree.

type BinZip = (BinCxt,Bin)

Intuitively, we can think of a zipper (c,t) as defining a (purely functional) pointer to t as a subtree of u = plug c t. The terminology comes from Gérard Huet’s classic paper, “The Zipper”.

To illustrate the technique, let’s consider a small example of a binary tree,

a small binary tree
a small binary tree

which is represented by the value u = B (B L L) L. This tree has five subtrees, as indicated by the following diagram:

its five subtrees
its five subtrees

To be clear, here we are distinguishing between different occurrences of the same subtree, so even though the tree contains three identical copies of a leaf L, we consider them as different subtrees since they occur at different locations of the tree. Formally, we represent the five different subtrees by the following zippers:

  1. (Hole, B (B L L) L)
  2. (B0 Hole L, B L L)
  3. (B0 (B0 Hole L) L, L)
  4. (B1 L (B0 Hole L), L)
  5. (B1 (B L L) Hole, L)

The first component of type BinCxt may be seen as describing a path from the hole of the surrounding context of the subtree down to the root, while the second component describes the subtree itself. For example, zipper #2 points to a subtree of the form B L L, where the path to the root comes down from the left while grafting a leaf onto the right (B0 Hole L). Zipper #4 points to a leaf subtree L, where the path to the root comes down from the right and then from the left, grafting leaves both times (B1 L (B0 Hole L)). Finally, zipper #5 points to another leaf subtree L, where the path goes immediately from the right to the root, while grafting B L L to the left (B1 (B L L) Hole).

The zipper type is perfectly designed for navigating through a tree in a purely functional way — the idea is that we just shift some values from the subtree into its surrounding context, or vice versa. The following functions implement moving the pointer up to the left child, up to the right child, or down to the parent of a subtree. (Note that these operations are only partial, i.e., return a Maybe type, since the subtree may not have a child or a parent.)

go_left :: BinZip -> Maybe BinZip
go_left (c,B t1 t2) = Just (B0 c t2,t1)  -- focus on the left child
go_left (c,L)       = Nothing            -- (leaf => no left child)

go_right :: BinZip -> Maybe BinZip
go_right (c,B t1 t2) = Just (B1 t1 c,t2) -- focus on the right child
go_right (c,L)       = Nothing           -- (leaf => no right child)

go_down :: BinZip -> Maybe BinZip
go_down (B0 c t2,t) = Just (c,B t t2)    -- focus on parent *from* left child
go_down (B1 t1 c,t) = Just (c,B t1 t)    -- focus on parent *from* right child
go_down (Hole,t)    = Nothing            -- (root => no parent)

For example, applying go_right to zipper #2 above yields (Just of) zipper #4.

It is also easy to implement operations that perform simple edits, such as say grafting another tree off to the left or right of the subtree in focus.

graft_left, graft_right :: Bin -> BinZip -> BinZip
graft_left  g (c,t) = (c,B g t)
graft_right g (c,t) = (c,B t g)

For example, we can construct the complete binary tree on four leaves by applying either graft_left L or graft_right L to zipper #5 above.

Finally, we include some pretty-printing routines for binary trees and binary tree zippers.

We make use of drawTree :: Tree String -> String from the Data.Tree module, after first defining some conversion routines from Bins and BinZips to Tree Strings, which also relies on interpreting a BinCxt as a function Tree String -> Tree String.

treeFromBin :: Bin -> Tree String
treeFromBin L         = Node "L" []
treeFromBin (B t1 t2) = Node "B" [treeFromBin t1,treeFromBin t2]

treeCxtFromBinCxt :: BinCxt -> Tree String -> Tree String
treeCxtFromBinCxt Hole      t = t
treeCxtFromBinCxt (B0 c t2) t = treeCxtFromBinCxt c (Node "B" [t, treeFromBin t2])
treeCxtFromBinCxt (B1 t1 c) t = treeCxtFromBinCxt c (Node "B" [treeFromBin t1, t])

treeFromBinZip :: BinZip -> Tree String
treeFromBinZip (c,t) = treeCxtFromBinCxt c (t'{rootLabel=marker})
  where
    t' = treeFromBin t
    marker = "@ <--you"

drawBin :: Bin -> String
drawBin = drawTree . treeFromBin

drawBinZip :: BinZip -> String
drawBinZip = drawTree . treeFromBinZip

Cmd.hs

This file just contains a small data type of commands:

data Cmd = Go_Left | Go_Right | Go_Down | Meditate Int | Quit

These commands will be interpreted in the game’s top-level loop, after first being recognized by the parser which we now describe.

Parser.hs

This module implements parsing of commands based on the technique of monadic parsing. It begins by defining the following type of parsers for values of an arbitrary type:

newtype Parser tok a = Parser { runParser :: [tok] -> Maybe (a,[tok]) }

The idea is that a value of type Parser tok a is something that takes a string of tokens as input, and tries to parse a prefix of the input as a value of type a. If it succeeds, it returns “Just” of a value of type (a,[tok]), where the second component is the suffix of remaining tokens. Otherwise it returns “Nothing”.

Or in other words, adapting a poem by Graham Hutton,

A parser for things

Is a function from strings

To maybe a pair

Of a thing and a string!

Anyways, we will use the fact that for any type tok of tokens, Parser tok defines a monad.

instance Monad (Parser tok) where
  -- return :: a -> Parser tok a
  return x = Parser (\ts -> Just (x,ts))

  -- (>>=) :: Parser a -> (a -> Parser tok b) -> Parser tok b
  p >>= f  = Parser (\ts -> case runParser p ts of
                             Nothing -> Nothing
                             Just (x,ts') -> runParser (f x) ts')

We add some boilerplate code to derive Functor and Applicative instances from the Monad instance.

instance Functor (Parser tok) where
  fmap f p = p >>= \x -> return (f x)

instance Applicative (Parser tok) where
  pure = return
  pf <*> p = pf >>= \f -> p >>= \x -> return (f x)

Note that the type Parser tok a is isomorphic to StateT [tok] Maybe a, and we could have defined it that way to automatically derive all these type class instances. But we prefer to do it for ourselves.

We also define an Alternative instance, which makes it convenient to write backtracking parsers.

instance Alternative (Parser tok) where
  -- empty :: Parser tok a
  empty = Parser (\ts -> Nothing)

  -- (<|>) :: Parser tok a -> Parser tok a -> Parser tok a
  p1 <|> p2 = Parser (\ts -> case runParser p1 ts of
                               Just (x,ts') -> Just (x,ts')
                               Nothing -> runParser p2 ts)

The idea is that empty is a parser that always fails, while p1 <|> p2 is a parser that first tries to parse a string of tokens using p1, and if that fails tries parsing the same string using p2.

Now we define parsers for various kinds of basic stuff.

The token parser just reads one token of the input and returns it. Note there must be at least one token in the list for it to succeed.

token :: Parser tok tok
token = Parser $ \ts -> case ts of
                          []     -> Nothing
                          (t:ts') -> Just (t,ts')

The sat p parser matches a token satisfying the predicate p.

sat :: (tok -> Bool) -> Parser tok tok
sat p = do
  t <- token
  if p t then return t else empty

Now we move onto our actual example of interest.

Our parsers will assume that the input string has already been split up into a space-separated list of words, and thus use String as the basic token type from now on.

It will be useful to have a parser that consumes a token matching a specific string and ignoring case. This is achieved by match s.

match :: String -> Parser String String
match s = sat (\s' -> map toLower s == map toLower s')

We can parse English number words as numbers, although our parser is restricted to numbers between one and nine.

number :: Parser String Int
number = do
  (match "one" >> return 1)    <|> (match "two" >> return 2) <|>
   (match "three" >> return 3) <|> (match "four" >> return 4) <|>
   (match "five" >> return 5)  <|> (match "six" >> return 6) <|>
   (match "seven" >> return 7) <|> (match "eight" >> return 8) <|>
   (match "nine" >> return 9)

Observe the use of the alternative operator <|> to try matching different number words, as well as the monadic sequencing operator >> to return a value in the case of a match.

parseCmd is our general-purpose parser for commands, which can be either climbing commands, meditation commands, or quitting.

parseCmd :: Parser String Cmd
parseCmd = parseClimb <|> parseMeditate <|> parseQuit

Again observe the use of <|> to directly combine parsers handling the different possibilities.

Here is how we parse a climbing command:

parseClimb :: Parser String Cmd
parseClimb = do
  match "climb" <|> match "go"
  (match "down" >> return Go_Down) <|>
   (match "left" >> return Go_Left) <|>
   (match "right" >> return Go_Right)

Here is how we parse a meditation command:

parseMeditate :: Parser String Cmd
parseMeditate = do
  match "meditate"
  match "for"
  n <- number
  if n == 1 then match "second" else match "seconds"
  return (Meditate n)

And here is how we parse a quit command:

parseQuit :: Parser String Cmd
parseQuit = do
  match "quit" <|> match "q"
  return Quit

Finally, we export a function that runs a parser on the entire input string, broken up into words. This function runs in any MonadFail monad, to deal with the possiblity of failure.

parseInput :: MonadFail m => Parser String a -> String -> m a
parseInput p s = case runParser p (words s) of
                   Just (x,ts') -> if null ts' then return x else fail "runParserInput: some tokens left"
                   Nothing -> fail "runParserInput: failed to parse"

If you want to get a better feel for monadic parsing in order to adapt it to your own game, besides reading through the code and comments above, you can read Chapter 13 of Hutton’s Programming in Haskell, 2nd edition (available in the BCX library), or watch the video Hutton produced for Computerphile on functional parsing.

BinTreeWorld.hs

This file implements the top-level interactive game loop, and can be compiled by running ghc BinTreeWorld to produce an executable. We leave the commented code below for inspection.

import Bin
import Cmd
import Parser

import System.IO
import Control.Concurrent (threadDelay)

-- a small binary tree
a_tree :: Bin
a_tree = B (B L L) (B L L)

-- the top-level interactive loop
repl :: IO ()
repl = do
  putStrLn "You are at the root of an ancient binary tree."
  go (Hole,a_tree)
  where
    go :: BinZip -> IO ()
    go z = do                                          -- give the player some information
      case z of                                        -- about the current position in the tree
        (_,L)     -> putStrLn "You see a leaf."
        (_,B _ _) -> putStrLn "You see a binary node."
      putStr "> "                                      -- print the prompt
      hFlush stdout                                    -- flush standard output
      line <- getLine                                  -- get a line of input
      case runParserInput parseCmd line of             -- parse the input
          Nothing -> do
            putStrLn "I'm sorry, I do not understand."
            go z

          Just Go_Left ->
            case z of
              (c,B t1 t2) -> go (B0 c t2,t1)           -- climb up to the left
              (c,L) -> do
                putStrLn "You cannot climb any further."
                go z

          Just Go_Right ->
            case z of
              (c,B t1 t2) -> go (B1 t1 c,t2)           -- climb up to the right
              (c,L) -> do
                putStrLn "You cannot climb any further."
                go z

          Just Go_Down ->
            case z of
              (B0 c t2,t) -> go (c,B t t2)             -- climb down from the left, or
              (B1 t1 c,t) -> go (c,B t1 t)             -- climb down from the right, or
              (Hole,t) -> do                           -- already at the root
                putStrLn "You are already at the root."
                putStrLn "You cannot climb down any further."
                go z

          Just (Meditate n) -> do
            putStrLn "You close your eyes and focus on your surroundings."
            threadDelay (n * 1000000)
            putStrLn "You open your eyes."
            go z

          Just Quit -> do
            putStrLn "Okay."
            putStrLn "You ended the game over here:\n"
            putStrLn (drawBinZip z)
            putStrLn "Goodbye."
            return ()

main = repl

As you can see, the game state consists of a single zipper pointing into a pre-defined tree. At each stage, the user is told whether the current subtree in focus is a L node or a B node and then prompted for input, which is parsed as a command by calling parseInput parseCmd and interpreted as an operation on the zipper, or as a meditation session (with a call to threadDelay for \(n\)-million microseconds). The final state of the zipper is printed after the user quits.

Expectations

Game design

The high-level design of your game is entirely up to you, as long as it incorporates the theme of “trees” and the three hard requirements listed above. For example, you are free to decide whether your game incorporates elements of interactive fiction or puzzles, and whether it is turn-based or real-time. It can be a game of incomplete information (like Binary Tree World) where the player only has limited knowledge about the game state, or it can be a game of complete information where the player just has to figure out an appropriate strategy.

Keep in mind that you only have roughly one month to complete the project, and so you probably should not set out to design a game requiring very sophisticated graphics or multiple programmer-years of coding.

Some examples of suitable project topics include

Natural language interface

Your game should have a primitive natural language interface, like Binary Tree World. For this project, your easiest path will probably be to adapt the monadic parsing code for your specific world. Alternatively, you might implement a general-purpose parsing algorithm for context-free grammars, such as the CYK algorithm or Earley’s algorithm, in order to gain flexibility for describing the game language by a CFG without worrying about the problem of left recursion. (You can find examples of some CFGs for generating simple English sentences in Chapter 17 of Jurafsky and Martin’s Speech and Language Processing (3rd ed. draft).)

You can use any natural language that you wish for the game interface, as long as you document the project clearly in English.

You should not use an outsourced LLM!

Teamwork, deadlines, and short presentation

For this project, you may work either individually or in teams of 2-3 people.

I would like every individual or group to send me an email by the end of the day on Monday, 16 October, including both the composition of your group as well as a high-level (one paragraph) description of the game that you aim to produce. (It is okay if you eventually decide to modify the design, but I would like to know that you are attempting something feasible.)

The deadline for completing the project is Monday, 6 November at 12h00, with submission via Moodle.

Each team will also be expected to give a short (~20 minute) live presentation, showcasing the game and explaining the design and programming choices that you made, as well as your overall experience with the project. We will try to schedule the presentations within the weeks of 6-10 Nov and 13-17 Nov.

Assessment

The primary criterion used for evaluating your project will be that it demonstrates mastery of functional programming. One way that you can demonstrate mastery is by incorporating different concepts and techniques we learned (or will learn) in class, including first-order data types, higher-order functions, lambda calculus, side-effects, laziness, and zippers — of course you can incorporate such elements into the coding of the project, or into the game itself.

It is also important to include clear documentation, with precise specifications of the different components of your project, and these components should correctly meet their specifications.

Finally, a portion of your grade will be based on your presentation.

It is not super important that your game be fun, although fun is considered to be a harmless side-effect. ;-)

It goes without saying that all team members are expected to contribute to the design, the coding, and the presentation, and barring exceptional circumstances, all members of a team will receive the same grade.

Final remarks