{-# OPTIONS_GHC -Wall -fwarn-tabs #-}
{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-}
#if __GLASGOW_HASKELL__ >= 701
-- N.B., GeneralizedNewtypeDeriving isn't "safe".
{-# LANGUAGE Trustworthy #-}
#endif
----------------------------------------------------------------
--                                                    2021.10.17
-- |
-- Module      :  Data.Number.CalkinWilf
-- Copyright   :  2012--2021 wren gayle romano
-- License     :  BSD3
-- Maintainer  :  wren@cpan.org
-- Stability   :  provisional
-- Portability :  Haskell98 + CPP + GeneralizedNewtypeDeriving
--
-- Enumerate the rationals in Calkin--Wilf order. That is, when we
-- give enumeration a well-specified meaning (as "Prelude.SafeEnum"
-- does) this renders instances for 'Ratio' problematic. 'Ratio'
-- instances /can/ be provided so long as the base type is integral
-- and enumerable; but they must be done in an obscure order that
-- does not coincide with the 'Ord' instance for 'Ratio'. Since
-- this is not what people may expect, we only provide an instance
-- for the newtype 'CalkinWilf', not for 'Ratio' itself.
--
--   * Jeremy Gibbons, David Lester, and Richard Bird (2006).
--     /Enumerating the Rationals/. JFP 16(3):281--291.
--     DOI:10.1017\/S0956796806005880
--     <http://www.cs.ox.ac.uk/jeremy.gibbons/publications/rationals.pdf>
----------------------------------------------------------------
module Data.Number.CalkinWilf (CalkinWilf(..), unCalkinWilf) where

import Prelude hiding (Enum(..))
import qualified Prelude (Enum(..))
import Prelude.SafeEnum
import Data.Ratio
import Data.List (elemIndex)

----------------------------------------------------------------
-- | Enumerate the rationals in Calkin--Wilf order. The enumeration
-- is symmetric about zero, ensuring that all the negative rationals
-- come before zero and all the positive rationals come after zero.
--
-- BUG: while the 'succeeds', 'precedes', 'toEnum', and 'fromEnum'
-- methods are correct, they are horribly inefficient. This can be
-- rectified (or at least mitigated), but this remains to be done.
newtype CalkinWilf a = CalkinWilf (Ratio a)
    deriving (ReadPrec [CalkinWilf a]
ReadPrec (CalkinWilf a)
Int -> ReadS (CalkinWilf a)
ReadS [CalkinWilf a]
(Int -> ReadS (CalkinWilf a))
-> ReadS [CalkinWilf a]
-> ReadPrec (CalkinWilf a)
-> ReadPrec [CalkinWilf a]
-> Read (CalkinWilf a)
forall a. (Integral a, Read a) => ReadPrec [CalkinWilf a]
forall a. (Integral a, Read a) => ReadPrec (CalkinWilf a)
forall a. (Integral a, Read a) => Int -> ReadS (CalkinWilf a)
forall a. (Integral a, Read a) => ReadS [CalkinWilf a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CalkinWilf a]
$creadListPrec :: forall a. (Integral a, Read a) => ReadPrec [CalkinWilf a]
readPrec :: ReadPrec (CalkinWilf a)
$creadPrec :: forall a. (Integral a, Read a) => ReadPrec (CalkinWilf a)
readList :: ReadS [CalkinWilf a]
$creadList :: forall a. (Integral a, Read a) => ReadS [CalkinWilf a]
readsPrec :: Int -> ReadS (CalkinWilf a)
$creadsPrec :: forall a. (Integral a, Read a) => Int -> ReadS (CalkinWilf a)
Read, Int -> CalkinWilf a -> ShowS
[CalkinWilf a] -> ShowS
CalkinWilf a -> String
(Int -> CalkinWilf a -> ShowS)
-> (CalkinWilf a -> String)
-> ([CalkinWilf a] -> ShowS)
-> Show (CalkinWilf a)
forall a. Show a => Int -> CalkinWilf a -> ShowS
forall a. Show a => [CalkinWilf a] -> ShowS
forall a. Show a => CalkinWilf a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CalkinWilf a] -> ShowS
$cshowList :: forall a. Show a => [CalkinWilf a] -> ShowS
show :: CalkinWilf a -> String
$cshow :: forall a. Show a => CalkinWilf a -> String
showsPrec :: Int -> CalkinWilf a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> CalkinWilf a -> ShowS
Show, CalkinWilf a -> CalkinWilf a -> Bool
(CalkinWilf a -> CalkinWilf a -> Bool)
-> (CalkinWilf a -> CalkinWilf a -> Bool) -> Eq (CalkinWilf a)
forall a. Eq a => CalkinWilf a -> CalkinWilf a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CalkinWilf a -> CalkinWilf a -> Bool
$c/= :: forall a. Eq a => CalkinWilf a -> CalkinWilf a -> Bool
== :: CalkinWilf a -> CalkinWilf a -> Bool
$c== :: forall a. Eq a => CalkinWilf a -> CalkinWilf a -> Bool
Eq, Eq (CalkinWilf a)
Eq (CalkinWilf a)
-> (CalkinWilf a -> CalkinWilf a -> Ordering)
-> (CalkinWilf a -> CalkinWilf a -> Bool)
-> (CalkinWilf a -> CalkinWilf a -> Bool)
-> (CalkinWilf a -> CalkinWilf a -> Bool)
-> (CalkinWilf a -> CalkinWilf a -> Bool)
-> (CalkinWilf a -> CalkinWilf a -> CalkinWilf a)
-> (CalkinWilf a -> CalkinWilf a -> CalkinWilf a)
-> Ord (CalkinWilf a)
CalkinWilf a -> CalkinWilf a -> Bool
CalkinWilf a -> CalkinWilf a -> Ordering
CalkinWilf a -> CalkinWilf a -> CalkinWilf a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Integral a => Eq (CalkinWilf a)
forall a. Integral a => CalkinWilf a -> CalkinWilf a -> Bool
forall a. Integral a => CalkinWilf a -> CalkinWilf a -> Ordering
forall a.
Integral a =>
CalkinWilf a -> CalkinWilf a -> CalkinWilf a
min :: CalkinWilf a -> CalkinWilf a -> CalkinWilf a
$cmin :: forall a.
Integral a =>
CalkinWilf a -> CalkinWilf a -> CalkinWilf a
max :: CalkinWilf a -> CalkinWilf a -> CalkinWilf a
$cmax :: forall a.
Integral a =>
CalkinWilf a -> CalkinWilf a -> CalkinWilf a
>= :: CalkinWilf a -> CalkinWilf a -> Bool
$c>= :: forall a. Integral a => CalkinWilf a -> CalkinWilf a -> Bool
> :: CalkinWilf a -> CalkinWilf a -> Bool
$c> :: forall a. Integral a => CalkinWilf a -> CalkinWilf a -> Bool
<= :: CalkinWilf a -> CalkinWilf a -> Bool
$c<= :: forall a. Integral a => CalkinWilf a -> CalkinWilf a -> Bool
< :: CalkinWilf a -> CalkinWilf a -> Bool
$c< :: forall a. Integral a => CalkinWilf a -> CalkinWilf a -> Bool
compare :: CalkinWilf a -> CalkinWilf a -> Ordering
$ccompare :: forall a. Integral a => CalkinWilf a -> CalkinWilf a -> Ordering
$cp1Ord :: forall a. Integral a => Eq (CalkinWilf a)
Ord, Integer -> CalkinWilf a
CalkinWilf a -> CalkinWilf a
CalkinWilf a -> CalkinWilf a -> CalkinWilf a
(CalkinWilf a -> CalkinWilf a -> CalkinWilf a)
-> (CalkinWilf a -> CalkinWilf a -> CalkinWilf a)
-> (CalkinWilf a -> CalkinWilf a -> CalkinWilf a)
-> (CalkinWilf a -> CalkinWilf a)
-> (CalkinWilf a -> CalkinWilf a)
-> (CalkinWilf a -> CalkinWilf a)
-> (Integer -> CalkinWilf a)
-> Num (CalkinWilf a)
forall a. Integral a => Integer -> CalkinWilf a
forall a. Integral a => CalkinWilf a -> CalkinWilf a
forall a.
Integral a =>
CalkinWilf a -> CalkinWilf a -> CalkinWilf a
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> CalkinWilf a
$cfromInteger :: forall a. Integral a => Integer -> CalkinWilf a
signum :: CalkinWilf a -> CalkinWilf a
$csignum :: forall a. Integral a => CalkinWilf a -> CalkinWilf a
abs :: CalkinWilf a -> CalkinWilf a
$cabs :: forall a. Integral a => CalkinWilf a -> CalkinWilf a
negate :: CalkinWilf a -> CalkinWilf a
$cnegate :: forall a. Integral a => CalkinWilf a -> CalkinWilf a
* :: CalkinWilf a -> CalkinWilf a -> CalkinWilf a
$c* :: forall a.
Integral a =>
CalkinWilf a -> CalkinWilf a -> CalkinWilf a
- :: CalkinWilf a -> CalkinWilf a -> CalkinWilf a
$c- :: forall a.
Integral a =>
CalkinWilf a -> CalkinWilf a -> CalkinWilf a
+ :: CalkinWilf a -> CalkinWilf a -> CalkinWilf a
$c+ :: forall a.
Integral a =>
CalkinWilf a -> CalkinWilf a -> CalkinWilf a
Num, Num (CalkinWilf a)
Num (CalkinWilf a)
-> (CalkinWilf a -> CalkinWilf a -> CalkinWilf a)
-> (CalkinWilf a -> CalkinWilf a)
-> (Rational -> CalkinWilf a)
-> Fractional (CalkinWilf a)
Rational -> CalkinWilf a
CalkinWilf a -> CalkinWilf a
CalkinWilf a -> CalkinWilf a -> CalkinWilf a
forall a. Integral a => Num (CalkinWilf a)
forall a. Integral a => Rational -> CalkinWilf a
forall a. Integral a => CalkinWilf a -> CalkinWilf a
forall a.
Integral a =>
CalkinWilf a -> CalkinWilf a -> CalkinWilf a
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> CalkinWilf a
$cfromRational :: forall a. Integral a => Rational -> CalkinWilf a
recip :: CalkinWilf a -> CalkinWilf a
$crecip :: forall a. Integral a => CalkinWilf a -> CalkinWilf a
/ :: CalkinWilf a -> CalkinWilf a -> CalkinWilf a
$c/ :: forall a.
Integral a =>
CalkinWilf a -> CalkinWilf a -> CalkinWilf a
$cp1Fractional :: forall a. Integral a => Num (CalkinWilf a)
Fractional, Num (CalkinWilf a)
Ord (CalkinWilf a)
Num (CalkinWilf a)
-> Ord (CalkinWilf a)
-> (CalkinWilf a -> Rational)
-> Real (CalkinWilf a)
CalkinWilf a -> Rational
forall a. Integral a => Num (CalkinWilf a)
forall a. Integral a => Ord (CalkinWilf a)
forall a. Integral a => CalkinWilf a -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: CalkinWilf a -> Rational
$ctoRational :: forall a. Integral a => CalkinWilf a -> Rational
$cp2Real :: forall a. Integral a => Ord (CalkinWilf a)
$cp1Real :: forall a. Integral a => Num (CalkinWilf a)
Real, Fractional (CalkinWilf a)
Real (CalkinWilf a)
Real (CalkinWilf a)
-> Fractional (CalkinWilf a)
-> (forall b. Integral b => CalkinWilf a -> (b, CalkinWilf a))
-> (forall b. Integral b => CalkinWilf a -> b)
-> (forall b. Integral b => CalkinWilf a -> b)
-> (forall b. Integral b => CalkinWilf a -> b)
-> (forall b. Integral b => CalkinWilf a -> b)
-> RealFrac (CalkinWilf a)
CalkinWilf a -> b
CalkinWilf a -> b
CalkinWilf a -> b
CalkinWilf a -> b
CalkinWilf a -> (b, CalkinWilf a)
forall a. Integral a => Fractional (CalkinWilf a)
forall a. Integral a => Real (CalkinWilf a)
forall b. Integral b => CalkinWilf a -> b
forall b. Integral b => CalkinWilf a -> (b, CalkinWilf a)
forall a b. (Integral a, Integral b) => CalkinWilf a -> b
forall a b.
(Integral a, Integral b) =>
CalkinWilf a -> (b, CalkinWilf a)
forall a.
Real a
-> Fractional a
-> (forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
floor :: CalkinWilf a -> b
$cfloor :: forall a b. (Integral a, Integral b) => CalkinWilf a -> b
ceiling :: CalkinWilf a -> b
$cceiling :: forall a b. (Integral a, Integral b) => CalkinWilf a -> b
round :: CalkinWilf a -> b
$cround :: forall a b. (Integral a, Integral b) => CalkinWilf a -> b
truncate :: CalkinWilf a -> b
$ctruncate :: forall a b. (Integral a, Integral b) => CalkinWilf a -> b
properFraction :: CalkinWilf a -> (b, CalkinWilf a)
$cproperFraction :: forall a b.
(Integral a, Integral b) =>
CalkinWilf a -> (b, CalkinWilf a)
$cp2RealFrac :: forall a. Integral a => Fractional (CalkinWilf a)
$cp1RealFrac :: forall a. Integral a => Real (CalkinWilf a)
RealFrac)
    -- BUG: Haddock does a horrible job with the generated contexts...


-- | Return the underlying 'Ratio'. Not using record syntax to
-- define this in order to pretty up the derived 'Show' instance.
unCalkinWilf :: CalkinWilf a -> Ratio a
unCalkinWilf :: CalkinWilf a -> Ratio a
unCalkinWilf (CalkinWilf Ratio a
q) = Ratio a
q
{-# INLINE unCalkinWilf #-}


succCW :: Integral a => CalkinWilf a -> CalkinWilf a
{-# SPECIALIZE succCW :: CalkinWilf Integer -> CalkinWilf Integer #-}
succCW :: CalkinWilf a -> CalkinWilf a
succCW CalkinWilf a
x
    | CalkinWilf a
x CalkinWilf a -> CalkinWilf a -> Bool
forall a. Ord a => a -> a -> Bool
< CalkinWilf a
0 =
        let y :: CalkinWilf a
y = CalkinWilf a -> CalkinWilf a
forall a. Fractional a => a -> a
recip CalkinWilf a
x CalkinWilf a -> CalkinWilf a -> CalkinWilf a
forall a. Num a => a -> a -> a
+ CalkinWilf a
1
        in  CalkinWilf a
2 CalkinWilf a -> CalkinWilf a -> CalkinWilf a
forall a. Num a => a -> a -> a
* Integer -> CalkinWilf a
forall a. Num a => Integer -> a
fromInteger(CalkinWilf a -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor CalkinWilf a
y) CalkinWilf a -> CalkinWilf a -> CalkinWilf a
forall a. Num a => a -> a -> a
- CalkinWilf a
y
    | Bool
otherwise =
        let (Integer
n,CalkinWilf a
y) = CalkinWilf a -> (Integer, CalkinWilf a)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction CalkinWilf a
x
        in  CalkinWilf a -> CalkinWilf a
forall a. Fractional a => a -> a
recip (Integer -> CalkinWilf a
forall a. Num a => Integer -> a
fromInteger Integer
n CalkinWilf a -> CalkinWilf a -> CalkinWilf a
forall a. Num a => a -> a -> a
+ CalkinWilf a
1 CalkinWilf a -> CalkinWilf a -> CalkinWilf a
forall a. Num a => a -> a -> a
- CalkinWilf a
y)


predCW :: Integral a => CalkinWilf a -> CalkinWilf a
{-# SPECIALIZE predCW :: CalkinWilf Integer -> CalkinWilf Integer #-}
predCW :: CalkinWilf a -> CalkinWilf a
predCW CalkinWilf a
x
    | CalkinWilf a
x CalkinWilf a -> CalkinWilf a -> Bool
forall a. Ord a => a -> a -> Bool
> CalkinWilf a
0 =
        let y :: CalkinWilf a
y = CalkinWilf a -> CalkinWilf a
forall a. Fractional a => a -> a
recip CalkinWilf a
x CalkinWilf a -> CalkinWilf a -> CalkinWilf a
forall a. Num a => a -> a -> a
- CalkinWilf a
1
        in  CalkinWilf a
2 CalkinWilf a -> CalkinWilf a -> CalkinWilf a
forall a. Num a => a -> a -> a
* Integer -> CalkinWilf a
forall a. Num a => Integer -> a
fromInteger(CalkinWilf a -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
ceiling CalkinWilf a
y) CalkinWilf a -> CalkinWilf a -> CalkinWilf a
forall a. Num a => a -> a -> a
- CalkinWilf a
y
    | Bool
otherwise =
        let (Integer
n,CalkinWilf a
y) = CalkinWilf a -> (Integer, CalkinWilf a)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction CalkinWilf a
x
        in  CalkinWilf a -> CalkinWilf a
forall a. Fractional a => a -> a
recip (Integer -> CalkinWilf a
forall a. Num a => Integer -> a
fromInteger Integer
n CalkinWilf a -> CalkinWilf a -> CalkinWilf a
forall a. Num a => a -> a -> a
- CalkinWilf a
1 CalkinWilf a -> CalkinWilf a -> CalkinWilf a
forall a. Num a => a -> a -> a
- CalkinWilf a
y)


-- TODO: We could probably speed everything below up by using the @mod@-based algorithm for 'igcd' and adding on the necessary number of bits; and by replacing [Bool] with a Word where the highest set bit indicates the end of the list. The trick, then, is what to do with [Bool] too large to fit into a Word?


-- TODO: does 'elemIndex' fail if the resulting Int would overflow?
cw2mbint :: Integral a => CalkinWilf a -> Maybe Int
{-# SPECIALIZE cw2mbint :: CalkinWilf Integer -> Maybe Int #-}
cw2mbint :: CalkinWilf a -> Maybe Int
cw2mbint CalkinWilf a
q =
    case CalkinWilf a -> CalkinWilf a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare CalkinWilf a
q CalkinWilf a
0 of
    Ordering
GT -> (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+) ([Bool] -> [[Bool]] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex (CalkinWilf a -> [Bool]
forall a. Integral a => CalkinWilf a -> [Bool]
cw2bits CalkinWilf a
q) [[Bool]]
boolseqs)
    Ordering
EQ -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
    Ordering
LT -> (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int
forall a. Num a => a -> a
negate (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+)) ([Bool] -> [[Bool]] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex (CalkinWilf a -> [Bool]
forall a. Integral a => CalkinWilf a -> [Bool]
cw2bits (CalkinWilf a -> CalkinWilf a
forall a. Num a => a -> a
abs CalkinWilf a
q)) [[Bool]]
boolseqs)
    where
    -- Using a local definition to try to avoid memoization
    boolseqs :: [[Bool]]
boolseqs = [] [Bool] -> [[Bool]] -> [[Bool]]
forall a. a -> [a] -> [a]
: [ Bool
bBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:[Bool]
bs | [Bool]
bs <- [[Bool]]
boolseqs, Bool
b <- [Bool
False,Bool
True]]


cw2bits :: Integral a => CalkinWilf a -> [Bool]
{-# SPECIALIZE cw2bits :: CalkinWilf Integer -> [Bool] #-}
cw2bits :: CalkinWilf a -> [Bool]
cw2bits (CalkinWilf Ratio a
q) = (a, [Bool]) -> [Bool]
forall a b. (a, b) -> b
snd (a -> a -> (a, [Bool])
forall a. Integral a => a -> a -> (a, [Bool])
igcd (Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
q) (Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
q))


igcd :: Integral a => a -> a -> (a,[Bool])
{-# SPECIALIZE igcd :: Integer -> Integer -> (Integer,[Bool]) #-}
igcd :: a -> a -> (a, [Bool])
igcd a
0 a
0 = (a
0,[])
igcd a
m a
n
    | a
m a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 Bool -> Bool -> Bool
|| a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 = String -> (a, [Bool])
forall a. HasCallStack => String -> a
error String
"igcd is undefined on negative arguments"
    | Bool
otherwise =
        case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
m a
n of
        Ordering
LT -> ([Bool] -> [Bool]) -> (a, [Bool]) -> (a, [Bool])
forall t b a. (t -> b) -> (a, t) -> (a, b)
second (Bool
FalseBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:) (a -> a -> (a, [Bool])
forall a. Integral a => a -> a -> (a, [Bool])
igcd a
m (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
m))
        Ordering
GT -> ([Bool] -> [Bool]) -> (a, [Bool]) -> (a, [Bool])
forall t b a. (t -> b) -> (a, t) -> (a, b)
second (Bool
TrueBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:)  (a -> a -> (a, [Bool])
forall a. Integral a => a -> a -> (a, [Bool])
igcd (a
ma -> a -> a
forall a. Num a => a -> a -> a
-a
n) a
n)
        Ordering
EQ -> (a
m,[])
    where
    second :: (t -> b) -> (a, t) -> (a, b)
second t -> b
f (a
x, t
y) = (a
x, t -> b
f t
y)


int2cw :: Integral a => Int -> CalkinWilf a
{-# SPECIALIZE int2cw :: Int -> CalkinWilf Integer #-}
int2cw :: Int -> CalkinWilf a
int2cw Int
i
    | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
minBound = (CalkinWilf a -> CalkinWilf a
forall a. Integral a => CalkinWilf a -> CalkinWilf a
predCW (CalkinWilf a -> CalkinWilf a)
-> (Int -> CalkinWilf a) -> Int -> CalkinWilf a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CalkinWilf a -> CalkinWilf a
forall a. Num a => a -> a
negate (CalkinWilf a -> CalkinWilf a)
-> (Int -> CalkinWilf a) -> Int -> CalkinWilf a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CalkinWilf a
forall a. Integral a => Int -> CalkinWilf a
posnat2cw (Int -> CalkinWilf a) -> (Int -> Int) -> Int -> CalkinWilf a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Num a => a -> a
negate) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
    | Bool
otherwise     =
        case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i Int
0 of
        Ordering
GT -> Int -> CalkinWilf a
forall a. Integral a => Int -> CalkinWilf a
posnat2cw Int
i
        Ordering
EQ -> CalkinWilf a
0
        Ordering
LT -> (CalkinWilf a -> CalkinWilf a
forall a. Num a => a -> a
negate (CalkinWilf a -> CalkinWilf a)
-> (Int -> CalkinWilf a) -> Int -> CalkinWilf a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CalkinWilf a
forall a. Integral a => Int -> CalkinWilf a
posnat2cw (Int -> CalkinWilf a) -> (Int -> Int) -> Int -> CalkinWilf a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Num a => a -> a
negate) Int
i -- Beware when i == minBound

posnat2cw :: Integral a => Int -> CalkinWilf a
{-# SPECIALIZE posnat2cw :: Int -> CalkinWilf Integer #-}
posnat2cw :: Int -> CalkinWilf a
posnat2cw Int
i = [Bool] -> CalkinWilf a
forall a. Integral a => [Bool] -> CalkinWilf a
bits2cw ([[Bool]]
boolseqs [[Bool]] -> Int -> [Bool]
forall a. [a] -> Int -> a
!! (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
    where
    -- Using a local definition to try to avoid memoization
    boolseqs :: [[Bool]]
boolseqs = [] [Bool] -> [[Bool]] -> [[Bool]]
forall a. a -> [a] -> [a]
: [ Bool
bBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:[Bool]
bs | [Bool]
bs <- [[Bool]]
boolseqs, Bool
b <- [Bool
False,Bool
True]]

bits2cw :: Integral a => [Bool] -> CalkinWilf a
{-# SPECIALIZE bits2cw :: [Bool] -> CalkinWilf Integer #-}
bits2cw :: [Bool] -> CalkinWilf a
bits2cw [Bool]
bs =
    let (a
m,a
n) = (Bool -> (a, a) -> (a, a)) -> (a, a) -> [Bool] -> (a, a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Bool -> (a, a) -> (a, a)
forall a. Num a => Bool -> (a, a) -> (a, a)
undo (a
1,a
1) [Bool]
bs
    in Ratio a -> CalkinWilf a
forall a. Ratio a -> CalkinWilf a
CalkinWilf (a
m a -> a -> Ratio a
forall a. Integral a => a -> a -> Ratio a
% a
n)
    -- GHC.Real doesn't export (:%), but we know this is already normalized...
    where
    undo :: Bool -> (a, a) -> (a, a)
undo Bool
False (a
m,a
n) = (a
m, a
na -> a -> a
forall a. Num a => a -> a -> a
+a
m)
    undo Bool
True  (a
m,a
n) = (a
ma -> a -> a
forall a. Num a => a -> a -> a
+a
n, a
n)


----------------------------------------------------------------
instance Integral a => UpwardEnum (CalkinWilf a) where
    succ :: CalkinWilf a -> Maybe (CalkinWilf a)
succ = CalkinWilf a -> Maybe (CalkinWilf a)
forall a. a -> Maybe a
Just (CalkinWilf a -> Maybe (CalkinWilf a))
-> (CalkinWilf a -> CalkinWilf a)
-> CalkinWilf a
-> Maybe (CalkinWilf a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CalkinWilf a -> CalkinWilf a
forall a. Integral a => CalkinWilf a -> CalkinWilf a
succCW
    -- BUG: What about when 'cw2mbint' fails?
    CalkinWilf a
x succeeds :: CalkinWilf a -> CalkinWilf a -> Bool
`succeeds` CalkinWilf a
y = CalkinWilf a -> Maybe Int
forall a. Integral a => CalkinWilf a -> Maybe Int
cw2mbint CalkinWilf a
x Maybe Int -> Maybe Int -> Bool
forall a. Ord a => a -> a -> Bool
> CalkinWilf a -> Maybe Int
forall a. Integral a => CalkinWilf a -> Maybe Int
cw2mbint CalkinWilf a
y
    {-# INLINE succ #-}
    {-# INLINE succeeds #-}


instance Integral a => DownwardEnum (CalkinWilf a) where
    pred :: CalkinWilf a -> Maybe (CalkinWilf a)
pred = CalkinWilf a -> Maybe (CalkinWilf a)
forall a. a -> Maybe a
Just (CalkinWilf a -> Maybe (CalkinWilf a))
-> (CalkinWilf a -> CalkinWilf a)
-> CalkinWilf a
-> Maybe (CalkinWilf a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CalkinWilf a -> CalkinWilf a
forall a. Integral a => CalkinWilf a -> CalkinWilf a
predCW
    -- BUG: What about when 'cw2mbint' fails?
    CalkinWilf a
x precedes :: CalkinWilf a -> CalkinWilf a -> Bool
`precedes` CalkinWilf a
y = CalkinWilf a -> Maybe Int
forall a. Integral a => CalkinWilf a -> Maybe Int
cw2mbint CalkinWilf a
x Maybe Int -> Maybe Int -> Bool
forall a. Ord a => a -> a -> Bool
< CalkinWilf a -> Maybe Int
forall a. Integral a => CalkinWilf a -> Maybe Int
cw2mbint CalkinWilf a
y
    {-# INLINE pred #-}
    {-# INLINE precedes #-}


instance Integral a => Enum (CalkinWilf a) where
    toEnum :: Int -> Maybe (CalkinWilf a)
toEnum   = CalkinWilf a -> Maybe (CalkinWilf a)
forall a. a -> Maybe a
Just (CalkinWilf a -> Maybe (CalkinWilf a))
-> (Int -> CalkinWilf a) -> Int -> Maybe (CalkinWilf a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CalkinWilf a
forall a. Integral a => Int -> CalkinWilf a
int2cw
    fromEnum :: CalkinWilf a -> Maybe Int
fromEnum = CalkinWilf a -> Maybe Int
forall a. Integral a => CalkinWilf a -> Maybe Int
cw2mbint
    {-# INLINE toEnum #-}
    {-# INLINE fromEnum #-}


instance Integral a => Prelude.Enum (CalkinWilf a) where
    succ :: CalkinWilf a -> CalkinWilf a
succ     = CalkinWilf a -> CalkinWilf a
forall a. Integral a => CalkinWilf a -> CalkinWilf a
succCW
    pred :: CalkinWilf a -> CalkinWilf a
pred     = CalkinWilf a -> CalkinWilf a
forall a. Integral a => CalkinWilf a -> CalkinWilf a
predCW
    toEnum :: Int -> CalkinWilf a
toEnum   = Int -> CalkinWilf a
forall a. Integral a => Int -> CalkinWilf a
int2cw
    fromEnum :: CalkinWilf a -> Int
fromEnum = Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
forall a. a
_fromEnum_OOR Int -> Int
forall a. a -> a
id (Maybe Int -> Int)
-> (CalkinWilf a -> Maybe Int) -> CalkinWilf a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CalkinWilf a -> Maybe Int
forall a. Integral a => CalkinWilf a -> Maybe Int
cw2mbint
    enumFrom :: CalkinWilf a -> [CalkinWilf a]
enumFrom = (CalkinWilf a -> CalkinWilf a) -> CalkinWilf a -> [CalkinWilf a]
forall a. (a -> a) -> a -> [a]
iterate CalkinWilf a -> CalkinWilf a
forall a. Integral a => CalkinWilf a -> CalkinWilf a
succCW
    {-# INLINE succ #-}
    {-# INLINE pred #-}
    {-# INLINE toEnum #-}
    {-# INLINE fromEnum #-}
    {-# INLINE enumFrom #-}

    -- TODO: enumFromThen :: a -> a -> [a]
    -- TODO: enumFromTo :: a -> a -> [a]
    -- TODO: enumFromThenTo :: a -> a -> a -> [a]

----------------------------------------------------------------
_fromEnum_OOR :: a
_fromEnum_OOR :: a
_fromEnum_OOR =
    String -> a
forall a. HasCallStack => String -> a
error String
"Enum.fromEnum{CalkinWilf}: argument out of range"
{-# NOINLINE _fromEnum_OOR #-}

----------------------------------------------------------------
----------------------------------------------------------- fin.