{-# LANGUAGE Strict #-}

{- |
Module      : Granite.Scale
Copyright   : (c) 2025
License     : MIT
Maintainer  : mschavinda@gmail.com

Scale training: turn a declarative 'Scale' into a 'TrainedScale' that
projects data values onto [0,1] and generates round-number ticks.
-}
module Granite.Scale (
    TrainedScale (..),
    train,
    niceTicks,
    niceNum,
) where

import Data.Text (Text)

import Granite.Format (Formatter (..), runFormatter)
import Granite.Internal.Util (eps)
import Granite.Spec (
    BreaksSpec (..),
    Expand (..),
    LogBase (..),
    Scale (..),
    ScaleOpts (..),
 )

data TrainedScale = TrainedScale
    { TrainedScale -> (Double, Double)
tsDomain :: !(Double, Double)
    , TrainedScale -> Double -> Double
tsProject :: !(Double -> Double)
    , TrainedScale -> Double -> Double
tsUnproject :: !(Double -> Double)
    , TrainedScale -> [Double]
tsBreaks :: ![Double]
    , TrainedScale -> [Text]
tsLabels :: ![Text]
    }

train :: Scale -> (Double, Double) -> TrainedScale
train :: Scale -> (Double, Double) -> TrainedScale
train Scale
scale (Double, Double)
dataRange = case Scale
scale of
    SLinear ScaleOpts
opts -> ScaleOpts -> (Double, Double) -> TrainedScale
trainLinear ScaleOpts
opts (Double, Double)
dataRange
    SLog LogBase
base ScaleOpts
opts -> LogBase -> ScaleOpts -> (Double, Double) -> TrainedScale
trainLog LogBase
base ScaleOpts
opts (Double, Double)
dataRange
    SSqrt ScaleOpts
opts -> ScaleOpts -> (Double, Double) -> TrainedScale
trainSqrt ScaleOpts
opts (Double, Double)
dataRange
    Scale
SIdentity -> (Double, Double) -> TrainedScale
trainIdentity (Double, Double)
dataRange
    SReverse Scale
inner -> TrainedScale -> TrainedScale
reverseScale (Scale -> (Double, Double) -> TrainedScale
train Scale
inner (Double, Double)
dataRange)
    Scale
SDiscrete -> ScaleOpts -> (Double, Double) -> TrainedScale
trainLinear (BreaksSpec -> ScaleOpts
defaultOpts BreaksSpec
BreaksNice) (Double, Double)
dataRange
    SColorContinuous [ColorSpec]
_ -> ScaleOpts -> (Double, Double) -> TrainedScale
trainLinear (BreaksSpec -> ScaleOpts
defaultOpts BreaksSpec
BreaksNice) (Double, Double)
dataRange
    SColorDiscrete [ColorSpec]
_ -> ScaleOpts -> (Double, Double) -> TrainedScale
trainLinear (BreaksSpec -> ScaleOpts
defaultOpts BreaksSpec
BreaksNice) (Double, Double)
dataRange
    SColorManual [(Text, ColorSpec)]
_ -> ScaleOpts -> (Double, Double) -> TrainedScale
trainLinear (BreaksSpec -> ScaleOpts
defaultOpts BreaksSpec
BreaksNice) (Double, Double)
dataRange

defaultOpts :: BreaksSpec -> ScaleOpts
defaultOpts :: BreaksSpec -> ScaleOpts
defaultOpts BreaksSpec
brk =
    ScaleOpts
        { scaleDomain :: Maybe (Double, Double)
scaleDomain = Maybe (Double, Double)
forall a. Maybe a
Nothing
        , scaleBreaks :: BreaksSpec
scaleBreaks = BreaksSpec
brk
        , scaleLabels :: Formatter
scaleLabels = Formatter
FormatDefault
        , scaleExpand :: Expand
scaleExpand = Double -> Double -> Expand
Expand Double
0.05 Double
0
        , scaleClip :: Bool
scaleClip = Bool
False
        }

trainLinear :: ScaleOpts -> (Double, Double) -> TrainedScale
trainLinear :: ScaleOpts -> (Double, Double) -> TrainedScale
trainLinear ScaleOpts
opts (Double, Double)
dataRange =
    let (Double
lo, Double
hi) = Expand -> (Double, Double) -> (Double, Double)
expandRange (ScaleOpts -> Expand
scaleExpand ScaleOpts
opts) (Maybe (Double, Double) -> (Double, Double) -> (Double, Double)
overrideRange (ScaleOpts -> Maybe (Double, Double)
scaleDomain ScaleOpts
opts) (Double, Double)
dataRange)
        span_ :: Double
span_ = Double
hi Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
lo Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
eps
        project :: Double -> Double
project Double
v = (Double
v Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
lo) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
span_
        unproject :: Double -> Double
unproject Double
t = Double
lo Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
span_
        breaks :: [Double]
breaks = BreaksSpec -> (Double, Double) -> [Double]
chooseBreaks (ScaleOpts -> BreaksSpec
scaleBreaks ScaleOpts
opts) (Double
lo, Double
hi)
        labels :: [Text]
labels = (Double -> Text) -> [Double] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Formatter -> Double -> Text
runFormatter (ScaleOpts -> Formatter
scaleLabels ScaleOpts
opts)) [Double]
breaks
     in (Double, Double)
