<div>Hi.</div>
<div> </div>
<div>Please, tell me where I&#39;m wrong and how to improve my approach.</div>
<div> </div>
<div>I&#39;m trying to simplify algebraic expressions this way:</div>
<div> </div>
<div>import Data.Ratio</div>
<div> </div>
<div>data Func = Const (Ratio Int)</div>
<div>         | Pow (Ratio Int)</div>
<div>         | Add Func Func</div>
<div>         | Mul Func Func</div>
<div>          </div>
<div>instance Show Func where</div>
<div>   show (Const n) = &quot;(&quot; ++ show n ++ &quot;)&quot;</div>
<div>   show (Pow n) | n == 0 = &quot;1&quot;</div>
<div>                | n == 1 = &quot;x&quot;</div>
<div>                | otherwise = &quot;(x**(&quot; ++ show n ++ &quot;))&quot;</div>
<div>   show (Add t1 t2) =&quot;(&quot; ++ (show t1) ++ &quot;+&quot; ++ (show t2) ++ &quot;)&quot;</div>
<div>   show (Mul t1 t2) =&quot;(&quot; ++ (show t1) ++ &quot;*&quot; ++ (show t2) ++ &quot;)&quot;</div>
<div> </div>
<div> </div>
<div>deriv (Const _) = Const 0</div>
<div>deriv (Pow 1) = Const 1</div>
<div>deriv (Pow n) = Const n `Mul` Pow (n-1)</div>
<div>deriv (Add a b) = deriv a `Add` deriv b</div>
<div>deriv (Mul a b) = Add (deriv a `Mul` b) (a `Mul` deriv b)</div>
<div> </div>
<div>p0 = Const 1</div>
<div>p1 = p0 `Add` (Mul (Pow 1) (Const 2))</div>
<div>p2 = p1 `Add` (Mul (Pow 2) (Const 3))</div>
<div> </div>
<div> </div>
<div>s rdc (Const x) = Const x</div>
<div>s rdc (Pow 0) = Const 1</div>
<div>s rdc (Pow x) = Pow x</div>
<div>s rdc (Add (Const a) (Const b)) = Const (a+b)</div>
<div>s rdc (Mul (Const 0) _) = Const 0</div>
<div>s rdc (Mul _ (Const 0)) = Const 0</div>
<div>s rdc (Mul (Const a) (Const b)) = Const (a*b)</div>
<div>s rdc (Mul (Pow n) (Pow m)) = Pow (n+m)</div>
<div> </div>
<div>s rdc (Add x (Const 0)) =  rdc x</div>
<div>s rdc (Add (Const 0) x) =  rdc x</div>
<div>s rdc (Mul (Const m) (Mul (Const n) x)) = rdc $ Mul (Const (n*m)) (rdc x)</div>
<div>s rdc (Mul x (Const 1)) =  rdc x</div>
<div>s rdc (Mul x (Const a)) =  rdc $ Mul (Const a) (rdc x)</div>
<div>s rdc (Mul (Const 1) x) =  rdc x</div>
<div>s rdc (Mul x (Add a b)) = Mul (rdc x) (rdc a) `Add` Mul (rdc x) (rdc b)</div>
<div>s rdc (Mul (Add a b) x) = Mul (rdc a) (rdc x) `Add` Mul (rdc b) (rdc x)</div>
<div>s rdc (Mul a b) =  rdc a `Mul` rdc b</div>
<div>s rdc (Add a b) =  rdc a `Add` rdc b</div>
<div> </div>
<div>fix f = f (fix f)</div>
<div> </div>
<div>The result I got is :</div>
<div> </div>
<div>*Main&gt; fix s $ deriv p2</div>
<div>(((2 % 1)+(0 % 1))+(((6 % 1)*x)+(0 % 1)))</div>
<div> </div>
<div>instead of the anticipated expression ((2 % 1)+((6 % 1)*x)).</div>
<div>And worst of all,  I must apply (fix s) repeatedly to achieve correct answer:</div>
<div> </div>
<div>*Main&gt; fix s $ fix s $ deriv p2</div>
<div>((2 % 1)+((6 % 1)*x)).</div>
<div> </div>
<div>I&#39;ll be very much appriciated for any help and useful links.</div>