/
BaseRationals.purs
339 lines (294 loc) · 12.1 KB
/
BaseRationals.purs
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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
-- | Implements in arbitrary basis given arbitrary digits:
-- | * parsing a string for a rational
-- | * rendering a non-fractional string represenation of a rational
-- |
-- | Digits can be created from an `Array` of `Char`s.
-- | ```
-- | let digits = digitsFromArray ['0', '1', '2', 'A', 'B']
-- | ```
-- |
-- | `toString` and `fromString` run both in the `(Either String)` monad,
-- | providing `String` error messages.
-- | Both have `Digits` and a *basis* as `Int` as their first two arguments;
-- | and a `String` or a `PreciseRational` as third one respectively. A usage
-- | example is:
-- | ```
-- | string :: Either String String
-- | string = do
-- | let pr = PR.fromInts 1 7 :: PreciseRational
-- | let basis = 4
-- | s <-
-- | pure s
-- |
-- | pr :: Either String PreciseRational
-- | pr = do
-- | let s = "A2AB01.20B1A" :: String
-- | let basis = 5
-- | pr <- fromString digits basis s
-- | ```
module BaseRationals
( Digits
, digitsFromArray
, arrayFromDigits
, maximalBasisOfDigits
, fromString
, toString
, index
, digitIndex
) where
import PreciseRational
import PreciseFloat
import Prelude
import Data.Int as Int
import Data.BigInt as BI
import Data.String as String
import Data.Array as Array
import Data.List as List
import Data.EuclideanRing (class EuclideanRing)
import Data.BigInt (BigInt(..), pow, toNumber, abs)
import Data.Ratio (Ratio, (%), numerator, denominator)
import Data.Foldable (any, foldl)
import Data.List (List(..), length, init, take, drop, filter,reverse, (:), (..),
elem)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Either (Either(..))
import Control.Error.Util (note)
import Control.Monad.Rec.Class (Step(..), tailRecM3)
import Control.MonadPlus (guard)
import Control.MonadZero (class MonadZero)
-- | Container type for an `Array` of `Chars` representing digits. The
-- | constructor is hidden, as digits are more constrained than an `Array` of
-- | `Char`s, use `digitsFromArray` instead.
data Digits = Digits (Array Char)
instance showDigits :: Show Digits where
show (Digits array) = show array
-- | Wrap `Array` of `Char`s in digit container, if array
-- | * contains at least two digits, as the minimum basis is two
-- | * all contained digits need to be unique
digitsFromArray :: Array Char -> Either String Digits
digitsFromArray array = do
unless
(Array.length array >= 2)
(Left $ "Could not create digits " <> show array
<> " has less than two digits")
unless
(hasNoRepeatingElem $ List.fromFoldable array)
(Left $ "Array " <> show array <> " has repeating digits")
pure $ Digits array
-- | Unwrap `Array` of `Char`s from `Digits` container
arrayFromDigits :: Digits -> Array Char
arrayFromDigits (Digits array) = array
-- | Get the maximal possible basis for `Digits`. It equals the length of the
-- | wrapped `Array` of `Char`s
maximalBasisOfDigits :: Digits -> Int
maximalBasisOfDigits (Digits array) = Array.length array
-- | Parse a `PreciseRational` from a `String` in basis `Int` given
-- | `Digits`.
fromString :: Digits -> Int -> String -> Either String PreciseRational
fromString digits basis string = do
errorUnlessValidBasis basis digits
let cs0 = List.fromFoldable $ String.toCharArray $ string
let {sign, cs: cs1} = splitSign cs0
{fcs: fcs0, ics} <- splitFinitAndInfinit cs1
let {shift, cs: fcs1} = splitShift fcs0
let basisBI = BI.fromInt basis
finit <- biFromCharList digits basisBI fcs1
infinit <- biFromCharList digits basisBI ics
let ratio =
if infinit == zero
then finit % one
else (finit * factor + infinit) % factor
where
infinitLength = BI.fromInt $ List.length ics
factor = basisBI `pow` infinitLength - one
pure $ ratio * (sign % (basisBI `pow` shift))
-- | Render a non-fractional `String`-representation of a `PreciseRational`
-- | in basis `Int` given `Digits`.
toString :: Digits -> Int -> PreciseRational -> Either String String
toString digits basis ratio = do
errorUnlessValidBasis basis digits
let basisBI = BI.fromInt basis
-- Seperate the *whole* part of the fraction and the *propper*
let {whole, propper} = toMixedRatio ratio
-- Get *pre* and *post* radix chars
pre <- preFromWhole digits basisBI whole
post <- postFromPropper digits basisBI (fromRatio propper)
let cs = pre <> ('.' : Nil) <> post
cs' <- note "String is empty" (alterCharsForDisplay cs)
pure $ String.fromCharArray $ List.toUnfoldable $ cs'
-- | Lookup the *digit* `Char` with *index* `BigInt` in `Digits`
index :: Digits -> BigInt -> Either String Char
index digits iBI = do
let digitArray = arrayFromDigits digits
i <- note
("Failed to convert BigInt index " <> BI.toString iBI <> " to Int")
(Int.fromNumber $ toNumber iBI)
c <- note
("Failed to lookup index " <> show i <> " in " <> show digits)
(digitArray `Array.index` i)
pure c
-- | Lookup the *index* `BigInt` of the first occurence of `Char` in
-- | `Digits`
digitIndex :: Char -> Digits -> Either String BigInt
digitIndex c digits = do
let digitArray = arrayFromDigits digits
i <- note
("Failed to lookup " <> show c <> " in digits " <> show digits)
(c `Array.elemIndex` digitArray)
pure $ BI.fromInt i
--
-- Helpers
--
-- Check if at least one of the elements of the list occur twice in the list
hasNoRepeatingElem :: forall e . Eq e => List e -> Boolean
hasNoRepeatingElem list = loop list Nil
where
loop (e : es) es' | not $ e `elem` es' = loop es (e : es')
| otherwise = false
loop _ _ = true
-- Unless guard, checking if the current basis is in the range of valid
-- basis, ie. if `2 <= basis <= maximalBasis`
errorUnlessValidBasis :: Int -> Digits -> Either String Unit
errorUnlessValidBasis basis digits = do
let maximalBasis = maximalBasisOfDigits digits
unless
(basis >= 2)
(Left $ "Basis " <> show basis <> " smaller than '2'")
unless
(basis <= maximalBasis)
(Left $ "Basis " <> show basis <> " bigger then maximal basis "
<> show maximalBasis)
-- Parse a `BigInt` from characters given *digits* and *basis*
biFromCharList
:: Digits -- Digits
-> BigInt -- Basis
-> List Char -- Input characters
-> Either String BigInt -- Error or parsed number
biFromCharList digits basis cs0 = loop (reverse cs0) zero zero
where
loop (c : cs) accumulator position = do
bi <- c `digitIndex` digits
unless
(bi < basis)
(Left $ show c <> " is no valid character in base " <> show basis)
let positionValue = basis `pow` position
let delta = bi * positionValue
loop cs (accumulator + delta) (position + one)
loop _ accumulator _ = pure accumulator
-- Render character representatoin of a whole number given *digits* and *basis*
preFromWhole
:: Digits -- Digits
-> BigInt -- Basis
-> BigInt -- Whole number
-> Either String (List Char) -- Error or pre radix characters
preFromWhole digits basis whole = loop Nil whole
where
loop cs dividend
| dividend >= one = do
-- Calculate quotient and remainder of division by
-- basis
let remainder = dividend `mod` basis
let quotient = (dividend - remainder) / basis
-- Get Corresponding digit character
c <- digits `index` remainder
loop (c : cs) quotient
| otherwise = Right cs
-- Render character representation of a propper fraction in a non-fractional
-- representation given *digits* and *basis*
postFromPropper
:: Digits -- Digits
-> BigInt -- Base
-> PreciseFloat -- Remainder
-> Either String (List Char) -- Error or post radix characters
postFromPropper digits basis pf0 = tailRecM3 loop Nil Nil (pf0 `scale` basis)
where
loop
:: List PreciseFloat -- Intermediate values to check for reccurence
-> List Char -- Accumulator for the output characters
-> PreciseFloat -- Intermediate value
-> Either String _
loop pfs cs pf@(PreciseFloat pfr)
| not $ isZero pf = case pf `List.elemIndex` pfs of
Nothing -> do
-- Calculate index *i* and lookup corresponding char *c*
let n = pfr.shift - pfr.infinitLength
let iBI = pfr.finit `stripNDigitsOnTheRight` n
c <- digits `index` iBI
let finit' = pfr.finit - iBI `appendNZerosOnTheRight` n
pure $ Loop
{ a: (pf : pfs)
, b: (c : cs)
, c: (PreciseFloat pfr {finit = finit'}) `scale` basis
}
-- Recurrence -> return with parantheses marking recurrence
Just i ->
let i' = length pfs - i - one
cs' = reverse cs
finitChars = take i' cs'
infinitChars = ('[' : Nil) <> (drop i' cs') <> (']' : Nil)
in pure $ Done (finitChars <> infinitChars)
| otherwise = pure $ Done $ reverse cs
-- Split a trailing sign from a list of characters, and return sign and
-- remaining chars
splitSign :: List Char -> {sign :: BigInt, cs :: List Char}
splitSign ('-' : cs) = {sign: (-one), cs}
splitSign cs = {sign: one , cs}
-- Remove the radix point from a character representatoin of a number and
-- calculate the corresponding shift, eg.
-- "123.45" -> {shift: 2, cs: "12345"}
splitShift :: List Char -> {shift :: BigInt, cs :: List Char}
splitShift cs = {shift, cs : filter (\c -> c /= '.') cs}
where
-- Calculate shift from position of radix point
indexOfRadixPoint = case '.' `List.elemIndex` cs of
Just i -> i + one
Nothing -> length cs
shift = BI.fromInt (length cs - indexOfRadixPoint)
-- TODO this should be implemented via a parser library
splitFinitAndInfinit
:: List Char
-> Either String {fcs:: List Char, ics:: List Char}
splitFinitAndInfinit cs = f ('[' `List.elemIndex` cs) (']' `List.elemIndex` cs)
where
f (Just iOpenBracket) Nothing = Left "Missing ']'"
f Nothing (Just iCloseBracket) = Left "Missing '['"
f Nothing Nothing = Right {fcs: cs, ics: Nil}
f (Just iOpenBracket) (Just iCloseBracket) = do
-- Check if '[' and ']' are used correctly
unless
(not $ 1 < (List.length $ filter (\c -> c == '[') cs))
(Left "More than one '[' present")
unless
(not $ 1 < (List.length $ filter (\c -> c == ']') cs))
(Left "More than one ']' present")
unless
(iOpenBracket < iCloseBracket)
(Left "Recurrence brackets are in wrong order")
unless
(not $ iOpenBracket + 1 == iCloseBracket)
(Left "Recurrence brackets are empty")
iPoint <- note
"Recurrence brackets present, but no radix point"
('.' `List.elemIndex` cs)
unless
(iPoint < iOpenBracket)
(Left "Recurrence brackets appear before the radix point")
unless
(iCloseBracket == (List.length cs - 1))
(Left "']' has to be last character")
let fcs = take iOpenBracket cs
ics <- note
"Seperating reuccring characters failed"
(init $ drop (iOpenBracket + one) cs)
pure {fcs, ics}
-- Add/remove some characters to display number more naturally, eg.
-- "123.0" -> Just "123"
alterCharsForDisplay :: List Char -> Maybe (List Char)
alterCharsForDisplay cs = do
p <- '.' `List.elemIndex` cs
let len = length cs
case Nothing of
_ | p == zero && len == one -> Just $ Cons '0' Nil -- "." -> "0"
| p == zero -> Just $ '0' : cs -- ".x" -> "0.x"
| p == len - one -> init cs -- "x." -> "x"
| otherwise -> Just cs -- Do nothing