Expression (03)

Dark Magus 2012-10-31 03:37:42.533917 UTC

1{-# OPTIONS_HADDOCK prune, ignore-exports #-}
2
3{------------------------------------------------------------------------------}
4{- | Модуль, содержащий описание программных сущностей для выполнения символьных
5 вычислений.
6
7 Автор: Душкин Р. В.
8 Проект: SymbolicComputations
9 Версия: 0.03 -}
10{------------------------------------------------------------------------------}
11
12module Expression_03
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 Negation x + Negation y = Negation (x + y)
77 Fraction x y + Fraction z v
78 | y == v = Fraction (x + z) y
79 | otherwise = Fraction (x * v + z * y) (y * v)
80 x + y = Operation (+) x y
81
82 Number x - Number y = Number (x - y)
83 Negation x - Negation y = Negation (x - y)
84 Fraction x y - Fraction z v
85 | y == v = Fraction (x - z) y
86 | otherwise = Fraction (x * v - z * y) (y * v)
87 x - y = Operation (-) x y
88
89 Number x * Number y = Number $ x * y
90 Negation x * Negation y = x * y
91 Sqrt x * Sqrt y = Sqrt $ x * y
92 Fraction x y * Fraction z v
93 | x == v && y == z = Number 1
94 | x == v = Fraction z y
95 | z == y = Fraction x v
96 | otherwise = Fraction (x * z) (y * v)
97 x * y = Operation (*) x y
98
99 negate (Number x) = Number $ negate x
100 negate (Negation x) = x
101 negate x = Negation x
102
103 abs (Number x) = Number $ abs x
104 abs (Negation x) = x
105 abs (Sqrt x) = Sqrt x
106 abs (Fraction x y) = Fraction (abs x) (abs y)
107 abs op@(Operation o x y) = Number $ abs $ evaluate op
108
109 signum = error "Num.signum"
110
111 fromInteger = Number . fromInteger
112
113instance (Enum a, Floating a, Integral a) => Enum (Expression a) where
114 succ = error "Enum.succ"
115 pred = error "Enum.pred"
116 toEnum = error "Enum.toEnum"
117 fromEnum = error "Enum.fromEnum"
118 enumFrom = error "Enum.enumFrom"
119 enumFromThen = error "Enum.enumFromThen"
120 enumFromTo = error "Enum.enumFromTo"
121 enumFromThenTo = error "Enum.enumFromThenTo"
122
123instance (Real a, Integral a, Floating a) => Real (Expression a) where
124 toRational = error "Real.toRational"
125
126instance (Ord a, Integral a, Floating a) => Ord (Expression a) where
127 compare = error "Ord.compare"
128 (<) = (<) `on` evaluate
129 (>=) = error "Ord.(>=)"
130 (>) = error "Ord.(>)"
131 (<=) = error "Ord.(<=)"
132 max = error "Ord.max"
133 min = error "Ord.min"
134
135instance (Integral a, Floating a) => Floating (Expression a) where
136 pi = error "Floating.pi"
137 exp = error "Floating.exp"
138 sqrt = Sqrt
139 log = error "Floating.log"
140 (**) = error "Floating.(**)"
141 logBase = error "Floating.logBase"
142 sin = error "Floating.sin"
143 tan = error "Floating.tan"
144 cos = error "Floating.cos"
145 asin = error "Floating.asin"
146 atan = error "Floating.atan"
147 acos = error "Floating.acos"
148 sinh = error "Floating.sinh"
149 tanh = error "Floating.tanh"
150 cosh = error "Floating.cosh"
151 asinh = error "Floating.asinh"
152 atanh = error "Floating.atanh"
153 acosh = error "Floating.acosh"
154
155instance (Integral a, Floating a) => Integral (Expression a) where
156 quot = error "Integral.quot"
157 rem = error "Integral.rem"
158 div = error "Integral.div"
159 mod = error "Integral.mod"
160 quotRem = error "Integral.quotRem"
161 divMod = error "Integral.divMod"
162 toInteger = error "Integral.toInteger"
163
164instance Integral Float where
165 quot = error "Integral.quot (Float)"
166 rem = error "Integral.rem (Float)"
167 div = error "Integral.div (Float)"
168 mod = error "Integral.mod (Float)"
169 quotRem = error "Integral.quotRem (Float)"
170 divMod = error "Integral.divMod (Float)"
171 toInteger = error "Integral.toInteger (Float)"
172
173instance (Fractional a, Integral a, Floating a) => Fractional (Expression a) where
174 x / y = Fraction x y
175 recip = error "Fractional.recip"
176 fromRational = error "Fractional.fromRational"
177
178instance (Integral a, Floating a, RealFrac a) => RealFrac (Expression a) where
179 properFraction = error "RealFrac.properFraction"
180 truncate = error "RealFrac.truncate"
181 round = error "RealFrac.round"
182 ceiling = error "RealFrac.ceiling"
183 floor = error "RealFrac.floor"
184
185instance (Integral a, RealFloat a) => RealFloat (Expression a) where
186 floatRadix = error "RealFloat.floatRadix"
187 floatDigits = error "RealFloat.floatDigits"
188 floatRange = error "RealFloat.floatRange"
189 decodeFloat = error "RealFloat.decodeFloat"
190 encodeFloat = error "RealFloat.encodeFloat"
191 exponent = error "RealFloat.exponent"
192 significand = error "RealFloat.significand"
193 scaleFloat n = id {-- scaleFloat n = sum . replicate n --}
194 isNaN = error "RealFloat.isNaN"
195 isInfinite = error "RealFloat.isInfinite"
196 isDenormalized = error "RealFloat.isDenormalized"
197 isNegativeZero = error "RealFloat.isNegativeZero"
198 isIEEE = error "RealFloat.isIEEE"
199 atan2 = error "RealFloat.atan2"
200
201instance (Show a, Eq a, Floating a) => Show (Expression a) where
202 show (Number x) = show x
203 show (Negation x) = '-' : show x
204 show (Sqrt x) = "\\sqrt{" ++ show x ++ "}"
205 show (Fraction x y) = "\\frac{" ++ show x ++ "}{" ++ show y ++ "}"
206 show op@(Operation _ x y) = case operationType op of
207 OTAddition -> show x ++ " + " ++ show y
208 OTSubtraction -> show x ++ " - " ++ show y
209 OTMultiplication -> show x ++ " * " ++ show y
210 _ -> "?"
211
212{-[ ФУНКЦИИ ]------------------------------------------------------------------}
213
214-- | Функция, возвращающая тип операции для заданного символьного выражения.
215operationType :: (Eq a, Num a, Floating a) => Expression a -> OperationType
216operationType (Fraction _ _) = OTFraction
217operationType op@(Operation o x y) | o' == x' + y' = OTAddition
218 | o' == x' - y' = OTSubtraction
219 | o' == x' * y' = OTMultiplication
220 | otherwise = OTUnknown
221 where
222 o' = evaluate op
223 x' = evaluate x
224 y' = evaluate y
225operationType _ = OTUndefined
226
227-- | Функция, которая вычисляет символьное выражение. Пока необходима для того,
228-- чтобы понимать, какая операция «сидит» в символьном выражении.
229evaluate :: Floating a => Expression a -> a
230evaluate (Number x) = x
231evaluate (Negation x) = - evaluate x
232evaluate (Sqrt x) = sqrt $ evaluate x
233evaluate (Fraction x y) = evaluate x / evaluate y
234evaluate (Operation o x y) = evaluate x `o` evaluate y
235
236{-[ КОНЕЦ МОДУЛЯ ]-------------------------------------------------------------}