├── .gitignore ├── Changelog.md ├── FastDownward.hs ├── FastDownward ├── Examples │ └── Gripper.hs ├── Exec.hs ├── SAS.hs └── SAS │ ├── Axiom.hs │ ├── DomainIndex.hs │ ├── Effect.hs │ ├── Goal.hs │ ├── MutexGroup.hs │ ├── Operator.hs │ ├── Plan.hs │ ├── State.hs │ ├── UseCosts.hs │ ├── Variable.hs │ ├── VariableAssignment.hs │ ├── VariableIndex.hs │ └── Version.hs ├── LICENSE ├── README.md └── fast-downward.cabal /.gitignore: -------------------------------------------------------------------------------- 1 | *.hi 2 | *.o 3 | dist/ 4 | *.hp 5 | dist-newstyle/ 6 | -------------------------------------------------------------------------------- /Changelog.md: -------------------------------------------------------------------------------- 1 | # 0.2.3.0 -- 2023-05-11 2 | 3 | * Support GHC 9.2 and 9.4 4 | * Support `text-2.0` 5 | 6 | # 0.2.2.0 -- 2022-03-21 7 | 8 | * Support GHC 9.0 9 | 10 | # 0.2.1.0 -- 2020-06-18 11 | 12 | * Support GHC 8.10 13 | 14 | # 0.2.0.0 -- 2019-11-29 15 | 16 | * Support GHC 8.8 17 | * Improve FastDownward.Exec to support predefining evaluators 18 | * Added FastDownward.Exec.bjqlp, which is a good starting point for configuring 19 | Fast Downward. 20 | * Add FastDownward.requiresAxioms, to see if a Test requires a search engine 21 | with axiom support. 22 | * Rewrite the `Effect` type to be considerably faster. The new implementation 23 | uses continuations to minimally compute the set of all concrete effects. 24 | * Enforce `writeVar v >=> readVar v === return` 25 | 26 | # 0.1.1.0 -- 2019-01-09 27 | 28 | * Support `containers-0.6`. 29 | * Added `instance MonadFail Effect` 30 | * Bumped `base` upper bound to `< 4.13` 31 | * Bumped `list-t` lower bound to `>= 1.0.2` (this is necessary for internal 32 | reasons related to generalised newtype deriving) 33 | 34 | # 0.1.0.1 -- 2019-01-02 35 | 36 | * Removed a stray `putStrLn`. 37 | 38 | # 0.1.0.0 39 | 40 | * Initial release! 41 | -------------------------------------------------------------------------------- /FastDownward.hs: -------------------------------------------------------------------------------- 1 | {-# language DeriveFunctor #-} 2 | {-# language FlexibleContexts #-} 3 | {-# language GADTs #-} 4 | {-# language GeneralizedNewtypeDeriving #-} 5 | {-# language LambdaCase #-} 6 | {-# language NamedFieldPuns #-} 7 | {-# language OverloadedStrings #-} 8 | {-# language RecordWildCards #-} 9 | 10 | {-| This module exposes a small DSL for building and solving planning problems 11 | using - an open source solver for 12 | . 13 | 14 | Using this module, you model problems with a finite-domain representation 15 | through state variables (see, 'Var', 'newVar'), and model their changes through 16 | 'Effect's (see 'readVar', and 'writeVar'). If you're familiar with software 17 | transactional memory, an effect is like a transaction, except the process of 18 | solving will choose the appropriate sequence for you. 19 | -} 20 | 21 | module FastDownward 22 | ( -- * Defining Problems 23 | Problem 24 | 25 | -- ** @Var@iables 26 | , Var 27 | , newVar 28 | , readVar 29 | , writeVar 30 | , modifyVar 31 | , resetInitial 32 | 33 | -- ** @Effect@s 34 | , Effect 35 | 36 | -- ** @Test@s 37 | , Test 38 | , (?=) 39 | , FastDownward.any 40 | , requiresAxioms 41 | 42 | -- * Solving Problems 43 | , solve 44 | , SolveResult(..) 45 | , Solution 46 | , runProblem 47 | 48 | -- ** Extracting Plans 49 | , totallyOrderedPlan 50 | , partiallyOrderedPlan 51 | ) 52 | where 53 | 54 | import Control.Applicative ( Alternative(..) ) 55 | import qualified Control.Monad.Fail 56 | import Control.Monad.IO.Class ( MonadIO, liftIO ) 57 | import Control.Monad.State.Class ( get, gets, modify ) 58 | import Control.Monad.Trans.Cont 59 | import Control.Monad.Trans.Reader ( ReaderT(..), runReaderT ) 60 | import Control.Monad.Trans.State.Lazy ( StateT, evalStateT ) 61 | import Data.Coerce ( coerce ) 62 | import qualified Data.Foldable 63 | import qualified Data.Graph 64 | import Data.IORef 65 | import Data.IntMap.Lazy ( IntMap ) 66 | import qualified Data.IntMap.Lazy as IntMap 67 | import Data.List ( inits, intersect ) 68 | import Data.Map.Lazy ( Map ) 69 | import qualified Data.Map.Lazy as Map 70 | import Data.Maybe ( mapMaybe ) 71 | import Data.Sequence ( Seq ) 72 | import qualified Data.Sequence as Seq 73 | import Data.String ( fromString ) 74 | import qualified Data.Text.Lazy 75 | import qualified Data.Text.Lazy.IO 76 | import Data.Traversable ( for ) 77 | import qualified FastDownward.Exec as Exec 78 | import qualified FastDownward.SAS 79 | import qualified FastDownward.SAS.Axiom 80 | import qualified FastDownward.SAS.Effect 81 | import qualified FastDownward.SAS.Operator 82 | import qualified FastDownward.SAS.Plan 83 | import qualified FastDownward.SAS.Variable 84 | import Prelude hiding ( reads ) 85 | import System.Exit 86 | import System.IO.Temp 87 | 88 | 89 | -- | A @Var@ is a state variable - a variable who's contents may change over 90 | -- the execution of a plan. 'Effect's can read and write from variables in 91 | -- order to change their state. 92 | data Var a = 93 | Var 94 | { variableIndex :: {-# UNPACK #-} !FastDownward.SAS.VariableIndex 95 | -- ^ The SAS variable index of this variable. 96 | , values :: {-# UNPACK #-} !( IORef ( Map a ( Committed, FastDownward.SAS.DomainIndex ) ) ) 97 | -- ^ Map Haskell values to the index in the domain in the SAS 98 | -- representation. 99 | , subscribed :: {-# UNPACK #-} !( IORef ( a -> FastDownward.SAS.DomainIndex -> IO () ) ) 100 | , fromDomainIndex :: {-# UNPACK #-} !( IORef ( Map FastDownward.SAS.DomainIndex a ) ) 101 | -- ^ Map back from a domain index to the Haskell value. 102 | } 103 | 104 | 105 | data Committed = 106 | Committed | Uncommitted 107 | 108 | 109 | -- | The @Problem@ monad is used to build a computation that describes a 110 | -- particular planning problem. In this monad you can declare state variables 111 | -- - 'Var's - using 'newVar', and you can solve planning problems using 'solve'. 112 | newtype Problem a = 113 | Problem { unProblem :: StateT ProblemState IO a } 114 | deriving 115 | ( Functor, Applicative, Monad, MonadIO ) 116 | 117 | 118 | -- | Information needed to translate a 'Var' into its SAS equivalance. 119 | data VariableDeclaration = 120 | VariableDeclaration 121 | { initial :: {-# UNPACK #-} !FastDownward.SAS.DomainIndex 122 | -- ^ The index of the initial (starting) value. 123 | , _enumerateDomain :: IO [ FastDownward.SAS.DomainIndex ] 124 | -- ^ List all values this variable can take. 125 | , _axiomLayer :: {-# UNPACK #-} !Int 126 | -- ^ The axiom layer of this variable. Most variables live at -1, derived 127 | -- variables at higher layers. 128 | } 129 | 130 | 131 | -- | The state used to translate a 'Problem' its SAS equivalance. 132 | data ProblemState = 133 | ProblemState 134 | { initialState :: !( Map FastDownward.SAS.VariableIndex VariableDeclaration ) 135 | -- ^ A table of variables, indexed by their apperance in the SAS variable 136 | -- list. 137 | , axioms :: !( Seq FastDownward.SAS.Axiom ) 138 | -- ^ A list of derived axioms. 139 | } 140 | 141 | 142 | -- | Observe that a 'Var' can take a particular value. 143 | observeValue :: ( Ord a, MonadIO m ) => Var a -> a -> m FastDownward.SAS.DomainIndex 144 | observeValue var a = liftIO $ do 145 | vs <- 146 | readIORef ( values var ) 147 | 148 | case Map.lookup a vs of 149 | Just ( _, i ) -> 150 | return i 151 | 152 | Nothing -> do 153 | let 154 | i = 155 | FastDownward.SAS.DomainIndex ( fromIntegral ( Map.size vs ) ) 156 | 157 | modifyIORef ( fromDomainIndex var ) ( Map.insert i a ) 158 | 159 | i <$ modifyIORef ( values var ) ( Map.insert a ( Uncommitted, i ) ) 160 | 161 | 162 | commit :: ( Ord a, MonadIO m ) => Var a -> a -> m () 163 | commit var a = liftIO $ do 164 | modifyIORef ( values var ) ( Map.adjust ( \( _, x ) -> ( Committed, x ) ) a ) 165 | 166 | 167 | -- | Introduce a new state variable into a problem, and set it to an initial 168 | -- starting value. 169 | newVar :: Ord a => a -> Problem ( Var a ) 170 | newVar = 171 | newVarAt (-1) 172 | 173 | 174 | -- | Introduce a new state variable into a problem at a particular axiom layer. 175 | newVarAt :: Ord a => Int -> a -> Problem ( Var a ) 176 | newVarAt axiomLayer initialValue = do 177 | -- Allocate the domain IORef 178 | values <- 179 | liftIO ( newIORef mempty ) 180 | 181 | -- Lookup an unused index for this variable. 182 | variableIndex <- 183 | freshIndex 184 | 185 | subscribed <- 186 | liftIO ( newIORef ( \_ _ -> return () ) ) 187 | 188 | fromDomainIndex <- 189 | liftIO ( newIORef mempty ) 190 | 191 | let 192 | enumerate = 193 | map snd . Map.elems <$> liftIO ( readIORef values ) 194 | 195 | var = 196 | Var{..} 197 | 198 | -- Observe the initial value... 199 | initialI <- 200 | observeValue var initialValue 201 | 202 | commit var initialValue 203 | 204 | -- ... and record it in the ProblemState. 205 | Problem 206 | ( modify 207 | ( \ps -> 208 | ps 209 | { initialState = 210 | Map.insert 211 | variableIndex 212 | ( VariableDeclaration initialI enumerate axiomLayer ) 213 | ( initialState ps ) 214 | } 215 | ) 216 | ) 217 | 218 | return var 219 | 220 | 221 | -- | Lookup the next unused variable index. 222 | freshIndex :: Problem FastDownward.SAS.VariableIndex 223 | freshIndex = 224 | FastDownward.SAS.VariableIndex <$> Problem ( gets ( fromIntegral . Map.size . initialState ) ) 225 | 226 | 227 | -- | Write a value into 'Var'. If the solver choses to use this particular 228 | -- 'Effect', then the @Var@ will begin take this new value. 229 | writeVar :: Ord a => Var a -> a -> Effect () 230 | writeVar var a = Effect $ do 231 | -- Writing a variable is fairly simple. First, we check what values the 232 | -- variable has already taken. If the value we're writing is in that set, then 233 | -- there's not much to do - we've already considered this assignment. 234 | -- 235 | -- If the value is new, we record that this write invalidated a Var, which 236 | -- will cause exhaustEffects to run again. 237 | edomainIndex <- liftIO $ do 238 | currentValues <- 239 | readIORef ( values var ) 240 | 241 | case Map.lookup a currentValues of 242 | Just ( Committed, domainIndex ) -> 243 | return ( Right domainIndex ) 244 | 245 | Just ( Uncommitted, domainIndex ) -> 246 | return ( Left domainIndex ) 247 | 248 | Nothing -> do 249 | -- We've never seen this value before, first observe it to obtain 250 | -- its domain index. 251 | Left <$> observeValue var a 252 | 253 | ContT $ \k -> ReaderT $ \es -> do 254 | es' <- 255 | case edomainIndex of 256 | Left domainIndex -> do 257 | -- We just discovered a new value, so we'll broadcast this. 258 | laterRef <- 259 | newIORef $ do 260 | currentValues <- 261 | readIORef ( values var ) 262 | 263 | case Map.lookup a currentValues of 264 | Just ( Committed, _ ) -> 265 | return () 266 | 267 | _ -> do 268 | commit var a 269 | 270 | notify <- 271 | readIORef ( subscribed var ) 272 | 273 | notify a domainIndex 274 | 275 | return 276 | es 277 | { writes = 278 | IntMap.insert ( coerce ( variableIndex var ) ) domainIndex ( writes es ) 279 | , onCommit = do 280 | action <- 281 | readIORef laterRef 282 | 283 | writeIORef laterRef ( return () ) 284 | >> action 285 | >> onCommit es 286 | } 287 | 288 | Right domainIndex -> 289 | -- This is not a new value, so just record it and continue. 290 | return 291 | es 292 | { writes = 293 | IntMap.insert ( coerce ( variableIndex var ) ) domainIndex ( writes es ) 294 | } 295 | 296 | runReaderT ( k () ) es' 297 | 298 | 299 | -- | Read the value of a 'Var' at the point the 'Effect' is invoked by the 300 | -- solver. 301 | readVar :: Ord a => Var a -> Effect a 302 | readVar var = Effect $ ContT $ \k -> ReaderT $ \es -> do 303 | -- To "read" a variable is actually to read *all* of its values 304 | -- non-deterministically. The first time the Var v1 is read, we enumerate it 305 | -- and run the continuation with all values. However, in this continuation a 306 | -- subsquent read from v1 should be stable - that is, deterministic. This 307 | -- is done by consulting the 'reads' map of prior reads first. 308 | -- Furthermore, if this variable has been written too, we re-read the last 309 | -- write. 310 | let 311 | mPrevRead = 312 | IntMap.lookup ( coerce ( variableIndex var ) ) ( reads es ) 313 | 314 | mPrevWrite = 315 | IntMap.lookup ( coerce ( variableIndex var ) ) ( writes es ) 316 | 317 | case ( mPrevWrite, mPrevRead ) of 318 | ( Just prevWriteIndex, _ ) -> do 319 | -- We've written this variable, so continue with what we last wrote. 320 | prevWrite <- 321 | ( Map.! prevWriteIndex ) <$> readIORef ( fromDomainIndex var ) 322 | 323 | runReaderT ( k prevWrite ) es 324 | 325 | ( Nothing, Just prevReadIndex ) -> do 326 | -- We've seen this variable before, so just continue with it. 327 | prevRead <- 328 | ( Map.! prevReadIndex ) <$> readIORef ( fromDomainIndex var ) 329 | 330 | runReaderT ( k prevRead ) es 331 | 332 | ( Nothing, Nothing ) -> do 333 | -- We have never seen this variable before. 334 | let 335 | runRecordingRead a domainIndex = 336 | let 337 | es' = 338 | es 339 | { reads = 340 | IntMap.insert ( coerce ( variableIndex var ) ) domainIndex ( reads es ) 341 | } 342 | 343 | in runReaderT ( k a ) es' 344 | 345 | currentValues <- 346 | readIORef ( values var ) 347 | 348 | -- First, subscribe to any new writes. This has to be done first because 349 | -- yielding known values could immediately cause a write to happen 350 | -- (e.g., in the case of using modifyVar = readVar v >>= writeVar . f). 351 | modifyIORef 352 | ( subscribed var ) 353 | ( \io x y -> runRecordingRead x y >> io x y ) 354 | 355 | -- Now enumerate all known reads. 356 | Map.foldMapWithKey 357 | ( \a ( committed, domainIndex ) -> 358 | case committed of 359 | Committed -> 360 | runRecordingRead a domainIndex 361 | 362 | _ -> 363 | return () 364 | ) 365 | currentValues 366 | 367 | 368 | -- | Modify the contents of a 'Var' by using a function. 369 | -- 370 | -- @modifyVar v f = readVar v >>= writeVar v . f@ 371 | modifyVar :: Ord a => Var a -> ( a -> a ) -> Effect () 372 | modifyVar v f = 373 | readVar v >>= writeVar v . f 374 | 375 | 376 | -- | An 'Effect' is a transition in a planning problem - a point where variables 377 | -- can be inspected for their current values, and where they can take on new 378 | -- values. For example, there might be an @Effect@ to instruct the robot to 379 | -- move to a particular target location, if its current location is adjacent. 380 | -- 381 | -- The @Effect@ monad supports failure, so you can 'guard' an @Effect@ to only 382 | -- be applicable under particular circumstances. Continuing the above example, 383 | -- we loosely mentioned the constraint that the robot must be adjacent to a 384 | -- target location - something that could be modelled by using 'readVar' to 385 | -- read the current location, and 'guard' to guard that this location is 386 | -- adjacent to our goal. 387 | newtype Effect a = 388 | Effect { runEffect :: ContT () ( ReaderT EffectState IO ) a } 389 | deriving 390 | ( Functor, Applicative ) 391 | 392 | 393 | instance Monad Effect where 394 | return a = 395 | Effect ( return a ) 396 | {-# INLINE return #-} 397 | 398 | Effect a >>= f = Effect $ 399 | a >>= runEffect . f 400 | {-# INLINE (>>=) #-} 401 | 402 | 403 | instance Control.Monad.Fail.MonadFail Effect where 404 | fail _ = 405 | empty 406 | {-# INLINE fail #-} 407 | 408 | 409 | instance Alternative Effect where 410 | empty = 411 | Effect ( ContT ( \_k -> return () ) ) 412 | {-# INLINE empty #-} 413 | 414 | Effect a <|> Effect b = 415 | Effect $ ContT $ \k -> 416 | runContT a k <|> runContT b k 417 | {-# INLINE (<|>) #-} 418 | 419 | 420 | -- | Used to track the evaluation of an 'Effect' as we enumerate all possible 421 | -- outcomes. 422 | data EffectState = 423 | EffectState 424 | { reads :: IntMap FastDownward.SAS.DomainIndex 425 | -- ^ The variables and their exact values read to reach a certain outcome. 426 | , writes :: IntMap FastDownward.SAS.DomainIndex 427 | -- ^ The changes made by this instance. 428 | , onCommit :: IO () 429 | } 430 | 431 | 432 | -- | The result from the solver on a call to 'solve'. 433 | data SolveResult a 434 | = Unsolvable 435 | -- ^ The problem was proven to be unsolvable. 436 | | UnsolvableIncomplete 437 | -- ^ The problem was determined to be unsolvable, but the entire search 438 | -- space was not explored. 439 | | OutOfMemory 440 | -- ^ The @downward@ executable ran out of memory. 441 | | OutOfTime 442 | -- ^ The @downward@ executable ran out of time. 443 | | CriticalError 444 | -- ^ The @downward@ executable encountered a critical error. 445 | | InputError 446 | -- ^ The @downward@ executable encountered an error parsing input. 447 | | Unsupported 448 | -- ^ The @downward@ executable was called with a search engine that is 449 | -- incompatible with the problem definition. 450 | | Crashed String String ExitCode 451 | -- ^ Fast Downward crashed (or otherwise rejected) the given problem. 452 | | Solved ( Solution a ) 453 | -- ^ A solution was found. 454 | deriving 455 | ( Functor, Show ) 456 | 457 | 458 | -- | A successful solution to a planning problem. You can unpack a @Solution@ 459 | -- into a plan by using 'totallyOrderedPlan' and 'partiallyOrderedPlan'. 460 | data Solution a = 461 | Solution 462 | { sas :: FastDownward.SAS.Plan 463 | , operators :: IntMap.IntMap a 464 | , stepIndices :: [ IntMap.Key ] 465 | } 466 | deriving 467 | ( Functor, Show ) 468 | 469 | 470 | -- | Extract a totally ordered plan from a solution. 471 | totallyOrderedPlan :: Solution a -> [ a ] 472 | totallyOrderedPlan Solution{..} = 473 | map ( operators IntMap.! ) stepIndices 474 | 475 | 476 | -- | Given a particular 'Exec.SearchEngine', attempt to solve a planning 477 | -- problem. 478 | solve 479 | :: Show a 480 | => Exec.SearchConfiguration 481 | -> [ Effect a ] 482 | -- ^ The set of effects available to the planner. Each effect can return 483 | -- some domain-specific information of type @a@ which you can use to 484 | -- interpret the plan. This will usually be some kind of @Action@ type. 485 | -> [ Test ] 486 | -- ^ A conjunction of tests that must true for a solution to be considered 487 | -- acceptable. 488 | -> Problem ( SolveResult a ) 489 | -- ^ The list of steps that will converge the initial state to a state that 490 | -- satisfies the given goal predicates. 491 | solve cfg ops tests = do 492 | -- It's convenient to work in the 'Problem' monad, but we don't want to dirty 493 | -- the state. (E.g., maybe the user will want to call @solve@ again with 494 | -- something that doesn't require axioms derived to satisfy the first calls 495 | -- 'Test'). 496 | s0 <- 497 | Problem get 498 | 499 | Problem $ liftIO $ flip evalStateT s0 $ do 500 | -- First, convert the given goal into a list of variable assignments. This 501 | -- will also introduce axioms for conjunctions, and will observe all test 502 | -- variable values. 503 | goal <- 504 | unProblem ( Prelude.traverse testToVariableAssignment tests ) 505 | 506 | -- Now that we've observed every value we know up-front, find the fixed point 507 | -- of the set of operators. 508 | operators <- 509 | liftIO ( exhaustEffects ops ) 510 | 511 | initialState <- 512 | gets initialState 513 | 514 | axioms <- 515 | gets axioms 516 | 517 | -- For all variables, convert them into a SAS-compatible list. 518 | variables <- 519 | for 520 | ( Map.toAscList initialState ) 521 | ( \( FastDownward.SAS.VariableIndex i 522 | , VariableDeclaration _ enumerate axiomLayer 523 | ) -> do 524 | domain <- 525 | liftIO enumerate 526 | 527 | return 528 | FastDownward.SAS.Variable 529 | { name = 530 | fromString ( "var-" <> show i ) 531 | , domain = 532 | Seq.fromList $ 533 | map 534 | ( \( FastDownward.SAS.DomainIndex d ) -> 535 | fromString 536 | ( "Atom var-" <> show i <> "(" <> show d <> ")" ) 537 | ) 538 | domain 539 | ++ [ "Atom dummy(dummy)" ] 540 | , axiomLayer = axiomLayer 541 | } 542 | ) 543 | 544 | let 545 | plan = 546 | FastDownward.SAS.Plan 547 | { version = 548 | FastDownward.SAS.SAS3 549 | , useCosts = 550 | FastDownward.SAS.NoCosts 551 | , variables = 552 | Seq.fromList variables 553 | , mutexGroups = 554 | mempty 555 | , initialState = 556 | FastDownward.SAS.State 557 | ( Seq.fromList $ map ( initial . snd ) ( Map.toAscList initialState ) ) 558 | , goal = 559 | FastDownward.SAS.Goal ( Seq.fromList goal ) 560 | , operators = 561 | Seq.fromList $ zipWith 562 | ( \i ( _, EffectState{ reads, writes } ) -> 563 | let 564 | unchangedWrites = 565 | IntMap.mapMaybe 566 | ( \( a, b ) -> if a == b then Just a else Nothing ) 567 | ( IntMap.intersectionWith (,) writes reads ) 568 | 569 | actualWrites = 570 | writes `IntMap.difference` unchangedWrites 571 | 572 | in 573 | FastDownward.SAS.Operator 574 | { name = fromString ( "op" <> show i ) 575 | , prevail = 576 | Seq.fromList $ map 577 | ( \( x, y ) -> FastDownward.SAS.VariableAssignment ( coerce x ) y ) 578 | ( IntMap.toList 579 | ( IntMap.difference reads writes <> unchangedWrites 580 | ) 581 | ) 582 | , effects = 583 | Seq.fromList $ map 584 | ( \( v, post ) -> FastDownward.SAS.Effect ( coerce v ) Nothing post ) 585 | ( IntMap.toList ( IntMap.difference writes reads ) ) 586 | ++ 587 | IntMap.elems 588 | ( IntMap.intersectionWithKey 589 | ( \v pre post -> 590 | FastDownward.SAS.Effect ( coerce v ) ( Just pre ) post 591 | ) 592 | reads 593 | actualWrites 594 | ) 595 | } 596 | ) 597 | [ 0 :: Int .. ] 598 | operators 599 | , axioms = 600 | Seq.fromList $ Data.Foldable.toList axioms 601 | } 602 | 603 | planFilePath <- 604 | liftIO ( emptySystemTempFile "sas_plan" ) 605 | 606 | ( exitCode, stdout, stderr ) <- 607 | liftIO 608 | ( Exec.callFastDownward 609 | Exec.Options 610 | { fastDownward = "downward" 611 | , problem = plan 612 | , planFilePath = planFilePath 613 | , searchConfiguration = cfg 614 | } 615 | ) 616 | 617 | case exitCode of 618 | ExitFailure 11 -> 619 | return Unsolvable 620 | 621 | ExitFailure 12 -> 622 | return UnsolvableIncomplete 623 | 624 | ExitFailure 22 -> 625 | return OutOfMemory 626 | 627 | ExitFailure 23 -> 628 | return OutOfTime 629 | 630 | ExitFailure 32 -> 631 | return CriticalError 632 | 633 | ExitFailure 33 -> 634 | return InputError 635 | 636 | ExitFailure 34 -> 637 | return Unsupported 638 | 639 | ExitFailure other -> 640 | return ( Crashed stdout stderr ( ExitFailure other ) ) 641 | 642 | ExitSuccess -> liftIO $ do 643 | planText <- 644 | Data.Text.Lazy.IO.readFile planFilePath 645 | 646 | let 647 | stepIndices = 648 | map -- Read "(op42)" as 42 649 | ( read 650 | . Data.Text.Lazy.unpack 651 | . Data.Text.Lazy.init -- keep everything up to ")" 652 | . Data.Text.Lazy.drop 3 -- drop "(op" 653 | ) 654 | ( takeWhile 655 | ( "(" `Data.Text.Lazy.isPrefixOf` ) 656 | ( Data.Text.Lazy.lines planText ) 657 | ) 658 | 659 | return 660 | ( Solved 661 | Solution 662 | { sas = plan 663 | , operators = IntMap.fromList ( zip [0..] ( map fst operators ) ) 664 | , .. 665 | } 666 | ) 667 | 668 | 669 | exhaustEffects 670 | :: Traversable t 671 | => t ( Effect a ) 672 | -> IO [ ( a, EffectState ) ] 673 | exhaustEffects ops = do 674 | out <- 675 | -- Every 'Effect' branch will eventually write it's output here. 676 | newIORef [] 677 | 678 | Data.Foldable.for_ 679 | ops 680 | ( \( Effect ( ContT k ) ) -> 681 | runReaderT 682 | ( k 683 | ( \a -> 684 | ReaderT $ \es -> do 685 | onCommit es 686 | 687 | let 688 | es' = es { onCommit = return () } 689 | 690 | modifyIORef out ( ( a, es' ) : ) 691 | ) 692 | ) 693 | s0 694 | ) 695 | 696 | readIORef out 697 | 698 | where 699 | 700 | s0 = 701 | EffectState mempty mempty ( return () ) 702 | 703 | 704 | -- | Leave the 'Problem' monad by running the given computation to 'IO'. 705 | runProblem :: MonadIO m => Problem a -> m a 706 | runProblem p = liftIO $ 707 | evalStateT 708 | ( unProblem p ) 709 | ProblemState { initialState = mempty , axioms = mempty } 710 | 711 | 712 | -- | Test that a 'Var' is set to a particular value. 713 | (?=) :: Ord a => Var a -> a -> Test 714 | (?=) = 715 | TestEq 716 | 717 | 718 | -- | @Test@s are use to drive the solver in order to find a plan to the goal. 719 | data Test where 720 | TestEq :: Ord a => {-# UNPACK #-} !( Var a ) -> !a -> Test 721 | Any :: ![ Test ] -> Test 722 | 723 | 724 | requiresAxioms :: Test -> Bool 725 | requiresAxioms = 726 | \case 727 | TestEq{} -> 728 | False 729 | 730 | Any{} -> 731 | True 732 | 733 | 734 | -- | Reset the initial state of a variable (the value that the solver will begin 735 | -- with). 736 | resetInitial :: Ord a => Var a -> a -> Problem () 737 | resetInitial var a = do 738 | liftIO ( writeIORef ( values var ) mempty ) 739 | 740 | liftIO ( writeIORef ( fromDomainIndex var ) mempty ) 741 | 742 | i <- 743 | observeValue var a 744 | 745 | commit var a 746 | 747 | Problem $ modify $ \ps -> 748 | ps 749 | { initialState = 750 | Map.adjust 751 | ( \decl -> decl { initial = i } ) 752 | ( variableIndex var ) 753 | ( initialState ps ) 754 | } 755 | 756 | 757 | -- | Take the disjunction (or) of a list of 'Test's to a form new a @Test@ that 758 | -- succeeds when at least one of the given tests is true. 759 | -- 760 | -- __Caution!__ The use of @any@ introduces /axioms/ into the problem definition, 761 | -- which is not compatible with many search engines. 762 | any :: [ Test ] -> Test 763 | any = 764 | Any 765 | 766 | 767 | testToVariableAssignment :: Test -> Problem FastDownward.SAS.VariableAssignment 768 | testToVariableAssignment ( TestEq var a ) = 769 | FastDownward.SAS.VariableAssignment ( variableIndex var ) 770 | <$> observeValue var a 771 | 772 | testToVariableAssignment ( Any tests ) = do 773 | axiom <- 774 | newVarAt 0 False 775 | 776 | falseI <- 777 | observeValue axiom False 778 | 779 | trueI <- 780 | observeValue axiom True 781 | 782 | assigns <- 783 | Prelude.traverse testToVariableAssignment tests 784 | 785 | Problem $ modify $ \ps -> 786 | ps 787 | { axioms = 788 | Seq.fromList 789 | [ FastDownward.SAS.Axiom 790 | { variable = variableIndex axiom 791 | , conditions = Seq.singleton va 792 | , pre = falseI 793 | , post = trueI 794 | } 795 | | va <- assigns 796 | ] 797 | <> axioms ps 798 | 799 | } 800 | 801 | return ( FastDownward.SAS.VariableAssignment ( variableIndex axiom ) trueI ) 802 | 803 | 804 | -- | Deorder a plan into a partially ordered plan. This attempts to recover some 805 | -- concurrency when adjacent plan steps do not need to be totally ordered. The 806 | -- result of this function is the same as the result of 807 | -- 'Data.Graph.graphFromEdges'. 808 | partiallyOrderedPlan 809 | :: Ord a 810 | => Solution a 811 | -> ( Data.Graph.Graph 812 | , Data.Graph.Vertex -> ( a, IntMap.Key, [ IntMap.Key ] ) 813 | , IntMap.Key -> Maybe Data.Graph.Vertex 814 | ) 815 | partiallyOrderedPlan Solution{..} = 816 | let 817 | ops = 818 | IntMap.fromList ( zip [0..] ( Data.Foldable.toList ( FastDownward.SAS.Plan.operators sas ) ) ) 819 | 820 | operation i = 821 | ops IntMap.! i 822 | 823 | g = do 824 | -- Here we consider every step in the list of steps. Using a combination 825 | -- of inits and reverse, given x1, x2, ..., xn, we end up with the 826 | -- following iterations: 827 | -- 828 | -- 1. ( x1, [] ) 829 | -- 2. ( x2, [ x1 ] ) 830 | -- 3. ( xn, [ x1, x2, .., x(n-1) ] ) 831 | -- 832 | ( i, o ) : priorReversed <- 833 | map 834 | reverse 835 | ( tail ( inits ( map ( \i -> ( i, operation i ) ) stepIndices ) ) ) 836 | 837 | let 838 | priors = 839 | reverse priorReversed 840 | 841 | -- For each step return it, and a list of any supporting operators. 842 | return 843 | ( operators IntMap.! i 844 | , i 845 | , mapMaybe 846 | ( \( j, x ) -> if o `after` x then Just j else Nothing ) 847 | priors 848 | ) 849 | 850 | ( gr, fromVertex, toVertex ) = 851 | Data.Graph.graphFromEdges g 852 | 853 | in 854 | ( Data.Graph.transposeG gr, fromVertex, toVertex ) 855 | 856 | 857 | -- | Given an 'Problem.Operator', return its effects as a list of variable 858 | -- assignments. 859 | assignments :: FastDownward.SAS.Operator -> [ FastDownward.SAS.VariableAssignment ] 860 | assignments o = 861 | [ FastDownward.SAS.VariableAssignment 862 | ( FastDownward.SAS.Effect.variable e ) 863 | ( FastDownward.SAS.Effect.post e ) 864 | | e <- Data.Foldable.toList ( FastDownward.SAS.Operator.effects o ) 865 | ] 866 | 867 | 868 | 869 | -- | Given an 'Problem.Operator', return a list of variable assignments that 870 | -- must be such in order for this operator to be applicable. This is the 871 | -- combination of the prevailing conditions for the operator, and the original 872 | -- state for all variables updated by effects. 873 | requirements :: FastDownward.SAS.Operator -> Seq FastDownward.SAS.VariableAssignment 874 | requirements o = 875 | FastDownward.SAS.Operator.prevail o <> Seq.fromList ( original o ) 876 | 877 | 878 | -- | Return all the original 'FastDownward.VariableAssignment's for an 879 | -- 'Problem.Operator'. This is the set of original assignments before the 880 | -- operator is applied. 881 | original :: FastDownward.SAS.Operator -> [ FastDownward.SAS.VariableAssignment ] 882 | original o = 883 | mapMaybe 884 | ( \e -> 885 | FastDownward.SAS.VariableAssignment ( FastDownward.SAS.Effect.variable e ) 886 | <$> FastDownward.SAS.Effect.pre e 887 | ) 888 | ( Data.Foldable.toList ( FastDownward.SAS.Operator.effects o ) ) 889 | 890 | 891 | -- | @o `after` x@ is true if: 892 | -- 893 | -- 1. o requires an initial variable state produced by x. 894 | -- 2. x requires an initial variable state that it is also required by 895 | -- o. This is because x will be changing the state of a variable o 896 | -- required by o. 897 | after 898 | :: FastDownward.SAS.Operator.Operator 899 | -> FastDownward.SAS.Operator.Operator 900 | -> Bool 901 | o `after` x = 902 | not ( null ( Data.Foldable.toList ( requirements o ) `intersect` assignments x ) ) || 903 | not ( null ( Data.Foldable.toList ( requirements x ) `intersect` original o ) ) 904 | -------------------------------------------------------------------------------- /FastDownward/Examples/Gripper.hs: -------------------------------------------------------------------------------- 1 | {-# language DisambiguateRecordFields #-} 2 | 3 | -- | This module is an example of using @fast-downward@ to solve a problem of 4 | -- transporting balls between rooms using a robot. See the source listing for 5 | -- this file for the full example, and see 6 | -- for a 7 | -- detailed walk through. 8 | 9 | module FastDownward.Examples.Gripper where 10 | 11 | import Control.Monad 12 | import qualified FastDownward.Exec as Exec 13 | import FastDownward 14 | 15 | 16 | data Room = RoomA | RoomB 17 | deriving (Eq, Ord, Show) 18 | 19 | 20 | adjacent :: Room -> Room 21 | adjacent RoomA = RoomB 22 | adjacent RoomB = RoomA 23 | 24 | 25 | data BallLocation = InRoom Room | InGripper 26 | deriving (Eq, Ord, Show) 27 | 28 | 29 | data GripperState = Empty | HoldingBall 30 | deriving (Eq, Ord, Show) 31 | 32 | 33 | type Ball = Var BallLocation 34 | 35 | 36 | type Gripper = Var GripperState 37 | 38 | 39 | data Action = PickUpBall | SwitchRooms | DropBall 40 | deriving (Show) 41 | 42 | 43 | problem :: Problem (SolveResult Action) 44 | problem = do 45 | balls <- replicateM 4 (newVar (InRoom RoomA)) 46 | robotLocation <- newVar RoomA 47 | grippers <- replicateM 2 (newVar Empty) 48 | 49 | let 50 | pickUpBallWithGrippper :: Ball -> Gripper -> Effect Action 51 | pickUpBallWithGrippper b gripper = do 52 | Empty <- readVar gripper 53 | 54 | robotRoom <- readVar robotLocation 55 | ballLocation <- readVar b 56 | guard (ballLocation == InRoom robotRoom) 57 | 58 | writeVar b InGripper 59 | writeVar gripper HoldingBall 60 | 61 | return PickUpBall 62 | 63 | 64 | moveRobotToAdjacentRoom :: Effect Action 65 | moveRobotToAdjacentRoom = do 66 | modifyVar robotLocation adjacent 67 | return SwitchRooms 68 | 69 | 70 | dropBall :: Ball -> Gripper -> Effect Action 71 | dropBall b gripper = do 72 | HoldingBall <- readVar gripper 73 | InGripper <- readVar b 74 | 75 | robotRoom <- readVar robotLocation 76 | writeVar b (InRoom robotRoom) 77 | 78 | writeVar gripper Empty 79 | 80 | return DropBall 81 | 82 | 83 | solve 84 | Exec.bjolp 85 | ( [ pickUpBallWithGrippper b g | b <- balls, g <- grippers ] 86 | ++ [ dropBall b g | b <- balls, g <- grippers ] 87 | ++ [ moveRobotToAdjacentRoom ] 88 | ) 89 | [ b ?= InRoom RoomB | b <- balls ] 90 | 91 | 92 | main :: IO () 93 | main = do 94 | res <- runProblem problem 95 | case res of 96 | Solved plan -> do 97 | putStrLn "Found a plan!" 98 | zipWithM_ 99 | ( \i step -> putStrLn ( show i ++ ": " ++ show step ) ) 100 | [ 1::Int .. ] 101 | ( totallyOrderedPlan plan ) 102 | 103 | _ -> 104 | putStrLn "Couldn't find a plan!" 105 | -------------------------------------------------------------------------------- /FastDownward/Exec.hs: -------------------------------------------------------------------------------- 1 | {-# language DuplicateRecordFields #-} 2 | {-# language LambdaCase #-} 3 | {-# language NamedFieldPuns #-} 4 | 5 | module FastDownward.Exec 6 | ( Options(..) 7 | , SearchConfiguration(..) 8 | , callFastDownward 9 | 10 | -- * Predefined Search Engines 11 | , bjolp 12 | 13 | -- * Search Engines 14 | , SearchEngine(..) 15 | , AStarConfiguration(..) 16 | , EagerBestFirstConfiguration(..) 17 | , EagerGreedyConfiguration(..) 18 | , EnforcedHillClimbingConfiguration(..) 19 | , IteratedConfiguration(..) 20 | , LazyBestFirstConfiguration(..) 21 | , LazyGreedyConfiguration(..) 22 | , LazyWeightedAStarConfiguration(..) 23 | 24 | -- ** Search Engine Options 25 | , CostType(..) 26 | , PreferredOperatorUsage(..) 27 | 28 | -- * Abstract Tasks 29 | , AbstractTask(..) 30 | 31 | -- * Constraint Generators 32 | , ConstraintGenerator(..) 33 | 34 | -- * Evaluators 35 | , Evaluator(..) 36 | , AddConfiguration(..) 37 | , AllStatesPotentialConfiguration(..) 38 | , BlindConfiguration(..) 39 | , CEAConfiguration(..) 40 | , CEGARConfiguration(..) 41 | , CEGARPick(..) 42 | , CGConfiguration(..) 43 | , DiversePotentialsConfiguration(..) 44 | , FFConfiguration(..) 45 | , GoalCountConfiguration(..) 46 | , HMConfiguration(..) 47 | , HMaxConfiguration(..) 48 | , InitialStatePotentialConfiguration(..) 49 | , LMCountConfiguration(..) 50 | , LMCutConfiguration(..) 51 | , MergeAndShrinkConfiguration(..) 52 | , Verbosity(..) 53 | , OperatorCountingConfiguration(..) 54 | , SampleBasedPotentialsConfiguration(..) 55 | , CanonicalPDBConfiguration(..) 56 | , IPDBConfiguration(..) 57 | , ZeroOnePDBConfiguration(..) 58 | 59 | -- ** Evaluator Configuration 60 | , LPSolver(..) 61 | 62 | -- * Label Reduction 63 | , LabelReduction(..) 64 | , ExactGeneralizedLabelReductionConfiguration(..) 65 | , LabelReductionMethod(..) 66 | , SystemOrder(..) 67 | 68 | -- * Landmark Factory 69 | , LandmarkFactory(..) 70 | , LMExhaustConfiguration(..) 71 | , LMHMConfiguration(..) 72 | , LMMergedConfiguration(..) 73 | , LMRHWConfiguration(..) 74 | , LMZGConfiguration(..) 75 | 76 | -- * Merge Scoring Function 77 | , MergeScoringFunction(..) 78 | , MIASMConfiguration(..) 79 | , TotalOrderConfiguration(..) 80 | , AtomicTsOrder(..) 81 | , ProductTsOrder(..) 82 | 83 | -- * Merge Selector 84 | , MergeSelector(..) 85 | 86 | -- * Merge Strategy 87 | , MergeStrategy(..) 88 | , MergeSCCsConfiguration(..) 89 | , OrderOfSCCs(..) 90 | 91 | -- * Merge Tree 92 | , MergeTree(..) 93 | , LinearMergeTreeConfiguration(..) 94 | , UpdateOption(..) 95 | , VariableOrder(..) 96 | 97 | -- * Open List 98 | , OpenList(..) 99 | , AltConfiguration(..) 100 | , EpsilonGreedyConfiguration(..) 101 | , ParetoConfiguration(..) 102 | , SingleConfiguration(..) 103 | , TiebreakingConfiguration(..) 104 | , TypeBasedConfiguration(..) 105 | 106 | -- * Pattern Collection Generators 107 | , PatternCollectionGenerator(..) 108 | , GeneticConfiguration(..) 109 | , HillclimbingConfiguration(..) 110 | , SystematicConfiguration(..) 111 | 112 | -- * Pruning Method 113 | , PruningMethod(..) 114 | , StubbornSetsConfiguration(..) 115 | 116 | -- * Shrink Strategy 117 | , ShrinkStrategy(..) 118 | , BisimulationConfiguration(..) 119 | , BisimulationLimitStrategy(..) 120 | , FPreservingConfiguration(..) 121 | , HighLow(..) 122 | 123 | -- * Subtask Generators 124 | , SubtaskGenerator(..) 125 | , GoalsConfiguration(..) 126 | , GoalsOrder(..) 127 | , LandmarksConfiguration(..) 128 | , OriginalConfiguration(..) 129 | ) 130 | where 131 | 132 | import Control.Monad.IO.Class ( MonadIO, liftIO ) 133 | import Data.Char 134 | import Data.List 135 | import Data.Maybe 136 | import Data.Ratio 137 | import qualified Data.Text.Lazy 138 | import qualified Data.Text.Lazy.IO 139 | import qualified FastDownward.SAS 140 | import qualified FastDownward.SAS.Plan 141 | import System.Exit ( ExitCode ) 142 | import System.IO ( hClose ) 143 | import System.Process 144 | 145 | 146 | bjolp :: SearchConfiguration 147 | bjolp = 148 | SearchConfiguration 149 | { search = 150 | AStar 151 | AStarConfiguration 152 | { evaluator = Predefined "lmc" 153 | , lazyEvaluator = Just ( Predefined "lmc" ) 154 | , pruning = Null 155 | , costType = Normal 156 | , bound = Nothing 157 | , maxTime = Just 60 158 | } 159 | , evaluators = 160 | [ ( "lmc" 161 | , LMCount 162 | LMCountConfiguration 163 | { lmFactory = 164 | LMMerged 165 | LMMergedConfiguration 166 | { factories = 167 | [ LMRHW 168 | LMRHWConfiguration 169 | { reasonableOrders = False 170 | , onlyCausalLandmarks = False 171 | , disjunctiveLandmarks = True 172 | , conjunctiveLandmarks = True 173 | , noOrders = False 174 | } 175 | , LMHM 176 | LMHMConfiguration 177 | { m = 1 178 | , reasonableOrders = False 179 | , onlyCausalLandmarks = False 180 | , disjunctiveLandmarks = True 181 | , conjunctiveLandmarks = True 182 | , noOrders = False 183 | } 184 | ] 185 | , reasonableOrders = False 186 | , onlyCausalLandmarks = False 187 | , disjunctiveLandmarks = True 188 | , conjunctiveLandmarks = True 189 | , noOrders = False 190 | } 191 | , admissible = True 192 | , optimal = False 193 | , pref = False 194 | , alm = True 195 | , lpSolver = CLP 196 | , transform = NoTransform 197 | , cacheEstimates = True 198 | } 199 | 200 | ) 201 | ] 202 | } 203 | 204 | 205 | data Expr 206 | = App String [ Expr ] [ ( String, Expr ) ] 207 | | Lit String 208 | | List [ Expr ] 209 | 210 | 211 | infinity :: Expr 212 | infinity = 213 | Lit "infinity" 214 | 215 | 216 | intToExpr :: Int -> Expr 217 | intToExpr = 218 | Lit . show 219 | 220 | 221 | doubleToExpr :: Double -> Expr 222 | doubleToExpr = 223 | Lit . show 224 | 225 | 226 | boolToExpr :: Bool -> Expr 227 | boolToExpr = 228 | Lit . map toLower . show 229 | 230 | 231 | none :: Expr 232 | none = 233 | Lit "" 234 | 235 | 236 | exprToString :: Expr -> String 237 | exprToString ( App f pos named ) = 238 | f 239 | <> "(" 240 | <> 241 | intercalate 242 | "," 243 | ( map exprToString pos 244 | <> map ( \( k, e ) -> k <> "=" <> exprToString e ) named 245 | ) 246 | <> ")" 247 | exprToString ( Lit s ) = 248 | s 249 | exprToString ( List l ) = 250 | "[" <> intercalate "," ( map exprToString l ) <> "]" 251 | 252 | 253 | data Options = 254 | Options 255 | { fastDownward :: FilePath 256 | , problem :: FastDownward.SAS.Plan 257 | , planFilePath :: FilePath 258 | , searchConfiguration :: SearchConfiguration 259 | } 260 | 261 | 262 | data SearchConfiguration = 263 | SearchConfiguration 264 | { search :: SearchEngine 265 | , evaluators :: [ ( String, Evaluator ) ] 266 | } 267 | 268 | 269 | 270 | callFastDownward :: MonadIO m => Options -> m ( ExitCode, String, String ) 271 | callFastDownward Options{ fastDownward, problem, planFilePath, searchConfiguration = SearchConfiguration{ search, evaluators } } = liftIO $ do 272 | ( Just writeProblemHandle, Just stdoutHandle, Just stderrHandle, processHandle ) <- 273 | createProcess 274 | ( proc 275 | fastDownward 276 | ( concat 277 | [ [ "--internal-plan-file", planFilePath ] 278 | , concatMap 279 | ( \( name, def ) -> 280 | [ "--evaluator" 281 | , name <> "=" <> exprToString ( evaluatorToExpr def ) 282 | ] 283 | ) 284 | evaluators 285 | , [ "--search", exprToString ( searchEngineToExpr search ) ] 286 | ] 287 | ) 288 | ) 289 | { std_in = CreatePipe 290 | , std_out = CreatePipe 291 | , std_err = CreatePipe 292 | } 293 | 294 | Data.Text.Lazy.IO.hPutStr writeProblemHandle ( FastDownward.SAS.Plan.toSAS problem ) 295 | >> hClose writeProblemHandle 296 | 297 | exitCode <- 298 | waitForProcess processHandle 299 | 300 | stdout <- 301 | Data.Text.Lazy.IO.hGetContents stdoutHandle 302 | 303 | stderr <- 304 | Data.Text.Lazy.IO.hGetContents stderrHandle 305 | 306 | return ( exitCode, Data.Text.Lazy.unpack stdout, Data.Text.Lazy.unpack stderr ) 307 | 308 | 309 | -- | See 310 | data SearchEngine 311 | = AStar AStarConfiguration 312 | | EagerBestFirst EagerBestFirstConfiguration 313 | | EagerGreedy EagerGreedyConfiguration 314 | | EnforcedHillClimbing EnforcedHillClimbingConfiguration 315 | | Iterated IteratedConfiguration 316 | | LazyBestFirst LazyBestFirstConfiguration 317 | | LazyGreedy LazyGreedyConfiguration 318 | | LazyWeightedAStar LazyWeightedAStarConfiguration 319 | 320 | 321 | searchEngineToExpr :: SearchEngine -> Expr 322 | searchEngineToExpr = 323 | \case 324 | AStar cfg -> 325 | aStar cfg 326 | 327 | EagerBestFirst cfg -> 328 | eager cfg 329 | 330 | EagerGreedy cfg -> 331 | eagerGreedy cfg 332 | 333 | EnforcedHillClimbing cfg -> 334 | ehc cfg 335 | 336 | Iterated cfg -> 337 | iterated cfg 338 | 339 | LazyBestFirst cfg -> 340 | lazy cfg 341 | 342 | LazyGreedy cfg -> 343 | lazyGreedy cfg 344 | 345 | LazyWeightedAStar cfg -> 346 | lazyWAStar cfg 347 | 348 | 349 | -- | See 350 | data AStarConfiguration = 351 | AStarConfiguration 352 | { evaluator :: Evaluator 353 | , lazyEvaluator :: Maybe Evaluator 354 | , pruning :: PruningMethod 355 | , costType :: CostType 356 | , bound :: Maybe Int 357 | , maxTime :: Maybe Double 358 | } 359 | 360 | 361 | aStar :: AStarConfiguration -> Expr 362 | aStar AStarConfiguration{ evaluator, lazyEvaluator, pruning, costType, bound, maxTime } = 363 | App 364 | "astar" 365 | [ evaluatorToExpr evaluator ] 366 | [ ( "lazy_evaluator", maybe none evaluatorToExpr lazyEvaluator ) 367 | , ( "pruning", pruningMethodToExpr pruning ) 368 | , ( "cost_type", costTypeToExpr costType ) 369 | , ( "bound", maybe infinity intToExpr bound ) 370 | , maxTimeExpr maxTime 371 | ] 372 | 373 | 374 | -- | See 375 | data EagerBestFirstConfiguration = 376 | EagerBestFirstConfiguration 377 | { open :: OpenList 378 | , reopenClosed :: Bool 379 | , fEval :: Maybe Evaluator 380 | , preferred :: [ Evaluator ] 381 | , pruning :: PruningMethod 382 | , costType :: CostType 383 | , bound :: Maybe Int 384 | , maxTime :: Maybe Double 385 | } 386 | 387 | 388 | eager :: EagerBestFirstConfiguration -> Expr 389 | eager EagerBestFirstConfiguration{ open, reopenClosed, fEval, preferred, pruning, costType, bound, maxTime } = 390 | App 391 | "eager" 392 | [ openListToExpr open ] 393 | [ ( "reopen_closed", boolToExpr reopenClosed ) 394 | , ( "f_eval", maybe none evaluatorToExpr fEval ) 395 | , ( "preferred", List ( map evaluatorToExpr preferred ) ) 396 | , ( "pruning", pruningMethodToExpr pruning ) 397 | , ( "cost_type", costTypeToExpr costType ) 398 | , ( "bound", maybe infinity intToExpr bound ) 399 | , maxTimeExpr maxTime 400 | ] 401 | 402 | 403 | -- | See 404 | data EagerGreedyConfiguration = 405 | EagerGreedyConfiguration 406 | { evaluators :: [ Evaluator ] 407 | , preferred :: [ Evaluator ] 408 | , boost :: Int 409 | , pruning :: PruningMethod 410 | , costType :: CostType 411 | , bound :: Maybe Int 412 | , maxTime :: Maybe Double 413 | } 414 | 415 | 416 | eagerGreedy :: EagerGreedyConfiguration -> Expr 417 | eagerGreedy EagerGreedyConfiguration{ evaluators, preferred, boost, pruning, costType, bound, maxTime } = 418 | App 419 | "eager_greedy" 420 | [ List ( map evaluatorToExpr evaluators ) ] 421 | [ ( "preferred", List ( map evaluatorToExpr preferred ) ) 422 | , ( "boost", intToExpr boost ) 423 | , ( "pruning", pruningMethodToExpr pruning ) 424 | , ( "cost_type", costTypeToExpr costType ) 425 | , ( "bound", maybe infinity intToExpr bound ) 426 | , maxTimeExpr maxTime 427 | ] 428 | 429 | 430 | -- | See 431 | data EnforcedHillClimbingConfiguration = 432 | EnforcedHillClimbingConfiguration 433 | { h :: Evaluator 434 | , preferredUsage :: PreferredOperatorUsage 435 | , preferred :: [ Evaluator ] 436 | , costType :: CostType 437 | , bound :: Maybe Int 438 | , maxTime :: Maybe Double 439 | } 440 | 441 | 442 | ehc :: EnforcedHillClimbingConfiguration -> Expr 443 | ehc EnforcedHillClimbingConfiguration{ h, preferredUsage, preferred, costType, bound, maxTime } = 444 | App 445 | "ehc" 446 | [ evaluatorToExpr h ] 447 | [ ( "preferred_usage", preferredUsageToExpr preferredUsage ) 448 | , ( "preferred", List ( map evaluatorToExpr preferred ) ) 449 | , ( "cost_type", costTypeToExpr costType ) 450 | , ( "bound", maybe infinity intToExpr bound ) 451 | , maxTimeExpr maxTime 452 | ] 453 | 454 | 455 | -- | See 456 | data IteratedConfiguration = 457 | IteratedConfiguration 458 | { engines :: [ SearchEngine ] 459 | , passBound :: Bool 460 | , repeatLast :: Bool 461 | , continueOnFail :: Bool 462 | , continueOnSolve :: Bool 463 | , costType :: CostType 464 | , bound :: Maybe Int 465 | , maxTime :: Maybe Double 466 | } 467 | 468 | 469 | iterated :: IteratedConfiguration -> Expr 470 | iterated IteratedConfiguration{ engines, passBound, repeatLast, continueOnFail, continueOnSolve, costType, bound, maxTime } = 471 | App 472 | "iterated" 473 | [ List ( map searchEngineToExpr engines ) ] 474 | [ ( "pass_bound", boolToExpr passBound ) 475 | , ( "repeat_last", boolToExpr repeatLast ) 476 | , ( "continue_on_fail", boolToExpr continueOnFail ) 477 | , ( "continue_on_solve", boolToExpr continueOnSolve ) 478 | , ( "cost_type", costTypeToExpr costType ) 479 | , ( "bound", maybe infinity intToExpr bound ) 480 | , maxTimeExpr maxTime 481 | ] 482 | 483 | 484 | -- | See 485 | data LazyBestFirstConfiguration = 486 | LazyBestFirstConfiguration 487 | { open :: OpenList 488 | , reopenClosed :: Bool 489 | , preferred :: [ Evaluator ] 490 | , randomizeSuccessors :: Bool 491 | , preferredSuccessorsFirst :: Bool 492 | , randomSeed :: Maybe Int 493 | , costType :: CostType 494 | , bound :: Maybe Int 495 | , maxTime :: Maybe Double 496 | } 497 | 498 | 499 | lazy :: LazyBestFirstConfiguration -> Expr 500 | lazy LazyBestFirstConfiguration{ open, reopenClosed, preferred, randomizeSuccessors, preferredSuccessorsFirst, randomSeed, costType, bound, maxTime } = 501 | App 502 | "lazy" 503 | [ openListToExpr open ] 504 | [ ( "reopen_closed", boolToExpr reopenClosed ) 505 | , ( "preferred", List ( map evaluatorToExpr preferred ) ) 506 | , ( "randomize_successors", boolToExpr randomizeSuccessors ) 507 | , ( "preferred_successors_first", boolToExpr preferredSuccessorsFirst ) 508 | , randomSeedExpr randomSeed 509 | , ( "cost_type", costTypeToExpr costType ) 510 | , ( "bound", maybe infinity intToExpr bound ) 511 | , maxTimeExpr maxTime 512 | ] 513 | 514 | 515 | -- | See 516 | data LazyGreedyConfiguration = 517 | LazyGreedyConfiguration 518 | { evaluators :: [ Evaluator ] 519 | , preferred :: [ Evaluator ] 520 | , reopenClosed :: Bool 521 | , boost :: Int 522 | , randomizeSuccessors :: Bool 523 | , preferredSuccessorsFirst :: Bool 524 | , randomSeed :: Maybe Int 525 | , costType :: CostType 526 | , bound :: Maybe Int 527 | , maxTime :: Maybe Double 528 | } 529 | 530 | 531 | lazyGreedy :: LazyGreedyConfiguration -> Expr 532 | lazyGreedy LazyGreedyConfiguration{ evaluators, preferred, reopenClosed, boost, randomizeSuccessors, preferredSuccessorsFirst, randomSeed, costType, bound, maxTime } = 533 | App 534 | "lazy_greedy" 535 | [ List ( map evaluatorToExpr evaluators ) ] 536 | [ ( "reopen_closed", boolToExpr reopenClosed ) 537 | , ( "preferred", List ( map evaluatorToExpr preferred ) ) 538 | , ( "boost", intToExpr boost ) 539 | , ( "randomize_successors", boolToExpr randomizeSuccessors ) 540 | , ( "preferred_successors_first", boolToExpr preferredSuccessorsFirst ) 541 | , randomSeedExpr randomSeed 542 | , ( "cost_type", costTypeToExpr costType ) 543 | , ( "bound", maybe infinity intToExpr bound ) 544 | , maxTimeExpr maxTime 545 | ] 546 | 547 | 548 | -- | See 549 | data LazyWeightedAStarConfiguration = 550 | LazyWeightedAStarConfiguration 551 | { evaluators :: [ Evaluator ] 552 | , preferred :: [ Evaluator ] 553 | , reopenClosed :: Bool 554 | , boost :: Int 555 | , w :: Int 556 | , randomizeSuccessors :: Bool 557 | , preferredSuccessorsFirst :: Bool 558 | , randomSeed :: Maybe Int 559 | , costType :: CostType 560 | , bound :: Maybe Int 561 | , maxTime :: Maybe Double 562 | } 563 | 564 | 565 | lazyWAStar :: LazyWeightedAStarConfiguration -> Expr 566 | lazyWAStar LazyWeightedAStarConfiguration{ evaluators, preferred, reopenClosed, boost, w, randomizeSuccessors, preferredSuccessorsFirst, randomSeed, costType, bound, maxTime } = 567 | App 568 | "lazy_wastar" 569 | [ List ( map evaluatorToExpr evaluators ) ] 570 | [ ( "reopen_closed", boolToExpr reopenClosed ) 571 | , ( "preferred", List ( map evaluatorToExpr preferred ) ) 572 | , ( "boost", intToExpr boost ) 573 | , ( "w", intToExpr w ) 574 | , ( "randomize_successors", boolToExpr randomizeSuccessors ) 575 | , ( "preferred_successors_first", boolToExpr preferredSuccessorsFirst ) 576 | , randomSeedExpr randomSeed 577 | , ( "cost_type", costTypeToExpr costType ) 578 | , ( "bound", maybe infinity intToExpr bound ) 579 | , maxTimeExpr maxTime 580 | ] 581 | 582 | 583 | -- | See 584 | data Evaluator 585 | = Predefined String 586 | | Add AddConfiguration 587 | | AllStatesPotential AllStatesPotentialConfiguration 588 | | Blind BlindConfiguration 589 | | CEA CEAConfiguration 590 | | CEGAR CEGARConfiguration 591 | | CG CGConfiguration 592 | | DiversePotentials DiversePotentialsConfiguration 593 | | FF FFConfiguration 594 | | GoalCount GoalCountConfiguration 595 | | HM HMConfiguration 596 | | HMax HMaxConfiguration 597 | | InitialStatePotential InitialStatePotentialConfiguration 598 | | LMCount LMCountConfiguration 599 | | LMCut LMCutConfiguration 600 | | Max [ Evaluator ] 601 | | MergeAndShrink MergeAndShrinkConfiguration 602 | | OperatorCounting OperatorCountingConfiguration 603 | | SampleBasedPotentials SampleBasedPotentialsConfiguration 604 | | ConstantEvaluator Int 605 | | G 606 | | Pref 607 | | Sum [ Evaluator ] 608 | | Weighted Evaluator Int 609 | | CanonicalPDB CanonicalPDBConfiguration 610 | | IPDB IPDBConfiguration 611 | | ZeroOnePDB ZeroOnePDBConfiguration 612 | 613 | 614 | evaluatorToExpr :: Evaluator -> Expr 615 | evaluatorToExpr = 616 | \case 617 | Predefined varName -> 618 | Lit varName 619 | 620 | Add cfg -> 621 | add cfg 622 | 623 | AllStatesPotential cfg -> 624 | allStatesPotential cfg 625 | 626 | Blind cfg -> 627 | blind cfg 628 | 629 | CEA cfg -> 630 | cea cfg 631 | 632 | CEGAR cfg -> 633 | cegar cfg 634 | 635 | CG cfg -> 636 | cg cfg 637 | 638 | DiversePotentials cfg -> 639 | diversePotentials cfg 640 | 641 | FF cfg -> 642 | ff cfg 643 | 644 | GoalCount cfg -> 645 | goalCount cfg 646 | 647 | HM cfg -> 648 | hm cfg 649 | 650 | HMax cfg -> 651 | hmax cfg 652 | 653 | InitialStatePotential cfg -> 654 | initialStatePotential cfg 655 | 656 | LMCount cfg -> 657 | lmcount cfg 658 | 659 | LMCut cfg -> 660 | lmcut cfg 661 | 662 | Max evals -> 663 | App "max" [ List ( map evaluatorToExpr evals ) ] [] 664 | 665 | MergeAndShrink cfg -> 666 | mergeAndShrink cfg 667 | 668 | OperatorCounting cfg -> 669 | operatorCounting cfg 670 | 671 | ConstantEvaluator cfg -> 672 | App "const" [] [ ( "vale", intToExpr cfg ) ] 673 | 674 | G -> 675 | App "g" [] [] 676 | 677 | Pref -> 678 | App "pref" [] [] 679 | 680 | Sum evals -> 681 | App "sum" [ List ( map evaluatorToExpr evals ) ] [] 682 | 683 | Weighted eval weight -> 684 | App "weight" [ evaluatorToExpr eval, intToExpr weight ] [] 685 | 686 | CanonicalPDB cfg -> 687 | cpdbs cfg 688 | 689 | SampleBasedPotentials cfg -> 690 | sampleBasedPotentials cfg 691 | 692 | IPDB cfg -> 693 | ipdb cfg 694 | 695 | ZeroOnePDB cfg -> 696 | zopdbs cfg 697 | 698 | 699 | -- | See 700 | data PruningMethod 701 | = Null 702 | | StubbornSetsEC StubbornSetsConfiguration 703 | | StubbornSetsSimple StubbornSetsConfiguration 704 | 705 | 706 | pruningMethodToExpr :: PruningMethod -> Expr 707 | pruningMethodToExpr = 708 | \case 709 | Null -> 710 | App "null" [] [] 711 | 712 | StubbornSetsEC cfg -> 713 | stubbornSetsEc cfg 714 | 715 | StubbornSetsSimple cfg -> 716 | stubbornSetsSimple cfg 717 | 718 | 719 | data CostType 720 | = Normal 721 | -- ^ All actions are accounted for with their real cost. 722 | | One 723 | -- ^ All actions are accounted for as unit cost. 724 | | PlusOne 725 | -- ^ All actions are accounted for as their real cost + 1 (except if all 726 | -- actions have original cost 1, in which case cost 1 is used). This is the 727 | -- behaviour known for the heuristics of the LAMA planner. This is intended 728 | -- to be used by the heuristics, not search engines, but is supported for 729 | -- both. 730 | deriving 731 | ( Show ) 732 | 733 | 734 | costTypeToExpr :: CostType -> Expr 735 | costTypeToExpr = 736 | Lit . map toUpper . show 737 | 738 | 739 | -- | See 740 | data OpenList 741 | = Alt AltConfiguration 742 | | EpsilonGreedy EpsilonGreedyConfiguration 743 | | Pareto ParetoConfiguration 744 | | Single SingleConfiguration 745 | | Tiebreaking TiebreakingConfiguration 746 | | TypeBased TypeBasedConfiguration 747 | 748 | 749 | openListToExpr :: OpenList -> Expr 750 | openListToExpr = 751 | \case 752 | Alt cfg -> 753 | alt cfg 754 | 755 | EpsilonGreedy cfg -> 756 | epsilonGreedy cfg 757 | 758 | Pareto cfg -> 759 | pareto cfg 760 | 761 | Single cfg -> 762 | single cfg 763 | 764 | Tiebreaking cfg -> 765 | tiebreaking cfg 766 | 767 | TypeBased cfg -> 768 | typeBased cfg 769 | 770 | 771 | data PreferredOperatorUsage = 772 | PruneByPreferred | RankPreferredFirst 773 | 774 | 775 | preferredUsageToExpr :: PreferredOperatorUsage -> Expr 776 | preferredUsageToExpr = 777 | \case 778 | PruneByPreferred -> 779 | Lit "PRUNE_BY_PREFERRED" 780 | 781 | RankPreferredFirst -> 782 | Lit "RANK_PREFERRED_FIRST" 783 | 784 | 785 | -- | See 786 | data AddConfiguration = 787 | AddConfiguration 788 | { transform :: AbstractTask 789 | , cacheEstimates :: Bool 790 | } 791 | 792 | 793 | add :: AddConfiguration -> Expr 794 | add AddConfiguration{ transform, cacheEstimates } = 795 | App 796 | "add" 797 | [] 798 | [ transformExpr transform 799 | , cacheEstimatesExpr cacheEstimates 800 | ] 801 | 802 | 803 | -- | See 804 | data AllStatesPotentialConfiguration = 805 | AllStatesPotentialConfiguration 806 | { maxPotential :: Maybe Double 807 | , lpSolver :: LPSolver 808 | , transform :: AbstractTask 809 | , cacheEstimates :: Bool 810 | } 811 | 812 | 813 | allStatesPotential :: AllStatesPotentialConfiguration -> Expr 814 | allStatesPotential AllStatesPotentialConfiguration{ maxPotential, lpSolver, transform, cacheEstimates } = 815 | App 816 | "all_states_potential" 817 | [] 818 | [ maxPotentialOption maxPotential 819 | , lpSolverOption lpSolver 820 | , transformExpr transform 821 | , cacheEstimatesExpr cacheEstimates 822 | ] 823 | 824 | 825 | -- | See 826 | data BlindConfiguration = 827 | BlindConfiguration 828 | { transform :: AbstractTask 829 | , cacheEstimates :: Bool 830 | } 831 | 832 | 833 | blind :: BlindConfiguration -> Expr 834 | blind BlindConfiguration{ transform, cacheEstimates } = 835 | App 836 | "blind" 837 | [] 838 | [ transformExpr transform 839 | , cacheEstimatesExpr cacheEstimates 840 | ] 841 | 842 | 843 | -- | See 844 | data CEAConfiguration = 845 | CEAConfiguration 846 | { transform :: AbstractTask 847 | , cacheEstimates :: Bool 848 | } 849 | 850 | 851 | cea :: CEAConfiguration -> Expr 852 | cea CEAConfiguration{ transform, cacheEstimates } = 853 | App 854 | "cea" 855 | [] 856 | [ transformExpr transform 857 | , cacheEstimatesExpr cacheEstimates 858 | ] 859 | 860 | 861 | -- | See 862 | data CEGARConfiguration = 863 | CEGARConfiguration 864 | { subtasks :: [ SubtaskGenerator ] 865 | , maxStates :: Maybe Int 866 | , maxTransitions :: Maybe Int 867 | , maxTime :: Maybe Double 868 | , pick :: CEGARPick 869 | , useGeneralCosts :: Bool 870 | , transform :: AbstractTask 871 | , cacheEstimates :: Bool 872 | , randomSeed :: Maybe Int 873 | } 874 | 875 | 876 | cegar :: CEGARConfiguration -> Expr 877 | cegar CEGARConfiguration{ subtasks, maxStates, maxTransitions, maxTime, pick, useGeneralCosts, transform, cacheEstimates, randomSeed } = 878 | App 879 | "cegar" 880 | [] 881 | [ ( "subtasks", List ( map subtaskToExpr subtasks ) ) 882 | , maxStatesOption maxStates 883 | , ( "max_transitions", maybe infinity intToExpr maxTransitions ) 884 | , maxTimeExpr maxTime 885 | , ( "pick", cegarPickToExpr pick ) 886 | , ( "use_general_costs", boolToExpr useGeneralCosts ) 887 | , transformExpr transform 888 | , cacheEstimatesExpr cacheEstimates 889 | , randomSeedExpr randomSeed 890 | ] 891 | 892 | 893 | -- | See 894 | data CGConfiguration = 895 | CGConfiguration 896 | { transform :: AbstractTask 897 | , cacheEstimates :: Bool 898 | } 899 | 900 | 901 | cg :: CGConfiguration -> Expr 902 | cg CGConfiguration{ transform, cacheEstimates } = 903 | App 904 | "cg" 905 | [] 906 | [ transformExpr transform 907 | , cacheEstimatesExpr cacheEstimates 908 | ] 909 | 910 | 911 | -- | See 912 | data DiversePotentialsConfiguration = 913 | DiversePotentialsConfiguration 914 | { numSamples :: Maybe Int 915 | , maxNumHeuristics :: Maybe Int 916 | , maxPotential :: Maybe Double 917 | , lpSolver :: LPSolver 918 | , transform :: AbstractTask 919 | , cacheEstimates :: Bool 920 | , randomSeed :: Maybe Int 921 | } 922 | 923 | 924 | diversePotentials :: DiversePotentialsConfiguration -> Expr 925 | diversePotentials DiversePotentialsConfiguration{ numSamples, maxNumHeuristics, maxPotential, lpSolver, transform, cacheEstimates, randomSeed } = 926 | App 927 | "diverse_potentials" 928 | [] 929 | [ ( "num_samples", maybe infinity intToExpr numSamples ) 930 | , ( "max_num_heuristics", maybe infinity intToExpr maxNumHeuristics ) 931 | , ( "max_potential", maybe infinity doubleToExpr maxPotential ) 932 | , lpSolverOption lpSolver 933 | , transformExpr transform 934 | , cacheEstimatesExpr cacheEstimates 935 | , randomSeedExpr randomSeed 936 | ] 937 | 938 | 939 | -- | See 940 | data FFConfiguration = 941 | FFConfiguration 942 | { transform :: AbstractTask 943 | , cacheEstimates :: Bool 944 | } 945 | 946 | 947 | ff :: FFConfiguration -> Expr 948 | ff FFConfiguration{ transform, cacheEstimates } = 949 | App 950 | "ff" 951 | [] 952 | [ transformExpr transform 953 | , cacheEstimatesExpr cacheEstimates 954 | ] 955 | 956 | 957 | -- | See 958 | data GoalCountConfiguration = 959 | GoalCountConfiguration 960 | { transform :: AbstractTask 961 | , cacheEstimates :: Bool 962 | } 963 | 964 | 965 | goalCount :: GoalCountConfiguration -> Expr 966 | goalCount GoalCountConfiguration{ transform, cacheEstimates } = 967 | App 968 | "goalcount" 969 | [] 970 | [ transformExpr transform 971 | , cacheEstimatesExpr cacheEstimates 972 | ] 973 | 974 | 975 | -- | See 976 | data HMConfiguration = 977 | HMConfiguration 978 | { m :: Int 979 | , transform :: AbstractTask 980 | , cacheEstimates :: Bool 981 | } 982 | 983 | 984 | hm :: HMConfiguration -> Expr 985 | hm HMConfiguration{ m, transform, cacheEstimates } = 986 | App 987 | "hm" 988 | [] 989 | [ ( "m", intToExpr m ) 990 | , transformExpr transform 991 | , cacheEstimatesExpr cacheEstimates 992 | ] 993 | 994 | 995 | -- | See 996 | data HMaxConfiguration = 997 | HMaxConfiguration 998 | { transform :: AbstractTask 999 | , cacheEstimates :: Bool 1000 | } 1001 | 1002 | 1003 | hmax :: HMaxConfiguration -> Expr 1004 | hmax HMaxConfiguration{ transform, cacheEstimates } = 1005 | App 1006 | "hmax" 1007 | [] 1008 | [ transformExpr transform 1009 | , cacheEstimatesExpr cacheEstimates 1010 | ] 1011 | 1012 | 1013 | -- | See 1014 | data InitialStatePotentialConfiguration = 1015 | InitialStatePotentialConfiguration 1016 | { maxPotential :: Maybe Double 1017 | , lpSolver :: LPSolver 1018 | , transform :: AbstractTask 1019 | , cacheEstimates :: Bool 1020 | } 1021 | 1022 | 1023 | initialStatePotential :: InitialStatePotentialConfiguration -> Expr 1024 | initialStatePotential InitialStatePotentialConfiguration{ maxPotential, lpSolver, transform, cacheEstimates } = 1025 | App 1026 | "initial_state_potential" 1027 | [] 1028 | [ maxPotentialOption maxPotential 1029 | , lpSolverOption lpSolver 1030 | , transformExpr transform 1031 | , cacheEstimatesExpr cacheEstimates 1032 | ] 1033 | 1034 | 1035 | -- | See 1036 | data LMCountConfiguration = 1037 | LMCountConfiguration 1038 | { lmFactory :: LandmarkFactory 1039 | , admissible :: Bool 1040 | , optimal :: Bool 1041 | , pref :: Bool 1042 | , alm :: Bool 1043 | , lpSolver :: LPSolver 1044 | , transform :: AbstractTask 1045 | , cacheEstimates :: Bool 1046 | } 1047 | 1048 | 1049 | lmcount :: LMCountConfiguration -> Expr 1050 | lmcount LMCountConfiguration{ lmFactory, admissible, optimal, pref, alm, lpSolver, transform, cacheEstimates } = 1051 | App 1052 | "lmcount" 1053 | [ landmarkFactoryToExpr lmFactory ] 1054 | [ ( "admissible", boolToExpr admissible ) 1055 | , ( "optimal", boolToExpr optimal ) 1056 | , ( "pref", boolToExpr pref ) 1057 | , ( "alm", boolToExpr alm ) 1058 | , lpSolverOption lpSolver 1059 | , transformExpr transform 1060 | , cacheEstimatesExpr cacheEstimates 1061 | ] 1062 | 1063 | 1064 | -- | See 1065 | data LMCutConfiguration = 1066 | LMCutConfiguration 1067 | { transform :: AbstractTask 1068 | , cacheEstimates :: Bool 1069 | } 1070 | 1071 | 1072 | lmcut :: LMCutConfiguration -> Expr 1073 | lmcut LMCutConfiguration{ transform, cacheEstimates } = 1074 | App 1075 | "lmcut" 1076 | [] 1077 | [ transformExpr transform 1078 | , cacheEstimatesExpr cacheEstimates 1079 | ] 1080 | 1081 | 1082 | -- | See 1083 | data MergeAndShrinkConfiguration = 1084 | MergeAndShrinkConfiguration 1085 | { transform :: AbstractTask 1086 | , cacheEstimates :: Bool 1087 | , mergeStrategy :: MergeStrategy 1088 | , shrinkStrategy :: ShrinkStrategy 1089 | , labelReduction :: LabelReduction 1090 | , pruneUnreachableStates :: Bool 1091 | , pruneIrrelevantStates :: Bool 1092 | , maxStates :: Maybe Int 1093 | , maxStatesBeforeMerge :: Maybe Int 1094 | , thresholdBeforeMerge :: Maybe Int 1095 | , verbosity :: Verbosity 1096 | } 1097 | 1098 | 1099 | mergeAndShrink :: MergeAndShrinkConfiguration -> Expr 1100 | mergeAndShrink MergeAndShrinkConfiguration{ transform, cacheEstimates, mergeStrategy, shrinkStrategy, labelReduction, pruneUnreachableStates, pruneIrrelevantStates, maxStates, maxStatesBeforeMerge, thresholdBeforeMerge, verbosity } = 1101 | App 1102 | "merge_and_shrink" 1103 | [] 1104 | [ transformExpr transform 1105 | , cacheEstimatesExpr cacheEstimates 1106 | , ( "merge_strategy", mergeStrategyToExpr mergeStrategy ) 1107 | , ( "shrink_strategy", shrinkStrategyToExpr shrinkStrategy ) 1108 | , ( "label_reduction", labelReductionToExpr labelReduction ) 1109 | , ( "prune_unreachable_states", boolToExpr pruneUnreachableStates ) 1110 | , ( "prune_irrelevant_states", boolToExpr pruneIrrelevantStates ) 1111 | , maxStatesOption maxStates 1112 | , maxStatesBeforeMergeOption maxStatesBeforeMerge 1113 | , thresholdBeforeMergeOption thresholdBeforeMerge 1114 | , ( "verbosity", verbosityToExpr verbosity ) 1115 | ] 1116 | 1117 | 1118 | -- | See 1119 | data OperatorCountingConfiguration = 1120 | OperatorCountingConfiguration 1121 | { constraintGenerators :: [ ConstraintGenerator ] 1122 | , lpSolver :: LPSolver 1123 | , transform :: AbstractTask 1124 | , cacheEstimates :: Bool 1125 | } 1126 | 1127 | 1128 | operatorCounting :: OperatorCountingConfiguration -> Expr 1129 | operatorCounting OperatorCountingConfiguration{ constraintGenerators, lpSolver, transform, cacheEstimates } = 1130 | App 1131 | "operatorcounting" 1132 | [ List ( map constraintGeneratorToExpr constraintGenerators ) ] 1133 | [ lpSolverOption lpSolver 1134 | , transformExpr transform 1135 | , cacheEstimatesExpr cacheEstimates 1136 | ] 1137 | 1138 | 1139 | -- | See 1140 | data SampleBasedPotentialsConfiguration = 1141 | SampleBasedPotentialsConfiguration 1142 | { numHeuristics :: Maybe Int 1143 | , numSamples :: Maybe Int 1144 | , maxPotential :: Maybe Double 1145 | , lpSolver :: LPSolver 1146 | , transform :: AbstractTask 1147 | , cacheEstimates :: Bool 1148 | , randomSeed :: Maybe Int 1149 | } 1150 | 1151 | 1152 | sampleBasedPotentials :: SampleBasedPotentialsConfiguration -> Expr 1153 | sampleBasedPotentials SampleBasedPotentialsConfiguration{ numHeuristics, numSamples, maxPotential, lpSolver, transform, cacheEstimates, randomSeed } = 1154 | App 1155 | "sample_based_potentials" 1156 | [] 1157 | [ ( "num_heuristics", maybe infinity intToExpr numHeuristics ) 1158 | , ( "num_samples", maybe infinity intToExpr numSamples ) 1159 | , ( "max_potential", maybe infinity doubleToExpr maxPotential ) 1160 | , lpSolverOption lpSolver 1161 | , transformExpr transform 1162 | , cacheEstimatesExpr cacheEstimates 1163 | , randomSeedExpr randomSeed 1164 | ] 1165 | 1166 | 1167 | -- | See 1168 | data CanonicalPDBConfiguration = 1169 | CanonicalPDBConfiguration 1170 | { patterns :: PatternCollectionGenerator 1171 | , maxTimeDominancePruning :: Maybe Double 1172 | , transform :: AbstractTask 1173 | , cacheEstimates :: Bool 1174 | } 1175 | 1176 | 1177 | cpdbs :: CanonicalPDBConfiguration -> Expr 1178 | cpdbs CanonicalPDBConfiguration{ patterns, maxTimeDominancePruning, transform, cacheEstimates } = 1179 | App 1180 | "cpdbs" 1181 | [] 1182 | [ ( "patterns", patternCollectionGeneratorToExpr patterns ) 1183 | , ( "max_time_dominance_pruning", maybe infinity doubleToExpr maxTimeDominancePruning ) 1184 | , transformExpr transform 1185 | , cacheEstimatesExpr cacheEstimates 1186 | ] 1187 | 1188 | 1189 | -- | See 1190 | data IPDBConfiguration = 1191 | IPDBConfiguration 1192 | { pdbMaxSize :: Maybe Int 1193 | , collectionMaxSize :: Maybe Int 1194 | , numSamples :: Maybe Int 1195 | , minImprovement :: Maybe Int 1196 | , maxTime :: Maybe Double 1197 | , randomSeed :: Maybe Int 1198 | , maxTimeDominancePruning :: Maybe Double 1199 | , transform :: AbstractTask 1200 | , cacheEstimates :: Bool 1201 | } 1202 | 1203 | 1204 | ipdb :: IPDBConfiguration -> Expr 1205 | ipdb IPDBConfiguration{ pdbMaxSize, collectionMaxSize, numSamples, minImprovement, maxTime, randomSeed, maxTimeDominancePruning, transform, cacheEstimates } = 1206 | App 1207 | "ipdb" 1208 | [] 1209 | [ pdbMaxSizeOption pdbMaxSize 1210 | , ( "collection_max_size", maybe infinity intToExpr collectionMaxSize ) 1211 | , ( "num_samples", maybe infinity intToExpr numSamples ) 1212 | , ( "min_improvement", maybe infinity intToExpr minImprovement ) 1213 | , maxTimeExpr maxTime 1214 | , randomSeedExpr randomSeed 1215 | , ( "max_time_dominance_pruning", maybe infinity doubleToExpr maxTimeDominancePruning ) 1216 | , transformExpr transform 1217 | , cacheEstimatesExpr cacheEstimates 1218 | ] 1219 | 1220 | 1221 | -- | See 1222 | data ZeroOnePDBConfiguration = 1223 | ZeroOnePDBConfiguration 1224 | { patterns :: PatternCollectionGenerator 1225 | , transform :: AbstractTask 1226 | , cacheEstimates :: Bool 1227 | } 1228 | 1229 | 1230 | zopdbs :: ZeroOnePDBConfiguration -> Expr 1231 | zopdbs ZeroOnePDBConfiguration{ patterns, transform, cacheEstimates } = 1232 | App 1233 | "zopdbs" 1234 | [] 1235 | [ ( "patterns", patternCollectionGeneratorToExpr patterns ) 1236 | , transformExpr transform 1237 | , cacheEstimatesExpr cacheEstimates 1238 | ] 1239 | 1240 | 1241 | -- | See 1242 | data StubbornSetsConfiguration = 1243 | StubbornSetsConfiguration 1244 | { minRequiredPruningRatio :: Ratio Int 1245 | , expansionsBeforeCheckingPruningRatio :: Maybe Int 1246 | } 1247 | 1248 | 1249 | stubbornSetsOptions :: StubbornSetsConfiguration -> [ ( String, Expr ) ] 1250 | stubbornSetsOptions StubbornSetsConfiguration{ minRequiredPruningRatio, expansionsBeforeCheckingPruningRatio } = 1251 | [ ( "min_required_pruning_ratio", doubleToExpr ( realToFrac minRequiredPruningRatio ) ) 1252 | , ( "expansions_before_checking_pruning_ratio", maybe infinity intToExpr expansionsBeforeCheckingPruningRatio ) 1253 | ] 1254 | 1255 | 1256 | stubbornSetsEc :: StubbornSetsConfiguration -> Expr 1257 | stubbornSetsEc = 1258 | App "stubborn_sets_ec" [] . stubbornSetsOptions 1259 | 1260 | 1261 | stubbornSetsSimple :: StubbornSetsConfiguration -> Expr 1262 | stubbornSetsSimple = 1263 | App "stubborn_sets_simple" [] . stubbornSetsOptions 1264 | 1265 | 1266 | -- | See 1267 | data AltConfiguration = 1268 | AltConfiguration 1269 | { sublists :: [ OpenList ] 1270 | , boost :: Int 1271 | } 1272 | 1273 | 1274 | alt :: AltConfiguration -> Expr 1275 | alt AltConfiguration{ sublists, boost } = 1276 | App 1277 | "alt" 1278 | [ List ( map openListToExpr sublists ) ] 1279 | [ ( "boost", intToExpr boost ) ] 1280 | 1281 | 1282 | -- | See 1283 | data EpsilonGreedyConfiguration = 1284 | EpsilonGreedyConfiguration 1285 | { eval :: Evaluator 1286 | , prefOnly :: Bool 1287 | , epsilon :: Ratio Int 1288 | , randomSeed :: Maybe Int 1289 | } 1290 | 1291 | 1292 | epsilonGreedy :: EpsilonGreedyConfiguration -> Expr 1293 | epsilonGreedy EpsilonGreedyConfiguration{ eval, prefOnly, epsilon, randomSeed } = 1294 | App 1295 | "epsilon_greedy" 1296 | [ evaluatorToExpr eval ] 1297 | [ prefOnlyExpr prefOnly 1298 | , ( "epsilon", doubleToExpr ( realToFrac epsilon ) ) 1299 | , randomSeedExpr randomSeed 1300 | ] 1301 | 1302 | 1303 | -- | See 1304 | data ParetoConfiguration = 1305 | ParetoConfiguration 1306 | { evals :: [ Evaluator ] 1307 | , prefOnly :: Bool 1308 | , stateUniformSelection :: Bool 1309 | , randomSeed :: Maybe Int 1310 | } 1311 | 1312 | 1313 | pareto :: ParetoConfiguration -> Expr 1314 | pareto ParetoConfiguration{ evals, prefOnly, stateUniformSelection, randomSeed } = 1315 | App 1316 | "pareto_configuration" 1317 | [ List ( map evaluatorToExpr evals ) ] 1318 | [ prefOnlyExpr prefOnly 1319 | , ( "state_uniform_selection", boolToExpr stateUniformSelection ) 1320 | , randomSeedExpr randomSeed 1321 | ] 1322 | 1323 | 1324 | -- | See 1325 | data SingleConfiguration = 1326 | SingleConfiguration 1327 | { eval :: Evaluator 1328 | , prefOnly :: Bool 1329 | } 1330 | 1331 | 1332 | single :: SingleConfiguration -> Expr 1333 | single SingleConfiguration{ eval, prefOnly } = 1334 | App "single" [ evaluatorToExpr eval ] [ prefOnlyExpr prefOnly ] 1335 | 1336 | 1337 | -- | See 1338 | data TiebreakingConfiguration = 1339 | TiebreakingConfiguration 1340 | { evals :: [ Evaluator ] 1341 | , prefOnly :: Bool 1342 | , unsafePruning :: Bool 1343 | } 1344 | 1345 | 1346 | tiebreaking :: TiebreakingConfiguration -> Expr 1347 | tiebreaking TiebreakingConfiguration{ evals, prefOnly, unsafePruning } = 1348 | App 1349 | "tiebreaking" 1350 | [ List ( map evaluatorToExpr evals ) ] 1351 | [ prefOnlyExpr prefOnly 1352 | , ( "unsafe_pruning", boolToExpr unsafePruning ) 1353 | ] 1354 | 1355 | 1356 | -- | See 1357 | data TypeBasedConfiguration = 1358 | TypeBasedConfiguration 1359 | { evaluators :: [ Evaluator ] 1360 | , randomSeed :: Maybe Int 1361 | } 1362 | 1363 | 1364 | typeBased :: TypeBasedConfiguration -> Expr 1365 | typeBased TypeBasedConfiguration{ evaluators, randomSeed } = 1366 | App 1367 | "type_based" 1368 | [ List ( map evaluatorToExpr evaluators ) ] 1369 | [ randomSeedExpr randomSeed ] 1370 | 1371 | 1372 | -- | See 1373 | data AbstractTask 1374 | = AdaptCost CostType 1375 | | NoTransform 1376 | 1377 | 1378 | abstractTaskToExpr :: AbstractTask -> Expr 1379 | abstractTaskToExpr = 1380 | \case 1381 | NoTransform -> 1382 | App "no_transform" [] [] 1383 | 1384 | AdaptCost ct -> 1385 | App "adapt_cost" [] [ ( "cost_type", costTypeToExpr ct ) ] 1386 | 1387 | 1388 | data LPSolver 1389 | = CLP 1390 | | CPLEX 1391 | | GUROBI 1392 | deriving 1393 | ( Show ) 1394 | 1395 | 1396 | lpSolverToExpr :: LPSolver -> Expr 1397 | lpSolverToExpr = 1398 | Lit . show 1399 | 1400 | 1401 | -- | See 1402 | data SubtaskGenerator 1403 | = Goals GoalsConfiguration 1404 | | Landmarks LandmarksConfiguration 1405 | | Original OriginalConfiguration 1406 | 1407 | 1408 | subtaskToExpr :: SubtaskGenerator -> Expr 1409 | subtaskToExpr = 1410 | \case 1411 | Goals cfg -> 1412 | goals cfg 1413 | 1414 | Landmarks cfg -> 1415 | landmarks cfg 1416 | 1417 | Original cfg -> 1418 | original cfg 1419 | 1420 | 1421 | data CEGARPick 1422 | = Random 1423 | | MinUnwanted 1424 | | MaxUnwanted 1425 | | MinRefined 1426 | | MaxRefined 1427 | | MinHAdd 1428 | | MaxHAdd 1429 | 1430 | 1431 | cegarPickToExpr :: CEGARPick -> Expr 1432 | cegarPickToExpr = 1433 | \case 1434 | Random -> 1435 | Lit "RANDOM" 1436 | 1437 | MinUnwanted -> 1438 | Lit "MIN_UNWANTED" 1439 | 1440 | MaxUnwanted -> 1441 | Lit "MAX_UNWANTED" 1442 | 1443 | MinRefined -> 1444 | Lit "MIN_REFINED" 1445 | 1446 | MaxRefined -> 1447 | Lit "MX_REFINED" 1448 | 1449 | MinHAdd -> 1450 | Lit "MIN_HADD" 1451 | 1452 | MaxHAdd -> 1453 | Lit "MAX_HADD" 1454 | 1455 | 1456 | -- | See 1457 | data LandmarkFactory 1458 | = LMExhaust LMExhaustConfiguration 1459 | | LMHM LMHMConfiguration 1460 | | LMMerged LMMergedConfiguration 1461 | | LMRHW LMRHWConfiguration 1462 | | LMZG LMZGConfiguration 1463 | 1464 | 1465 | landmarkFactoryToExpr :: LandmarkFactory -> Expr 1466 | landmarkFactoryToExpr = 1467 | \case 1468 | LMExhaust cfg -> 1469 | lmexhaust cfg 1470 | 1471 | LMHM cfg -> 1472 | lmhm cfg 1473 | 1474 | LMMerged cfg -> 1475 | lmMerged cfg 1476 | 1477 | LMRHW cfg -> 1478 | lmRHW cfg 1479 | 1480 | LMZG cfg -> 1481 | lmzg cfg 1482 | 1483 | 1484 | -- | See 1485 | data MergeStrategy 1486 | = MergePrecomputed MergeTree 1487 | | MergeSCCs MergeSCCsConfiguration 1488 | | MergeStateless MergeSelector 1489 | 1490 | 1491 | mergeStrategyToExpr :: MergeStrategy -> Expr 1492 | mergeStrategyToExpr = 1493 | \case 1494 | MergePrecomputed cfg -> 1495 | App "merge_precomputed" [ mergeTreeToExpr cfg ] [] 1496 | 1497 | MergeSCCs cfg -> 1498 | mergeSCCs cfg 1499 | 1500 | MergeStateless cfg -> 1501 | App "merge_stateless" [ mergeSelectorToExpr cfg ] [] 1502 | 1503 | 1504 | -- | See 1505 | data ShrinkStrategy 1506 | = Bisimulation BisimulationConfiguration 1507 | | FPreserving FPreservingConfiguration 1508 | | RandomShrink ( Maybe Int ) 1509 | 1510 | 1511 | shrinkStrategyToExpr :: ShrinkStrategy -> Expr 1512 | shrinkStrategyToExpr = 1513 | \case 1514 | Bisimulation cfg -> 1515 | bisimulation cfg 1516 | 1517 | FPreserving cfg -> 1518 | fPreserving cfg 1519 | 1520 | RandomShrink randomSeed -> 1521 | App "shrink_random" [] [ randomSeedExpr randomSeed ] 1522 | 1523 | 1524 | newtype LabelReduction 1525 | = ExactGeneralizedLabelReduction ExactGeneralizedLabelReductionConfiguration 1526 | 1527 | 1528 | labelReductionToExpr :: LabelReduction -> Expr 1529 | labelReductionToExpr ( ExactGeneralizedLabelReduction cfg ) = 1530 | exact cfg 1531 | 1532 | 1533 | data Verbosity = 1534 | Silent | Basic | Verbose 1535 | deriving 1536 | ( Show ) 1537 | 1538 | 1539 | verbosityToExpr :: Verbosity -> Expr 1540 | verbosityToExpr = 1541 | Lit . map toLower . show 1542 | 1543 | 1544 | data ConstraintGenerator 1545 | = LMCutConstraints 1546 | | PosthocOptimizationConstraints PatternCollectionGenerator 1547 | | StateEquationConstraints 1548 | 1549 | 1550 | constraintGeneratorToExpr :: ConstraintGenerator -> Expr 1551 | constraintGeneratorToExpr = 1552 | \case 1553 | LMCutConstraints -> 1554 | App "lmcut_constraints" [] [] 1555 | 1556 | PosthocOptimizationConstraints cfg -> 1557 | App "pho_constraints" [] [ ( "patterns", patternCollectionGeneratorToExpr cfg ) ] 1558 | 1559 | StateEquationConstraints -> 1560 | App "state_equation_constraints" [] [] 1561 | 1562 | 1563 | -- | See 1564 | data PatternCollectionGenerator 1565 | = Combo ( Maybe Int ) 1566 | | Genetic GeneticConfiguration 1567 | | Hillclimbing HillclimbingConfiguration 1568 | | ManualPattern [ [ Int ] ] 1569 | | Systematic SystematicConfiguration 1570 | 1571 | 1572 | patternCollectionGeneratorToExpr :: PatternCollectionGenerator -> Expr 1573 | patternCollectionGeneratorToExpr = 1574 | \case 1575 | Combo maxStates -> 1576 | App "combo" [] [ maxStatesOption maxStates ] 1577 | 1578 | Genetic cfg -> 1579 | genetic cfg 1580 | 1581 | Hillclimbing cfg -> 1582 | hillclimbing cfg 1583 | 1584 | ManualPattern cfg -> 1585 | App 1586 | "manual_patterns" 1587 | [ List ( map ( List . map intToExpr ) cfg ) ] 1588 | [] 1589 | 1590 | Systematic cfg -> 1591 | systematic cfg 1592 | 1593 | 1594 | -- | See 1595 | data GoalsConfiguration = 1596 | GoalsConfiguration 1597 | { order :: GoalsOrder 1598 | , randomSeed :: Maybe Int 1599 | } 1600 | 1601 | 1602 | goals :: GoalsConfiguration -> Expr 1603 | goals GoalsConfiguration{ order, randomSeed } = 1604 | App 1605 | "goals" 1606 | [] 1607 | [ orderExpr order 1608 | , randomSeedExpr randomSeed 1609 | ] 1610 | 1611 | 1612 | -- | See 1613 | data LandmarksConfiguration = 1614 | LandmarksConfiguration 1615 | { order :: GoalsOrder 1616 | , randomSeed :: Maybe Int 1617 | , combineFacts :: Bool 1618 | } 1619 | 1620 | 1621 | landmarks :: LandmarksConfiguration -> Expr 1622 | landmarks LandmarksConfiguration{ order, randomSeed, combineFacts } = 1623 | App 1624 | "landmarks" 1625 | [] 1626 | [ orderExpr order 1627 | , randomSeedExpr randomSeed 1628 | , ( "combine_facts", boolToExpr combineFacts ) 1629 | ] 1630 | 1631 | 1632 | newtype OriginalConfiguration = 1633 | OriginalConfiguration 1634 | { copies :: Maybe Int } 1635 | 1636 | 1637 | original :: OriginalConfiguration -> Expr 1638 | original OriginalConfiguration{ copies } = 1639 | App "original" [] [ ( "copies", maybe infinity intToExpr copies ) ] 1640 | 1641 | 1642 | -- | See 1643 | data LMExhaustConfiguration = 1644 | LMExhaustConfiguration 1645 | { reasonableOrders :: Bool 1646 | , onlyCausalLandmarks :: Bool 1647 | , disjunctiveLandmarks :: Bool 1648 | , conjunctiveLandmarks :: Bool 1649 | , noOrders :: Bool 1650 | } 1651 | 1652 | 1653 | lmexhaust :: LMExhaustConfiguration -> Expr 1654 | lmexhaust LMExhaustConfiguration{ reasonableOrders, onlyCausalLandmarks, disjunctiveLandmarks, conjunctiveLandmarks, noOrders } = 1655 | App 1656 | "lm_exhaust" 1657 | [] 1658 | [ ( "reasonable_orders", boolToExpr reasonableOrders ) 1659 | , ( "only_causal_landmarks", boolToExpr onlyCausalLandmarks ) 1660 | , ( "disjunctive_landmarks", boolToExpr disjunctiveLandmarks ) 1661 | , ( "conjunctive_landmarks", boolToExpr conjunctiveLandmarks ) 1662 | , ( "no_orders", boolToExpr noOrders ) 1663 | ] 1664 | 1665 | 1666 | -- | See 1667 | data LMHMConfiguration = 1668 | LMHMConfiguration 1669 | { m :: Int 1670 | , reasonableOrders :: Bool 1671 | , onlyCausalLandmarks :: Bool 1672 | , disjunctiveLandmarks :: Bool 1673 | , conjunctiveLandmarks :: Bool 1674 | , noOrders :: Bool 1675 | } 1676 | 1677 | 1678 | lmhm :: LMHMConfiguration -> Expr 1679 | lmhm LMHMConfiguration{ m, reasonableOrders, onlyCausalLandmarks, disjunctiveLandmarks, conjunctiveLandmarks, noOrders } = 1680 | App 1681 | "lm_hm" 1682 | [] 1683 | [ ( "m", intToExpr m ) 1684 | , ( "reasonable_orders", boolToExpr reasonableOrders ) 1685 | , ( "only_causal_landmarks", boolToExpr onlyCausalLandmarks ) 1686 | , ( "disjunctive_landmarks", boolToExpr disjunctiveLandmarks ) 1687 | , ( "conjunctive_landmarks", boolToExpr conjunctiveLandmarks ) 1688 | , ( "no_orders", boolToExpr noOrders ) 1689 | ] 1690 | 1691 | 1692 | -- | See 1693 | data LMMergedConfiguration = 1694 | LMMergedConfiguration 1695 | { factories :: [ LandmarkFactory ] 1696 | , reasonableOrders :: Bool 1697 | , onlyCausalLandmarks :: Bool 1698 | , disjunctiveLandmarks :: Bool 1699 | , conjunctiveLandmarks :: Bool 1700 | , noOrders :: Bool 1701 | } 1702 | 1703 | 1704 | lmMerged :: LMMergedConfiguration -> Expr 1705 | lmMerged LMMergedConfiguration{ factories, reasonableOrders, onlyCausalLandmarks, disjunctiveLandmarks, conjunctiveLandmarks, noOrders } = 1706 | App 1707 | "lm_merged" 1708 | [ List ( map landmarkFactoryToExpr factories ) ] 1709 | [ ( "reasonable_orders", boolToExpr reasonableOrders ) 1710 | , ( "only_causal_landmarks", boolToExpr onlyCausalLandmarks ) 1711 | , ( "disjunctive_landmarks", boolToExpr disjunctiveLandmarks ) 1712 | , ( "conjunctive_landmarks", boolToExpr conjunctiveLandmarks ) 1713 | , ( "no_orders", boolToExpr noOrders ) 1714 | ] 1715 | 1716 | 1717 | -- | See . 1718 | data LMRHWConfiguration = 1719 | LMRHWConfiguration 1720 | { reasonableOrders :: Bool 1721 | , onlyCausalLandmarks :: Bool 1722 | , disjunctiveLandmarks :: Bool 1723 | , conjunctiveLandmarks :: Bool 1724 | , noOrders :: Bool 1725 | } 1726 | 1727 | 1728 | lmRHW :: LMRHWConfiguration -> Expr 1729 | lmRHW LMRHWConfiguration{ reasonableOrders, onlyCausalLandmarks, disjunctiveLandmarks, conjunctiveLandmarks, noOrders } = 1730 | App 1731 | "lm_rhw" 1732 | [] 1733 | [ ( "reasonable_orders", boolToExpr reasonableOrders ) 1734 | , ( "only_causal_landmarks", boolToExpr onlyCausalLandmarks ) 1735 | , ( "disjunctive_landmarks", boolToExpr disjunctiveLandmarks ) 1736 | , ( "conjunctive_landmarks", boolToExpr conjunctiveLandmarks ) 1737 | , ( "no_orders", boolToExpr noOrders ) 1738 | ] 1739 | 1740 | 1741 | -- | See 1742 | data LMZGConfiguration = 1743 | LMZGConfiguration 1744 | { reasonableOrders :: Bool 1745 | , onlyCausalLandmarks :: Bool 1746 | , disjunctiveLandmarks :: Bool 1747 | , conjunctiveLandmarks :: Bool 1748 | , noOrders :: Bool 1749 | } 1750 | 1751 | 1752 | lmzg :: LMZGConfiguration -> Expr 1753 | lmzg LMZGConfiguration{ reasonableOrders, onlyCausalLandmarks, disjunctiveLandmarks, conjunctiveLandmarks, noOrders } = 1754 | App 1755 | "lm_zg" 1756 | [] 1757 | [ ( "reasonable_orders", boolToExpr reasonableOrders ) 1758 | , ( "only_causal_landmarks", boolToExpr onlyCausalLandmarks ) 1759 | , ( "disjunctive_landmarks", boolToExpr disjunctiveLandmarks ) 1760 | , ( "conjunctive_landmarks", boolToExpr conjunctiveLandmarks ) 1761 | , ( "no_orders", boolToExpr noOrders ) 1762 | ] 1763 | 1764 | 1765 | newtype MergeTree 1766 | = LinearMergeTree LinearMergeTreeConfiguration 1767 | 1768 | 1769 | mergeTreeToExpr :: MergeTree -> Expr 1770 | mergeTreeToExpr ( LinearMergeTree cfg ) = 1771 | linear cfg 1772 | 1773 | 1774 | -- | See 1775 | data MergeSCCsConfiguration = 1776 | MergeSCCsConfiguration 1777 | { orderOfSCCs :: OrderOfSCCs 1778 | , mergeTree :: Maybe MergeTree 1779 | , mergeSelector :: Maybe MergeSelector 1780 | } 1781 | 1782 | 1783 | mergeSCCs :: MergeSCCsConfiguration -> Expr 1784 | mergeSCCs MergeSCCsConfiguration{ orderOfSCCs, mergeTree, mergeSelector } = 1785 | App 1786 | "merge_sccs" 1787 | [] 1788 | [ ( "order_of_sccs", orderOfSCCsToExpr orderOfSCCs ) 1789 | , ( "merge_tree", maybe none mergeTreeToExpr mergeTree ) 1790 | , ( "merge_selector", maybe none mergeSelectorToExpr mergeSelector ) 1791 | ] 1792 | 1793 | 1794 | newtype MergeSelector 1795 | = ScoreBasedFiltering [ MergeScoringFunction ] 1796 | 1797 | 1798 | mergeSelectorToExpr :: MergeSelector -> Expr 1799 | mergeSelectorToExpr ( ScoreBasedFiltering scoringFunctions ) = 1800 | App "score_based_filtering" [ List ( map mergeScoringFunctionToExpr scoringFunctions ) ] [] 1801 | 1802 | 1803 | -- | See 1804 | data BisimulationConfiguration = 1805 | BisimulationConfiguration 1806 | { greedy :: Bool 1807 | , atLimit :: BisimulationLimitStrategy 1808 | } 1809 | 1810 | 1811 | bisimulation :: BisimulationConfiguration -> Expr 1812 | bisimulation BisimulationConfiguration{ greedy, atLimit } = 1813 | App 1814 | "shrink_bisimulation" 1815 | [] 1816 | [ ( "greedy", boolToExpr greedy ) 1817 | , ( "at_limit", bisimulationLimitStrategyToExpr atLimit ) 1818 | ] 1819 | 1820 | 1821 | -- | See 1822 | data FPreservingConfiguration = 1823 | FPreservingConfiguration 1824 | { randomSeed :: Maybe Int 1825 | , shrinkF :: HighLow 1826 | , shrinkH :: HighLow 1827 | } 1828 | 1829 | 1830 | fPreserving :: FPreservingConfiguration -> Expr 1831 | fPreserving FPreservingConfiguration{ randomSeed, shrinkF, shrinkH } = 1832 | App 1833 | "shrink_fh" 1834 | [] 1835 | [ randomSeedExpr randomSeed 1836 | , ( "shrink_f", highLowToExpr shrinkF ) 1837 | , ( "shrink_h", highLowToExpr shrinkH ) 1838 | ] 1839 | 1840 | 1841 | -- | See 1842 | data ExactGeneralizedLabelReductionConfiguration = 1843 | ExactGeneralizedLabelReductionConfiguration 1844 | { beforeShrinking :: Bool 1845 | , beforeMerging :: Bool 1846 | , method :: LabelReductionMethod 1847 | , systemOrder :: SystemOrder 1848 | , randomSeed :: Maybe Int 1849 | } 1850 | 1851 | 1852 | exact :: ExactGeneralizedLabelReductionConfiguration -> Expr 1853 | exact ExactGeneralizedLabelReductionConfiguration{ beforeShrinking, beforeMerging, method, systemOrder, randomSeed } = 1854 | App 1855 | "exact" 1856 | [ boolToExpr beforeShrinking 1857 | , boolToExpr beforeMerging 1858 | ] 1859 | [ ( "method", labelReductionMethodToExpr method ) 1860 | , ( "system_order", systemOrderToExpr systemOrder ) 1861 | , randomSeedExpr randomSeed 1862 | ] 1863 | 1864 | 1865 | -- | See 1866 | data GeneticConfiguration = 1867 | GeneticConfiguration 1868 | { pdbMaxSize :: Maybe Int 1869 | , numCollections :: Maybe Int 1870 | , numEpisodes :: Maybe Int 1871 | , mutationProbability :: Ratio Int 1872 | , disjoint :: Bool 1873 | , randomSeed :: Maybe Int 1874 | } 1875 | 1876 | 1877 | genetic :: GeneticConfiguration -> Expr 1878 | genetic GeneticConfiguration{ pdbMaxSize, numCollections, numEpisodes, mutationProbability, disjoint, randomSeed } = 1879 | App 1880 | "genetic" 1881 | [] 1882 | [ pdbMaxSizeOption pdbMaxSize 1883 | , ( "num_collections", maybe infinity intToExpr numCollections ) 1884 | , ( "num_episodes", maybe infinity intToExpr numEpisodes ) 1885 | , ( "mutation_probability", doubleToExpr ( realToFrac mutationProbability ) ) 1886 | , ( "disjoint", boolToExpr disjoint ) 1887 | , randomSeedExpr randomSeed 1888 | ] 1889 | 1890 | 1891 | -- | See 1892 | data HillclimbingConfiguration = 1893 | HillclimbingConfiguration 1894 | { pdbMaxSize :: Maybe Int 1895 | , collectionMaxSize :: Maybe Int 1896 | , numSamples :: Maybe Int 1897 | , minImprovement :: Maybe Int 1898 | , maxTime :: Maybe Double 1899 | , randomSeed :: Maybe Int 1900 | } 1901 | 1902 | 1903 | hillclimbing :: HillclimbingConfiguration -> Expr 1904 | hillclimbing HillclimbingConfiguration{ pdbMaxSize, collectionMaxSize, numSamples, minImprovement, maxTime, randomSeed } = 1905 | App 1906 | "hillclimbing" 1907 | [] 1908 | [ pdbMaxSizeOption pdbMaxSize 1909 | , ( "collection_max_size", maybe infinity intToExpr collectionMaxSize ) 1910 | , ( "num_samples", maybe infinity intToExpr numSamples ) 1911 | , ( "min_improvement", maybe infinity intToExpr minImprovement ) 1912 | , maxTimeExpr maxTime 1913 | , randomSeedExpr randomSeed 1914 | ] 1915 | 1916 | 1917 | -- | See 1918 | data SystematicConfiguration = 1919 | SystematicConfiguration 1920 | { patternMaxSize :: Maybe Int 1921 | , onlyInterestingPatterns :: Bool 1922 | } 1923 | 1924 | 1925 | systematic :: SystematicConfiguration -> Expr 1926 | systematic SystematicConfiguration{ patternMaxSize, onlyInterestingPatterns } = 1927 | App 1928 | "systematic" 1929 | [] 1930 | [ ( "pattern_max_size", maybe infinity intToExpr patternMaxSize ) 1931 | , ( "only_interesting_patterns", boolToExpr onlyInterestingPatterns ) 1932 | ] 1933 | 1934 | 1935 | data GoalsOrder = 1936 | OriginalOrder | RandomOrder | HAddUp | HAddDown 1937 | 1938 | 1939 | goalsOrderToExpr :: GoalsOrder -> Expr 1940 | goalsOrderToExpr = 1941 | \case 1942 | OriginalOrder -> 1943 | Lit "ORIGINAL" 1944 | 1945 | RandomOrder -> 1946 | Lit "RANDOM" 1947 | 1948 | HAddUp -> 1949 | Lit "HADD_UP" 1950 | 1951 | HAddDown -> 1952 | Lit "HADD_DOWN" 1953 | 1954 | 1955 | -- | See 1956 | data LinearMergeTreeConfiguration = 1957 | LinearMergeTreeConfiguration 1958 | { randomSeed :: Maybe Int 1959 | , updateOption :: UpdateOption 1960 | , variableOrder :: VariableOrder 1961 | } 1962 | 1963 | 1964 | linear :: LinearMergeTreeConfiguration -> Expr 1965 | linear LinearMergeTreeConfiguration { randomSeed, updateOption, variableOrder } = 1966 | App 1967 | "linear" 1968 | [] 1969 | [ randomSeedExpr randomSeed 1970 | , ( "update_option", updateOptionToExpr updateOption ) 1971 | , ( "variable_order", variableOrderToExpr variableOrder ) 1972 | ] 1973 | 1974 | 1975 | data OrderOfSCCs = 1976 | Topological | ReverseTopological | Decreasing | Increasing 1977 | 1978 | 1979 | orderOfSCCsToExpr :: OrderOfSCCs -> Expr 1980 | orderOfSCCsToExpr = 1981 | \case 1982 | Topological -> 1983 | Lit "topological" 1984 | 1985 | ReverseTopological -> 1986 | Lit "reverse_topological" 1987 | 1988 | Decreasing -> 1989 | Lit "decreasing" 1990 | 1991 | Increasing -> 1992 | Lit "increasing" 1993 | 1994 | 1995 | -- | See 1996 | data MergeScoringFunction 1997 | = DFP 1998 | | GoalRelevance 1999 | | MIASM MIASMConfiguration 2000 | | SingleRandom ( Maybe Int ) 2001 | | TotalOrder TotalOrderConfiguration 2002 | 2003 | 2004 | mergeScoringFunctionToExpr :: MergeScoringFunction -> Expr 2005 | mergeScoringFunctionToExpr = 2006 | \case 2007 | DFP -> 2008 | App "dfp" [] [] 2009 | 2010 | GoalRelevance -> 2011 | App "goal_relevance" [] [] 2012 | 2013 | MIASM cfg -> 2014 | miasm cfg 2015 | 2016 | SingleRandom cfg -> 2017 | App "single_random" [] [ randomSeedExpr cfg ] 2018 | 2019 | TotalOrder cfg -> 2020 | totalOrder cfg 2021 | 2022 | 2023 | data BisimulationLimitStrategy = 2024 | Return | UseUp 2025 | 2026 | 2027 | bisimulationLimitStrategyToExpr :: BisimulationLimitStrategy -> Expr 2028 | bisimulationLimitStrategyToExpr = 2029 | \case 2030 | Return -> 2031 | Lit "RETURN" 2032 | 2033 | UseUp -> 2034 | Lit "USE_UP" 2035 | 2036 | 2037 | data HighLow = 2038 | High | Low 2039 | deriving 2040 | ( Show ) 2041 | 2042 | 2043 | highLowToExpr :: HighLow -> Expr 2044 | highLowToExpr = 2045 | Lit . map toUpper . show 2046 | 2047 | 2048 | data LabelReductionMethod = 2049 | TwoTransitionSystems | AllTransitionSystems | AllTransitionSystemsWithFixpoint 2050 | 2051 | 2052 | labelReductionMethodToExpr :: LabelReductionMethod -> Expr 2053 | labelReductionMethodToExpr = 2054 | \case 2055 | TwoTransitionSystems -> 2056 | Lit "TWO_TRANSITION_SYSTEMS" 2057 | 2058 | AllTransitionSystems -> 2059 | Lit "ALL_TRANSITION_SYSTEMS" 2060 | 2061 | AllTransitionSystemsWithFixpoint -> 2062 | Lit "ALL_TRANSITION_SYSTEMS_WITH_FIXPOINT" 2063 | 2064 | 2065 | data SystemOrder = 2066 | RegularSystemOrder | ReverseSystemOrder | RandomSystemOrder 2067 | 2068 | 2069 | systemOrderToExpr :: SystemOrder -> Expr 2070 | systemOrderToExpr = 2071 | \case 2072 | RegularSystemOrder -> 2073 | Lit "REGULAR" 2074 | 2075 | ReverseSystemOrder -> 2076 | Lit "REVERSE" 2077 | 2078 | RandomSystemOrder -> 2079 | Lit "RANDOM" 2080 | 2081 | 2082 | data UpdateOption = 2083 | UseFirst | UseSecond | UseRandom 2084 | 2085 | 2086 | updateOptionToExpr :: UpdateOption -> Expr 2087 | updateOptionToExpr = 2088 | \case 2089 | UseFirst -> 2090 | Lit "use_first" 2091 | 2092 | UseSecond -> 2093 | Lit "use_second" 2094 | 2095 | UseRandom -> 2096 | Lit "use_random" 2097 | 2098 | 2099 | data VariableOrder = 2100 | CGGoalLevel | CGGoalRandom | GoalCGLevel | RandomVariableOrder | LevelOrder | ReverseLevelOrder 2101 | 2102 | 2103 | variableOrderToExpr :: VariableOrder -> Expr 2104 | variableOrderToExpr = 2105 | \case 2106 | CGGoalLevel -> 2107 | Lit "CG_GOAL_LEVEL" 2108 | 2109 | CGGoalRandom -> 2110 | Lit "CG_GOAL_RANDOM" 2111 | 2112 | GoalCGLevel -> 2113 | Lit "GOAL_CG_LEVEL" 2114 | 2115 | RandomVariableOrder -> 2116 | Lit "RANDOM" 2117 | 2118 | LevelOrder -> 2119 | Lit "LEVEL" 2120 | 2121 | ReverseLevelOrder -> 2122 | Lit "REVERSE_LEVEL" 2123 | 2124 | 2125 | data MIASMConfiguration = 2126 | MIASMConfiguration 2127 | { shrinkStrategy :: ShrinkStrategy 2128 | , maxStates :: Maybe Int 2129 | , maxStatesBeforeMerge :: Maybe Int 2130 | , thresholdBeforeMerge :: Maybe Int 2131 | } 2132 | 2133 | 2134 | miasm :: MIASMConfiguration -> Expr 2135 | miasm MIASMConfiguration{ shrinkStrategy, maxStates, maxStatesBeforeMerge, thresholdBeforeMerge } = 2136 | App 2137 | "sf_miasm" 2138 | [ shrinkStrategyToExpr shrinkStrategy ] 2139 | [ maxStatesOption maxStates 2140 | , maxStatesBeforeMergeOption maxStatesBeforeMerge 2141 | , ( "threshold_before_merge", maybe infinity intToExpr thresholdBeforeMerge ) 2142 | ] 2143 | 2144 | 2145 | data TotalOrderConfiguration = 2146 | TotalOrderConfiguration 2147 | { atomicTsOrder :: AtomicTsOrder 2148 | , productTsOrder :: ProductTsOrder 2149 | , atomicBeforeProduct :: Bool 2150 | , randomSeed :: Maybe Int 2151 | } 2152 | 2153 | 2154 | totalOrder :: TotalOrderConfiguration -> Expr 2155 | totalOrder TotalOrderConfiguration{ atomicTsOrder, productTsOrder, atomicBeforeProduct, randomSeed } = 2156 | App 2157 | "total_order" 2158 | [] 2159 | [ ( "atomic_ts_order", atomicTsOrderToExpr atomicTsOrder ) 2160 | , ( "product_ts_order", productTsOrderToExpr productTsOrder ) 2161 | , ( "atomic_before_product", boolToExpr atomicBeforeProduct ) 2162 | , randomSeedExpr randomSeed 2163 | ] 2164 | 2165 | 2166 | data AtomicTsOrder = 2167 | ReverseLevelAtomicTs | LevelAtomicTs | RandomAtomicTs 2168 | 2169 | 2170 | atomicTsOrderToExpr :: AtomicTsOrder -> Expr 2171 | atomicTsOrderToExpr = 2172 | \case 2173 | ReverseLevelAtomicTs -> 2174 | Lit "reverse_level" 2175 | 2176 | LevelAtomicTs -> 2177 | Lit "level" 2178 | 2179 | RandomAtomicTs -> 2180 | Lit "random" 2181 | 2182 | 2183 | data ProductTsOrder = 2184 | OldToNew | NewToOld | RandomProductTsOrder 2185 | 2186 | 2187 | productTsOrderToExpr :: ProductTsOrder -> Expr 2188 | productTsOrderToExpr = 2189 | \case 2190 | OldToNew -> 2191 | Lit "old_to_new" 2192 | 2193 | NewToOld -> 2194 | Lit "new_to_old" 2195 | 2196 | RandomProductTsOrder -> 2197 | Lit "random" 2198 | 2199 | 2200 | randomSeedExpr :: Maybe Int -> ( String, Expr ) 2201 | randomSeedExpr r = 2202 | ( "random_seed", intToExpr ( fromMaybe (-1) r ) ) 2203 | 2204 | 2205 | prefOnlyExpr :: Bool -> ( String, Expr ) 2206 | prefOnlyExpr b = 2207 | ( "pref_only", boolToExpr b ) 2208 | 2209 | 2210 | transformExpr :: AbstractTask -> ( String, Expr ) 2211 | transformExpr t = 2212 | ( "transform", abstractTaskToExpr t ) 2213 | 2214 | 2215 | cacheEstimatesExpr :: Bool -> ( String, Expr ) 2216 | cacheEstimatesExpr b = 2217 | ( "cache_estimates", boolToExpr b ) 2218 | 2219 | 2220 | maxTimeExpr :: Maybe Double -> ( String, Expr ) 2221 | maxTimeExpr t = 2222 | ( "max_time", maybe infinity doubleToExpr t ) 2223 | 2224 | 2225 | orderExpr :: GoalsOrder -> ( String, Expr ) 2226 | orderExpr g = 2227 | ( "order", goalsOrderToExpr g ) 2228 | 2229 | 2230 | lpSolverOption :: LPSolver -> ( String, Expr ) 2231 | lpSolverOption a = 2232 | ( "lpsolver", lpSolverToExpr a ) 2233 | 2234 | 2235 | maxPotentialOption :: Maybe Double -> ( String, Expr ) 2236 | maxPotentialOption a = 2237 | ( "max_potential", maybe infinity doubleToExpr a ) 2238 | 2239 | 2240 | maxStatesOption :: Maybe Int -> ( String, Expr ) 2241 | maxStatesOption a = 2242 | ( "max_states", maybe infinity intToExpr a ) 2243 | 2244 | 2245 | maxStatesBeforeMergeOption :: Maybe Int -> ( String, Expr ) 2246 | maxStatesBeforeMergeOption a = 2247 | ( "max_states_before_merge", maybe infinity intToExpr a ) 2248 | 2249 | 2250 | thresholdBeforeMergeOption :: Maybe Int -> ( String, Expr ) 2251 | thresholdBeforeMergeOption a = 2252 | ( "threshold_before_merge", maybe infinity intToExpr a ) 2253 | 2254 | 2255 | pdbMaxSizeOption :: Maybe Int -> ( String, Expr ) 2256 | pdbMaxSizeOption a = 2257 | ( "pdb_max_size", maybe infinity intToExpr a ) 2258 | -------------------------------------------------------------------------------- /FastDownward/SAS.hs: -------------------------------------------------------------------------------- 1 | module FastDownward.SAS 2 | ( Axiom( Axiom ) 3 | , DomainIndex( DomainIndex, unDomainIndex ) 4 | , Effect( Effect ) 5 | , Goal( Goal ) 6 | , MutexGroup( MutexGroup ) 7 | , Operator( Operator ) 8 | , Plan( Plan ) 9 | , State( State ) 10 | , UseCosts(..) 11 | , Variable( Variable ) 12 | , VariableAssignment( VariableAssignment ) 13 | , VariableIndex( VariableIndex, unVariableIndex ) 14 | , Version(..) 15 | ) where 16 | 17 | import FastDownward.SAS.Axiom 18 | import FastDownward.SAS.DomainIndex 19 | import FastDownward.SAS.Effect 20 | import FastDownward.SAS.Goal 21 | import FastDownward.SAS.MutexGroup 22 | import FastDownward.SAS.Operator 23 | import FastDownward.SAS.Plan 24 | import FastDownward.SAS.State 25 | import FastDownward.SAS.UseCosts 26 | import FastDownward.SAS.Variable 27 | import FastDownward.SAS.VariableAssignment 28 | import FastDownward.SAS.VariableIndex 29 | import FastDownward.SAS.Version 30 | -------------------------------------------------------------------------------- /FastDownward/SAS/Axiom.hs: -------------------------------------------------------------------------------- 1 | {-# language OverloadedStrings #-} 2 | {-# language RecordWildCards #-} 3 | 4 | module FastDownward.SAS.Axiom ( Axiom(..), toSAS ) where 5 | 6 | import Data.Sequence ( Seq ) 7 | import qualified Data.Sequence as Seq 8 | import qualified Data.Text.Lazy.Builder 9 | import qualified Data.Text.Lazy.Builder.Int 10 | import FastDownward.SAS.DomainIndex ( DomainIndex ) 11 | import qualified FastDownward.SAS.DomainIndex as DomainIndex 12 | import FastDownward.SAS.VariableAssignment ( VariableAssignment ) 13 | import qualified FastDownward.SAS.VariableAssignment as VariableAssignment 14 | import FastDownward.SAS.VariableIndex ( VariableIndex ) 15 | import qualified FastDownward.SAS.VariableIndex as VariableIndex 16 | 17 | 18 | data Axiom = 19 | Axiom 20 | { variable :: VariableIndex 21 | , conditions :: Seq VariableAssignment 22 | , pre :: DomainIndex 23 | , post :: DomainIndex 24 | } 25 | deriving 26 | ( Show ) 27 | 28 | 29 | toSAS :: Axiom -> Data.Text.Lazy.Builder.Builder 30 | toSAS Axiom{..} = 31 | "begin_rule\n" 32 | <> Data.Text.Lazy.Builder.Int.decimal ( Seq.length conditions ) <> "\n" 33 | <> foldMap ( \x -> VariableAssignment.toSAS x <> "\n" ) conditions 34 | <> VariableIndex.toSAS variable <> " " <> DomainIndex.toSAS pre <> " " <> DomainIndex.toSAS post <> "\n" 35 | <> "end_rule" 36 | -------------------------------------------------------------------------------- /FastDownward/SAS/DomainIndex.hs: -------------------------------------------------------------------------------- 1 | module FastDownward.SAS.DomainIndex ( DomainIndex(..), toSAS ) where 2 | 3 | import qualified Data.Text.Lazy.Builder 4 | import qualified Data.Text.Lazy.Builder.Int 5 | 6 | 7 | newtype DomainIndex = 8 | DomainIndex { unDomainIndex :: Int } 9 | deriving 10 | ( Eq, Ord, Show ) 11 | 12 | 13 | toSAS :: DomainIndex -> Data.Text.Lazy.Builder.Builder 14 | toSAS ( DomainIndex i ) = 15 | Data.Text.Lazy.Builder.Int.decimal i 16 | -------------------------------------------------------------------------------- /FastDownward/SAS/Effect.hs: -------------------------------------------------------------------------------- 1 | {-# language OverloadedStrings #-} 2 | {-# language RecordWildCards #-} 3 | 4 | module FastDownward.SAS.Effect ( Effect(..), toSAS ) where 5 | 6 | import qualified Data.Text.Lazy.Builder 7 | import FastDownward.SAS.DomainIndex ( DomainIndex ) 8 | import qualified FastDownward.SAS.DomainIndex as DomainIndex 9 | import FastDownward.SAS.VariableIndex ( VariableIndex ) 10 | import qualified FastDownward.SAS.VariableIndex as VariableIndex 11 | 12 | 13 | data Effect = 14 | Effect 15 | { variable :: VariableIndex 16 | , pre :: Maybe DomainIndex 17 | , post :: DomainIndex 18 | } 19 | deriving 20 | ( Eq, Ord, Show ) 21 | 22 | 23 | toSAS :: Effect -> Data.Text.Lazy.Builder.Builder 24 | toSAS Effect{..} = 25 | "0" 26 | <> " " 27 | <> VariableIndex.toSAS variable <> " " 28 | <> case pre of 29 | Nothing -> 30 | "-1" 31 | 32 | Just x -> 33 | DomainIndex.toSAS x 34 | <> " " 35 | <> DomainIndex.toSAS post 36 | -------------------------------------------------------------------------------- /FastDownward/SAS/Goal.hs: -------------------------------------------------------------------------------- 1 | {-# language OverloadedStrings #-} 2 | {-# language RecordWildCards #-} 3 | 4 | module FastDownward.SAS.Goal ( Goal(..), toSAS ) where 5 | 6 | import Data.Sequence ( Seq ) 7 | import qualified Data.Sequence as Seq 8 | import qualified Data.Text.Lazy.Builder 9 | import qualified Data.Text.Lazy.Builder.Int 10 | import FastDownward.SAS.VariableAssignment ( VariableAssignment ) 11 | import qualified FastDownward.SAS.VariableAssignment as VariableAssignment 12 | 13 | 14 | newtype Goal = 15 | Goal { finalAssignments :: Seq VariableAssignment } 16 | deriving 17 | ( Show ) 18 | 19 | 20 | toSAS :: Goal -> Data.Text.Lazy.Builder.Builder 21 | toSAS Goal{..} = 22 | "begin_goal\n" 23 | <> Data.Text.Lazy.Builder.Int.decimal ( Seq.length finalAssignments ) <> "\n" 24 | <> foldMap ( \x -> VariableAssignment.toSAS x <> "\n" ) finalAssignments 25 | <> "end_goal" 26 | -------------------------------------------------------------------------------- /FastDownward/SAS/MutexGroup.hs: -------------------------------------------------------------------------------- 1 | {-# language OverloadedStrings #-} 2 | {-# language RecordWildCards #-} 3 | 4 | module FastDownward.SAS.MutexGroup ( MutexGroup(..), toSAS ) where 5 | 6 | import Data.Sequence ( Seq ) 7 | import qualified Data.Sequence as Seq 8 | import qualified Data.Text.Lazy.Builder 9 | import qualified Data.Text.Lazy.Builder.Int 10 | import FastDownward.SAS.VariableAssignment ( VariableAssignment ) 11 | import qualified FastDownward.SAS.VariableAssignment as VariableAssignment 12 | 13 | 14 | newtype MutexGroup = 15 | MutexGroup { assignments :: Seq VariableAssignment } 16 | deriving 17 | ( Show ) 18 | 19 | 20 | toSAS :: MutexGroup -> Data.Text.Lazy.Builder.Builder 21 | toSAS MutexGroup{..} = 22 | "begin_mutex_group\n" 23 | <> Data.Text.Lazy.Builder.Int.decimal ( Seq.length assignments ) <> "\n" 24 | <> foldMap ( \x -> VariableAssignment.toSAS x <> "\n" ) assignments 25 | <> "end_mutex_group" 26 | -------------------------------------------------------------------------------- /FastDownward/SAS/Operator.hs: -------------------------------------------------------------------------------- 1 | {-# language OverloadedStrings #-} 2 | {-# language RecordWildCards #-} 3 | 4 | module FastDownward.SAS.Operator ( Operator(..), toSAS ) where 5 | 6 | import Data.Sequence ( Seq ) 7 | import qualified Data.Sequence as Seq 8 | import qualified Data.Text.Lazy 9 | import qualified Data.Text.Lazy.Builder 10 | import qualified Data.Text.Lazy.Builder.Int 11 | import FastDownward.SAS.Effect ( Effect ) 12 | import qualified FastDownward.SAS.Effect as Effect 13 | import FastDownward.SAS.VariableAssignment ( VariableAssignment ) 14 | import qualified FastDownward.SAS.VariableAssignment as VariableAssignment 15 | 16 | 17 | data Operator = 18 | Operator 19 | { name :: Data.Text.Lazy.Text 20 | , prevail :: Seq VariableAssignment 21 | , effects :: Seq Effect 22 | } 23 | deriving 24 | ( Show ) 25 | 26 | 27 | toSAS :: Operator -> Data.Text.Lazy.Builder.Builder 28 | toSAS Operator{..} = 29 | "begin_operator\n" 30 | <> Data.Text.Lazy.Builder.fromLazyText name <> "\n" 31 | <> Data.Text.Lazy.Builder.Int.decimal ( Seq.length prevail ) <> "\n" 32 | <> foldMap ( \x -> VariableAssignment.toSAS x <> "\n" ) prevail 33 | <> Data.Text.Lazy.Builder.Int.decimal ( length effects ) <> "\n" 34 | <> foldMap ( \x -> Effect.toSAS x <> "\n" ) effects 35 | <> "0\n" 36 | <> "end_operator" 37 | -------------------------------------------------------------------------------- /FastDownward/SAS/Plan.hs: -------------------------------------------------------------------------------- 1 | {-# language OverloadedStrings #-} 2 | {-# language RecordWildCards #-} 3 | 4 | module FastDownward.SAS.Plan ( Plan(..), toSAS ) where 5 | 6 | import qualified Data.Text.Lazy 7 | import qualified Data.Text.Lazy.Builder 8 | import qualified Data.Text.Lazy.Builder.Int 9 | import Data.Sequence ( Seq ) 10 | import qualified Data.Sequence as Seq 11 | import FastDownward.SAS.Axiom ( Axiom ) 12 | import qualified FastDownward.SAS.Axiom as Axiom 13 | import FastDownward.SAS.Goal ( Goal ) 14 | import qualified FastDownward.SAS.Goal as Goal 15 | import FastDownward.SAS.MutexGroup ( MutexGroup ) 16 | import FastDownward.SAS.Operator ( Operator ) 17 | import qualified FastDownward.SAS.Operator as Operator 18 | import FastDownward.SAS.State ( State ) 19 | import qualified FastDownward.SAS.State as State 20 | import FastDownward.SAS.UseCosts ( UseCosts ) 21 | import qualified FastDownward.SAS.UseCosts as UseCosts 22 | import FastDownward.SAS.Variable ( Variable ) 23 | import qualified FastDownward.SAS.Variable as Variable 24 | import FastDownward.SAS.Version ( Version ) 25 | import qualified FastDownward.SAS.Version as Version 26 | 27 | 28 | data Plan = 29 | Plan 30 | { version :: Version 31 | , useCosts :: UseCosts 32 | , variables :: Seq Variable 33 | , mutexGroups :: Seq MutexGroup 34 | , initialState :: State 35 | , goal :: Goal 36 | , operators :: Seq Operator 37 | , axioms :: Seq Axiom 38 | } 39 | deriving 40 | ( Show ) 41 | 42 | 43 | toSAS :: Plan -> Data.Text.Lazy.Text 44 | toSAS Plan{..} = 45 | Data.Text.Lazy.Builder.toLazyText 46 | $ Version.toSAS version <> "\n" 47 | <> UseCosts.toSAS useCosts <> "\n" 48 | <> Data.Text.Lazy.Builder.Int.decimal ( Seq.length variables ) <> "\n" 49 | <> foldMap ( \v -> Variable.toSAS v <> "\n" ) variables 50 | <> Data.Text.Lazy.Builder.Int.decimal ( Seq.length mutexGroups ) <> "\n" 51 | <> State.toSAS initialState <> "\n" 52 | <> Goal.toSAS goal <> "\n" 53 | <> Data.Text.Lazy.Builder.Int.decimal ( Seq.length operators ) <> "\n" 54 | <> foldMap ( \x -> Operator.toSAS x <> "\n" ) operators 55 | <> Data.Text.Lazy.Builder.Int.decimal ( Seq.length axioms ) <> "\n" 56 | <> foldMap ( \x -> Axiom.toSAS x <> "\n" ) axioms 57 | -------------------------------------------------------------------------------- /FastDownward/SAS/State.hs: -------------------------------------------------------------------------------- 1 | {-# language OverloadedStrings #-} 2 | {-# language RecordWildCards #-} 3 | 4 | module FastDownward.SAS.State ( State(..), toSAS ) where 5 | 6 | import Data.Sequence ( Seq ) 7 | import qualified Data.Text.Lazy.Builder 8 | import FastDownward.SAS.DomainIndex ( DomainIndex ) 9 | import qualified FastDownward.SAS.DomainIndex as DomainIndex 10 | 11 | 12 | newtype State = 13 | State { initialValues :: Seq DomainIndex } 14 | deriving 15 | ( Show ) 16 | 17 | 18 | toSAS :: State -> Data.Text.Lazy.Builder.Builder 19 | toSAS State{..} = 20 | "begin_state\n" 21 | <> foldMap ( \x -> DomainIndex.toSAS x <> "\n" ) initialValues 22 | <> "end_state" 23 | -------------------------------------------------------------------------------- /FastDownward/SAS/UseCosts.hs: -------------------------------------------------------------------------------- 1 | {-# language OverloadedStrings #-} 2 | 3 | module FastDownward.SAS.UseCosts ( UseCosts(..), toSAS ) where 4 | 5 | import qualified Data.Text.Lazy.Builder 6 | 7 | 8 | data UseCosts = 9 | UseCosts | NoCosts 10 | deriving 11 | ( Show ) 12 | 13 | 14 | toSAS :: UseCosts -> Data.Text.Lazy.Builder.Builder 15 | toSAS a = 16 | "begin_metric\n" 17 | <> case a of 18 | NoCosts -> 19 | "0\n" 20 | 21 | UseCosts -> 22 | "1\n" 23 | <> "end_metric" 24 | -------------------------------------------------------------------------------- /FastDownward/SAS/Variable.hs: -------------------------------------------------------------------------------- 1 | {-# language OverloadedStrings #-} 2 | {-# language RecordWildCards #-} 3 | 4 | module FastDownward.SAS.Variable ( Variable(..), toSAS ) where 5 | 6 | import Data.Sequence ( Seq ) 7 | import qualified Data.Sequence as Seq 8 | import qualified Data.Text.Lazy 9 | import qualified Data.Text.Lazy.Builder 10 | import qualified Data.Text.Lazy.Builder.Int 11 | 12 | 13 | data Variable = 14 | Variable 15 | { name :: Data.Text.Lazy.Text 16 | , domain :: Seq Data.Text.Lazy.Text 17 | , axiomLayer :: Int 18 | } 19 | deriving 20 | ( Show ) 21 | 22 | 23 | toSAS :: Variable -> Data.Text.Lazy.Builder.Builder 24 | toSAS Variable{..} = 25 | "begin_variable\n" 26 | <> Data.Text.Lazy.Builder.fromLazyText name <> "\n" 27 | <> Data.Text.Lazy.Builder.Int.decimal axiomLayer <> "\n" 28 | <> Data.Text.Lazy.Builder.Int.decimal ( Seq.length domain ) <> "\n" 29 | <> foldMap ( \val -> Data.Text.Lazy.Builder.fromLazyText val <> "\n" ) domain 30 | <> "end_variable" 31 | -------------------------------------------------------------------------------- /FastDownward/SAS/VariableAssignment.hs: -------------------------------------------------------------------------------- 1 | {-# language OverloadedStrings #-} 2 | 3 | module FastDownward.SAS.VariableAssignment ( VariableAssignment(..), toSAS ) where 4 | 5 | import qualified Data.Text.Lazy.Builder 6 | import FastDownward.SAS.DomainIndex ( DomainIndex ) 7 | import qualified FastDownward.SAS.DomainIndex as DomainIndex 8 | import FastDownward.SAS.VariableIndex ( VariableIndex ) 9 | import qualified FastDownward.SAS.VariableIndex as VariableIndex 10 | 11 | 12 | data VariableAssignment = 13 | VariableAssignment VariableIndex DomainIndex 14 | deriving 15 | ( Eq, Ord, Show ) 16 | 17 | 18 | toSAS :: VariableAssignment -> Data.Text.Lazy.Builder.Builder 19 | toSAS ( VariableAssignment x y ) = 20 | VariableIndex.toSAS x <> " " <> DomainIndex.toSAS y 21 | -------------------------------------------------------------------------------- /FastDownward/SAS/VariableIndex.hs: -------------------------------------------------------------------------------- 1 | module FastDownward.SAS.VariableIndex ( VariableIndex(..), toSAS ) where 2 | 3 | import qualified Data.Text.Lazy.Builder 4 | import qualified Data.Text.Lazy.Builder.Int 5 | 6 | 7 | newtype VariableIndex = 8 | VariableIndex { unVariableIndex :: Int } 9 | deriving 10 | ( Eq, Ord, Show ) 11 | 12 | 13 | toSAS :: VariableIndex -> Data.Text.Lazy.Builder.Builder 14 | toSAS ( VariableIndex i ) = 15 | Data.Text.Lazy.Builder.Int.decimal i 16 | -------------------------------------------------------------------------------- /FastDownward/SAS/Version.hs: -------------------------------------------------------------------------------- 1 | {-# language OverloadedStrings #-} 2 | 3 | module FastDownward.SAS.Version ( Version(..), toSAS ) where 4 | 5 | import qualified Data.Text.Lazy.Builder 6 | 7 | 8 | data Version = 9 | SAS3 10 | deriving 11 | ( Show ) 12 | 13 | 14 | toSAS :: Version -> Data.Text.Lazy.Builder.Builder 15 | toSAS v = 16 | "begin_version\n" 17 | <> case v of 18 | SAS3 -> 19 | "3\n" 20 | <> "end_version" 21 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016, Ollie Charles 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Ollie Charles nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # `fast-downward` 2 | 3 | fast-downward is a library for modelling classical planning problems and solving them using the [Fast Downward](http://www.fast-downward.org) engine. For general usage, see [`FastDownward`](https://hackage.haskell.org/package/fast-downward-0.1.0.0/docs/FastDownward.html), and for an example see [`FastDownward.Examples.Gripper`](https://hackage.haskell.org/package/fast-downward-0.1.0.0/docs/FastDownward-Examples-Gripper.html). 4 | 5 | Note that usage of this library requires the downward executable - see [Obtaining and Running Fast Downward](http://www.fast-downward.org/ObtainingAndRunningFastDownward) for more instructions. 6 | -------------------------------------------------------------------------------- /fast-downward.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2 | 2.0 3 | name: 4 | fast-downward 5 | version: 6 | 0.2.3.0 7 | build-type: 8 | Simple 9 | synopsis: 10 | Solve classical planning problems (STRIPS/SAS+) using Haskell & Fast Downward. 11 | description: 12 | @fast-downward@ is a library for modelling classical planning problems and 13 | solving them using the Fast Downward engine. For general usage, see 14 | "FastDownward", and for an example see "FastDownward.Examples.Gripper". 15 | . 16 | Note that usage of this library requires the @downward@ executable - see 17 | 18 | for more instructions. 19 | license: 20 | BSD3 21 | license-file: 22 | LICENSE 23 | extra-source-files: 24 | Changelog.md 25 | maintainer: 26 | Ollie Charles 27 | category: 28 | AI 29 | homepage: 30 | https://github.com/circuithub/fast-downward 31 | bug-reports: 32 | https://github.com/circuithub/fast-downward/issues 33 | 34 | source-repository head 35 | type: 36 | git 37 | location: 38 | https://github.com/circuithub/fast-downward 39 | 40 | library 41 | exposed-modules: 42 | FastDownward 43 | FastDownward.Examples.Gripper 44 | FastDownward.Exec 45 | FastDownward.SAS 46 | FastDownward.SAS.Axiom 47 | FastDownward.SAS.DomainIndex 48 | FastDownward.SAS.Effect 49 | FastDownward.SAS.Goal 50 | FastDownward.SAS.MutexGroup 51 | FastDownward.SAS.Operator 52 | FastDownward.SAS.Plan 53 | FastDownward.SAS.State 54 | FastDownward.SAS.UseCosts 55 | FastDownward.SAS.Variable 56 | FastDownward.SAS.VariableAssignment 57 | FastDownward.SAS.VariableIndex 58 | FastDownward.SAS.Version 59 | build-depends: 60 | base ^>= 4.11.1.0 || ^>= 4.12.0.0 || ^>= 4.13.0.0 || ^>= 4.14.0.0 || ^>= 4.15.0.0 || ^>= 4.16.0.0 || ^>= 4.17.0.0, 61 | containers ^>= 0.5.11.0 || ^>= 0.6, 62 | mtl ^>= 2.2.2, 63 | process ^>= 1.6.3.0, 64 | temporary ^>= 1.3, 65 | text ^>= 1.2.3.0 || ^>= 2.0, 66 | transformers ^>= 0.5.5.0 67 | default-language: 68 | Haskell2010 69 | ghc-options: 70 | -Wall -fwarn-incomplete-uni-patterns -O2 71 | --------------------------------------------------------------------------------