Why?

real numbers, complex nuimbers, n-dimensional spaces have well defined + and * operations (vectorial product in the latter case).

even algebraic expressions like:

data Expr = Var String | Number Integer | Sin Expr | Cos Expr


can be instances of Num and express certain simplification rules in the definition.

instance Num Expr where
  ...
 (Sin x) * (Cos x) = (Sin (2 * x))/2
 ...


I started to develop a extensible symbolic math manipulation around the idea of using symbolic expressions as instances of Num and other basic classes. But I leaved it out due to lack of time.

By the way I attach it just in case anyone want to get some idea from it:


module DynAlgebra where

data Dyn= forall a.(Num a, Eq a, Show a, Ord a, Read a, Simplify a)=> Dyn a

instance Show Dyn where
   show (Dyn a)= show a

instance Eq Dyn where
    (Dyn a) == (Dyn b)= solve a== solve b

class Simplify a where
  simplify :: a -> a
  solve    :: a -> Polonomial Expr1

data Polonomial e  =  e  :/ e  | e :+ e  | e :* e    deriving Show

data Expr1= Var String | I Integer   | Pi | E   deriving Show

-- Integer :/ Integer for exact rational arithmetic

data Expr= Polinomial Expr  | Formula Dyn deriving (Show, Eq)


instance Num (Polonomial Expr1) where
 fromInteger = I
 (+) (I a) (I b)= I (a+b)
 (+) e1 e2  = e1 :+ e2

 (*) (I a) (I b)= I (a*b)
 (*) e1 e2 = (:*) e1 e2
 
 abs (I x) | x>=0 = I x 
           | otherwise = I (-x)
 signum (I x) | x >= 0 = 1 
              | otherwise= -1

instance Ord Polonomial  where
 compare  (I a) (I b)= compare a b
 compare  ( x :+ z)  y | x < y && z >0 = LT
                       | x > y && z >0 = GT

 compare   y ( x :+ z) | y > x && z >0 = LT
                       | y > x && z >0 = GT

instance Eq Polonomial  where
   (I a) == (I b) = a == b

   
   (I a :+ I b)== ( I c :+ I d)= a + b== c + d
   (I a :* I b)== ( I c :* I d)= a * b== c * d

   (a :+ b)== (c :+ d)= a==c && b == d
   (a :* b)== (c :* d)= a== c && b == d
   (a :/ b)== (c :/ d)= a * d == b * c
   
   exp1 == exp2 = simplify exp1== simplify exp2

            
             
instance Simplify  (Polonomial Expr1) where
  solve  x = simplify x     

  simplify ( (I x) :/ (I y))=  case quotRem x y   of
                      (q,0) -> I q
                      (q,r) -> let m= mcd y r in (I(x `div` m)) :/  (I(y `div` m)) 
 
  simplify ((I a) :+ (I b))= I (a + b)
  simplify ((I a) :* (I b))= I (a * b)
  
  
  simplify ((a :* b) :+ (c :* d)) | a == c = simplify $  a * (b :+d)
  simplify (exp1 :+ exp2) = simplify exp1 :+ simplify exp2
  simplify (exp1 :* exp2) = simplify exp1 :* simplify exp2

  simplify expr= expr

mcd x y= case mod x y of
           0 -> y
           t -> mcd y t
  
  
subst:: Polonomial  -> [(String, Polonomial )] -> Polonomial 
subst exp l= subs1 exp where
 subs1 (Var v)= case lookup v l of
                 Nothing -> Var v
                 Just e  -> e
 subs1 (e1 :+ e2) = ((subs1 e1) :+ (subs1 e2))
 subs1 (e1 :* e2) = ((subs1 e1) :* (subs1 e2))
 subs1 (e1 :/ e2) = ((subs1 e1) :/ (subs1 e2))

 subst e= e

f x= x :* x



main= print  $ solve  $ 2 :+1


2009/10/5 Miguel Mitrofanov <miguelimo38@yandex.ru>



Sönke Hahn wrote:

I used to implement

   fromInteger n = (r, r) where r = fromInteger n

, but thinking about it,
   fromInteger n = (fromInteger n, 0)

seems very reasonable, too.

Stop pretending something is a number when it's not.

_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe