Skip to content

Instantly share code, notes, and snippets.

@keksnicoh
Last active October 26, 2020 15:27
Show Gist options
  • Save keksnicoh/5e32ebe5989e1a007daf993f7c386850 to your computer and use it in GitHub Desktop.
Save keksnicoh/5e32ebe5989e1a007daf993f7c386850 to your computer and use it in GitHub Desktop.
takehome-fp-interview solution
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
module Test where
import Control.Applicative (Alternative (..), Applicative (liftA2))
import Control.Monad (MonadPlus (..), guard)
import Data.Char (isDigit, ord, toLower)
-- notes: solved with IDE Support (HLS)
-- 1) trivial
sumInt :: [Int] -> Int
sumInt [] = 0
sumInt (x : xs) = x + sumInt xs
-- 2) trivial without fold
reverseList :: [a] -> [a]
reverseList [] = []
reverseList (x : xs) = reverseList xs ++ [x]
-- 2) trivial when using ide to get foldl signature
reverseListFold :: [a] -> [a]
reverseListFold = foldl f []
where
f a b = [b] ++ a
-- 3) trivial
filterList :: (a -> Bool) -> [a] -> [a]
filterList _ [] = []
filterList p (x : xs)
| p x = [x] ++ filterList p xs
| otherwise = filterList p xs
bla :: (a -> Bool) -> [a] -> [a]
bla = takeWhile
-- 4) medium
filterListFold :: (a -> Bool) -> [a] -> [a]
filterListFold p = foldr f []
where
f a b | p a = [a] ++ b
f _ b = b
takeWhileFold :: (a -> Bool) -> [a] -> [a]
takeWhileFold p = foldr f []
where
f a b | p a = [a] ++ b
f _ _ = []
-- 5) trivial
{-
forall a . a -> a
forall a . a -> (a, a)
forall a b . (a -> b) -> a -> b
forall a b c . (a -> b -> c) -> (a,b) -> c
-}
f1 :: forall a. a -> a
f1 a = a
f2 :: forall a. a -> (a, a)
f2 a = (a, a)
f3 :: forall a b. (a -> b) -> a -> b
f3 f a = f a
f4 :: forall a b c. (a -> b -> c) -> (a, b) -> c
f4 f (a, b) = f a b
-- 7) easy
data Maybe' a = Just' a | Nothing'
deriving (Show)
instance Functor Maybe' where
fmap f (Just' a) = Just' $ f a
fmap _ Nothing' = Nothing'
instance Applicative Maybe' where
pure = Just'
Just' f <*> Just' a = Just' $ f a
_ <*> _ = Nothing'
instance Monad Maybe' where
return = pure
Just' a >>= f = f a
_ >>= _ = Nothing'
liftM2' :: (Monad m) => (a -> b -> c) -> m a -> m b -> m c
liftM2' f fa fb = do
a <- fa
b <- fb
return $ f a b
-- liftM2 applies two defined values (Just a, Just b) to a function a -> b -> c while lifting
-- the function into the monadic context.
-- 8) hard
bind :: (a -> b) -> (b -> (a -> c)) -> (a -> c)
bind fa k = \a -> ((k (fa a)) a)
return' :: a -> (b -> a)
return' a = \_ -> a
-- see what liftM2 does..
-- liftM2 f fa fb = fa `bind` (\a -> fb `bind` (\b -> return $ f a b))
-- liftM2 f fa fb = \m -> (((\a -> fb `bind` (\b -> return $ f a b)) (fa m)) m)
-- liftM2 f fa fb = \m -> (((\a -> (\n -> (((\b -> return $ f a b) (fb n)) n))) (fa m)) m)
-- liftM2 f fa fb = \m -> (((\a -> (\n -> (((\b -> (\_ -> f a b)) (fb n)) n))) (fa m)) m)
-- liftM2 f fa fb = \m -> (((\a -> (\n -> ((((\_ -> f a (fb n)))) n))) (fa m)) m)
-- liftM2 f fa fb = \m -> (((\a -> (\n -> ((\_ -> f a (fb n)) n))) (fa m)) m)
-- liftM2 f fa fb = \m -> ( (\n -> (f (fa m) (fb n))) m)
-- liftM2 f fa fb = \m -> f (fa m) (fb m)
-- liftM2' :: (Monad (->) e) => (a -> b -> c) -> (e -> a) -> (e -> b) -> (e -> c)
{-
+------- fa e ---[a]---+
| |
e ------| |---- f a b ---> c
| |
+------- fb e ---[b]---+
-}
-- liftM2 applies a values to two functions and combines the result using an operator
-- e.g.: tupleFunc = liftM2 (,)
-- 9) hard
-- special case of Traversable. Implementing it by hand turned out to be
-- kind of technical mystery. It helped a lot specializing it to Maybe
myFunc :: Applicative f => [(f a, b)] -> f [(a, b)]
myFunc [] = pure []
myFunc ((fa, b) : xs) = f <$> fa <*> myFunc xs
where
f a = (++) [(a, b)]
--f = (++) . pure . flip (,) b
-- >>> myFunc [(Just 5, True), (Just 3, False), (Just 1, False)]
-- Just [(5,True),(3,False),(1,False)]
{-
myFunc2 :: [(Maybe a, b)] -> Maybe [(a, b)]
myFunc2 [] = Just []
myFunc2 ((Just a, b):xs) = fmap (\x -> [(a, b)] ++ x) (myFunc2 xs)
myFunc2 ((Nothing, _):_) = Nothing
myFunc3 :: [(Maybe a, b)] -> Maybe [(a, b)]
myFunc3 [] = Just []
myFunc3 ((fa, b):xs) = (fmap (\x -> \a -> [(a, b)] ++ x) (myFunc2 xs)) <*> fa
-}
-- 10) easy
someFunc :: (Traversable t, Applicative f) => t (f a, b) -> f (t (a, b))
someFunc = traverse (\(a, b) -> (\a -> (a, b)) <$> a)
-- traverse :: Applicative f => (a -> f b) -> t a -> f (t b)
-- traverse :: Applicative f => ((f x, y) -> f (x, y)) -> t (f x, y) -> f (t (x, y))
-- 11) easy
data Errer e b = Error e | Success b
deriving (Show)
instance Functor (Errer e) where
fmap f (Success b) = Success $ f b
fmap _ (Error e) = Error e
instance Semigroup e => Applicative (Errer e) where
pure a = Success a
Success f <*> Success b = Success $ f b
Error a <*> Error e = Error (a <> e)
Error a <*> _ = Error a
_ <*> Error e = Error e
-- 12) easy (if correct laws are satisfied)
data Pair a = Pair a a
instance Functor Pair where
fmap f (Pair a b) = Pair (f a) (f b)
-- looks reasonable, but laws are not fully proofed yet
instance Applicative Pair where
pure a = Pair a a
Pair f g <*> Pair a b = Pair (f a) (g b)
-- Monad instance would require some kind of combinator,
-- for example Semigroup. Which is not possible to define
-- without introducing and additional type paramerer to Pair
-- e.g. Pair m a
-- instance Semigroup m => Monad (Pair m) where
-- laws
{-
pure id <*> v = v -- Identity -> OK
pure f <*> pure x = pure (f x) -- Homomorphism -> OK
u <*> pure y = pure ($ y) <*> u -- Interchange -> XXX
pure (.) <*> u <*> v <*> w = u <*> (v <*> w) -- Composition -> XXX
-}
-- pure id <*> (Pair a b) = (Pair id id) <*> (Pair a b)
-- = Pair (id a) (id b)
-- = Pair a b
-- pure f <*> pure x = Pair f f <*> Pair x x
-- = Pair (f x) (f x)
-- = pure (f x)
-- Pair f g <*> pure y = Pair f g <*> Pair y y
-- = Pair (f y) (g y)
-- pure ($ y) <*> Pair a b
-- = Pair ($ y) ($y) <*> Pair a b
-- = Pair (y a) (y b)
-- XXX TODO last two laws
-- 13) hard, had never implemented a parser, http://dev.stephendiehl.com/fun/002_parsers.html
-- provided basic inspiration for the parse type and examples
-- m MonadPlus container
-- a result type
newtype Parser m a = Parse
{runParser :: (String -> m (a, String))}
instance Functor f => Functor (Parser f) where
fmap f (Parse parser) = Parse $ \str -> (\(v, r) -> (f v, r)) <$> parser str
instance Monad m => Applicative (Parser m) where
pure a = Parse $ \str -> pure (a, str)
(Parse pf) <*> (Parse p) = Parse $ \str -> do
(f, n) <- pf str
(v, r) <- p n
return $ (f v, r)
applicativeTest :: Parser [] Int
applicativeTest = (*) <$> digit <*> digit
-- >>> runParser applicativeTest $ "234234"
-- [(6,"4234")]
instance MonadPlus f => Alternative (Parser f) where
empty = Parse $ \_ -> empty
(Parse p1) <|> (Parse p2) = Parse $ \str -> p1 str <|> p2 str
instance Monad f => Monad (Parser f) where
return = pure
-- run parser and use the result to create a new one which is
-- where the tail if applied to
(Parse p) >>= fp = Parse $ \str -> do
(v, s) <- p str
runParser (fp v) s
monadTest :: Parser [] Int
monadTest = do
d1 <- digit
r <- case d1 of
1 -> empty
_ -> digit
return $ d1 * r
-- >>> runParser monadTest "23"
-- [(6,"")]
instance MonadPlus f => MonadPlus (Parser f) where
mzero = Parse $ const mzero
mplus (Parse p1) (Parse p2) = Parse $ liftA2 mplus p1 p2
predicate :: MonadPlus f => (Char -> Bool) -> Parser f Char
predicate predicate = do
char <- anyChar
guard $ predicate char
return char
oneOf :: MonadPlus f => [Char] -> Parser f Char
oneOf whitelist = predicate (\s -> s `elem` whitelist)
char :: MonadPlus f => Char -> Parser f Char
char whitelist = predicate (\s -> s == whitelist)
anyChar :: Alternative f => Parser f Char
anyChar = Parse $ \case
[] -> empty
(c : cs) -> pure (c, cs)
-- some = >0
-- many = >=0
natural :: MonadPlus f => Parser f Integer
natural = read <$> some (predicate isDigit)
-- playground
-- >>> runParser natural $ "1337abc"
-- (1337,"abc")
-- simple string parser without escape sequences
parseString :: MonadPlus m => Parser m String
parseString = do
predicate dchar
result <- many . predicate $ not <$> dchar
predicate dchar
return result
where
dchar = (==) '"'
-- >>> runParser @[] parseString $ "\"foo\"derp"
-- [("foo","derp")]
letter :: Alternative f => Parser f Char
letter = Parse $ \case
[] -> empty
(x : xs)
| ord x > 64 && ord x < 122 -> pure (x, xs)
| x == '_' -> pure (x, xs)
| otherwise -> empty
digit :: Alternative f => Parser f Int
digit = Parse $ \case
[] -> empty
('0' : cs) -> pure (0, cs)
('1' : cs) -> pure (1, cs)
('2' : cs) -> pure (2, cs)
('3' : cs) -> pure (3, cs)
('4' : cs) -> pure (4, cs)
('5' : cs) -> pure (5, cs)
('6' : cs) -> pure (6, cs)
('7' : cs) -> pure (7, cs)
('8' : cs) -> pure (8, cs)
('9' : cs) -> pure (9, cs)
_ -> empty
-- playground parser / eval of simple expression evaluator
data Operator = Plus | Minus | Multiplication | Division
deriving (Show, Eq)
data AST
= Number Float
| Expr Operator AST AST
| Function String AST
deriving (Show, Eq)
parseOperator :: MonadPlus f => Parser f Operator
parseOperator = Parse $ \case
('+' : cs) -> pure (Plus, cs)
('-' : cs) -> pure (Minus, cs)
('/' : cs) -> pure (Division, cs)
('*' : cs) -> pure (Multiplication, cs)
_ -> empty
parseNumber :: MonadPlus f => Parser f Float
parseNumber = read <$> some (predicate isDigit) -- XXX
hull :: MonadPlus f => Char -> Char -> Parser f a -> Parser f a
hull a b p = do
char a
result <- p
char b
return result
parseExpr :: MonadPlus f => Parser f AST
parseExpr = spaces *> operation <|> dotOperation <|> atom <* spaces
where
atom = Number <$> parseNumber <|> hull '(' ')' parseExpr <|> parseFunc
parseFunc =
Function
<$> some (oneOf funcChars)
<*> hull '(' ')' parseExpr
operation = do
a <- dotOperation <|> atom
operator <- op [Plus, Minus]
Expr operator a <$> parseExpr
dotOperation = do
a <- atom
operator <- op [Multiplication, Division]
Expr operator a <$> (dotOperation <|> atom)
op a = do
spaces
operator <- parseOperator
guard $ operator `elem` a
spaces
return operator
spaces = many $ oneOf [' ', '\t', '\n']
-- >>> runParser parseExpr $ "5*3*2*sin(5+3)"
-- (Expr Multiplication (Number 5.0) (Expr Multiplication (Number 3.0) (Expr Multiplication (Number 2.0) (Function "sin" (Expr Plus (Number 5.0) (Number 3.0))))),"")
evalAST :: AST -> Either String Float
evalAST (Number n) = Right n
evalAST (Expr Plus a b) = (+) <$> evalAST a <*> evalAST b
evalAST (Expr Minus a b) = (-) <$> evalAST a <*> evalAST b
evalAST (Expr Multiplication a b) = (*) <$> evalAST a <*> evalAST b
evalAST (Expr Division a b) = (/) <$> evalAST a <*> evalAST b
evalAST (Function name expr) = case toLower <$> name of
"sin" -> sin <$> evalAST expr
"cos" -> cos <$> evalAST expr
"tan" -> tan <$> evalAST expr
"abs" -> abs <$> evalAST expr
name -> Left $ "unkown function name: " ++ name
-- >>> evalAST . fst <$> (runParser @Maybe parseExpr) "abs(20-30)*4-5*2+2"
-- Just (Right 28.0)
-- buggy... need some fix
funcChars =
[ 'a',
'b',
'c',
'd',
'e',
'f',
'g',
'h',
'i',
'j',
'k',
'l',
'm',
'n',
'o',
'p',
'q',
'r',
's',
't',
'u',
'v',
'w',
'x',
'y',
'z',
'A',
'B',
'C',
'D',
'E',
'F',
'G',
'H',
'I',
'J',
'K',
'L',
'M',
'N',
'O',
'P',
'Q',
'E',
'S',
'T',
'U',
'V',
'W',
'X',
'Y',
'Z',
'_'
]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment