d.hs

import Numeric
import Data.Ratio

data Op =
    Plus Op Op
  | Mul Op Op
  | Pow Op Op
  | Ln Op
  | E Op
  | Pi Op
  | Const Rational
  | Var
  deriving (Eq)

class Derivable a where
  d :: a -> a

instance Derivable Op where
  d (Const u) = Const 0
  d (Var) = Const 1
  d (Plus u v) = Plus (d u) (d v)
  d (Mul u v) = Plus (Mul u (d v)) (Mul (d u) v)
  d (E u) = Mul (d u) (E u)
  d (Pi u) = Mul (d u) (Mul (Pi u) (Ln (Pi (Const 1))))
  d (Pow u v) = Plus (Mul df_du du_dx) (Mul df_dv dv_dx)
    where
      df_du = Mul v (Pow u (Plus v (Const $ -1)))
      du_dx = d u
      df_dv = Mul (Pow u v) (Ln u)
      dv_dx = d v
  d (Ln r) = Mul (d r) (Pow r (Const $ -1))

simplify (Plus (Const 0) v) = v
simplify (Plus u (Const 0)) = u
simplify (Plus (Const a) (Const b)) = Const (a + b)
simplify (Plus u v) = Plus (simplify u) (simplify v)
simplify (Mul (Const 0) _) = Const 0
simplify (Mul _ (Const 0)) = Const 0
simplify (Mul (Const 1) v) = v
simplify (Mul u (Const 1)) = u
simplify (Mul (Const a) (Const b)) = Const (a * b)
simplify (Mul u v) = Mul (simplify u) (simplify v)
simplify (Pow u (Const 0)) = Const 1
simplify (Pow u (Const 1)) = u
simplify (Pow (Const 1) _) = Const 1
simplify (Pow (Const 0) _) = Const 0
simplify (Pow (Const a) (Const b))
  | denominator a == 1 = Const (a ^ (numerator b))
  | otherwise = Pow (Const a) (Const b)
simplify (Pow u v) = Pow (simplify u) (simplify v)
simplify (Ln u) = Ln (simplify u)
simplify (E u) = E (simplify u)
simplify (Pi u) = Pi (simplify u)
simplify (Const u) = Const u
simplify (Var) = Var

fullSimplify :: Op -> Op
fullSimplify op =
  let op' = simplify op in
    case op' == op of
      True -> op
      False -> fullSimplify op'

instance Show Op where
  show (Const r) = (display 1) $ r
    where
      display :: Int -> Rational -> String
      display n x = (showFFloat (Just n) $ fromRat x) ""
  show (Plus l r) = "(" ++ show l ++ "+" ++ show r ++ ")"
  show (Mul l r) = "(" ++ show l ++ "*" ++ show r ++ ")"
  show (Ln r) = "ln[" ++ show r ++ "]"
  show (E r) = "e^{" ++ show r ++ "}"
  show (Pi r) = "pi^{" ++ show r ++ "}"
  show (Pow l r) = show l ++ "^{" ++ show r ++ "}"
  show (Var) = "x"

--dn :: Derivable a => Int -> a -> [a]
dn n f = take n $ iterate (fullSimplify . d) f