Skip to content

Instantly share code, notes, and snippets.

# CYBAI/chapter3.purs Last active Jun 16, 2019

PureScript By Example Exercises
 module Exercise where import Prelude import Data.AddressBook import Data.Functor ((<\$>)) import Data.List (filter, head, null, nubBy) import Data.Maybe (Maybe) -- 1. findEntryByStreet :: String -> AddressBook -> Maybe Entry findEntryByStreet street = head <<< filter filterStreet where filterStreet :: Entry -> Boolean filterStreet entry = entry.address.street == street printEntryWithStreet :: String -> AddressBook -> Maybe String printEntryWithStreet street book = map showEntry \$ findEntryByStreet street book -- 2. checkNameInAddress :: String -> String -> AddressBook -> Boolean checkNameInAddress firstName lastName book = null \$ filter filterEntry book where filterEntry :: Entry -> Boolean filterEntry entry = (entry.firstName <> entry.lastName) == (firstName <> lastName) -- 3. sameName :: Entry -> Entry -> Boolean sameName e1 e2 = e1.firstName == e2.firstName && e1.lastName == e2.lastName removeDuplicates :: AddressBook -> AddressBook removeDuplicates = nubBy sameName
 module Exercise where import Prelude import Control.MonadZero (guard) import Data.Array (concat, filter, foldl, null, (..), (:)) import Data.Array.Partial (head, tail) import Partial.Unsafe (unsafePartial) -- 1. length :: forall a. Array a -> Int length arr = if null arr then 0 else 1 + length (unsafePartial tail arr) isEven :: Int -> Boolean isEven int = if int < 0 then isEven (-int) else if int == 0 then true else if int == 1 then false else isEven (int - 2) countEven :: Array Int -> Int countEven arr = if null arr then 0 else if isEven \$ unsafePartial head arr then 1 + countEven (unsafePartial tail arr) else countEven (unsafePartial tail arr) -- 2. squareNumbers :: Array Int -> Array Int squareNumbers = map (\num -> num * num) removeNegatives :: Array Int -> Array Int removeNegatives = (<\$?>) (\num -> num >= 0) infix 0 filter as <\$?> -- 3. factors :: Int -> Array (Array Int) factors n = do i <- 1 .. n j <- i .. n guard \$ i * j == n pure [i, j] isPrime :: Int -> Boolean isPrime n = (length \$ factors n) == 1 cartProd :: Array Int -> Array Int -> Array (Array Int) cartProd a b = do i <- a j <- b pure [i, j] pythaTriple :: Int -> Array (Array Int) pythaTriple n = do i <- 1 .. n j <- i .. n k <- j .. n guard \$ i * i + j * j == k * k pure [i, j, k] factorizations :: Int -> Array Int factorizations = concat <<< factors -- 4. checkAllTrue :: Array Boolean -> Boolean checkAllTrue = foldl (\x y -> x == y) true count :: forall a. (a -> Boolean) -> Array a -> Int count f = count' 0 where count' acc [] = acc count' acc xs = if f (unsafePartial head xs) then count' (acc + 1) (unsafePartial tail xs) else count' (acc) (unsafePartial tail xs) reverse :: forall a. Array a -> Array a reverse = foldl (\x xs -> xs : x) []
 module Exercise where import Prelude import Data.Maybe (Maybe(..)) import Math (pow, pi) -- 1. factorial :: Int -> Int factorial 0 = 1 factorial n = n * factorial (n - 1) -- Reference from -- https://github.com/quephird/purescript-by-example/blob/master/chapter5/src/Chapter5.purs#L13-L17 binomialCoefficient :: Int -> Int -> Int binomialCoefficient n k | k > n = 0 binomialCoefficient n 0 = 1 binomialCoefficient n k = binomialCoefficient (n-1) (k-1) + binomialCoefficient (n-1) k -- 2. type Address = { street :: String, city :: String } type Person = { name :: String, address :: Address } sameCity :: Person -> Person -> Boolean sameCity { address: { city: x } } { address: { city: y } } = x == y fromSingleton :: forall a. a -> Array a -> a fromSingleton _ [x] = x fromSingleton x _ = x -- 3. data Shape = Circle Point Number | Rectangle Point Number Number | Line Point Point | Text Point String data Point = Point { x :: Number , y :: Number } instance showPoint :: Show Point where show (Point { x, y }) = "(" <> show x <> ", " <> show y <> ")" instance showShape :: Show Shape where show (Circle c r) = "Circle [center: " <> show c <> ", radius: " <> show r <> "]" show (Rectangle c w h) = "Rectangle [center: " <> show c <> ", width: " <> show w <> ", height: " <> show h <> "]" show (Line start end) = "Line [start: " <> show start <> ", end: " <> show end <> "]" show (Text loc text) = "Text [location: " <> show loc <> ", text: " <> show text <> "]" origin :: Point origin = Point { x, y } where x = 0.0 y = 0.0 centerCircle :: Shape centerCircle = Circle origin 10.0 scaleShape :: Shape -> Shape scaleShape (Circle p r) = Circle origin (r * 2.0) scaleShape (Rectangle p w h) = Rectangle origin (w * 2.0) (h * 2.0) scaleShape (Line (Point start) (Point end)) = Line newStart newEnd where xdiff = start.x - end.x ydiff = start.y - end.y newStart = Point { x: -xdiff, y: -ydiff } newEnd = Point { x: xdiff, y: ydiff } scaleShape (Text p text) = Text origin text scaleShapes :: Array Shape -> Array Shape scaleShapes = map scaleShape findText :: Shape -> Maybe String findText (Text _ str) = Just str findText _ = Nothing -- 4. area :: Shape -> Number area (Circle _ r) = pi * (pow r 2.0) area (Rectangle _ w h) = w * h area _ = 0.0
 module Exercise where import Data.Array as Array import Data.Foldable (class Foldable, foldMap, foldl, foldr, maximum) import Data.Maybe (Maybe(..), fromJust) import Data.Monoid (class Monoid, mempty) import Data.String as String import Prelude (class Eq, class Functor, class Ord, class Semigroup, class Show, Ordering(..), map, show, (&&), (*), (-), (<<<), (<>), (==), (||)) -- 1. newtype Complex = Complex { real :: Number , imaginary :: Number } instance showComplex :: Show Complex where show (Complex { real, imaginary }) = show real <> " + " <> show imaginary <> "i" instance eqComplex :: Eq Complex where eq (Complex c1) (Complex c2) = c1.real == c2.real && c1.imaginary == c2.imaginary -- 2. data NonEmpty a = NonEmpty a (Array a) instance eqNonEmpty :: Eq a => Eq (NonEmpty a) where eq (NonEmpty el1 arr1) (NonEmpty el2 arr2) = (el1 == el2) && (arr1 == arr2) instance semigroupNonEmpty :: Semigroup (NonEmpty a) where append (NonEmpty el1 arr1) (NonEmpty el2 arr2) = NonEmpty el1 (arr1 <> arr2) instance functorNonEmpty :: Functor NonEmpty where map f (NonEmpty a arr) = NonEmpty (f a) (map f arr) instance foldableNonEmpty :: Foldable NonEmpty where foldr f z (NonEmpty v arr) = foldr f z (Array.cons v arr) foldl f z (NonEmpty v arr) = foldl f z (Array.cons v arr) foldMap f (NonEmpty v arr) = foldMap f (Array.cons v arr) data Extended a = Finite a | Infinite instance eqExtended :: Eq a => Eq (Extended a) where eq a b = (a == b) instance ordExtended :: Ord a => Ord (Extended a) where compare a b | (a == b) = EQ compare a b | (a == Infinite || b == Infinite) = GT compare _ _ = LT data OneMore f a = OneMore a (f a) instance foldableOneMore :: Foldable f => Foldable (OneMore f) where foldr f z (OneMore _ b) = foldr f z b foldl f z (OneMore _ b) = foldl f z b foldMap f (OneMore _ b) = foldMap f b class Stream stream element | stream -> element where uncons :: stream -> Maybe { head :: element, tail :: stream } instance streamArray :: Stream (Array a) a where uncons = Array.uncons instance streamString :: Stream String Char where uncons = String.uncons foldStream :: forall l e m. Stream l e => Monoid m => (e -> m) -> l -> m foldStream f list = case uncons list of Nothing -> mempty Just cons -> f cons.head <> foldStream f cons.tail -- 3. findMax :: Partial => Array Int -> Int findMax = fromJust <<< maximum newtype Multiply = Multiply Int instance semigroupMultiply :: Semigroup Multiply where append (Multiply n) (Multiply m) = Multiply (n * m) instance monoidMultiply :: Monoid Multiply where mempty = Multiply 1 class Monoid m <= Action m a where act :: m -> a -> a instance repeatAction :: Action Multiply String where act (Multiply n) str = act' n str where act' 0 acc = acc act' x acc = act' (x - 1) (acc <> str) instance arrayAction :: Action m a => Action m (Array a) where act m a = map (\x -> act m x) a newtype Self m = Self m instance semigroupSelf :: Semigroup m => Semigroup (Self m) where append (Self n) (Self m) = Self (n <> m) instance selfAction :: Monoid m => Action m (Self m) where act m a = a <> a
 module Exercise where import Prelude import Data.AddressBook (Address(..), address) import Data.AddressBook.Validation (Errors, matches, nonEmpty) import Data.Either (Either(..)) import Data.Maybe (Maybe(..)) import Data.String.Regex (Regex, regex) import Data.String.Regex.Flags (noFlags) import Data.Validation.Semigroup (V) import Partial.Unsafe (unsafePartial) -- 1. -- lift2 (+) (Just 1) (Just 3) -- lift2 (+) (Just 1) Nothing combineMaybe :: forall a f. Applicative f => Maybe (f a) -> f (Maybe a) combineMaybe (Just a) = Just <\$> a combineMaybe Nothing = pure Nothing -- 2. stateRegex :: Regex stateRegex = unsafePartial case regex "^[a-zA-Z]{2}\$" noFlags of Right r -> r nonEmptyRegex :: Regex nonEmptyRegex = unsafePartial case regex "^([^\\s]?).+\\1\$" noFlags of Right r -> r validateAddress :: Address -> V Errors Address validateAddress (Address o) = address <\$> (matches "Street" nonEmptyRegex o.street *> pure o.street) <*> (matches "City" nonEmptyRegex o.city *> pure o.city) <*> (matches "State" stateRegex o.state *> pure o.state)
to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.