-> (Double -> Double)
-> (Double -> Double)
-> [Double]
-> [Text]
-> TrainedScale
TrainedScale (Double
lo, Double
hi) Double -> Double
project Double -> Double
unproject [Double]
breaks [Text]
labels

{- | Log scales need a strictly positive domain. When the data range
contains zero or negatives we fall back to a window 3 decades below
the data max (or [1, 10] if neither bound is positive).
-}
trainLog :: LogBase -> ScaleOpts -> (Double, Double) -> TrainedScale
trainLog :: LogBase -> ScaleOpts -> (Double, Double) -> TrainedScale
trainLog LogBase
base ScaleOpts
opts (Double
dlo, Double
dhi) =
    let safeLo :: Double
safeLo
            | Double
dlo Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 = Double
dlo
            | Double
dhi Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 = Double
dhi Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1000
            | Bool
otherwise = Double
1
        safeHi :: Double
safeHi
            | Double
dhi Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
safeLo = Double
dhi
            | Bool
otherwise = Double
safeLo Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10
        (Double
lo, Double
hi) =
            Expand -> (Double, Double) -> (Double, Double)
expandLog (ScaleOpts -> Expand
scaleExpand ScaleOpts
opts) (Maybe (Double, Double) -> (Double, Double) -> (Double, Double)
overrideRange (ScaleOpts -> Maybe (Double, Double)
scaleDomain ScaleOpts
opts) (Double
safeLo, Double
safeHi))
        b :: Double
b = LogBase -> Double
logBaseConst LogBase
base
        ll :: Double
ll = Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
b Double
lo
        lh :: Double
lh = Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
b Double
hi
        span_ :: Double
span_ = Double
lh Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
ll Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
eps
        project :: Double -> Double
project Double
v = (Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
b (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
safeLo Double
v) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
ll) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
span_
        unproject :: Double -> Double
unproject Double
t = Double
b Double -> Double -> Double
forall a. Floating a => a -> a -> a
** (Double
ll Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
span_)
        breaks :: [Double]
breaks = case ScaleOpts -> BreaksSpec
scaleBreaks ScaleOpts
opts of
            BreaksAt [Double]
xs -> [Double]
xs
            BreaksCount Int
n -> Double -> Double -> Double -> Int -> [Double]
sampleLogBreaks Double
b Double
lo Double
hi Int
n
            BreaksSpec
BreaksNice -> Double -> Double -> Double -> [Double]
integerPowers Double
b Double
lo Double
hi
        labels :: [Text]
labels = (Double -> Text) -> [Double] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Formatter -> Double -> Text
runFormatter (ScaleOpts -> Formatter
scaleLabels ScaleOpts
opts)) [Double]
breaks
     in (Double, Double)
-> (Double -> Double)
-> (Double -> Double)
-> [Double]
-> [Text]
-> TrainedScale
TrainedScale (Double
lo, Double
hi) Double -> Double
project Double -> Double
unproject [Double]
breaks [Text]
labels

logBaseConst :: LogBase -> Double
logBaseConst :: LogBase -> Double
logBaseConst LogBase
Base2 = Double
2
logBaseConst LogBase
BaseE = Double -> Double
forall a. Floating a => a -> a
exp Double
1
logBaseConst LogBase
Base10 = Double
10

integerPowers :: Double -> Double -> Double -> [Double]
integerPowers :: Double -> Double -> Double -> [Double]
integerPowers Double
b Double
lo Double
hi =
    let kLo :: Int
kLo = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
b Double
lo) :: Int
        kHi :: Int
kHi = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
b Double
hi) :: Int
        n :: Int
