a2ndrade · July 21, 2014 15:06 · Aug 2, 2014 · Aug 1, 2014 · Jul 27, 2014 · Jul 26, 2014
diff --git a/sandbox.hs b/sandbox.hs
@@ -298,3 +298,23 @@ instance Applicative' Tree where
 -- (<*>) s t
 -- s <*> t
 
+-- wrong! (incomplete)
+-- instance Applicative' [] where
+--   pure a = [a]
+--   _ <*> [] = []
+--   (x:_) <*> (y:ys) = x y:(pure x <*> ys)
+
+-- right
+instance Applicative' [] where
+  pure a = [a]
+  fs <*> xs = [f x | f <- fs, x <- xs]
+
+-- [(+),(*)] <*> [1,2] <*> [3,4]
+
+instance Applicative' IO where
+  pure = return
+  f <*> x = do
+    g <- f -- g is the function yielded by f
+    y <- x -- y is the value yielded by x
+    return (g y)
+
diff --git a/sandbox.hs b/sandbox.hs
@@ -202,7 +202,7 @@ type MyString = String
 
 -- binary search tree
 
-data Tree a = EmptyTree | Node a (Tree a) (Tree a) deriving (Show)
+data Tree a = EmptyTree | Node a (Tree a) (Tree a) deriving (Show,Eq)
 
 singleton :: a -> Tree a
 singleton v = Node v EmptyTree EmptyTree
