CS计算机代考程序代写 Java \begin{code}

\begin{code}
{-# OPTIONS_GHC -Wall #-}
module Feb25 where

— import qualified Prelude as P
import Prelude hiding (Functor, Monad, (>>=), return)
\end{code}

Learning objectives:
\begin{itemize}
\item Functor, laws
\item Monad, Laws
\end{itemize}

\begin{code}
class Functor f where
fmap :: (a -> b) -> f a -> f b
\end{code}

\begin{code}
instance Functor [] where
fmap f l = map f l

instance Functor Maybe where
fmap _ Nothing = Nothing — fmap.Maybe.1
fmap f (Just a) = Just (f a) — fmap.Maybe.2

\end{code}

Laws:
1. forall x. fmap id x = id x
2. forall x, f, g. fmap f (fmap g x) = fmap (f . g) x

Prove, Functor for Maybe satisfies the laws:

1. first law, two cases:
fmap id Nothing == — fmap.Maybe.1
Nothing == — id.1
id Nothing

fmap id (Just x) == — fmap.Maybe.2
Just (f x) == — id.1
id (Just (f x))

2. second law
fmap f (fmap g Nothing) == — fmap.Maybe.1
fmap f Nothing == — fmap.Maybe.1
Nothing == — fmap.Maybe.1
fmap (f . g) Nothing

fmap f (fmap g (Just x)) == — fmap.Maybe.2
fmap f (Just (g x)) == — fmap.Maybe.2
Just (f (g x)) == — (.) defn
Just ((f . g) x) == — fmap.Maybe.2
fmap (f . g) (Just x)

— 6 minutes?

Reader: “Values that dependent on an environment”

\begin{code}
newtype Reader e a = Reader (e -> a)

instance Functor (Reader e) where
— f :: a -> b
— r :: e -> a
fmap f (Reader r) = Reader $ \e -> f (r e)

— if you want to go point-free:
— fmap f (Reader r) = Reader (f . r)
— reader Functors works by post-composition
\end{code}

——————————————–

Monad.
Roughly: (representation of) computations that sequence
sequence == ordered composition

note: the ‘;’ of C, Java is forward-order composition, aka sequencing
Java’s ‘;’ is basically (flip (.)) in world-passing style
world ~~~ the heap

\begin{code}
class Monad m where
— >>= is pronounced ‘bind’
(>>=) :: m a -> (a -> m b) -> m b
return :: a -> m a
\end{code}

— Back to Modelling computations that can fail…
— simplest case: result is either a value, or nothing, i.e. Maybe

\begin{code}
instance Monad Maybe where
— m :: Maybe a
— f :: (a -> Maybe b)
Nothing >>= _ = Nothing
(Just x) >>= f = f x
return x = Just x
\end{code}

Want to do examples… but they look ugly:
\begin{code}
z :: Maybe Integer
z =
Just 5 >>= (\x -> return $ x + 2)
>>= (\x -> return $ x * 7)
\end{code}

Sugar time!
do x <- m -- bind an x to the result of computation m f x -- continue computation with f is the same as m >>= f

\begin{code}
z’ :: Maybe Integer
z’ = do x <- Just 5 y <- return $ x + 2 w <- return $ y * 7 return w \end{code} \begin{code} w' :: Maybe Integer w' = do x <- Just 5 -- experiment : change to Nothing y <- Just 3 -- experiment : change to Nothing return $ x + y \end{code} enables writing: w'' n = do x <- f n y <- g x t <- h y return (t*(x+y)) Monads: - Maybe (potentially failing computation) - Identity monad (pure values) - List (kind of represents non-deterministic computations) - Reader (computations in an environment) - State (stateful computations), i.e. heap, world-passing, ... ... and then it gets weird - Cont (Continuation monad) - Tardis