module SMCDEL.Examples.MuddyPlanning where

import SMCDEL.Examples.MuddyChildren
import SMCDEL.Language
import SMCDEL.Other.Planning

toyPlan :: [OfflinePlan]
toyPlan :: [OfflinePlan]
toyPlan = Int
-> KnowScene -> OfflinePlan -> OfflinePlan -> Form -> [OfflinePlan]
forall a.
(Eq a, Semantics a, Update a Form) =>
Int -> a -> OfflinePlan -> OfflinePlan -> Form -> [OfflinePlan]
offlineSearch Int
maxSteps KnowScene
start OfflinePlan
acts OfflinePlan
cons Form
goal where
  maxSteps :: Int
maxSteps = Int
5 -- 2 would be enough
  start :: KnowScene
start = Int -> Int -> KnowScene
mudScnInit Int
3 Int
2
  acts :: OfflinePlan
acts = OfflinePlan -> Form
Disj [Prp -> Form
PrpF (Int -> Prp
P Int
k) | Int
k <- [Int
1,Int
2,Int
3]] Form -> OfflinePlan -> OfflinePlan
forall a. a -> [a] -> [a]
: [Form -> Form
Neg (Form -> Form) -> Form -> Form
forall a b. (a -> b) -> a -> b
$ Agent -> Form -> Form
Kw (Int -> Agent
forall a. Show a => a -> Agent
show Int
k) (Form -> Form) -> Form -> Form
forall a b. (a -> b) -> a -> b
$ Prp -> Form
PrpF (Int -> Prp
P Int
k) | Int
k <- [Int
1,Int
2,Int
3]]
  cons :: OfflinePlan
cons = [ Form -> Form
Neg (Form -> Form) -> Form -> Form
forall a b. (a -> b) -> a -> b
$ Agent -> Form -> Form
Kw Agent
"2" (Prp -> Form
PrpF (Prp -> Form) -> Prp -> Form
forall a b. (a -> b) -> a -> b
$ Int -> Prp
P Int
2) ]
  goal :: Form
goal = Agent -> Form -> Form
Kw Agent
"1" (Prp -> Form
PrpF (Prp -> Form) -> Prp -> Form
forall a b. (a -> b) -> a -> b
$ Int -> Prp
P Int
1)