@@ -259,6 +259,17 @@ instance Functor' Tree where
   fmap' _ EmptyTree = EmptyTree
   fmap' f (Node v left right) = Node (f v) (fmap' f left) (fmap' f right)
 
+-- first law of functors
+-- fmap' id t == id t
+-- second law of functors
+-- fmap' ((+3) . (*4)) t == ((fmap' (+3)) . (fmap' (*4))) t
+--
+
+instance Functor' IO where
+  fmap' f action = do
+    original <- action
+    return (f original)
+
 -- partially apply type constructor to obtain one with a single type parameter
 instance Functor' (Either a) where
   fmap' f (Right x) = Right (f x)
@@ -267,8 +278,23 @@ instance Functor' (Either a) where
 instance Functor' (Map.Map k) where
   fmap' = Map.map
 
-main = putStrLn $ show $ fmap' (*20) $ Map.fromList [(1,2)]
+runDo :: String -> IO ()
+runDo a = putStrLn a
+
+--data Tree a = EmptyTree | Node a (Tree a) (Tree a) deriving (Show)
 
+class Applicative' f where
+  pure :: a -> f a
+  (<*>) :: f (a -> b) -> f a -> f b
 
+instance Applicative' Tree where
+  pure a = Node a EmptyTree EmptyTree
+  (<*>) _ EmptyTree = EmptyTree
+  (<*>) EmptyTree _ = EmptyTree
+  (<*>) (Node g _ _) (Node v a b) = (Node (g v) ((<*>) (pure g) a) ((<*>) (pure g) b))
 
+-- let t = foldr treeInsert EmptyTree [1,2,3]
+-- let s = singleton (*2)
+-- (<*>) s t
+-- s <*> t
 
diff --git a/sandbox.hs b/sandbox.hs
@@ -1,4 +1,5 @@
 -- Learn you a Haskell for Great Good --
+-- GIST: 4e3241f2a73fe93d7a96
 
 import Data.List
 import Data.Char
@@ -169,3 +170,105 @@ findByKey ((k,v):xs) key
 -- Mat.insert
 -- Map.size
 --
+
+-- data types
+data MyType = MyValueConstructor1 Int | MyValueConstructor2 Float
+  deriving (Show)
+
+data SingleValueConstructor = SingleValueConstructor
+  deriving (Show)
+
+data MyRecord = MyRecord {
+    name :: String,
+    age :: Int
+  } deriving (Show)
+
+-- MyRecord "Antonio" 31
+-- MyRecord {age=31, name="Antonio"}
+
+-- value constructors are "tags" used to build new instances of the data (type) and pattern match them
+data MyTypeConstructor a = MyOtherValueConstructor1 a | MyOtherValueConstructor2 a
+  deriving (Show)
+
+myFunction :: (MyTypeConstructor a) -> (MyTypeConstructor a)
+myFunction (MyOtherValueConstructor1 n) = MyOtherValueConstructor2 n
+myFunction (MyOtherValueConstructor2 n) = MyOtherValueConstructor1 n
+
+-- pattern matching is all about value constructors (including data structures which are
+-- simply syntactic sugar for value constructors anyway)
+
+-- type aliases
+type MyString = String
+
+-- binary search tree
+
+data Tree a = EmptyTree | Node a (Tree a) (Tree a) deriving (Show)
+
+singleton :: a -> Tree a
+singleton v = Node v EmptyTree EmptyTree
+
+treeInsert :: (Ord a) => a -> Tree a -> Tree a
+treeInsert v EmptyTree = singleton v
+treeInsert v (Node n left right)
+  | v < n = Node n (treeInsert v left) right
+  | v > n = Node n left (treeInsert v right)
+  | otherwise = Node v left right
+
+treeElem :: (Ord a) => a -> Tree a -> Bool
+treeElem _ EmptyTree = False
+treeElem v (Node n left right)
+  | v == n = True
+  | v < n = treeElem v left
+  | v > n = treeElem v right
+
+-- type classes
+class MyClass a where
+  something :: a -> [a]
+
+instance MyClass (Tree a) where
+  something EmptyTree = [EmptyTree]
+  something (Node v _ _) = [Node v EmptyTree EmptyTree]
+
+class YesNo a where
+  yesno :: a -> Bool
+
+instance YesNo Int where
+  yesno 0 = False
+  yesno _ = True
+
+instance YesNo [a] where
+  yesno [] = False
+  yesno _ = True
+
+instance YesNo Bool where
+  yesno = id
+
+-- functor
+-- f is a type constructor with a single type parameter, not a concrete type!!!!!!
+class Functor' f where
+  fmap' :: (a -> b) -> f a -> f b
+
+instance Functor' Maybe where
+  fmap' _ Nothing = Nothing
+  fmap' f (Just a) = Just (f a)
+
+instance Functor' [] where
+  fmap' = map
+
+instance Functor' Tree where
+  fmap' _ EmptyTree = EmptyTree
+  fmap' f (Node v left right) = Node (f v) (fmap' f left) (fmap' f right)
+
+-- partially apply type constructor to obtain one with a single type parameter
+instance Functor' (Either a) where
+  fmap' f (Right x) = Right (f x)
+  fmap' _ (Left x ) = Left x
+
+instance Functor' (Map.Map k) where
+  fmap' = Map.map
+
+main = putStrLn $ show $ fmap' (*20) $ Map.fromList [(1,2)]
+
+
+
+
diff --git a/sandbox.hs b/sandbox.hs
@@ -1,5 +1,9 @@
 -- Learn you a Haskell for Great Good --
 
+import Data.List
+import Data.Char
+import qualified Data.Map as Map
+
 -- head, tail, take, drop, takeWhile, dropWhile
 -- fst, snd, zip, zipWith, flip
 -- sum, product, maximum
@@ -139,8 +143,29 @@ collatz n
 reverse' :: [a] -> [a]
 reverse' = foldl (\acc x -> x : acc) []
 
+-- function composition
+--replicate 2 (product (map (*3) (zipWith max [1,2] [4,5])))
+--replicate 2 . product . map (*3) $ zipWith max [1,2] [4,5]
 
+digits :: (Integral a) => a -> [a]
+digits n
+  | n < 10 = [n]
+  | otherwise = digits (n `quot` 10) ++ [n `mod` 10]
 
+-- (length $ takeWhile (/=40) $ map (foldl1 (+)) $ map digits [1..]) + 1
 
 
+-- dictionaries
+--
+findByKey :: (Eq k) => [(k,v)] -> k -> Maybe v
+findByKey [] key = Nothing
+findByKey ((k,v):xs) key
+  | key == k = Just v
+  | otherwise = findByKey xs key
 
+-- Map.fromList
+-- Map.fromListWith
+-- Mat.lookup
+-- Mat.insert
+-- Map.size
+--
diff --git a/sandbox.hs b/sandbox.hs
@@ -1,5 +1,9 @@
 -- Learn you a Haskell for Great Good --
 
+-- head, tail, take, drop, takeWhile, dropWhile
+-- fst, snd, zip, zipWith, flip
+-- sum, product, maximum
+
 sum2 :: Int -> Int -> Int
 sum2 a b = a + b
 
@@ -132,6 +136,9 @@ collatz n
 --foldl' :: (a->b->a) -> a -> [b] -> a
 --foldr' :: (a->b->b) -> b -> [a] -> b
 
+reverse' :: [a] -> [a]
+reverse' = foldl (\acc x -> x : acc) []
+
 
 
 

diff --git a/sandbox.hs b/sandbox.hs
@@ -1,3 +1,5 @@
+-- Learn you a Haskell for Great Good --
+
 sum2 :: Int -> Int -> Int
 sum2 a b = a + b
 

diff --git a/sandbox.hs b/sandbox.hs
@@ -0,0 +1,137 @@
+sum2 :: Int -> Int -> Int
+sum2 a b = a + b
+
+-- pattern matching on Ints
+factorial :: Int -> Int
+factorial 0 = 1
+factorial n = n * factorial (n-1)
+
+-- pattern matching on tuples
+addTuples :: (Double, Double) -> (Double,Double) -> (Double, Double)
+addTuples (a,b) (c,d) = (a + c, b + d)
+
+-- pattern matching on lists
+head' :: [a] -> a
+head' [] = error "cannot give head"
+head' (x:_) = x
+
+-- class constraints
+tell :: (Show a) => [a] -> String
+tell [] = "empty string"
+tell (x:[]) = "list is one item " ++ show x
+tell (x:y:_) = "list is more than one item, first two items are " ++ show x ++ " and " ++ show y
+
+-- guards (replacements for big if/else conditions) + where + function body
+bmiTell :: Double -> String
+bmiTell bmi
+  | bmi <= 18.5 = "Underweigth"
+  | bmi <= 25.0 = "Normal"
+  | bmi <= 30.0 = "Overweigth"
+bmiTell bmi = "You are Obese " ++ show doubleBmi
+  where doubleBmi = bmi * 2
+
+-- where w/ pattern matching
+initial :: String -> String -> (Char, Char)
+initial firstName lastName = (f, l)
+  where (f:_) = firstName
+        (l:_) = lastName
+
+-- case expression
+head'' :: [a] -> a
+head'' xs = case xs of [] -> error "cannot give head"
+                       (x:_) -> x
+-- recursion
+fibonacci :: Int -> Int
+fibonacci 0 = 0
+fibonacci 1 = 1
+fibonacci n = fibonacci (n-1) + fibonacci (n-2)
+
+-- sequence
+--let fibonacciSeq = [fibonacci x | x <- [2..12]]
+
+-- recursion
+maximum' :: (Ord a) => [a] -> a
+maximum' [] = error "empty list"
+maximum' [x] = x
+maximum' (x:xs) = max x (maximum' xs)
+
+-- recursion
+replicate' :: Int -> a -> [a]
+replicate' 0 _ = []
+replicate' 1 x = [x]
+replicate' n x =  x : replicate' (n-1) x
+
+-- use guards instead of patterns b/c we're testing for a boolean condition
+replicate'' :: Int -> a -> [a]
+replicate'' n x
+  | n <= 0 = []
+  | otherwise = x : replicate'' (n-1) x
+
+take' :: Int -> [a] -> [a]
+take' n _
+  | n <= 0 = []
+take' _ [] = []
+take' n (x:xs) = x : take' (n-1) xs
+
+zip' :: [a] -> [b] -> [(a,b)]
+zip' [] _ = []
+zip' _ [] = []
+zip' (x:xs) (y:ys) = (x,y) : zip' xs ys
+
+elem' :: (Eq a) => a -> [a] -> Bool
+elem' x [] = False
+elem' x (y:ys) = x == y || elem' x ys
+
+quicksort' :: (Ord a) => [a] -> [a]
+quicksort' [] = []
+quicksort' (x:[]) = [x]
+quicksort' (x:xs) = let smaller = quicksort' [l | l <- xs, l < x]
+                        largerOrEqual = quicksort' [g | g <- xs, g >= x]
+                    in smaller ++ x : largerOrEqual
+
+-- curried functions
+isAlpha :: Char -> Bool
+isAlpha = (`elem` ['A'..'Z'])
+
+applyTwice :: (a->a) -> a -> a
+applyTwice f x = f (f x)
+
+zipWith' :: (a->b->c) -> [a] -> [b] -> [c]
+zipWith' _ [] _ = []
+zipWith' _ _ [] = []
+zipWith' f (x:xs) (y:ys) = f x y : zipWith' f xs ys
+
+
+flip' :: (a -> b -> c) -> b -> a -> c
+flip' f x y = f y x
+
+-- common higher-order functions
+map' :: (a -> b) -> [a] -> [b]
+map' _ [] = []
+map' f (x:xs) = f x : map' f xs
+
+filter' :: (a -> Bool) -> [a] -> [a]
+filter' f xs = [y | y <- xs, f y]
+
+--find sum of all odd squares that are smaller than 10,000
+--sum (takeWhile (<10000) (filter odd (map (^2) [1..])))
+
+-- collatz sequences
+collatz :: Integer -> [Integer]
+collatz 1 = [1]
+collatz n
+  | even n = n:collatz (n `div` 2)
+  | odd n = n:collatz (n * 3 + 1)
+
+-- find # of chains larger than 15 for numbers between 1 and 100
+--length (filter (>15) (map length (map collatz [1..100])))
+--length (filter (\xs -> length xs > 15) (map collatz [1..100]))
+
+--foldl' :: (a->b->a) -> a -> [b] -> a
+--foldr' :: (a->b->b) -> b -> [a] -> b
+
+
+
+
+
+
No results found