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
|
module Numeric.Decidable.Units
( DecidableUnits(..)
, recipUnitIntegral
, recipUnitWhole
) where
import Data.Maybe (isJust)
import Data.Int
import Data.Word
import Numeric.Algebra.Class
import Numeric.Algebra.Unital
import Numeric.Natural.Internal
import Control.Applicative
import Prelude hiding ((*))
class Unital r => DecidableUnits r where
recipUnit :: r -> Maybe r
isUnit :: DecidableUnits r => r -> Bool
isUnit = isJust . recipUnit
(^?) :: Integral n => r -> n -> Maybe r
x0 ^? y0 = case compare y0 0 of
LT -> fmap (`f` negate y0) (recipUnit x0)
EQ -> Just one
GT -> Just (f x0 y0)
where
f x y
| even y = f (x * x) (y `quot` 2)
| y == 1 = x
| otherwise = g (x * x) ((y - 1) `quot` 2) x
g x y z
| even y = g (x * x) (y `quot` 2) z
| y == 1 = x * z
| otherwise = g (x * x) ((y - 1) `quot` 2) (x * z)
recipUnitIntegral :: Integral r => r -> Maybe r
recipUnitIntegral a@1 = Just a
recipUnitIntegral a@(-1) = Just a
recipUnitIntegral _ = Nothing
recipUnitWhole :: Integral r => r -> Maybe r
recipUnitWhole a@1 = Just a
recipUnitWhole _ = Nothing
instance DecidableUnits Bool where
recipUnit False = Nothing
recipUnit True = Just True
instance DecidableUnits Integer where recipUnit = recipUnitIntegral
instance DecidableUnits Int where recipUnit = recipUnitIntegral
instance DecidableUnits Int8 where recipUnit = recipUnitIntegral
instance DecidableUnits Int16 where recipUnit = recipUnitIntegral
instance DecidableUnits Int32 where recipUnit = recipUnitIntegral
instance DecidableUnits Int64 where recipUnit = recipUnitIntegral
instance DecidableUnits Natural where recipUnit = recipUnitWhole
instance DecidableUnits Word where recipUnit = recipUnitWhole
instance DecidableUnits Word8 where recipUnit = recipUnitWhole
instance DecidableUnits Word16 where recipUnit = recipUnitWhole
instance DecidableUnits Word32 where recipUnit = recipUnitWhole
instance DecidableUnits Word64 where recipUnit = recipUnitWhole
instance DecidableUnits () where recipUnit _ = Just ()
instance (DecidableUnits a, DecidableUnits b) => DecidableUnits (a, b) where
recipUnit (a,b) = (,) <$> recipUnit a <*> recipUnit b
instance (DecidableUnits a, DecidableUnits b, DecidableUnits c) => DecidableUnits (a, b, c) where
recipUnit (a,b,c) = (,,) <$> recipUnit a <*> recipUnit b <*> recipUnit c
instance (DecidableUnits a, DecidableUnits b, DecidableUnits c, DecidableUnits d) => DecidableUnits (a, b, c, d) where
recipUnit (a,b,c,d) = (,,,) <$> recipUnit a <*> recipUnit b <*> recipUnit c <*> recipUnit d
instance (DecidableUnits a, DecidableUnits b, DecidableUnits c, DecidableUnits d, DecidableUnits e) => DecidableUnits (a, b, c, d, e) where
recipUnit (a,b,c,d,e) = (,,,,) <$> recipUnit a <*> recipUnit b <*> recipUnit c <*> recipUnit d <*> recipUnit e
|
