72 lines
3.3 KiB
Haskell
72 lines
3.3 KiB
Haskell
-- Widened borrow of a particular repeated amount
|
|
-- i.e., for borrow2 qr 2, the borrow is 22 = 100
|
|
-- `qr` is an integer division function returning the quotient and remainder.
|
|
-- i.e., either `divMod` or `quotRem`
|
|
borrow2' qr b
|
|
| b == 1 = error "Cannot borrow 1: implies positional symbol zero disallowed"
|
|
| otherwise = borrow' []
|
|
where borrow' zs (x:y:z:xs)
|
|
| abs x >= b = zipUp ys zs -- carry here
|
|
| otherwise = borrow' (x:zs) (y:z:xs) -- try borrowing at a higher place value
|
|
where ys = r : y-x+r : z+q : xs
|
|
(q, r) = x `qr` b
|
|
zipUp = foldl (flip (:))
|
|
|
|
borrow2 = borrow2' quotRem
|
|
|
|
--degenerate `borrow2 1` that remedies inadequacies in below for 1, i.e., the borrow is 11 = 100
|
|
--this system is VERY bad because we invoke the place value '0' to expand into
|
|
--borrow1' zs (x:y:z:xs) | abs x > 1 = zipUp ys zs
|
|
-- | otherwise = borrow1' (x:zs) (y:z:xs)
|
|
-- where ys = (signum x):(y-x+signum x):z+(x-1):xs
|
|
|
|
-- Truncate the adic expansion to n digits, for a system where borrows are two digits wide and both b
|
|
truncadic' n b = (!! n) . iterate (borrow2 b)
|
|
truncadic n = (take n .) . truncadic' n
|
|
|
|
-- same but, produce a list of expansions, taking modulo m in between borrows
|
|
truncadicMod b m n = map (take n) . take n . iterate (map (`rem` m) . borrow2 2)
|
|
|
|
-- Find moduli starting from `s` where truncations agree
|
|
-- Caveat: the last of truncadicMod is not guaranteed to exhaust terms outside alphabet
|
|
-- i.e., for b = 2, the alphabet {-1, 0, 1}
|
|
findAccurate n b s xs = map fst $ filter ((==good) . snd) bads
|
|
where good = truncadic n b xs
|
|
bads = map (\m -> (,) m $ last $ truncadicMod b m n xs) [s..]
|
|
|
|
-- Given an amount of digits `n`, a 2-wide borrow `b`, and a canonical representation of `b`
|
|
-- construct integer multiples of `b`
|
|
evens n b = ([0]:) . map (take n) . iterate addb
|
|
-- add b to an adic expansion
|
|
where addb = truncadic' n b . (b:) . tail
|
|
|
|
-- first 200 digits of cendree-adic expansions of even numbers
|
|
adics = evens 200 2 $ 0:0:cycle [1,-1]
|
|
adic2 = adics !! 1
|
|
-- Expansion of 4, generated from incrementing the expansion of 2 twice
|
|
adic4 = adics !! 2
|
|
-- Expansion of 4, generated from pointwise multiplication of the expansion of 2
|
|
adic4' = truncadic 200 2 $ (++repeat 0) $ map (*2) adic2
|
|
|
|
-- Note: `truncadic 200 n $ 4:repeat 0` is the aggressive application of the carry to 4
|
|
-- but this could be done better since there are only 3 terms in the head, and no higher
|
|
-- series terms get in the way; the remainders would be emitted while the thunk continued
|
|
|
|
truncadicQR' qr n b = (!! n) . iterate (borrow2' qr b)
|
|
truncadicQR qr n b = take n . truncadicQR' qr n b
|
|
|
|
-- Given an amount of digits `n`, a 2-wide borrow `b`, and a canonical representation of `b`
|
|
-- construct integer multiples of `b`
|
|
evensQR qr n b = ([0]:) . map (take n) . iterate addb
|
|
-- add b to an adic expansion
|
|
where addb = truncadicQR' qr n b . (b:) . tail
|
|
|
|
data QRMethod = QuotRem | DivMod deriving Show
|
|
qrMethod QuotRem = quotRem
|
|
qrMethod DivMod = divMod
|
|
|
|
cendreeEvens :: QRMethod -> Int -> Int -> IO ()
|
|
cendreeEvens qr m n = writeFile fn $ unlines $ take m $ map show $ evensQR qr' n 2 $ truncadicQR qr' (n + 2) 2 $ 2:repeat 0
|
|
where qr' = qrMethod qr
|
|
fn = "cendree_" ++ show qr ++ "_count_" ++ show m ++ "_" ++ show n ++ "_digits.txt"
|