From 70c88a8ba227ad793587d1a51aea04679eac58be Mon Sep 17 00:00:00 2001 From: Yuri Tatishchev Date: Mon, 2 Mar 2026 11:14:28 -0800 Subject: [PATCH] lab08: init --- lab08/applyMaybe.hs | 8 +++++ lab08/bender.hs | 15 ++++++++ lab08/benderPerhaps.hs | 34 ++++++++++++++++++ lab08/doit.hs | 21 +++++++++++ lab08/monadLab.lhs | 80 ++++++++++++++++++++++++++++++++++++++++++ lab08/stack.hs | 29 +++++++++++++++ 6 files changed, 187 insertions(+) create mode 100644 lab08/applyMaybe.hs create mode 100644 lab08/bender.hs create mode 100644 lab08/benderPerhaps.hs create mode 100644 lab08/doit.hs create mode 100644 lab08/monadLab.lhs create mode 100644 lab08/stack.hs diff --git a/lab08/applyMaybe.hs b/lab08/applyMaybe.hs new file mode 100644 index 0000000..c5aaa5b --- /dev/null +++ b/lab08/applyMaybe.hs @@ -0,0 +1,8 @@ +applyMaybe :: Maybe a -> (a -> Maybe b) -> Maybe b   +applyMaybe Nothing f  = Nothing   +applyMaybe (Just x) f = f x + +test1 = Just 3 `applyMaybe` (\x -> Just $ x * 2) `applyMaybe` (\x -> Just $ x - 1) + +test2 = Just 3 `applyMaybe` (\_ -> Nothing) `applyMaybe` (\x -> Just $ x - 1) + diff --git a/lab08/bender.hs b/lab08/bender.hs new file mode 100644 index 0000000..426f0bb --- /dev/null +++ b/lab08/bender.hs @@ -0,0 +1,15 @@ +type Pos = (Int, Int) + +start = (0,0) + +up (x, y) = (x, y+1) +down (x, y) = (x, y-1) +left (x, y) = (x-1, y) +right (x, y) = (x+1, y) + +x -: f = f x + +-- Using the "-:" operator, we can chain movements together +test1 = start -: up -: right +test2 = start -: up -: left -: left -: right -: down + diff --git a/lab08/benderPerhaps.hs b/lab08/benderPerhaps.hs new file mode 100644 index 0000000..1797084 --- /dev/null +++ b/lab08/benderPerhaps.hs @@ -0,0 +1,34 @@ +import Data.Map (Map) +import qualified Data.Map as Map + +-- In this code, we model bender moving around, but +-- if he finds beer, he will stop responding to commands. +type Pos = (Integer, Integer) + +x -: f = f x + +start = (0,0) + +badPos = Map.empty + -: Map.insert (0,2) True + -: Map.insert (-1,3) True + -: Map.insert (-3,-8) True + + +moveTo :: Pos -> Maybe Pos +moveTo p = + if Map.member p badPos + then Nothing + else Just p + +up (x, y) = moveTo (x, y+1) +down (x, y) = moveTo (x, y-1) +left (x, y) = moveTo (x-1, y) +right (x, y) = moveTo (x+1, y) + +-- Our directions now result in Maybe Pos values, so we can't chain them with "-:" anymore. +test1 = return start >>= up >>= right +test2 = return start >>= up >>= left >>= left >>= right >>= down +test3 = return start >>= left >>= left >>= up >>= up >>= right >>= up >>= right >>= right >>= down + + diff --git a/lab08/doit.hs b/lab08/doit.hs new file mode 100644 index 0000000..8ba180f --- /dev/null +++ b/lab08/doit.hs @@ -0,0 +1,21 @@ +mydiv x y = + x >>= (\numer -> + y >>= (\denom -> + if denom > 0 + then Just $ numer `div` denom + else Nothing)) + +mydiv' x y = do + numer <- x + denom <- y + if denom > 0 + then return $ numer `div` denom + else Nothing + +test1 = (Just 99) `mydiv` (Just 11) +test1' = (Just 99) `mydiv'` (Just 11) + +test2 = (Just 9) `mydiv` (Just 0) +test2' = (Just 9) `mydiv'` (Just 0) + + diff --git a/lab08/monadLab.lhs b/lab08/monadLab.lhs new file mode 100644 index 0000000..56e3a87 --- /dev/null +++ b/lab08/monadLab.lhs @@ -0,0 +1,80 @@ +Below we have some mathematical binary arguments that you may recognize from homework 2. + +> data Binop = +> Plus -- + :: Int -> Int -> Int +> | Minus -- - :: Int -> Int -> Int +> | Times -- * :: Int -> Int -> Int +> | Divide -- / :: Int -> Int -> Int +> deriving (Show) + +applyOp performs these operations, but unlike in the homework, +you now must consider errors (represented by 'Nothing'). + +> applyOp :: Binop -> Maybe Int -> Maybe Int -> Maybe Int + +Plus is done for you. Notice how code must check for 'Nothing' +for each operand. + +> applyOp Plus mi mj = +> case mi of +> Nothing -> Nothing +> Just i -> +> case mj of +> Nothing -> Nothing +> Just j -> Just $ i + j + +Minus is also done for you. This case **does** use monads, +but without the do syntax. + +> applyOp Minus mi mj = +> mi >>= (\i -> mj >>= (\j -> Just $ i - j)) + +Implement Times and Divide. Try the Times case without monads (as we did with +the Plus case). + +> applyOp Times mi mj = error "TBD" + +For the Divide case, use bind (>>=) as we did for Minus. +On an attempt to divide by 0, return Nothing as the answer. + +> applyOp Divide mi mj = error "TBD" + +The following test cases will help you verify your changes. + +> testapp1 = applyOp Minus (applyOp Times (Just 3) (Just 4)) $ applyOp Divide (Just 8) (Just 2) +> testapp2 = applyOp Minus (applyOp Times (Just 3) (Just 4)) $ applyOp Divide (Just 8) (applyOp Plus (Just 3) (Just (-3))) + + +Now implement applyOp', which implements all methods using the do syntax. +The Plus case is done for you once again. Be sure to check for zero with Divide. + +> applyOp' :: Binop -> Maybe Int -> Maybe Int -> Maybe Int +> applyOp' Plus mi mj = do +> i <- mi +> j <- mj +> return $ i + j +> applyOp' Minus mi mj = error "TBD" +> applyOp' Times mi mj = error "TBD" +> applyOp' Divide mi mj = error "TBD" + +More test cases: + +> testapp1' = applyOp' Minus (applyOp' Times (Just 3) (Just 4)) $ applyOp' Divide (Just 8) (Just 2) +> testapp2' = applyOp' Minus (applyOp' Times (Just 3) (Just 4)) $ applyOp' Divide (Just 8) (applyOp' Plus (Just 3) (Just (-3))) + + +Finally, note the following function for incrementing and decrementing ints. + +> mincr :: Int -> Maybe Int +> mincr i = Just $ i + 1 + +> mdecr :: Int -> Maybe Int +> mdecr i = Just $ i - 1 + +Experiment with these functions and the >>= syntax. +Here is one example: + +> testIncDec = Just 7 >>= mincr >>= mincr >>= mincr >>= mdecr + +Does bind seem more natural in this case than using do? Why or why not? + diff --git a/lab08/stack.hs b/lab08/stack.hs new file mode 100644 index 0000000..98887e9 --- /dev/null +++ b/lab08/stack.hs @@ -0,0 +1,29 @@ +import Control.Monad.State + +type Stack = [Int] + +pop :: Stack -> (Int,Stack) +pop (x:xs) = (x,xs) + +push :: Int -> Stack -> ((),Stack) +push a xs = ((),a:xs) + +stackManip :: Stack -> (Int, Stack) +stackManip stack = let + ((),newStack1) = push 3 stack + (a ,newStack2) = pop newStack1 + in pop newStack2 + + +pop' :: State Stack Int +pop' = State $ \(x:xs) -> (x,xs) + +push' :: Int -> State Stack () +push' a = State $ \xs -> ((),a:xs) + +stackManip' :: State Stack Int +stackManip' = do + push' 3 + a <- pop' + pop' +