Expression (05)

Dark Magus 2012-10-31 06:54:45.107888 UTC

1{-# OPTIONS_HADDOCK prune, ignore-exports #-}
2
3{------------------------------------------------------------------------------}
4{- | Модуль, содержащий описание программных сущностей для выполнения символьных
5 вычислений.
6
7 Автор: Душкин Р. В.
8 Проект: SymbolicComputations
9 Версия: 0.05 -}
10{------------------------------------------------------------------------------}
11
12module Expression_05
13(
14 -- * Алгебраические типы данных
15 Expression(..),
16
17 -- * Функции
18 evaluate
19)
20where
21
22{-[ СЕКЦИЯ ИМПОРТА ]-----------------------------------------------------------}
23
24import Data.Function (on)
25
26{-[ АЛГЕБРАИЧЕСКИЕ ТИПЫ ДАННЫХ ]-----------------------------------------------}
27
28-- | Основной тип, представляющий символьное выражение. В данной версии
29-- реализации символьное выражение может быть просто числом, отрицанием
30-- символьного выражение, квадратным корнем из символьного выражения,
31-- отношением двух символьных выражений и применением бинарной операции
32-- (\+\, \-\, \*\) к двум символьным выражениям.
33data Expression a
34 = Number -- ^ Просто число.
35 {
36 number :: a -- ^ Число.
37 }
38 | Negation -- ^ Отрицание символьного выражения.
39 {
40 negation :: Expression a -- ^ Выражение.
41 }
42 | Sqrt -- ^ Квадратный корень из символьного выражения.
43 {
44 squareRoot :: Expression a -- ^ Подкоренное выражение.
45 }
46 | Fraction -- ^ Отношение двух символьных выражений.
47 {
48 numerator :: Expression a, -- ^ Числитель.
49 denominator :: Expression a -- ^ Знаменатель.
50 }
51 | Operation -- ^ Некая бинарная операция между двумя символьными выражениями.
52 {
53 operator :: a -> a -> a, -- ^ Бинарная операция.
54 operandX :: Expression a, -- ^ Первый операнд.
55 operandY :: Expression a -- ^ Второй операнд.
56 }
57
58-- | Служебное перечисление, определяющее тип операции, которая участвует в
59-- формировании символьного выражения. Имеет смысл для символьных выражений
60-- типа `Fraction` или `Operation`.
61data OperationType = OTUndefined -- ^ Неопределённая операция.
62 | OTUnknown -- ^ Неизвестная операция.
63 | OTAddition -- ^ Сложение.
64 | OTSubtraction -- ^ Вычитание.
65 | OTMultiplication -- ^ Умножение.
66 | OTFraction -- ^ Деление (отношение).
67 deriving Eq
68
69{-[ ЭКЗЕМПЛЯРЫ КЛАССОВ ]-------------------------------------------------------}
70
71instance (Eq a, Integral a, Floating a) => Eq (Expression a) where
72 (==) = (==) `on` evaluate
73
74instance (Num a, Integral a, Floating a) => Num (Expression a) where
75 Number x + Number y = Number (x + y)
76 x + Negation y | x == y = Number 0
77 Negation x + y | x == y = Number 0
78 Negation x + Negation y = Negation (x + y)
79 Fraction x y + Fraction z v
80 | y == v = Fraction (x + z) y
81 | otherwise = Fraction (x * v + z * y) (y * v)
82 x + y
83 | x == Number 0 = y
84 | y == Number 0 = x
85 | otherwise = Operation (+) x y
86
87 Number x - Number y = Number (x - y)
88 Negation x - Negation y = Negation (x - y)
89 Fraction x y - Fraction z v
90 | y == v = Fraction (x - z) y
91 | otherwise = Fraction (x * v - z * y) (y * v)
92 x - y
93 | x == y = Number 0
94 | x == Number 0 = Negation y
95 | y == Number 0 = x
96 | otherwise = Operation (-) x y
97
98 Number x * Number y = Number $ x * y
99 Negation x * Negation y = x * y
100 Negation x * y = Negation $ x * y
101 x * Negation y = Negation $ x * y
102 Sqrt x * Sqrt y = Sqrt $ x * y
103 Fraction x y * Fraction z v
104 | x == v && y == z = Number 1
105 | x == v = Fraction z y
106 | z == y = Fraction x v
107 | otherwise = Fraction (x * z) (y * v)
108 x * Fraction y z
109 | x == z = y
110 | otherwise = Fraction (x * y) z
111 Fraction x y * z
112 | y == z = x
113 | otherwise = Fraction (x * z) y
114 x * y
115 | x == Number 0 = Number 0
116 | y == Number 0 = Number 0
117 | x == Number 1 = y
118 | y == Number 1 = x
119 | otherwise = Operation (*) x y
120
121 negate (Number x) = Number $ negate x
122 negate (Negation x) = x
123 negate x = Negation x
124
125 abs (Number x) = Number $ abs x
126 abs (Negation x) = x
127 abs (Sqrt x) = Sqrt x
128 abs (Fraction x y) = Fraction (abs x) (abs y)
129 abs op@(Operation o x y) = Number $ abs $ evaluate op
130
131 signum = error "Num.signum"
132
133 fromInteger = Number . fromInteger
134
135instance (Enum a, Floating a, Integral a) => Enum (Expression a) where
136 succ = error "Enum.succ"
137 pred = error "Enum.pred"
138 toEnum = error "Enum.toEnum"
139 fromEnum = error "Enum.fromEnum"
140 enumFrom = error "Enum.enumFrom"
141 enumFromThen = error "Enum.enumFromThen"
142 enumFromTo = error "Enum.enumFromTo"
143 enumFromThenTo = error "Enum.enumFromThenTo"
144
145instance (Real a, Integral a, Floating a) => Real (Expression a) where
146 toRational = error "Real.toRational"
147
148instance (Ord a, Integral a, Floating a) => Ord (Expression a) where
149 compare = error "Ord.compare"
150 (<) = (<) `on` evaluate
151 (>=) = error "Ord.(>=)"
152 (>) = error "Ord.(>)"
153 (<=) = error "Ord.(<=)"
154 max = error "Ord.max"
155 min = error "Ord.min"
156
157instance (Integral a, Floating a) => Floating (Expression a) where
158 pi = error "Floating.pi"
159 exp = error "Floating.exp"
160 sqrt = Sqrt
161 log = error "Floating.log"
162 (**) = error "Floating.(**)"
163 logBase = error "Floating.logBase"
164 sin = error "Floating.sin"
165 tan = error "Floating.tan"
166 cos = error "Floating.cos"
167 asin = error "Floating.asin"
168 atan = error "Floating.atan"
169 acos = error "Floating.acos"
170 sinh = error "Floating.sinh"
171 tanh = error "Floating.tanh"
172 cosh = error "Floating.cosh"
173 asinh = error "Floating.asinh"
174 atanh = error "Floating.atanh"
175 acosh = error "Floating.acosh"
176
177instance (Integral a, Floating a) => Integral (Expression a) where
178 quot = error "Integral.quot"
179 rem = error "Integral.rem"
180 div = error "Integral.div"
181 mod = error "Integral.mod"
182 quotRem = error "Integral.quotRem"
183 divMod = error "Integral.divMod"
184 toInteger = error "Integral.toInteger"
185
186instance Integral Float where
187 quot = error "Integral.quot (Float)"
188 rem = error "Integral.rem (Float)"
189 div = error "Integral.div (Float)"
190 mod = error "Integral.mod (Float)"
191 quotRem = error "Integral.quotRem (Float)"
192 divMod = error "Integral.divMod (Float)"
193 toInteger = error "Integral.toInteger (Float)"
194
195instance (Fractional a, Integral a, Floating a) => Fractional (Expression a) where
196 x / y = Fraction x y
197 recip = error "Fractional.recip"
198 fromRational = error "Fractional.fromRational"
199
200instance (Integral a, Floating a, RealFrac a) => RealFrac (Expression a) where
201 properFraction = error "RealFrac.properFraction"
202 truncate = error "RealFrac.truncate"
203 round = error "RealFrac.round"
204 ceiling = error "RealFrac.ceiling"
205 floor = error "RealFrac.floor"
206
207instance (Integral a, RealFloat a) => RealFloat (Expression a) where
208 floatRadix = error "RealFloat.floatRadix"
209 floatDigits = error "RealFloat.floatDigits"
210 floatRange = error "RealFloat.floatRange"
211 decodeFloat = error "RealFloat.decodeFloat"
212 encodeFloat = error "RealFloat.encodeFloat"
213 exponent = error "RealFloat.exponent"
214 significand = error "RealFloat.significand"
215 scaleFloat n = id {-- scaleFloat n = sum . replicate n --}
216 isNaN = error "RealFloat.isNaN"
217 isInfinite = error "RealFloat.isInfinite"
218 isDenormalized = error "RealFloat.isDenormalized"
219 isNegativeZero = error "RealFloat.isNegativeZero"
220 isIEEE = error "RealFloat.isIEEE"
221 atan2 = error "RealFloat.atan2"
222
223instance (Show a, Eq a, Floating a) => Show (Expression a) where
224 show (Number x) = show x
225 show (Negation x) = '-' : show x
226 show (Sqrt x) = "\\sqrt{" ++ show x ++ "}"
227 show (Fraction x y) = "\\frac{" ++ show x ++ "}{" ++ show y ++ "}"
228 show op@(Operation _ x y) = case operationType op of
229 OTAddition -> show x ++ " + " ++ show y
230 OTSubtraction -> show x ++ " - " ++ show y
231 OTMultiplication -> show x ++ " * " ++ show y
232 _ -> "?"
233
234{-[ ФУНКЦИИ ]------------------------------------------------------------------}
235
236-- | Функция, возвращающая тип операции для заданного символьного выражения.
237operationType :: (Eq a, Num a, Floating a) => Expression a -> OperationType
238operationType (Fraction _ _) = OTFraction
239operationType op@(Operation o x y) | o' == x' + y' = OTAddition
240 | o' == x' - y' = OTSubtraction
241 | o' == x' * y' = OTMultiplication
242 | otherwise = OTUnknown
243 where
244 o' = evaluate op
245 x' = evaluate x
246 y' = evaluate y
247operationType _ = OTUndefined
248
249-- | Функция, которая вычисляет символьное выражение. Пока необходима для того,
250-- чтобы понимать, какая операция «сидит» в символьном выражении.
251evaluate :: Floating a => Expression a -> a
252evaluate (Number x) = x
253evaluate (Negation x) = - evaluate x
254evaluate (Sqrt x) = sqrt $ evaluate x
255evaluate (Fraction x y) = evaluate x / evaluate y
256evaluate (Operation o x y) = evaluate x `o` evaluate y
257
258{-[ КОНЕЦ МОДУЛЯ ]-------------------------------------------------------------}