diff --git a/src/AlgebraicDataTypes.hs b/src/AlgebraicDataTypes.hs index 1b36e03..0655f24 100644 --- a/src/AlgebraicDataTypes.hs +++ b/src/AlgebraicDataTypes.hs @@ -22,20 +22,22 @@ data Pair = P Status Severity --deriving (Show) data Tree a = Leaf a | Node (Tree a) (Tree a) deriving (Eq, Show, Read, Functor, Foldable) ---data Maybe a = Nothing | Just a deriving (Eq, Ord) -{-- -lookup :: (Eq a) => a -> [(a,b)] -> Maybe b -lookup _key [] = Nothing -lookup key ((x,y):xys) +-- data Maybe a = Nothing | Just a deriving (Eq, Ord) +{--} +lookup' :: String -> [(String,Double)] -> Maybe Double +lookup' _key [] = Nothing +lookup' key ((x,y):xys) | key == x = Just y - | otherwise = lookup key xys + | otherwise = lookup' key xys --} -safeDiv :: (Eq a, Fractional a) => a -> a -> Maybe a +--safeDiv :: (Eq a, Fractional a) => a -> a -> Maybe a +safeDiv :: Double -> Double -> Maybe Double safeDiv _ 0 = Nothing safeDiv x y = Just (x / y) -safeRoot :: (Ord a, Floating a) => a -> Maybe a +--safeRoot :: (Ord a, Floating a) => a -> Maybe a +safeRoot :: Double -> Maybe Double safeRoot x | x < 0 = Nothing | otherwise = Just (sqrt x) @@ -54,15 +56,16 @@ andThen :: Maybe a -> (a -> Maybe b) -> Maybe b andThen Nothing _fun = Nothing andThen (Just x) fun = fun x +findDivRoot'''' :: Eq a => Double -> a -> [(a, Double)] -> Maybe Double findDivRoot'''' x key map = lookup key map `andThen` \y -> safeDiv x y `andThen` \d -> safeRoot d findDivRoot' x key map = - lookup key map >>= \y -> - safeDiv x y >>= \d -> - safeRoot d + lookup key map >>= -- \y -> + safeDiv x >>= -- \d -> + safeRoot findDivRoot'' x key map = lookup key map >>= diff --git a/src/Functions.hs b/src/Functions.hs index 3b88e36..e9d155f 100644 --- a/src/Functions.hs +++ b/src/Functions.hs @@ -1,7 +1,8 @@ +{-# LANGUAGE FlexibleContexts #-} module Functions where import Control.Arrow ((>>>)) -import Data.Natural +import Data.Natural ( Natural ) import Prelude hiding ((.)) -- define constant `aNumber` with a value of 42. @@ -16,13 +17,17 @@ aString = "Hello World" square :: Integer -> Integer square n = n ^ 2 +-- define a function `double` which takes an Integer as argument and compute its double double :: Integer -> Integer double n = 2 * n --- combining functions with the `.` operator: (.) :: (b -> c) -> (a -> b) -> a -> c +(∘) :: (b -> c) -> (a -> b) -> a -> c -- f :: a -> b, g :: b -> c +(g ∘ f) x = g (f x) + +-- combining functions with the `.` operator: (∘) :: (b -> c) -> (a -> b) -> a -> c squareAfterDouble :: Integer -> Integer ---squareAfterDouble = square . double -squareAfterDouble n = (square . double) n +squareAfterDouble = square ∘ double +--squareAfterDouble n = (square ∘ double) n ifOddDouble :: Integer -> Integer ifOddDouble n = @@ -48,7 +53,10 @@ ifOddDouble' n = ifOdd double n ifOddSquare' :: Integer -> Integer ifOddSquare' n = ifOdd square n -ifPredGrow :: (Integer -> Bool) -> (Integer -> Integer) -> Integer -> Integer +ifPredGrow :: (Integer -> Bool) -- a predicate function argument + -> (Integer -> Integer) -- a growth function argument + -> Integer -- the input number + -> Integer -- the output number ifPredGrow predicate growthFunction n = if predicate n then growthFunction n @@ -79,21 +87,28 @@ add x y = x + y add5 :: Integer -> Integer add5 = add 5 -(.) :: (b -> c) -> (a -> b) -> a -> c -(.) f g x = f (g x) -- combining functions with the `.` operator: (.) :: (b -> c) -> (a -> b) -> a -> c add5AndSquare :: Integer -> Integer -add5AndSquare = square . add5 +add5AndSquare = square ∘ add5 -- or by using the (>>>) operator: f >>> g = g . f --- add5AndSquare = add5 >>> square +add5AndSquare' :: Integer -> Integer +add5AndSquare' = add5 >>> square -- The function curry takes a function of type ((a, b) -> c) and return the equivalent curried function of type a -> b -> c -- curry :: ((a, b) -> c) -> a -> b -> c curMul :: Integer -> Integer -> Integer curMul = curry mul +{-- +curry :: ((a, b) -> c) -> a -> b -> c +curry f x y = f (x, y) + +uncurry :: (a -> b -> c) -> ((a, b) -> c) +uncurry f p = f (fst p) (snd p) +--} + -- uncurry does the inverse, take the curried form and return the equivalent uncurried function -- uncurry :: (a -> b -> c) -> (a, b) -> c uncurAdd :: (Integer, Integer) -> Integer @@ -108,6 +123,36 @@ factorial n = -- definition of factorial using pattern matching fac :: Natural -> Natural -fac 0 = 1 -fac n = n * fac (n - 1) +fac 0 = 1 -- (a) +fac n = n * fac (n - 1) -- (b) +{-- +fac 2 = 2 * fac (2 - 1) -- (b) + = 2 * fac 1 -- 2 - 1 + = 2 * 1 * fac (1 - 1) -- (b) + = 2 * fac 0) -- 1-1=0 , 2*1=2 + = 2 * 1 -- (1) + = 2 -- 2*1=2 +--} +{-- +even :: Integer -> Bool +even n = n `rem` 2 == 0 + +odd :: Integer -> Bool +odd n = n `rem` 2 /= 0 +--} + +next :: Double -> Double -> Double +next a x_n = (x_n + a/x_n)/2 + +within :: Double -> [Double] -> Double +within eps (a:b:rest) = + if abs(a - b) <= eps + then b + else within eps (b:rest) + +root :: Double -> Double -> Double +root a eps = within eps (repeat' (next a) (a/2)) + +repeat' :: (a -> a) -> a -> [a] +repeat' f a = a : (repeat' f (f a)) \ No newline at end of file diff --git a/src/LazyEvaluation.hs b/src/LazyEvaluation.hs index eb62a6a..0760a81 100644 --- a/src/LazyEvaluation.hs +++ b/src/LazyEvaluation.hs @@ -1,12 +1,13 @@ module LazyEvaluation where -import Data.Natural +import Data.Natural ( Natural ) -- it's possible to define non-terminating expressions like viciousCircle :: a viciousCircle = viciousCircle -- this expression returns True because of lazy evaluation: +test :: Bool test = (4 == 4) || viciousCircle ignoreY :: Integer -> Integer -> Integer @@ -14,12 +15,15 @@ ignoreY x y = x -- arithmetic sequences -- all natural numbers +naturalNumbers :: [Integer] naturalNumbers = [0..] -- all even numbers +evens :: [Integer] evens = [2,4..] -- all odd numbers +odds :: [Integer] odds = [1,3..] fibs :: [Integer] @@ -53,16 +57,16 @@ myIf :: Bool -> b -> b -> b myIf p x y = if p then x else y cond :: [(Bool, a)] -> a -cond [] = error "make sure that at least one condition is true" -cond ((True, v):rest) = v -cond ((False, _):rest) = cond rest +cond [] = error "make sure that at least one condition is true" +cond ((True, v):_rest) = v +cond ((False, _):rest) = cond rest sign :: (Ord a, Num a) => a -> a sign x = cond [(x > 0 , 1 ) ,(x < 0 , -1) ,(otherwise , 0 )] --- |An operator that allows you to write C-style ternary conditionals of +-- | An operator that allows you to write C-style ternary conditionals of -- the form: -- > p ? t ?? f infixr 0 ? diff --git a/src/Lists.hs b/src/Lists.hs index 4898c5e..d91a0e0 100644 --- a/src/Lists.hs +++ b/src/Lists.hs @@ -1,9 +1,11 @@ module Lists where -import Prelude hiding (map, foldr, length, filter) -import qualified Prelude as P (foldr) +import Prelude hiding (map, foldr, length, filter, sum) +--import qualified Prelude as P (foldr) import Functions (square, double) +--data [a] = [] | a : [a] + -- a list of numbers to play around with someNumbers :: [Integer] someNumbers = [49,64,97,54,19,90,934,22,215,6,68,325,720,8082,1,33,31] @@ -15,11 +17,12 @@ upToHundred = [1..100] oddsUpToHundred :: [Integer] oddsUpToHundred = [1,3..100] +fac' :: Integer -> Integer fac' n = prod [1..n] length :: [a] -> Integer length [] = 0 -length (x:xs) = 1 + length xs +length (_x:xs) = 1 + length xs filter :: (a -> Bool) -> [a] -> [a] filter _pred [] = [] @@ -55,9 +58,9 @@ squareAll' :: [Integer] -> [Integer] squareAll' = map square -sumUp :: [Integer] -> Integer -sumUp [] = 0 -sumUp (n:rest) = n + sumUp rest +sum :: [Integer] -> Integer +sum [] = 0 +sum (n:rest) = n + sum rest prod :: [Integer] -> Integer prod [] = 1 @@ -81,6 +84,13 @@ prod' = foldr (*) 1 -- making use of such abstract higher order functions -- algorithms can be defined in a dense declarative way +len :: [a] -> Integer +len = foldr count 0 + where count _ n = n + 1 + +map' :: (a1 -> a2) -> [a1] -> [a2] +map' f = foldr ((:) . f) [] + -- now we have map and a reduce, what about the legendary map/reduce? -- it's called foldMap in Haskell @@ -92,3 +102,55 @@ foldMap :: (Monoid m) => (a -> m) -> [a] -> m foldMap f = foldr (mappend . f) mempty + + + +-- building stuff based on lists + +newtype Stack a = Stck [a] deriving Show + +sempty :: Stack a +sempty = Stck [] + +pop :: Stack a -> (a, Stack a) +pop (Stck []) = error "Stack is empty!" +pop (Stck (x:xs)) = (x, Stck xs) + +push :: Stack a -> a -> Stack a +push (Stck l) x = Stck (x : l) + +rev :: Stack a -> Stack a +rev (Stck xs) = Stck (reverse xs) + + +type Queue a = (Stack a, Stack a) + +qempty :: Queue a +qempty = (sempty, sempty) + +enqueue :: Queue a -> a -> Queue a +enqueue (inStack, outStack) x = (push inStack x, outStack) + +dequeue :: Queue a -> (a, Queue a) +dequeue (Stck [], Stck []) = error "Queue is empty!" +dequeue (inStack, Stck []) = + let revertedInStack = rev inStack + (x, restInstack) = pop revertedInStack + in (x, (Stck [], restInstack)) +dequeue (inStack, outStack) = + let (x, restOutStack) = pop outStack + in (x, (inStack, restOutStack)) + +type Queue' a = [a] + +qempty' :: Queue' a +qempty' = [] + +enqueue' :: Queue' a -> a -> Queue' a +enqueue' q x = x:q + +dequeue' :: Queue' a -> (a, Queue' a) +dequeue' [] = error "Queue is empty!" +dequeue' xs = (last xs, init xs) + + diff --git a/src/TypeClasses.hs b/src/TypeClasses.hs index 7f951c8..37a5efd 100644 --- a/src/TypeClasses.hs +++ b/src/TypeClasses.hs @@ -1,7 +1,6 @@ module TypeClasses where import AlgebraicDataTypes (Status (..), Severity (..), PairStatusSeverity (..), Tree (..)) -import Data.Foldable import Data.Char (toUpper) instance Num Char where diff --git a/stack.yaml b/stack.yaml index e53d705..5a9bb80 100644 --- a/stack.yaml +++ b/stack.yaml @@ -17,7 +17,7 @@ # # resolver: ./custom-snapshot.yaml # resolver: https://example.com/snapshots/2018-01-01.yaml -resolver: lts-15.2 +resolver: ghc-8.10.1 #lts-15.2 # User packages to be built. # Various formats can be used as shown in the example below.