blob: 9053fa05934b8506d56e43b5ef468563a55c6ce7 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|
module Equation
( Equation (..)
, Polynomial
, Term (..)
, degree
, reduce
, solve
) where
import Data.List
data Equation = Equation { left :: Polynomial, right :: Polynomial }
type Polynomial = [Term]
data Term = Term { coefficient :: Float, exponent :: Int }
instance Eq Term where
(Term _ e1) == (Term _ e2) = e1 == e2
instance Ord Term where
compare (Term _ e1) (Term _ e2) = compare e1 e2
instance Show Term where
show (Term 0 e) = ""
show (Term c 0) = show (round c)
show (Term c e) = show (round c) ++ " * X^" ++ show e
instance Show Equation where
show (Equation l r) = showPolynomial l ++ " = " ++ showPolynomial r
where showPolynomial [] = "0"
showPolynomial p = dropWhile (`elem` " +") $ foldl f "" (map show p)
where f s (c:cs)
| c == '-' = s ++ " - " ++ cs
| otherwise = s ++ " + " ++ (c:cs)
equationMap :: (Polynomial -> Polynomial) -> Equation -> Equation
equationMap f (Equation l r) = Equation (f l) (f r)
degree :: Polynomial -> Int
degree p = Equation.exponent (maximum p)
reduce :: Equation -> Equation
reduce equ = Equation (merge (left stdForm) (right stdForm)) []
where stdForm = equationMap (\a -> (reducePolynomial $ sort a)) equ
merge [] rs = rs
merge ls [] = ls
merge (l:ls) (r:rs)
| l == r = (subTerm l r) : merge ls rs
| l < r = l : merge ls (r:rs)
| r < l = r : merge (l:ls) rs
where subTerm (Term c1 e) (Term c2 _) = Term (c1 - c2) e
reducePolynomial [] = []
reducePolynomial [t] = [t]
reducePolynomial (t1:t2:ts)
| t1 == t2 = (addTerm t1 t2) : reducePolynomial ts
| otherwise = t1 : reducePolynomial (t2:ts)
where addTerm (Term c1 e) (Term c2 _) = Term (c1 + c2) e
solveDegree2 :: Float -> Float -> Float -> [Float]
solveDegree2 a b c
| phi < 0 = []
| phi == 0 = [(-b) / (2.0 * a)]
| phi > 0 = [ (-b + sqrt phi) / (2.0 * a) -- not alowed
, (-b - sqrt phi) / (2.0 * a)
]
where phi = b * b - 4.0 * a * c
solveDegree1 :: Float -> Float -> Float
solveDegree1 b c = -c / b
solve :: Polynomial -> [Float]
solve [t0] = []
solve [t0, t1] = [solveDegree1 (coefficient t1) (coefficient t0)]
solve [t0, t1, t2] = solveDegree2 (coefficient t2) (coefficient t1) (coefficient t0)
solve _ = undefined
|
