{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Math.ExpPairs.Pair
( Triangle (..)
, InitPair' (..)
, InitPair
, initPairs
, initPairToValue
, initPairToProjValue
) where
import Data.Maybe
import Data.Ratio
import GHC.Generics (Generic (..))
import Data.Text.Prettyprint.Doc
data Triangle
= Corput16
| HuxW87b1
| Bourgain17
deriving (Show, Bounded, Enum, Eq, Ord, Generic)
instance Pretty Triangle where
pretty = pretty . show
data InitPair' t
= Corput01
| Corput12
| Mix !t !t
deriving (Eq, Ord, Show, Generic)
type InitPair = InitPair' Rational
instance (Integral a, Show a) => Pretty (Ratio a) where
pretty = pretty . show
instance (Pretty t, Num t, Eq t) => Pretty (InitPair' t) where
pretty Corput01 = parens (pretty (0%1) <> comma <+> pretty (1%1))
pretty Corput12 = parens (pretty (1%2) <> comma <+> pretty (1%2))
pretty (Mix r1 r2) = cat $ punctuate plus $ mapMaybe f [(r1, Corput16), (r2, HuxW87b1), (1 - r1 - r2, Bourgain17)] where
plus = space <> pretty "+" <> space
f (0, _) = Nothing
f (1, t) = Just (pretty t)
f (r, t) = Just (pretty r <+> pretty "*" <+> pretty t)
sect :: Integer
sect = 30
initPairs :: [InitPair]
initPairs = Corput01 : Corput12 : [Mix (r1 % sect) (r2 % sect) | r1 <- [0 .. sect], r2 <- [0 .. sect - r1]]
initPairToValue :: InitPair -> (Rational, Rational)
initPairToValue (Mix r1 r2) = (x, y) where
r3 = 1 - r1 - r2
(x1, y1) = (1%6, 2%3)
(x2, y2) = ( 2 % 13, 35 % 52)
(x3, y3) = (13 % 84, 55 % 84)
x = x1*r1 + x2*r2 + x3*r3
y = y1*r1 + y2*r2 + y3*r3
initPairToValue Corput01 = (0, 1)
initPairToValue Corput12 = (1%2, 1%2)
initPairToProjValue :: InitPair -> (Integer, Integer, Integer)
initPairToProjValue (Mix r1 r2) = (k `div` d , l `div` d, m `div` d)
where
dr1 = denominator r1
dr2 = denominator r2
m = 1092 * dr1 * dr2
k = 13 * numerator r1 * dr2 - 1 * numerator r2 * dr1 + 169 * dr1 * dr2
l = 13 * numerator r1 * dr2 + 20 * numerator r2 * dr1 + 715 * dr1 * dr2
d = k `gcd` l `gcd` m
initPairToProjValue Corput01 = (0, 1, 1)
initPairToProjValue Corput12 = (1, 1, 2)
{-# INLINABLE initPairToProjValue #-}