{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module TextShow.Data.Floating (
showbRealFloatPrec
, showbEFloat
, showbFFloat
, showbGFloat
, showbFFloatAlt
, showbGFloatAlt
, showbFPFormat
, FPFormat(..)
, formatRealFloatB
, formatRealFloatAltB
) where
import Data.Array.Base (unsafeAt)
import Data.Array.IArray (Array, array)
import qualified Data.Text as T (replicate)
import Data.Text.Lazy.Builder (Builder, fromString, fromText, singleton)
import Data.Text.Lazy.Builder.Int (decimal)
import Data.Text.Lazy.Builder.RealFloat (FPFormat(..))
import Prelude ()
import Prelude.Compat
import TextShow.Classes (TextShow(..), showbParen)
import TextShow.TH.Internal (deriveTextShow)
import TextShow.Utils (i2d)
$(deriveTextShow ''FPFormat)
instance TextShow Float where
showbPrec :: Int -> Float -> Builder
showbPrec = Int -> Float -> Builder
forall a. RealFloat a => Int -> a -> Builder
showbRealFloatPrec
{-# INLINE showbPrec #-}
instance TextShow Double where
showbPrec :: Int -> Double -> Builder
showbPrec = Int -> Double -> Builder
forall a. RealFloat a => Int -> a -> Builder
showbRealFloatPrec
{-# INLINE showbPrec #-}
showbRealFloatPrec :: RealFloat a => Int -> a -> Builder
showbRealFloatPrec :: Int -> a -> Builder
showbRealFloatPrec p :: Int
p x :: a
x
| a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< 0 Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero a
x = Bool -> Builder -> Builder
showbParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 6) (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Char -> Builder
singleton '-' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Maybe Int -> a -> Builder
forall a. RealFloat a => Maybe Int -> a -> Builder
showbGFloat Maybe Int
forall a. Maybe a
Nothing (-a
x)
| Bool
otherwise = Maybe Int -> a -> Builder
forall a. RealFloat a => Maybe Int -> a -> Builder
showbGFloat Maybe Int
forall a. Maybe a
Nothing a
x
{-# INLINE showbRealFloatPrec #-}
{-# SPECIALIZE showbEFloat ::
Maybe Int -> Float -> Builder,
Maybe Int -> Double -> Builder #-}
{-# SPECIALIZE showbFFloat ::
Maybe Int -> Float -> Builder,
Maybe Int -> Double -> Builder #-}
{-# SPECIALIZE showbGFloat ::
Maybe Int -> Float -> Builder,
Maybe Int -> Double -> Builder #-}
showbEFloat :: RealFloat a => Maybe Int -> a -> Builder
showbEFloat :: Maybe Int -> a -> Builder
showbEFloat = FPFormat -> Maybe Int -> a -> Builder
forall a. RealFloat a => FPFormat -> Maybe Int -> a -> Builder
formatRealFloatB FPFormat
Exponent
showbFFloat :: RealFloat a => Maybe Int -> a -> Builder
showbFFloat :: Maybe Int -> a -> Builder
showbFFloat = FPFormat -> Maybe Int -> a -> Builder
forall a. RealFloat a => FPFormat -> Maybe Int -> a -> Builder
formatRealFloatB FPFormat
Fixed
showbGFloat :: RealFloat a => Maybe Int -> a -> Builder
showbGFloat :: Maybe Int -> a -> Builder
showbGFloat = FPFormat -> Maybe Int -> a -> Builder
forall a. RealFloat a => FPFormat -> Maybe Int -> a -> Builder
formatRealFloatB FPFormat
Generic
showbFFloatAlt :: RealFloat a => Maybe Int -> a -> Builder
showbFFloatAlt :: Maybe Int -> a -> Builder
showbFFloatAlt d :: Maybe Int
d = FPFormat -> Maybe Int -> Bool -> a -> Builder
forall a.
RealFloat a =>
FPFormat -> Maybe Int -> Bool -> a -> Builder
formatRealFloatAltB FPFormat
Fixed Maybe Int
d Bool
True
{-# INLINE showbFFloatAlt #-}
showbGFloatAlt :: RealFloat a => Maybe Int -> a -> Builder
showbGFloatAlt :: Maybe Int -> a -> Builder
showbGFloatAlt d :: Maybe Int
d = FPFormat -> Maybe Int -> Bool -> a -> Builder
forall a.
RealFloat a =>
FPFormat -> Maybe Int -> Bool -> a -> Builder
formatRealFloatAltB FPFormat
Generic Maybe Int
d Bool
True
{-# INLINE showbGFloatAlt #-}
showbFPFormat :: FPFormat -> Builder
showbFPFormat :: FPFormat -> Builder
showbFPFormat = FPFormat -> Builder
forall a. TextShow a => a -> Builder
showb
{-# INLINE showbFPFormat #-}
formatRealFloatB :: RealFloat a
=> FPFormat
-> Maybe Int
-> a
-> Builder
formatRealFloatB :: FPFormat -> Maybe Int -> a -> Builder
formatRealFloatB fmt :: FPFormat
fmt decs :: Maybe Int
decs = FPFormat -> Maybe Int -> Bool -> a -> Builder
forall a.
RealFloat a =>
FPFormat -> Maybe Int -> Bool -> a -> Builder
formatRealFloatAltB FPFormat
fmt Maybe Int
decs Bool
False
{-# INLINE formatRealFloatB #-}
formatRealFloatAltB :: RealFloat a
=> FPFormat
-> Maybe Int
-> Bool
-> a
-> Builder
{-# SPECIALIZE formatRealFloatAltB :: FPFormat -> Maybe Int -> Bool -> Float -> Builder #-}
{-# SPECIALIZE formatRealFloatAltB :: FPFormat -> Maybe Int -> Bool -> Double -> Builder #-}
formatRealFloatAltB :: FPFormat -> Maybe Int -> Bool -> a -> Builder
formatRealFloatAltB fmt :: FPFormat
fmt decs :: Maybe Int
decs alt :: Bool
alt x :: a
x
| a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x = "NaN"
| a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
x = if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< 0 then "-Infinity" else "Infinity"
| a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< 0 Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero a
x = Char -> Builder
singleton '-' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FPFormat -> ([Int], Int) -> Builder
doFmt FPFormat
fmt (a -> ([Int], Int)
forall a. RealFloat a => a -> ([Int], Int)
floatToDigits (-a
x))
| Bool
otherwise = FPFormat -> ([Int], Int) -> Builder
doFmt FPFormat
fmt (a -> ([Int], Int)
forall a. RealFloat a => a -> ([Int], Int)
floatToDigits a
x)
where
doFmt :: FPFormat -> ([Int], Int) -> Builder
doFmt format :: FPFormat
format (is :: [Int]
is, e :: Int
e) =
let ds :: [Char]
ds = (Int -> Char) -> [Int] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
i2d [Int]
is in
case FPFormat
format of
Generic ->
FPFormat -> ([Int], Int) -> Builder
doFmt (if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 Bool -> Bool -> Bool
|| Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 7 then FPFormat
Exponent else FPFormat
Fixed)
([Int]
is,Int
e)
Exponent ->
case Maybe Int
decs of
Nothing ->
let show_e' :: Builder
show_e' = Int -> Builder
forall a. Integral a => a -> Builder
decimal (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) in
case [Char]
ds of
"0" -> "0.0e0"
[d :: Char
d] -> Char -> Builder
singleton Char
d Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ".0e" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
show_e'
(d :: Char
d:ds' :: [Char]
ds') -> Char -> Builder
singleton Char
d Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton '.' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
fromString [Char]
ds' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton 'e' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
show_e'
[] -> [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error "formatRealFloat/doFmt/Exponent: []"
Just d :: Int
d | Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 ->
case [Int]
is of
[0] -> "0e0"
_ ->
let
(ei :: Int
ei,is' :: [Int]
is') = Int -> [Int] -> (Int, [Int])
roundTo 1 [Int]
is
n :: Char
n:_ = (Int -> Char) -> [Int] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
i2d (if Int
ei Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then [Int] -> [Int]
forall a. [a] -> [a]
init [Int]
is' else [Int]
is')
in Char -> Builder
singleton Char
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton 'e' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
forall a. Integral a => a -> Builder
decimal (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
-1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ei)
Just dec :: Int
dec ->
let dec' :: Int
dec' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
dec 1 in
case [Int]
is of
[0] -> "0." Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText (Int -> Text -> Text
T.replicate Int
dec' "0") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> "e0"
_ ->
let
(ei :: Int
ei,is' :: [Int]
is') = Int -> [Int] -> (Int, [Int])
roundTo (Int
dec'Int -> Int -> Int
forall a. Num a => a -> a -> a
+1) [Int]
is
(d :: Char
d:ds' :: [Char]
ds') = (Int -> Char) -> [Int] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
i2d (if Int
ei Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then [Int] -> [Int]
forall a. [a] -> [a]
init [Int]
is' else [Int]
is')
in
Char -> Builder
singleton Char
d Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton '.' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
fromString [Char]
ds' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton 'e' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
forall a. Integral a => a -> Builder
decimal (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
-1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ei)
Fixed ->
let
mk0 :: [Char] -> Builder
mk0 ls :: [Char]
ls = case [Char]
ls of { "" -> "0" ; _ -> [Char] -> Builder
fromString [Char]
ls}
in
case Maybe Int
decs of
Nothing
| Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 -> "0." Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText (Int -> Text -> Text
T.replicate (-Int
e) "0") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
fromString [Char]
ds
| Bool
otherwise ->
let
f :: a -> [Char] -> [Char] -> Builder
f 0 str :: [Char]
str rs :: [Char]
rs = [Char] -> Builder
mk0 ([Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
str) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton '.' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
mk0 [Char]
rs
f n :: a
n str :: [Char]
str "" = a -> [Char] -> [Char] -> Builder
f (a
na -> a -> a
forall a. Num a => a -> a -> a
-1) ('0'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
str) ""
f n :: a
n str :: [Char]
str (r :: Char
r:rs :: [Char]
rs) = a -> [Char] -> [Char] -> Builder
f (a
na -> a -> a
forall a. Num a => a -> a -> a
-1) (Char
rChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
str) [Char]
rs
in
Int -> [Char] -> [Char] -> Builder
forall a. (Eq a, Num a) => a -> [Char] -> [Char] -> Builder
f Int
e "" [Char]
ds
Just dec :: Int
dec ->
let dec' :: Int
dec' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
dec 0 in
if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 then
let
(ei :: Int
ei,is' :: [Int]
is') = Int -> [Int] -> (Int, [Int])
roundTo (Int
dec' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
e) [Int]
is
(ls :: [Char]
ls,rs :: [Char]
rs) = Int -> [Char] -> ([Char], [Char])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ei) ((Int -> Char) -> [Int] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
i2d [Int]
is')
in
[Char] -> Builder
mk0 [Char]
ls Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (if [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
rs Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
alt then "" else Char -> Builder
singleton '.' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
fromString [Char]
rs)
else
let
(ei :: Int
ei,is' :: [Int]
is') = Int -> [Int] -> (Int, [Int])
roundTo Int
dec' (Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate (-Int
e) 0 [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
is)
d :: Char
d:ds' :: [Char]
ds' = (Int -> Char) -> [Int] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
i2d (if Int
ei Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then [Int]
is' else 0Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
is')
in
Char -> Builder
singleton Char
d Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (if [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ds' Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
alt then "" else Char -> Builder
singleton '.' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
fromString [Char]
ds')
floatToDigits :: (RealFloat a) => a -> ([Int], Int)
{-# SPECIALIZE floatToDigits :: Float -> ([Int], Int) #-}
{-# SPECIALIZE floatToDigits :: Double -> ([Int], Int) #-}
floatToDigits :: a -> ([Int], Int)
floatToDigits 0 = ([0], 0)
floatToDigits x :: a
x =
let
(f0 :: Integer
f0, e0 :: Int
e0) = a -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat a
x
(minExp0 :: Int
minExp0, _) = a -> (Int, Int)
forall a. RealFloat a => a -> (Int, Int)
floatRange a
x
p :: Int
p = a -> Int
forall a. RealFloat a => a -> Int
floatDigits a
x
b :: Integer
b = a -> Integer
forall a. RealFloat a => a -> Integer
floatRadix a
x
minExp :: Int
minExp = Int
minExp0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
p
(f :: Integer
f, e :: Int
e) =
let n :: Int
n = Int
minExp Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
e0 in
if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then (Integer
f0 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` (Integer -> Int -> Integer
expt Integer
b Int
n), Int
e0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) else (Integer
f0, Int
e0)
(r :: Integer
r, s' :: Integer
s', mUp :: Integer
mUp, mDn :: Integer
mDn) =
if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 then
let be :: Integer
be = Integer -> Int -> Integer
expt Integer
b Int
e in
if Integer
f Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> Int -> Integer
expt Integer
b (Int
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) then
(Integer
fInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
beInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
bInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*2, 2Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
b, Integer
beInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
b, Integer
be)
else
(Integer
fInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
beInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*2, 2, Integer
be, Integer
be)
else
if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
minExp Bool -> Bool -> Bool
&& Integer
f Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> Int -> Integer
expt Integer
b (Int
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) then
(Integer
fInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
bInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*2, Integer -> Int -> Integer
expt Integer
b (-Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*2, Integer
b, 1)
else
(Integer
fInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*2, Integer -> Int -> Integer
expt Integer
b (-Int
e)Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*2, 1, 1)
k :: Int
k :: Int
k =
let
k0 :: Int
k0 :: Int
k0 =
if Integer
b Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 2 then
let lx :: Int
lx = Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
e0
k1 :: Int
k1 = (Int
lx Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8651) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` 28738
in if Int
lx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 then Int
k1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 else Int
k1
else
Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling ((Float -> Float
forall a. Floating a => a -> a
log (Integer -> Float
forall a. Num a => Integer -> a
fromInteger (Integer
fInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+1) :: Float) Float -> Float -> Float
forall a. Num a => a -> a -> a
+
Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
e Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float -> Float
forall a. Floating a => a -> a
log (Integer -> Float
forall a. Num a => Integer -> a
fromInteger Integer
b)) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/
Float -> Float
forall a. Floating a => a -> a
log 10)
fixup :: Int -> Int
fixup n :: Int
n =
if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 then
if Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
mUp Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer -> Int -> Integer
expt 10 Int
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
s' then Int
n else Int -> Int
fixup (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
else
if Integer -> Int -> Integer
expt 10 (-Int
n) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
mUp) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
s' then Int
n else Int -> Int
fixup (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
in
Int -> Int
fixup Int
k0
gen :: [t] -> t -> t -> t -> t -> [t]
gen ds :: [t]
ds rn :: t
rn sN :: t
sN mUpN :: t
mUpN mDnN :: t
mDnN =
let
(dn :: t
dn, rn' :: t
rn') = (t
rn t -> t -> t
forall a. Num a => a -> a -> a
* 10) t -> t -> (t, t)
forall a. Integral a => a -> a -> (a, a)
`quotRem` t
sN
mUpN' :: t
mUpN' = t
mUpN t -> t -> t
forall a. Num a => a -> a -> a
* 10
mDnN' :: t
mDnN' = t
mDnN t -> t -> t
forall a. Num a => a -> a -> a
* 10
in
case (t
rn' t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
mDnN', t
rn' t -> t -> t
forall a. Num a => a -> a -> a
+ t
mUpN' t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
sN) of
(True, False) -> t
dn t -> [t] -> [t]
forall a. a -> [a] -> [a]
: [t]
ds
(False, True) -> t
dnt -> t -> t
forall a. Num a => a -> a -> a
+1 t -> [t] -> [t]
forall a. a -> [a] -> [a]
: [t]
ds
(True, True) -> if t
rn' t -> t -> t
forall a. Num a => a -> a -> a
* 2 t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
sN then t
dn t -> [t] -> [t]
forall a. a -> [a] -> [a]
: [t]
ds else t
dnt -> t -> t
forall a. Num a => a -> a -> a
+1 t -> [t] -> [t]
forall a. a -> [a] -> [a]
: [t]
ds
(False, False) -> [t] -> t -> t -> t -> t -> [t]
gen (t
dnt -> [t] -> [t]
forall a. a -> [a] -> [a]
:[t]
ds) t
rn' t
sN t
mUpN' t
mDnN'
rds :: [Integer]
rds =
if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 then
[Integer] -> Integer -> Integer -> Integer -> Integer -> [Integer]
forall t. Integral t => [t] -> t -> t -> t -> t -> [t]
gen [] Integer
r (Integer
s' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer -> Int -> Integer
expt 10 Int
k) Integer
mUp Integer
mDn
else
let bk :: Integer
bk = Integer -> Int -> Integer
expt 10 (-Int
k) in
[Integer] -> Integer -> Integer -> Integer -> Integer -> [Integer]
forall t. Integral t => [t] -> t -> t -> t -> t -> [t]
gen [] (Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
bk) Integer
s' (Integer
mUp Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
bk) (Integer
mDn Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
bk)
in
((Integer -> Int) -> [Integer] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Integer] -> [Integer]
forall a. [a] -> [a]
reverse [Integer]
rds), Int
k)
roundTo :: Int -> [Int] -> (Int,[Int])
#if MIN_VERSION_base(4,6,0)
roundTo :: Int -> [Int] -> (Int, [Int])
roundTo d :: Int
d is :: [Int]
is =
case Int -> Bool -> [Int] -> (Int, [Int])
f Int
d Bool
True [Int]
is of
x :: (Int, [Int])
x@(0,_) -> (Int, [Int])
x
(1,xs :: [Int]
xs) -> (1, 1Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
xs)
_ -> [Char] -> (Int, [Int])
forall a. HasCallStack => [Char] -> a
error "roundTo: bad Value"
where
b2 :: Int
b2 = Int
base Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` 2
f :: Int -> Bool -> [Int] -> (Int, [Int])
f n :: Int
n _ [] = (0, Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate Int
n 0)
f 0 e :: Bool
e (x :: Int
x:xs :: [Int]
xs) | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b2 Bool -> Bool -> Bool
&& Bool
e Bool -> Bool -> Bool
&& (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0) [Int]
xs = (0, [])
| Bool
otherwise = (if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
b2 then 1 else 0, [])
f n :: Int
n _ (i :: Int
i:xs :: [Int]
xs)
| Int
i' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
base = (1,0Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
ds)
| Bool
otherwise = (0,Int
i'Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
ds)
where
(c :: Int
c,ds :: [Int]
ds) = Int -> Bool -> [Int] -> (Int, [Int])
f (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) (Int -> Bool
forall a. Integral a => a -> Bool
even Int
i) [Int]
xs
i' :: Int
i' = Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i
base :: Int
base = 10
#else
roundTo d is =
case f d is of
x@(0,_) -> x
(1,xs) -> (1, 1:xs)
_ -> error "roundTo: bad Value"
where
f n [] = (0, replicate n 0)
f 0 (x:_) = (if x >= 5 then 1 else 0, [])
f n (i:xs)
| i' == 10 = (1,0:ds)
| otherwise = (0,i':ds)
where
(c,ds) = f (n-1) xs
i' = c + i
#endif
minExpt :: Int
minExpt :: Int
minExpt = 0
maxExpt :: Int
maxExpt :: Int
maxExpt = 1100
expt :: Integer -> Int -> Integer
expt :: Integer -> Int -> Integer
expt base :: Integer
base n :: Int
n
| Integer
base Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 2 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
minExpt Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxExpt = Array Int Integer
expts Array Int Integer -> Int -> Integer
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int
n
| Integer
base Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 10 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxExpt10 = Array Int Integer
expts10 Array Int Integer -> Int -> Integer
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int
n
| Bool
otherwise = Integer
baseInteger -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
n
expts :: Array Int Integer
expts :: Array Int Integer
expts = (Int, Int) -> [(Int, Integer)] -> Array Int Integer
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
array (Int
minExpt,Int
maxExpt) [(Int
n,2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
n) | Int
n <- [Int
minExpt .. Int
maxExpt]]
maxExpt10 :: Int
maxExpt10 :: Int
maxExpt10 = 324
expts10 :: Array Int Integer
expts10 :: Array Int Integer
expts10 = (Int, Int) -> [(Int, Integer)] -> Array Int Integer
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
array (Int
minExpt,Int
maxExpt10) [(Int
n,10Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
n) | Int
n <- [Int
minExpt .. Int
maxExpt10]]