{-# language DisambiguateRecordFields #-}
module FastDownward.Examples.Gripper where
import Control.Monad
import qualified FastDownward.Exec as Exec
import FastDownward
data Room = RoomA | RoomB
deriving (Room -> Room -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Room -> Room -> Bool
$c/= :: Room -> Room -> Bool
== :: Room -> Room -> Bool
$c== :: Room -> Room -> Bool
Eq, Eq Room
Room -> Room -> Bool
Room -> Room -> Ordering
Room -> Room -> Room
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Room -> Room -> Room
$cmin :: Room -> Room -> Room
max :: Room -> Room -> Room
$cmax :: Room -> Room -> Room
>= :: Room -> Room -> Bool
$c>= :: Room -> Room -> Bool
> :: Room -> Room -> Bool
$c> :: Room -> Room -> Bool
<= :: Room -> Room -> Bool
$c<= :: Room -> Room -> Bool
< :: Room -> Room -> Bool
$c< :: Room -> Room -> Bool
compare :: Room -> Room -> Ordering
$ccompare :: Room -> Room -> Ordering
Ord, Int -> Room -> ShowS
[Room] -> ShowS
Room -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Room] -> ShowS
$cshowList :: [Room] -> ShowS
show :: Room -> String
$cshow :: Room -> String
showsPrec :: Int -> Room -> ShowS
$cshowsPrec :: Int -> Room -> ShowS
Show)
adjacent :: Room -> Room
adjacent :: Room -> Room
adjacent Room
RoomA = Room
RoomB
adjacent Room
RoomB = Room
RoomA
data BallLocation = InRoom Room | InGripper
deriving (BallLocation -> BallLocation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BallLocation -> BallLocation -> Bool
$c/= :: BallLocation -> BallLocation -> Bool
== :: BallLocation -> BallLocation -> Bool
$c== :: BallLocation -> BallLocation -> Bool
Eq, Eq BallLocation
BallLocation -> BallLocation -> Bool
BallLocation -> BallLocation -> Ordering
BallLocation -> BallLocation -> BallLocation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BallLocation -> BallLocation -> BallLocation
$cmin :: BallLocation -> BallLocation -> BallLocation
max :: BallLocation -> BallLocation -> BallLocation
$cmax :: BallLocation -> BallLocation -> BallLocation
>= :: BallLocation -> BallLocation -> Bool
$c>= :: BallLocation -> BallLocation -> Bool
> :: BallLocation -> BallLocation -> Bool
$c> :: BallLocation -> BallLocation -> Bool
<= :: BallLocation -> BallLocation -> Bool
$c<= :: BallLocation -> BallLocation -> Bool
< :: BallLocation -> BallLocation -> Bool
$c< :: BallLocation -> BallLocation -> Bool
compare :: BallLocation -> BallLocation -> Ordering
$ccompare :: BallLocation -> BallLocation -> Ordering
Ord, Int -> BallLocation -> ShowS
[BallLocation] -> ShowS
BallLocation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BallLocation] -> ShowS
$cshowList :: [BallLocation] -> ShowS
show :: BallLocation -> String
$cshow :: BallLocation -> String
showsPrec :: Int -> BallLocation -> ShowS
$cshowsPrec :: Int -> BallLocation -> ShowS
Show)
data GripperState = Empty | HoldingBall
deriving (GripperState -> GripperState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GripperState -> GripperState -> Bool
$c/= :: GripperState -> GripperState -> Bool
== :: GripperState -> GripperState -> Bool
$c== :: GripperState -> GripperState -> Bool
Eq, Eq GripperState
GripperState -> GripperState -> Bool
GripperState -> GripperState -> Ordering
GripperState -> GripperState -> GripperState
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GripperState -> GripperState -> GripperState
$cmin :: GripperState -> GripperState -> GripperState
max :: GripperState -> GripperState -> GripperState
$cmax :: GripperState -> GripperState -> GripperState
>= :: GripperState -> GripperState -> Bool
$c>= :: GripperState -> GripperState -> Bool
> :: GripperState -> GripperState -> Bool
$c> :: GripperState -> GripperState -> Bool
<= :: GripperState -> GripperState -> Bool
$c<= :: GripperState -> GripperState -> Bool
< :: GripperState -> GripperState -> Bool
$c< :: GripperState -> GripperState -> Bool
compare :: GripperState -> GripperState -> Ordering
$ccompare :: GripperState -> GripperState -> Ordering
Ord, Int -> GripperState -> ShowS
[GripperState] -> ShowS
GripperState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GripperState] -> ShowS
$cshowList :: [GripperState] -> ShowS
show :: GripperState -> String
$cshow :: GripperState -> String
showsPrec :: Int -> GripperState -> ShowS
$cshowsPrec :: Int -> GripperState -> ShowS
Show)
type Ball = Var BallLocation
type Gripper = Var GripperState
data Action = PickUpBall | SwitchRooms | DropBall
deriving (Int -> Action -> ShowS
[Action] -> ShowS
Action -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Action] -> ShowS
$cshowList :: [Action] -> ShowS
show :: Action -> String
$cshow :: Action -> String
showsPrec :: Int -> Action -> ShowS
$cshowsPrec :: Int -> Action -> ShowS
Show)
problem :: Problem (SolveResult Action)
problem :: Problem (SolveResult Action)
problem = do
[Var BallLocation]
balls <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
4 (forall a. Ord a => a -> Problem (Var a)
newVar (Room -> BallLocation
InRoom Room
RoomA))
Var Room
robotLocation <- forall a. Ord a => a -> Problem (Var a)
newVar Room
RoomA
[Var GripperState]
grippers <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 (forall a. Ord a => a -> Problem (Var a)
newVar GripperState
Empty)
let
pickUpBallWithGrippper :: Ball -> Gripper -> Effect Action
pickUpBallWithGrippper :: Var BallLocation -> Var GripperState -> Effect Action
pickUpBallWithGrippper Var BallLocation
b Var GripperState
gripper = do
GripperState
Empty <- forall a. Ord a => Var a -> Effect a
readVar Var GripperState
gripper
Room
robotRoom <- forall a. Ord a => Var a -> Effect a
readVar Var Room
robotLocation
BallLocation
ballLocation <- forall a. Ord a => Var a -> Effect a
readVar Var BallLocation
b
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (BallLocation
ballLocation forall a. Eq a => a -> a -> Bool
== Room -> BallLocation
InRoom Room
robotRoom)
forall a. Ord a => Var a -> a -> Effect ()
writeVar Var BallLocation
b BallLocation
InGripper
forall a. Ord a => Var a -> a -> Effect ()
writeVar Var GripperState
gripper GripperState
HoldingBall
forall (m :: * -> *) a. Monad m => a -> m a
return Action
PickUpBall
moveRobotToAdjacentRoom :: Effect Action
moveRobotToAdjacentRoom :: Effect Action
moveRobotToAdjacentRoom = do
forall a. Ord a => Var a -> (a -> a) -> Effect ()
modifyVar Var Room
robotLocation Room -> Room
adjacent
forall (m :: * -> *) a. Monad m => a -> m a
return Action
SwitchRooms
dropBall :: Ball -> Gripper -> Effect Action
dropBall :: Var BallLocation -> Var GripperState -> Effect Action
dropBall Var BallLocation
b Var GripperState
gripper = do
GripperState
HoldingBall <- forall a. Ord a => Var a -> Effect a
readVar Var GripperState
gripper
BallLocation
InGripper <- forall a. Ord a => Var a -> Effect a
readVar Var BallLocation
b
Room
robotRoom <- forall a. Ord a => Var a -> Effect a
readVar Var Room
robotLocation
forall a. Ord a => Var a -> a -> Effect ()
writeVar Var BallLocation
b (Room -> BallLocation
InRoom Room
robotRoom)
forall a. Ord a => Var a -> a -> Effect ()
writeVar Var GripperState
gripper GripperState
Empty
forall (m :: * -> *) a. Monad m => a -> m a
return Action
DropBall
forall a.
Show a =>
SearchConfiguration
-> [Effect a] -> [Test] -> Problem (SolveResult a)
solve
SearchConfiguration
Exec.bjolp
( [ Var BallLocation -> Var GripperState -> Effect Action
pickUpBallWithGrippper Var BallLocation
b Var GripperState
g | Var BallLocation
b <- [Var BallLocation]
balls, Var GripperState
g <- [Var GripperState]
grippers ]
forall a. [a] -> [a] -> [a]
++ [ Var BallLocation -> Var GripperState -> Effect Action
dropBall Var BallLocation
b Var GripperState
g | Var BallLocation
b <- [Var BallLocation]
balls, Var GripperState
g <- [Var GripperState]
grippers ]
forall a. [a] -> [a] -> [a]
++ [ Effect Action
moveRobotToAdjacentRoom ]
)
[ Var BallLocation
b forall a. Ord a => Var a -> a -> Test
?= Room -> BallLocation
InRoom Room
RoomB | Var BallLocation
b <- [Var BallLocation]
balls ]
main :: IO ()
main :: IO ()
main = do
SolveResult Action
res <- forall (m :: * -> *) a. MonadIO m => Problem a -> m a
runProblem Problem (SolveResult Action)
problem
case SolveResult Action
res of
Solved Solution Action
plan -> do
String -> IO ()
putStrLn String
"Found a plan!"
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_
( \Int
i Action
step -> String -> IO ()
putStrLn ( forall a. Show a => a -> String
show Int
i forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Action
step ) )
[ Int
1::Int .. ]
( forall a. Solution a -> [a]
totallyOrderedPlan Solution Action
plan )
SolveResult Action
_ ->
String -> IO ()
putStrLn String
"Couldn't find a plan!"