CYBAI · June 16, 2019 01:22 · Sep 30, 2017 · Sep 23, 2017 · Sep 23, 2017
diff --git a/chapter7.purs b/chapter7.purs
@@ -0,0 +1,42 @@
+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)
+
diff --git a/chapter6.purs b/chapter6.purs
@@ -0,0 +1,104 @@
+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
diff --git a/chapter3.purs b/chapter3.purs
@@ -0,0 +1,33 @@
+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
diff --git a/chapter4.purs b/chapter4.purs
@@ -0,0 +1,91 @@
+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) []
+
diff --git a/chapter5.purs b/chapter5.purs
@@ -0,0 +1,96 @@
+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
No results found