diff --git a/week12_job/12.icl b/week12_job/12.icl new file mode 100644 index 0000000000000000000000000000000000000000..a4e0b740955366fde43ba59d863f89c1f1f00b02 --- /dev/null +++ b/week12_job/12.icl @@ -0,0 +1,160 @@ +module ex12 + +import StdEnv, StdMaybe, StdDebug +import Data.Functor, Control.Applicative, Control.Monad + +::BM a b = + {t:: a -> b + ,f:: b -> a + } + +bm :: BM a a +bm = + {f = id + ,t = id + } + +:: Action a b i j x y + = MoveToShip (BM a High) (BM b High) (BM i j) (BM x Quay) (BM y Ship) // move the crane to the ship + | MoveToQuay (BM a High) (BM b High) (BM i j) (BM x Ship) (BM y Quay) // move the crane to the quay + | MoveUp (BM a Low) (BM b High) (BM i j) (BM x y) // moves the crane up + | MoveDown (BM a High) (BM b Low) (BM i j) (BM x y) // moves the crane down + | Lock (BM a Low) (BM b Low) (BM i Empty) (BM j Full) (BM x y) // locks the top container of the stack under the crane + | Unlock (BM a Low) (BM b Low) (BM i Full) (BM j Empty) (BM x y) // unlocks the container the crane is carrying, put it on the stack + | Wait (BM a b) (BM i j) (BM x y) // do nothing + | E.c k z:(:.) infixl 1 (Action a c i k x z) (Action c b k j z y) // sequence of two actions + | WhileContainerBelow (Action High High Empty Empty Quay Quay) // repeat action while there is a container at current position + +:: High = High +:: Low = Low + +:: Quay = Quay +:: Ship = Ship + +:: Full = Full +:: Empty = Empty + +:: Result r = Res r | Err String + +:: State = + {onShip :: [Container] + ,onQuay :: [Container] + ,craneOnQuay :: Bool + ,craneUp :: Bool + ,locked :: Maybe Container + } + +:: Container :== String + +initialState = + {onShip = [] + ,onQuay = ["apples", "beer", "camera"] + ,craneOnQuay = True + ,craneUp = True + ,locked = Nothing + } + +moveDown :: Action High Low i i x x +moveDown = MoveDown bm bm bm bm + +moveUp :: Action Low High i i x x +moveUp = MoveUp bm bm bm bm + +moveToShip :: Action High High i i Quay Ship +moveToShip = MoveToShip bm bm bm bm bm + +moveToQuay :: Action High High i i Ship Quay +moveToQuay = MoveToQuay bm bm bm bm bm + +lock :: Action Low Low Empty Full x x +lock = Lock bm bm bm bm bm + +test :: Action High High Empty Full Quay Quay +test = moveUp :. lock + +wait :: Action a a i i x x +wait = Wait bm bm bm + +unlock :: Action Low Low Full Empty x x +unlock = Unlock bm bm bm bm bm + +whileContainerBelow :: (Action High High Empty Empty Quay Quay) -> Action High High Empty Empty Quay Quay +whileContainerBelow a = WhileContainerBelow a + +loadShip :: Action High High Empty Empty Quay Quay +loadShip = whileContainerBelow ( + moveDown:. + lock:. + moveUp:. + moveToShip:. + wait:. + moveDown:. + wait:. + unlock:. + moveUp:. + moveToQuay + ) + +highError :: String -> Result State +highError str = Err ("Can not do '" +++ str +++ "', crane is high!") + +eval :: (Action a b i j x y) State -> Result State +eval (MoveUp _ _ _ _) st = Res {st & craneUp = True} +eval (MoveDown _ _ _ _) st = Res {st & craneUp = False} +eval (Unlock _ _ _ _ _) st = if st.craneUp + (highError "Unlock") + case st.locked of + (Just a) -> if st.craneOnQuay (unlockResultQuay a) (unlockResultShip a) + (Nothing) -> (Err "Crane is empty!") + where + unlockResultShip a = Res {st & locked = Nothing, onShip = [a:st.onShip] } + unlockResultQuay a = Res {st & locked = Nothing, onQuay = [a:st.onQuay] } +eval (Lock _ _ _ _ _) st = if st.craneUp + (highError "Lock") + if (isJust st.locked) + (Err "Crane is full!") + if st.craneOnQuay lockResultQuay lockResultShip + where + lockResultShip = case st.onShip of + [x:xs] -> (Res {st & locked = Just x, onShip = xs}) + [] -> (Err "No crates left on ship") + lockResultQuay = case st.onQuay of + [x:xs] -> (Res {st & locked = Just x, onQuay = xs }) + [] -> (Err "No crates left on quay") +eval (MoveToShip _ _ _ _ _) st = if (not st.craneOnQuay) + (Err "Can not move to Ship already on Ship") + (Res {st & craneOnQuay = False }) +eval (MoveToQuay _ _ _ _ _) st = if st.craneOnQuay + (Err "Can not move to Quay already on Quay") + (Res {st & craneOnQuay = True }) +eval (Wait _ _ _) st = Res st +eval (:. a b) st = case eval a st of + Res st1 -> eval b st1 + Err str -> Err str +eval (WhileContainerBelow a) st = if (containerBelow st) iteration (Res st) + where + iteration = case eval a st of + (Res st1) -> eval (WhileContainerBelow a) st1 + (Err str) -> Err str + +isNotEmpty = (not o isEmpty) + +containerBelow :: State -> Bool +containerBelow s = if s.craneOnQuay + (isNotEmpty s.onQuay) + (isNotEmpty s.onShip) + +print :: (Action a b i j x y) -> [String] +print (MoveToShip _ _ _ _ _) = ["moveToShip"] +print (MoveToQuay _ _ _ _ _) = ["moveToQuay"] +print (MoveUp _ _ _ _) = ["moveUp"] +print (MoveDown _ _ _ _) = ["moveDown"] +print (Lock _ _ _ _ _) = ["lock"] +print (Unlock _ _ _ _ _) = ["unlock"] +print (Wait _ _ _) = ["wait"] +print (:. a b) = print a ++ [":.":"\n": print b ] +print (WhileContainerBelow a) = ["whileContainerBelow":"(":"\n": (print a ++ [")"])] + +//Start = optimize (wait:.moveUp) +Start = eval loadShip initialState +//Start = print loadShip diff --git a/week12_job/ex12 b/week12_job/ex12 new file mode 100755 index 0000000000000000000000000000000000000000..6f1e0493e624dbd610ac6c043a7ef9c524aace92 Binary files /dev/null and b/week12_job/ex12 differ diff --git a/week12_job/ex12.icl b/week12_job/ex12.icl index d0ce56e1ee91875f507029defa9a1b6a1b5931fa..a0202c12c9ddced336ccb8718118453e345cbb6b 100644 --- a/week12_job/ex12.icl +++ b/week12_job/ex12.icl @@ -4,26 +4,26 @@ import StdEnv, StdMaybe, StdDebug import Data.Functor, Control.Applicative, Control.Monad ::BM a b = - {t::a -> b - ,f::b -> a + {t:: a -> b + ,f:: b -> a } bm :: BM a a bm = - {f = id - ,t = id + {f = id + ,t = id } -:: Action a b x y - = MoveToShip (BM a High) (BM b High) (BM x Quay) (BM y Ship) // move the crane to the ship - | MoveToQuay (BM a High) (BM b High) (BM x Ship) (BM y Quay) // move the crane to the quay - | MoveUp (BM a Low) (BM b High) (BM x y) (BM x y) // moves the crane up - | MoveDown (BM a High) (BM b Low) (BM x y) (BM x y) // moves the crane down - | Lock (BM a Low) (BM b Low) (BM x y) (BM x y) // locks the top container of the stack under the crane - | Unlock (BM a Low) (BM b Low) (BM x y) (BM x y) // unlocks the container the crane is carrying, put it on the stack - | Wait (BM a b) (BM a b) (BM x y) (BM x y) // do nothing - | E.c.z:(:.) infixl 1 (Action a c x z) (Action c b z y) // sequence of two actions - | WhileContainerBelow (Action High High Quay Quay) // repeat action while there is a container at current position +:: Action a b i j x y + = MoveToShip (BM a High) (BM b High) (BM i j) (BM x Quay) (BM y Ship) // move the crane to the ship + | MoveToQuay (BM a High) (BM b High) (BM i j) (BM x Ship) (BM y Quay) // move the crane to the quay + | MoveUp (BM a Low) (BM b High) (BM i j) (BM x y) // moves the crane up + | MoveDown (BM a High) (BM b Low) (BM i j) (BM x y) // moves the crane down + | Lock (BM a Low) (BM b Low) (BM i Empty) (BM j Full) (BM x y) // locks the top container of the stack under the crane + | Unlock (BM a Low) (BM b Low) (BM i Full) (BM j Empty) (BM x y) // unlocks the container the crane is carrying, put it on the stack + | Wait (BM a b) (BM i j) (BM x y) // do nothing + | E.c k z:(:.) infixl 1 (Action a c i k x z) (Action c b k j z y) // sequence of two actions + | WhileContainerBelow (Action High High Empty Empty Quay Quay) // repeat action while there is a container at current position :: High = High :: Low = Low @@ -31,12 +31,16 @@ bm = :: Quay = Quay :: Ship = Ship +:: Full = Full +:: Empty = Empty + :: Result r = Res r | Err String :: State = {onShip :: [Container] ,onQuay :: [Container] ,craneOnQuay :: Bool + ,craneUp :: Bool ,locked :: Maybe Container } @@ -46,34 +50,35 @@ initialState = {onShip = [] ,onQuay = ["apples", "beer", "camera"] ,craneOnQuay = True + ,craneUp = True ,locked = Nothing } -moveDown :: Action High Low x x -moveDown = MoveDown bm bm bm bm +moveDown :: Action High Low i i x x +moveDown = MoveDown bm bm bm bm -moveUp :: Action Low High x x +moveUp :: Action Low High i i x x moveUp = MoveUp bm bm bm bm -moveToShip :: Action High High Quay Ship -moveToShip = MoveToShip bm bm bm bm +moveToShip :: Action High High i i Quay Ship +moveToShip = MoveToShip bm bm bm bm bm -moveToQuay :: Action High High Ship Quay -moveToQuay = MoveToQuay bm bm bm bm +moveToQuay :: Action High High i i Ship Quay +moveToQuay = MoveToQuay bm bm bm bm bm -lock :: Action Low Low x x -lock = Lock bm bm bm bm +lock :: Action Low Low Empty Full x x +lock = Lock bm bm bm bm bm -wait :: Action a a x x -wait = Wait bm bm bm bm +wait :: Action a a i i x x +wait = Wait bm bm bm -unlock :: Action Low Low x x -unlock = Unlock bm bm bm bm +unlock :: Action Low Low Full Empty x x +unlock = Unlock bm bm bm bm bm -whileContainerBelow :: (Action High High Quay Quay) -> Action High High Quay Quay +whileContainerBelow :: (Action High High Empty Empty Quay Quay) -> Action High High Empty Empty Quay Quay whileContainerBelow a = WhileContainerBelow a -loadShip :: Action High High Quay Quay +loadShip :: Action High High Empty Empty Quay Quay loadShip = whileContainerBelow ( moveDown:. lock:. @@ -87,40 +92,66 @@ loadShip = whileContainerBelow ( moveToQuay ) -eval :: (Action a b x y) State -> Result State -eval (MoveUp _ _ _ _) st = Res st -eval (MoveDown _ _ _ _) st = Res st -eval (Unlock _ _ _ _) st - | st.craneOnQuay = Res {st & locked = Nothing, onQuay = [fromJust st.locked:st.onQuay] } - | otherwise = Res {st & locked = Nothing, onShip = [fromJust st.locked:st.onShip] } -eval (Lock _ _ _ _) st - | st.craneOnQuay = Res {st & locked = Just (hd st.onQuay), onQuay = tl st.onQuay } - | otherwise = Res {st & locked = Just (hd st.onShip), onShip = tl st.onShip } -eval (MoveToShip _ _ _ _) st = Res {st & craneOnQuay = False } -eval (MoveToQuay _ _ _ _) st = Res {st & craneOnQuay = True } -eval (Wait _ _ _ _) st = Res st -eval (:. a b) st = - case eval a st of - Res st1 -> eval b st1 - Err str -> Err str -eval (WhileContainerBelow a) st = if quayNotEmpty iteration (Res st) +highError :: String -> Result State +highError str = Err ("Can not do '" +++ str +++ "', crane is high!") + +eval :: (Action a b i j x y) State -> Result State +eval (MoveUp _ _ _ _) st = Res {st & craneUp = True} +eval (MoveDown _ _ _ _) st = Res {st & craneUp = False} +eval (Unlock _ _ _ _ _) st = if st.craneUp + (highError "Unlock") + case st.locked of + (Just a) -> if st.craneOnQuay (unlockResultQuay a) (unlockResultShip a) + (Nothing) -> (Err "Crane is empty!") + where + unlockResultShip a = Res {st & locked = Nothing, onShip = [a:st.onShip] } + unlockResultQuay a = Res {st & locked = Nothing, onQuay = [a:st.onQuay] } +eval (Lock _ _ _ _ _) st = if st.craneUp + (highError "Lock") + if (isJust st.locked) + (Err "Crane is full!") + if st.craneOnQuay lockResultQuay lockResultShip + where + lockResultShip = case st.onShip of + [x:xs] -> (Res {st & locked = Just x, onShip = xs}) + [] -> (Err "No crates left on ship") + lockResultQuay = case st.onQuay of + [x:xs] -> (Res {st & locked = Just x, onQuay = xs }) + [] -> (Err "No crates left on quay") +eval (MoveToShip _ _ _ _ _) st = if (not st.craneOnQuay) + (Err "Can not move to Ship already on Ship") + (Res {st & craneOnQuay = False }) +eval (MoveToQuay _ _ _ _ _) st = if st.craneOnQuay + (Err "Can not move to Quay already on Quay") + (Res {st & craneOnQuay = True }) +eval (Wait _ _ _) st = Res st +eval (:. a b) st = case eval a st of + Res st1 -> eval b st1 + Err str -> Err str +eval (WhileContainerBelow a) st = if (containerBelow st) iteration (Res st) where - quayNotEmpty = length st.onQuay > 0 - iteration = case eval a st of + iteration = case eval a st of (Res st1) -> eval (WhileContainerBelow a) st1 (Err str) -> Err str -print :: (Action a b x y) -> [String] -print (MoveToShip _ _ _ _) = ["moveToShip"] -print (MoveToQuay _ _ _ _) = ["moveToQuay"] -print (MoveUp _ _ _ _) = ["moveUp"] -print (MoveDown _ _ _ _) = ["moveDown"] -print (Lock _ _ _ _) = ["lock"] -print (Unlock _ _ _ _) = ["unlock"] -print (Wait _ _ _ _) = ["wait"] +isNotEmpty = (not o isEmpty) + +containerBelow :: State -> Bool +containerBelow s = if s.craneOnQuay + (isNotEmpty s.onQuay) + (isNotEmpty s.onShip) + +print :: (Action a b i j x y) -> [String] +print (MoveToShip _ _ _ _ _) = ["moveToShip"] +print (MoveToQuay _ _ _ _ _) = ["moveToQuay"] +print (MoveUp _ _ _ _) = ["moveUp"] +print (MoveDown _ _ _ _) = ["moveDown"] +print (Lock _ _ _ _ _) = ["lock"] +print (Unlock _ _ _ _ _) = ["unlock"] +print (Wait _ _ _) = ["wait"] print (:. a b) = print a ++ [":.":"\n": print b ] print (WhileContainerBelow a) = ["whileContainerBelow":"(":"\n": (print a ++ [")"])] -//Start = loadShip -Start = eval loadShip initialState +//Start = optimize (wait:.moveUp) +Start = eval lock initialState //Start = print loadShip