1{-# LANGUAGE FlexibleInstances #-}
2{-# LANGUAGE TypeSynonymInstances #-}
3{-# LANGUAGE DefaultSignatures #-}
4module Basement.Numerical.Multiplicative
5    ( Multiplicative(..)
6    , IDivisible(..)
7    , Divisible(..)
8    , recip
9    ) where
10
11import           Basement.Compat.Base
12import           Basement.Compat.C.Types
13import           Basement.Compat.Natural
14import           Basement.Compat.NumLiteral
15import           Basement.Numerical.Number
16import           Basement.Numerical.Additive
17import           Basement.Types.Word128 (Word128)
18import           Basement.Types.Word256 (Word256)
19import qualified Basement.Types.Word128 as Word128
20import qualified Basement.Types.Word256 as Word256
21import qualified Prelude
22
23-- | Represent class of things that can be multiplied together
24--
25-- > x * midentity = x
26-- > midentity * x = x
27class Multiplicative a where
28    {-# MINIMAL midentity, (*) #-}
29    -- | Identity element over multiplication
30    midentity :: a
31
32    -- | Multiplication of 2 elements that result in another element
33    (*) :: a -> a -> a
34
35    -- | Raise to power, repeated multiplication
36    -- e.g.
37    -- > a ^ 2 = a * a
38    -- > a ^ 10 = (a ^ 5) * (a ^ 5) ..
39    --(^) :: (IsNatural n) => a -> n -> a
40    (^) :: (IsNatural n, Enum n, IDivisible n) => a -> n -> a
41    (^) = power
42
43-- | Represent types that supports an euclidian division
44--
45-- > (x ‘div‘ y) * y + (x ‘mod‘ y) == x
46class (Additive a, Multiplicative a) => IDivisible a where
47    {-# MINIMAL (div, mod) | divMod #-}
48    div :: a -> a -> a
49    div a b = fst $ divMod a b
50    mod :: a -> a -> a
51    mod a b = snd $ divMod a b
52    divMod :: a -> a -> (a, a)
53    divMod a b = (div a b, mod a b)
54
55-- | Support for division between same types
56--
57-- This is likely to change to represent specific mathematic divisions
58class Multiplicative a => Divisible a where
59    {-# MINIMAL (/) #-}
60    (/) :: a -> a -> a
61
62infixl 7  *, /
63infixr 8  ^
64
65instance Multiplicative Integer where
66    midentity = 1
67    (*) = (Prelude.*)
68instance Multiplicative Int where
69    midentity = 1
70    (*) = (Prelude.*)
71instance Multiplicative Int8 where
72    midentity = 1
73    (*) = (Prelude.*)
74instance Multiplicative Int16 where
75    midentity = 1
76    (*) = (Prelude.*)
77instance Multiplicative Int32 where
78    midentity = 1
79    (*) = (Prelude.*)
80instance Multiplicative Int64 where
81    midentity = 1
82    (*) = (Prelude.*)
83instance Multiplicative Natural where
84    midentity = 1
85    (*) = (Prelude.*)
86instance Multiplicative Word where
87    midentity = 1
88    (*) = (Prelude.*)
89instance Multiplicative Word8 where
90    midentity = 1
91    (*) = (Prelude.*)
92instance Multiplicative Word16 where
93    midentity = 1
94    (*) = (Prelude.*)
95instance Multiplicative Word32 where
96    midentity = 1
97    (*) = (Prelude.*)
98instance Multiplicative Word64 where
99    midentity = 1
100    (*) = (Prelude.*)
101instance Multiplicative Word128 where
102    midentity = 1
103    (*) = (Word128.*)
104instance Multiplicative Word256 where
105    midentity = 1
106    (*) = (Word256.*)
107
108instance Multiplicative Prelude.Float where
109    midentity = 1.0
110    (*) = (Prelude.*)
111instance Multiplicative Prelude.Double where
112    midentity = 1.0
113    (*) = (Prelude.*)
114instance Multiplicative Prelude.Rational where
115    midentity = 1.0
116    (*) = (Prelude.*)
117
118instance Multiplicative CChar where
119    midentity = 1
120    (*) = (Prelude.*)
121instance Multiplicative CSChar where
122    midentity = 1
123    (*) = (Prelude.*)
124instance Multiplicative CUChar where
125    midentity = 1
126    (*) = (Prelude.*)
127instance Multiplicative CShort where
128    midentity = 1
129    (*) = (Prelude.*)
130instance Multiplicative CUShort where
131    midentity = 1
132    (*) = (Prelude.*)
133instance Multiplicative CInt where
134    midentity = 1
135    (*) = (Prelude.*)
136instance Multiplicative CUInt where
137    midentity = 1
138    (*) = (Prelude.*)
139instance Multiplicative CLong where
140    midentity = 1
141    (*) = (Prelude.*)
142instance Multiplicative CULong where
143    midentity = 1
144    (*) = (Prelude.*)
145instance Multiplicative CPtrdiff where
146    midentity = 1
147    (*) = (Prelude.*)
148instance Multiplicative CSize where
149    midentity = 1
150    (*) = (Prelude.*)
151instance Multiplicative CWchar where
152    midentity = 1
153    (*) = (Prelude.*)
154instance Multiplicative CSigAtomic where
155    midentity = 1
156    (*) = (Prelude.*)
157instance Multiplicative CLLong where
158    midentity = 1
159    (*) = (Prelude.*)
160instance Multiplicative CULLong where
161    midentity = 1
162    (*) = (Prelude.*)
163instance Multiplicative CIntPtr where
164    midentity = 1
165    (*) = (Prelude.*)
166instance Multiplicative CUIntPtr where
167    midentity = 1
168    (*) = (Prelude.*)
169instance Multiplicative CIntMax where
170    midentity = 1
171    (*) = (Prelude.*)
172instance Multiplicative CUIntMax where
173    midentity = 1
174    (*) = (Prelude.*)
175instance Multiplicative CClock where
176    midentity = 1
177    (*) = (Prelude.*)
178instance Multiplicative CTime where
179    midentity = 1
180    (*) = (Prelude.*)
181instance Multiplicative CUSeconds where
182    midentity = 1
183    (*) = (Prelude.*)
184instance Multiplicative CSUSeconds where
185    midentity = 1
186    (*) = (Prelude.*)
187instance Multiplicative COff where
188    midentity = 1
189    (*) = (Prelude.*)
190
191instance Multiplicative CFloat where
192    midentity = 1.0
193    (*) = (Prelude.*)
194instance Multiplicative CDouble where
195    midentity = 1.0
196    (*) = (Prelude.*)
197
198instance IDivisible Integer where
199    div = Prelude.div
200    mod = Prelude.mod
201instance IDivisible Int where
202    div = Prelude.div
203    mod = Prelude.mod
204instance IDivisible Int8 where
205    div = Prelude.div
206    mod = Prelude.mod
207instance IDivisible Int16 where
208    div = Prelude.div
209    mod = Prelude.mod
210instance IDivisible Int32 where
211    div = Prelude.div
212    mod = Prelude.mod
213instance IDivisible Int64 where
214    div = Prelude.div
215    mod = Prelude.mod
216instance IDivisible Natural where
217    div = Prelude.quot
218    mod = Prelude.rem
219instance IDivisible Word where
220    div = Prelude.quot
221    mod = Prelude.rem
222instance IDivisible Word8 where
223    div = Prelude.quot
224    mod = Prelude.rem
225instance IDivisible Word16 where
226    div = Prelude.quot
227    mod = Prelude.rem
228instance IDivisible Word32 where
229    div = Prelude.quot
230    mod = Prelude.rem
231instance IDivisible Word64 where
232    div = Prelude.quot
233    mod = Prelude.rem
234instance IDivisible Word128 where
235    div = Word128.quot
236    mod = Word128.rem
237instance IDivisible Word256 where
238    div = Word256.quot
239    mod = Word256.rem
240
241instance IDivisible CChar where
242    div = Prelude.quot
243    mod = Prelude.rem
244instance IDivisible CSChar where
245    div = Prelude.quot
246    mod = Prelude.rem
247instance IDivisible CUChar where
248    div = Prelude.quot
249    mod = Prelude.rem
250instance IDivisible CShort where
251    div = Prelude.quot
252    mod = Prelude.rem
253instance IDivisible CUShort where
254    div = Prelude.quot
255    mod = Prelude.rem
256instance IDivisible CInt where
257    div = Prelude.quot
258    mod = Prelude.rem
259instance IDivisible CUInt where
260    div = Prelude.quot
261    mod = Prelude.rem
262instance IDivisible CLong where
263    div = Prelude.quot
264    mod = Prelude.rem
265instance IDivisible CULong where
266    div = Prelude.quot
267    mod = Prelude.rem
268instance IDivisible CPtrdiff where
269    div = Prelude.quot
270    mod = Prelude.rem
271instance IDivisible CSize where
272    div = Prelude.quot
273    mod = Prelude.rem
274instance IDivisible CWchar where
275    div = Prelude.quot
276    mod = Prelude.rem
277instance IDivisible CSigAtomic where
278    div = Prelude.quot
279    mod = Prelude.rem
280instance IDivisible CLLong where
281    div = Prelude.quot
282    mod = Prelude.rem
283instance IDivisible CULLong where
284    div = Prelude.quot
285    mod = Prelude.rem
286instance IDivisible CIntPtr where
287    div = Prelude.quot
288    mod = Prelude.rem
289instance IDivisible CUIntPtr where
290    div = Prelude.quot
291    mod = Prelude.rem
292instance IDivisible CIntMax where
293    div = Prelude.quot
294    mod = Prelude.rem
295instance IDivisible CUIntMax where
296    div = Prelude.quot
297    mod = Prelude.rem
298
299instance Divisible Prelude.Rational where
300    (/) = (Prelude./)
301instance Divisible Float where
302    (/) = (Prelude./)
303instance Divisible Double where
304    (/) = (Prelude./)
305
306instance Divisible CFloat where
307    (/) = (Prelude./)
308instance Divisible CDouble where
309    (/) = (Prelude./)
310
311recip :: Divisible a => a -> a
312recip x = midentity / x
313
314power :: (Enum n, IsNatural n, IDivisible n, Multiplicative a) => a -> n -> a
315power a n
316    | n == 0    = midentity
317    | otherwise = squaring midentity a n
318  where
319    squaring y x i
320        | i == 0    = y
321        | i == 1    = x * y
322        | even i    = squaring y (x*x) (i`div`2)
323        | otherwise = squaring (x*y) (x*x) (pred i`div` 2)
324
325even :: (IDivisible n, IsIntegral n) => n -> Bool
326even n = (n `mod` 2) == 0
327