Skip to content

Instantly share code, notes, and snippets.

@cblp
Last active September 28, 2022 06:28
Show Gist options
  • Save cblp/c0f4ff54836f02a34f06c857d939ad6d to your computer and use it in GitHub Desktop.
Save cblp/c0f4ff54836f02a34f06c857d939ad6d to your computer and use it in GitHub Desktop.
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE LambdaCase #-}
data Expr
= Lit Integer
| Var
| Add Expr Expr
| Mul Expr Expr
| Pow Expr Expr
| Sin Expr
| Cos Expr
deriving Eq
instance Show Expr where
show = \case
Lit n -> show n
Var -> "x"
Add a b -> show a ++ " + " ++ show b
Mul a b -> show a ++ " * " ++ show b
Pow a b -> show a ++ " ** " ++ show b
Sin a -> "sin " ++ show a
Cos a -> "cos " ++ show a
instance Floating Expr where
sin = Sin
(**) = Pow
instance Fractional Expr
instance Num Expr where
(*) = Mul
(+) = Add
fromInteger = Lit
derive :: (Expr -> Expr) -> Expr
derive f = simplify $ d $ f Var where
d = \case
Var -> 1
Mul a b -> d a * b + a * d b
Sin a -> Cos a * d a
Pow a (Lit n) -> Lit n * Pow a (Lit $ n - 1) * d a
simplify = \case
Mul a 1 -> simplify a
Mul a b -> Mul (simplify a) (simplify b)
a -> a
source :: (Expr -> Expr) -> String
source f = show $ f Var
eval :: Expr -> Double -> Double
eval f x =
case f of
Lit i -> fromIntegral i
Var -> x
Mul a b -> eval a x * eval b x
Pow a b -> eval a x ** eval b x
Sin a -> sin $ eval a x
Cos a -> cos $ eval a x
_ -> error $ show f
f x = sin x ** 4
-- $> f (pi / 2)
-- $> source f
-- $> derive f
-- $> let f' = eval (derive f) in f' 1
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment