Skip to content

Instantly share code, notes, and snippets.

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

Embed
What would you like to do?
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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.