n = Int
kHi Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
kLo Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        maxTicks :: Int
maxTicks = Int
10
     in if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxTicks
            then [Double
b Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k | Int
k <- [Int
kLo .. Int
kHi]]
            else
                let stride :: Int
stride = (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
maxTicks Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
maxTicks
                 in [Double
b Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k | Int
k <- [Int
kLo, Int
kLo Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
stride .. Int
kHi]]

sampleLogBreaks :: Double -> Double -> Double -> Int -> [Double]
sampleLogBreaks :: Double -> Double -> Double -> Int -> [Double]
sampleLogBreaks Double
b Double
lo Double
hi Int
n
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 = [Double
lo, Double
hi]
    | Bool
otherwise =
        let ll :: Double
ll = Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
b Double
lo
            lh :: Double
lh = Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
b Double
hi
            step :: Double
step = (Double
lh Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
ll) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
         in [Double
b Double -> Double -> Double
forall a. Floating a => a -> a -> a
** (Double
ll Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
step Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i) | Int
i <- [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]

trainSqrt :: ScaleOpts -> (Double, Double) -> TrainedScale
trainSqrt :: ScaleOpts -> (Double, Double) -> TrainedScale
trainSqrt ScaleOpts
opts (Double, Double)
dataRange =
    let (Double
lo0, Double
hi0) = Maybe (Double, Double) -> (Double, Double) -> (Double, Double)
overrideRange (ScaleOpts -> Maybe (Double, Double)
scaleDomain ScaleOpts
opts) (Double, Double)
dataRange
        lo :: Double
lo = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 Double
lo0
        hi :: Double
hi = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
lo Double
hi0
        (Double
lo', Double
hi') = Expand -> (Double, Double) -> (Double, Double)
expandRange (ScaleOpts -> Expand
scaleExpand ScaleOpts
opts) (Double
lo, Double
hi)
        sLo :: Double
sLo = Double -> Double
forall a. Floating a => a -> a
sqrt (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 Double
lo')
        sHi :: Double
sHi = Double -> Double
forall a. Floating a => a -> a
sqrt (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
sLo Double
hi')
        span_ :: Double
span_ = Double
sHi Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
sLo Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
eps
        project :: Double -> Double
project Double
v = (Double -> Double
forall a. Floating a => a -> a
sqrt (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 Double
v) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
sLo) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
span_
        unproject :: Double -> Double
unproject Double
t =
            let s :: Double
s = Double
sLo Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
span_
             in Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
s
        breaks :: [Double]
breaks = BreaksSpec -> (Double, Double) -> [Double]
chooseBreaks (ScaleOpts -> BreaksSpec
scaleBreaks ScaleOpts
opts) (Double
lo', Double
hi')
        labels :: [Text]
labels = (Double -> Text) -> [Double] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Formatter -> Double -> Text
runFormatter (ScaleOpts -> Formatter
scaleLabels ScaleOpts
opts)) [Double]
breaks
     in (Double, Double)
-> (Double -> Double)
-> (Double -> Double)
-> [Double]
-> [Text]
-> TrainedScale
TrainedScale (Double
lo', Double
hi') Double -> Double
project Double -> Double
unproject [Double]
breaks [Text]
labels

trainIdentity :: (Double, Double) -> TrainedScale
trainIdentity :: (Double, Double) -> TrainedScale
trainIdentity (Double
lo, Double
hi) =
    let breaks :: [Double]
breaks = BreaksSpec -> (Double, Double) -> [Double]
chooseBreaks BreaksSpec
BreaksNice (Double
lo, Double
hi)
        labels :: [Text]
labels = (Double -> Text) -> [Double] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Formatter -> Double -> Text
runFormatter Formatter
FormatDefault) [Double]
breaks
     in TrainedScale
            { tsDomain :: (Double, Double)
tsDomain = (Double
lo, Double
hi)
            , tsProject :: Double -> Double
tsProject = Double -> Double
forall a. a -> a
id
            , tsUnproject :: Double -> Double
tsUnproject = Double -> Double
forall a. a -> a
id
            , tsBreaks :: [Double]
tsBreaks = [Double]
breaks
            , tsLabels :: [Text]
tsLabels = [Text]
labels
            }

reverseScale :: TrainedScale -> TrainedScale
reverseScale :: TrainedScale -> TrainedScale
reverseScale TrainedScale
ts =
    TrainedScale
ts
        { tsProject = \Double
v -> Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- TrainedScale -> Double -> Double
tsProject TrainedScale
ts Double
v
        , tsUnproject = tsUnproject ts . (1 -)
        }

overrideRange :: Maybe (Double, Double) -> (Double, Double) -> (Double, Double)
overrideRange :: Maybe (Double, Double) -> (Double, Double) -> (Double, Double)
overrideRange Maybe (Double, Double)
Nothing (Double, Double)
r = (Double, Double)
r
overrideRange (Just (Double
a, Double
b)) (Double, Double)
_ = (Double
a, Double
b)

expandRange :: Expand -> (Double, Double) -> (Double, Double)
expandRange :: Expand -> (Double, Double) -> (Double, Double)
expandRange (Expand Double
m Double
a) (Double
lo, Double
hi) =
    let pad :: Double
pad = (Double
hi Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
lo) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
m Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
a
     in (Double
lo Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
pad, Double
hi Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
pad)

expandLog :: Expand -> (Double, Double) -> (Double, Double)
expandLog :: Expand -> (Double, Double) -> (Double, Double)
expandLog (Expand Double
m Double
_) (Double
lo, Double
hi)
    | Double
m Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0 = (Double
lo, Double
hi)
    | Bool
otherwise =
        let factor :: Double
factor = (Double
hi Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
lo) Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
m
         in (Double
lo Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
factor, Double
hi Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
factor)

chooseBreaks :: BreaksSpec -> (Double, Double) -> [Double]
chooseBreaks :: BreaksSpec -> (Double, Double) -> [Double]
chooseBreaks BreaksSpec
brk (Double
lo, Double
hi) = case BreaksSpec
brk of
    BreaksAt [Double]
xs -> [Double]
xs
    BreaksCount Int
n -> (Double, Double) -> Int -> [Double]
niceTicks (Double
lo, Double
hi) Int
n
    BreaksSpec
BreaksNice -> (Double, Double) -> Int -> [Double]
niceTicks (Double
lo, Double
hi) Int
5

{- | Heckbert "loose label" tick selection. Round-number positions in
@{1, 2, 2.5, 5} × 10^k@ that bracket the data range.
-}
niceTicks :: (Double, Double) -> Int -> [Double]
niceTicks :: (Double, Double) -> Int -> [Double]
niceTicks (Double
lo, Double
hi) Int
target0
    | Bool -> Bool
not (Double -> Bool
forall {a}. RealFloat a => a -> Bool
isValid Double
lo Bool -> Bool -> Bool
&& Double -> Bool
forall {a}. RealFloat a => a -> Bool
isValid Double
hi) Bool -> Bool -> Bool
|| Double
lo Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
hi = [Double
lo]
    | Double
lo Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
hi = (Double, Double) -> Int -> [Double]
niceTicks (Double
hi, Double
lo) Int
target0
    | Bool
otherwise =
        let target :: Int
target = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
2 Int
target0
            range :: Double
range = Double -> Bool -> Double
niceNum (Double
hi Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
lo) Bool
False
            step :: Double
step = Double -> Bool -> Double
niceNum (Double
range Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
target Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Bool
True
            gMin :: Double
gMin = (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Double) (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
lo Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
step)) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
step
            gMax :: Double
gMax = (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Double) (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double
hi Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
step)) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
step
            n :: Int
n = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round ((Double
gMax Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
gMin) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
step) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 :: Int
         in [Double
gMin Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
step Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i | Int
i <- [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]
  where
    isValid :: a -> Bool
isValid a
x = Bool -> Bool
not (a -> Bool
forall {a}. RealFloat a => a -> Bool
isNaN a
x Bool -> Bool -> Bool
|| a -> Bool
forall {a}. RealFloat a => a -> Bool
isInfinite a
x)

niceNum :: Double -> Bool -> Double
niceNum :: Double -> Bool -> Double
niceNum Double
0 Bool
_ = Double
1
niceNum Double
x Bool
roundIt =
    let absX :: Double
absX = Double -> Double
forall a. Num a => a -> a
abs Double
x
        sign :: Double
sign = if Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0 then (-Double
1) else Double
1
        exp10 :: Int
exp10 = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
10 Double
absX) :: Int
        f :: Double
f = Double
absX Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
10 Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
exp10)
        nf :: Double
nf
            | Bool
roundIt =
                if Double
f Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1.5
                    then Double
1
                    else
                        if Double
f Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
3
                            then Double
2
                            else
                                if Double
f Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
7
                                    then Double
5
                                    else Double
10
            | Double
f Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
1 = Double
1
            | Double
f Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
2 = Double
2
            | Double
f Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
5 = Double
5
            | Bool
otherwise = Double
10
     in Double
sign Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
nf Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
10 Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
exp10)