Skip to content

Instantly share code, notes, and snippets.

@ocharles
Last active October 24, 2019 03:56
Show Gist options
  • Save ocharles/1a9c400027971c9b313ca3ca8284d9a3 to your computer and use it in GitHub Desktop.
Save ocharles/1a9c400027971c9b313ca3ca8284d9a3 to your computer and use it in GitHub Desktop.

Solving Planning Problems with Fast Downward and Haskell

In this post I'll demonstrate my new fast-downward library to solve planning problems. The name "Fast Downward" comes from the backend solver - Fast Downward. But what's a planning problem?

Roughly speaking, planning problems are a subclass of AI problems where we have:

  • A known starting state - information about the world we know to be true right now.
  • A set of possible effects - deterministic ways we can change the world.
  • A goal state that we wish to reach.
  • A solution to a planning problem is a plan - a totally ordered sequence of steps that converge the starting state into the goal state.

Planning problems are essentially state space search problems, and crop up in all sorts of places. The common examples are that of moving a robot around, planning logistics problems, and so on, but they can be used for plenty more! For example, the Beam library uses state space search to work out how to converge a database from one state to another (automatic migrations) by adding/removing columns.

State space search is an intuitive approach, but naive enumeration of all states rapidly grinds to a halt. Forming optimal plans (least cost, least steps, etc) is an extremely difficult problem, and there is a lot of literature on the topic (see ICAPS - the International Conference on Automated Planning and Scheduling and recent International Planning Competitions for an idea of the state of the art). The fast-downward library uses the state of the art Fast Downward solver and provides a small DSL to interface to it with Haskell.

In this post, we'll look at fast-downward in the context of solving a small planning problem - moving balls between rooms via a robot. This post is literate Haskell, here's the context we'll be working in:

