Achievement get : show

.gitignore

@@ -0,0 +1,5 @@
+.*.sw[p-z]
+*.hi
+*.o
+lab/*
+mySolver

Makefile

@@ -15,7 +15,7 @@ OBJ = $(addprefix $(OBJD)/, $(OBJ_))
 IFACE_ = $(SRC_:.hs=.hi)
 IFACE = $(addprefix $(OBJD)/, $(IFACE_))
 
-GHCFLAGS = -O 
+GHCFLAGS = -O
 
 
 

src/Main.hs

@@ -1,4 +1,3 @@
-
 import MyPolynome
 import Data.Complex
 
@@ -20,7 +19,10 @@ main = do
 
 --	print $ isQuadratic $ (Member (-1) (-1)):(Member (-1) (1)):[]
 
-	let lolPoly = canonicalQuadratic $ (Member 666 (-69)):concat( [poly, canonicalQuadratic ( [] )] )
-	print ( lolPoly )
-	let roots = solveQuadratic poly
+	let lolPoly = (Member 666 (-69)):concat( [poly, canonicalQuadratic ( [] )] )
+--	putStrLn $ MyPolynome.showList lolPoly $ []
+	print lolPoly
+	let roots = solveQuadratic lolPoly
 			in putStrLn $ showSolution roots
+	print (5 :*^: 1)
+--	print $ read "(0.0 * X ^ 0)"

src/MyPolynome.hs

@@ -1,19 +1,41 @@
+--{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses #-}
 
-module MyPolynome where
+module MyPolynome
+	where
 
 import Data.Complex
 import Data.List
 
+infix 5 :*^:
+data Member = Member Float Int | Float :*^: Int deriving (Ord, Eq)
 
-data Member = Member Float Int deriving (Show)
 type Polynome = [Member] 
 
+-- Pretty Member and [Member] (aka Polynome) Show.
+instance Show Member where
+	show (Member c p) = show (c :*^: p)
+	show (c :*^: p) = ('(':) . shows c . (" * X ^ " ++) . shows p $ ")" 
+	showList = goDeeper
+		where
+			goDeeper []  = ("" ++)
+			goDeeper (mn:[]) = shows mn
+			goDeeper (m1:(m2@(Member c2 p2)):ms) = shows m1 . signBridge . next
+				where
+					signBridge
+						| c2 < 0 = (" - " ++)
+						| otherwise = (" + " ++)
+					next
+						| c2 < 0 = goDeeper ((Member (-c2) p2):ms)
+						| otherwise = goDeeper (m2:ms)
+
+
 mbrCoeff :: Member -> Float
 mbrCoeff ( Member c _ ) = c
 
 mbrPower :: Member -> Int
 mbrPower ( Member _ p ) = p
 
+
 showComplex :: (Ord c, Num c, Show c, RealFloat c) => Complex c -> [Char]
 showComplex c = show a ++ img
 	where
@@ -53,6 +75,7 @@ isQuadratic poly
 
 
 -- Make it aX^2 + bX + c ; cut the garbage, insert missing Members (power 0->2).
+-- Resulting Polynome is in the form (m2:m1:m0:[])
 canonicalQuadratic :: Polynome -> Polynome 
 canonicalQuadratic poly = smashedPoly
 	where
@@ -66,22 +89,24 @@ discriminantQuadratic :: (Num n) => (n, n, n) -> n
 discriminantQuadratic (a, b, c) = (b ^ 2 - 4 * a * c)
 
 
-realRoots :: (Float, Float, Float) -> (Float, Float)
-realRoots (a, b, c) =
-	let delta = discriminantQuadratic (a, b, c)
-		in let	x1 = (-b - sqrt(delta)) / (2 * a);
-						x2 = (-b + sqrt(delta)) / (2 * a)
-						in (x1, x2)
-
-
-complexRoots :: (Float, Float, Float) -> (Complex Float, Complex Float)
-complexRoots (a, b, c) = 
-	let delta = discriminantQuadratic (a, b, c)
-			in let	x1 = (-b / (2 * a)) :+ (sqrt(delta) / (2 * a));
-							x2 = (-b / (2 * a)) :+ ((-sqrt(delta) / (2 * a)))
-							in (x1, x2)
-
-
+roots :: (Float, Float, Float) -> (Complex Float, Complex Float)
+roots (a, b, c)
+	| delta < 0 = (cr1, cr2)
+	| delta == 0 = (rr0, rr0)
+	| delta > 0 = (rr1, rr2)
+	where
+		delta = discriminantQuadratic (a, b, c)
+		cr1 = (-b / (2 * a)) :+ (sqrt(-delta) / (2 * a))
+		cr2 = (-b / (2 * a)) :+ (-sqrt(-delta) / (2 * a))
+		rr1 = ((-b - sqrt(delta)) / (2 * a)) :+ 0
+		rr2 = ((-b + sqrt(delta)) / (2 * a)) :+ 0
+		rr0 = rr1
+
+-- Enforce canonical quadratic form and solve .
 solveQuadratic :: Polynome -> (Complex Float, Complex Float)
-solveQuadratic _ = (5, 1)
-
+solveQuadratic supposedQuadratic = 
+	let	canonPoly@(m2:m1:m0:[]) = canonicalQuadratic ( supposedQuadratic );
+			c2 = mbrCoeff m2;
+			c1 = mbrCoeff m1;
+			c0 = mbrCoeff m0
+			in roots (c2, c1, c0)