derive.hs

{-# 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