{-# language DisambiguateRecordFields #-}

module FastDownward.Examples.Gripper where

import Control.Monad
import qualified FastDownward.Exec as Exec
import FastDownward.Problem

Modelling The Problem

As mentioned, in this example, we'll consider the problem of transporting balls between rooms via a robot. The robot has two grippers and can move between rooms. Each gripper can hold zero or one balls. Our initial state is that everything is in room A, and our goal is to move all balls to room B.

First, we'll introduce some domain specific types and functions to help model the problem. The fast-downwadr DSL can work with any type that is an instance of Ord.

data Room = RoomA | RoomB
  deriving (Eq, Ord, Show)

adjacent :: Room -> Room
adjacent RoomA = RoomB
adjacent RoomB = RoomA

data BallLocation = InRoom Room | InGripper
  deriving (Eq, Ord, Show)

data GripperState = Empty | HoldingBall
  deriving (Eq, Ord, Show)

A ball in our model is modelled by its current location.

type Ball = Var BallLocation

A gripper in our model is modelled by its state - whether or not it's holding a ball.

type Gripper = Var GripperState

Finally, we'll introduce a type of all possible actions that can be taken:

data Action = PickUpBall | SwitchRooms | DropBall
  deriving (Show)

With this, we can now begin modelling the specific instance of the problem. We do this by working in the Problem monad, which lets us introduce variables (Vars).

problem :: Problem (Maybe [Action])
problem = do

First, we introduce a state variable for each of the 4 balls. As in the problem description, all balls are initially in room A.

  balls <- replicateM 4 (newVar (InRoom RoomA))

Next, introduce a variable for the room the robot is in - which also begins in room A.

  robotLocation <- newVar RoomA

We also introduce variables to track the state of each gripper.

  grippers <- replicateM 2 (newVar Empty)

This is sufficient to model our problem. Next, we'll define some effects to change the state of the world.

Defining Effects

Effects are actions in the Effect monad - a monad that allows us to read and write to variables, and also fail (via MonadPlus). We could define these effects as top-level definitions (which might be better if we were writing a library), but here I'll just define them inline so they can easily access the above state variables.

Effects may be used at any time by the solver. Indeed, that's what solving planning problems is all about! The hard part is choosing effects intelligently, rather than blindly trying everything. Fortunately, you don't need to worry about that - Fast Downward will take care of that for you!

  let

Picking Up Balls

The first effect takes a ball and a gripper, and attemps to pick up that ball with that gripper.

    pickUpBallWithGrippper :: Ball -> Gripper -> Effect Action
    pickUpBallWithGrippper b gripper = do

First we check that the gripper is empty. This can be done conscisely by using an incomplete pattern match. do notation desugars incomplete pattern matches to a call to fail, which in the Effect monad simply means "this effect can't currently be used".

      Empty <- readVar gripper

Next, we check where the ball and robot are, and make sure they are both in the same room.

      robotRoom <- readVar robotLocation
      ballLocation <- readVar b
      guard (ballLocation == InRoom robotRoom)

Here we couldn't choose a particular pattern to match on, because picking up a ball should be possible in either room. Instead, we simply observe the location of both the ball and the robot, and use an equality test to make sure they match.

If we got this far then we can pick up the ball. The act of picking up the ball is to say that the ball is now in a gripper, and that the gripper is now holding a ball.

      writeVar b InGripper
      writeVar gripper HoldingBall

Finally, we return some domain specific information to use if the solver chooses this effect. This has no impact on the final plan, it's simply information we can use to execute the plan.

      return PickUpBall

Moving Between Rooms

This effect moves the robot to the room adjacent to its current location.

    moveRobotToAdjacentRoom :: Effect Action
    moveRobotToAdjacentRoom = do

This is an "unconditional" effect as we don't have any explicit guards or pattern matches. We simply flip the current location by an adjacency function.

      modifyVar robotLocation adjacent

Again, we return some information to use when this effect is chosen.

      return SwitchRooms

Dropping Balls

Finally, we have an effect to drop a ball from a gripper.

    dropBall :: Ball -> Gripper -> Effect Action
    dropBall b gripper = do

First we check that the given gripper is holding a ball, and the given ball is in a gripper.

      HoldingBall <- readVar gripper
      InGripper <- readVar b

If we got here then those assumptions hold. We'll update the location of the ball to be the location of the robot, so first read out the robot's location.

      robotRoom <- readVar robotLocation

Empty the gripper.

      writeVar gripper Empty

Move the ball.

      writeVar b (InRoom robotRoom)

And we're done! We'll just return a tag to indicate that this effect was chosen:

      return DropBall

Solving Problems

With our problem modelled, we can now attempt to solve it. We invoke 'solve' with a particular search engine (in this case A* with landmark counting heuristics). We give the solver two bits of information:

  1. A list of all effects - all possible actions the solver can use. These are precisely the effects we defined above, but instantiated for all balls and grippers.
  2. A goal state. Here we're using a list comprehension which enumerates all balls, adding the condition that the ball location must be InRoom RoomB.
  solve
    cfg
    ( [ pickUpBallWithGrippper b g | b <- balls, g <- grippers ]
        ++ [ dropBall b g | b <- balls, g <- grippers ]
        ++ [ moveRobotToAdjacentRoom ]
    )
    [ b ?= InRoom RoomB | b <- balls ]

So far we've been working in the Problem monad. We can escape this monad by using runProblem :: Problem a -> IO a. In our case, a is Maybe [Action], so running the problem might give us a plan (courtesy of solve). If it did, we'll print the plan.

main :: IO ()
main = do
  plan <- runProblem problem
  case plan of
    Nothing ->
      putStrLn "Couldn't find a plan!"

    Just steps -> do
      putStrLn "Found a plan!"
      zipWithM_ (\i step -> putStrLn $ show i ++ ": " ++ show step) [1::Int ..] steps

Well, Did it Work?!

All that's left is to run the problem!

> main
Found a plan!
1: PickUpBall
2: PickUpBall
3: SwitchRooms
4: DropBall
5: DropBall
6: SwitchRooms
7: PickUpBall
8: PickUpBall
9: SwitchRooms
10: DropBall
11: DropBall

Woohoo! Not bad for 0.02 secs, too :)

Appendix: Search Configuration

cfg :: Exec.SearchEngine
cfg =
  Exec.AStar Exec.AStarConfiguration
    { evaluator =
        Exec.LMCount Exec.LMCountConfiguration
          { lmFactory =
              Exec.LMExhaust Exec.LMExhaustConfiguration
                { reasonableOrders = False
                , onlyCausalLandmarks = False
                , disjunctiveLandmarks = True
                , conjunctiveLandmarks = True
                , noOrders = False
                }
          , admissible = False
          , optimal = False
          , pref = True
          , alm = True
          , lpSolver = Exec.CPLEX
          , transform = Exec.NoTransform
          , cacheEstimates = True
          }
    , lazyEvaluator = Nothing
    , pruning = Exec.Null
    , costType = Exec.Normal
    , bound = Nothing
    , maxTime = Nothing
    }

Appendix: Code Without Comments

Here is the complete example, as a single Haskell block:

{-# language DisambiguateRecordFields #-}

module FastDownward.Examples.Gripper where

import Control.Monad
import qualified FastDownward.Exec as Exec
import FastDownward.Problem


data Room = RoomA | RoomB
  deriving (Eq, Ord, Show)


adjacent :: Room -> Room
adjacent RoomA = RoomB
adjacent RoomB = RoomA


data BallLocation = InRoom Room | InGripper
  deriving (Eq, Ord, Show)


data GripperState = Empty | HoldingBall
  deriving (Eq, Ord, Show)


type Ball = Var BallLocation


type Gripper = Var GripperState

  
data Action = PickUpBall | SwitchRooms | DropBall
  deriving (Show)


problem :: Problem (Maybe [Action])
problem = do
  balls <- replicateM 4 (newVar (InRoom RoomA))
  robotLocation <- newVar RoomA
  grippers <- replicateM 2 (newVar Empty)

  let
    pickUpBallWithGrippper :: Ball -> Gripper -> Effect Action
    pickUpBallWithGrippper b gripper = do
      Empty <- readVar gripper
  
      robotRoom <- readVar robotLocation
      ballLocation <- readVar b
      guard (ballLocation == InRoom robotRoom)
  
      writeVar b InGripper
      writeVar gripper HoldingBall
  
      return PickUpBall


    moveRobotToAdjacentRoom :: Effect Action
    moveRobotToAdjacentRoom = do
      modifyVar robotLocation adjacent
      return SwitchRooms


    dropBall :: Ball -> Gripper -> Effect Action
    dropBall b gripper = do
      HoldingBall <- readVar gripper
      InGripper <- readVar b
  
      robotRoom <- readVar robotLocation
      writeVar b (InRoom robotRoom)
  
      writeVar gripper Empty
  
      return DropBall

  
  solve
    cfg
    ( [ pickUpBallWithGrippper b g | b <- balls, g <- grippers ]
        ++ [ dropBall b g | b <- balls, g <- grippers ]
        ++ [ moveRobotToAdjacentRoom ]
    )
    [ b ?= InRoom RoomB | b <- balls ]

  
main :: IO ()
main = do
  plan <- runProblem problem
  case plan of
    Nothing ->
      putStrLn "Couldn't find a plan!"

    Just steps -> do
      putStrLn "Found a plan!"
      zipWithM_ (\i step -> putStrLn $ show i ++ ": " ++ show step) [1::Int ..] steps


cfg :: Exec.SearchEngine
cfg =
  Exec.AStar Exec.AStarConfiguration
    { evaluator =
        Exec.LMCount Exec.LMCountConfiguration
          { lmFactory =
              Exec.LMExhaust Exec.LMExhaustConfiguration
                { reasonableOrders = False
                , onlyCausalLandmarks = False
                , disjunctiveLandmarks = True
                , conjunctiveLandmarks = True
                , noOrders = False
                }
          , admissible = False
          , optimal = False
          , pref = True
          , alm = True
          , lpSolver = Exec.CPLEX
          , transform = Exec.NoTransform
          , cacheEstimates = True
          }
    , lazyEvaluator = Nothing
    , pruning = Exec.Null
    , costType = Exec.Normal
    , bound = Nothing
    , maxTime = Nothing
    }
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment