{-# LANGUAGE BangPatterns, NoImplicitPrelude #-}

module EgyptianFractions ( 
  egyptianFractionDecomposition
  , egyptianFractionDecomposition1G
) where

import GHC.Base
import GHC.Num ((+),(-),(*),Integer)
import GHC.List (cycle,zip,take,splitAt)
import Data.List (sort)
import GHC.Real (gcd,quot,(/))
import UnitFractionsDecomposition2 (lessErrSimpleDecomp5PG)

-- | The argument should be greater or equal than 0.005 (1/200) though it is not checked. Returns the
-- representation of the fraction using canonical ancient Egyptian representation and its error as
-- 'Double' value in the resulting tuple.
egyptianFractionDecomposition :: Double -> ([(Integer,Integer)], Double)
egyptianFractionDecomposition :: Double -> ([(Integer, Integer)], Double)
egyptianFractionDecomposition Double
k 
  | Double
k forall a. Ord a => a -> a -> Bool
> Double
2.0forall a. Fractional a => a -> a -> a
/Double
3.0 Bool -> Bool -> Bool
&& Double
k forall a. Ord a => a -> a -> Bool
<= Double
1.0 = let ([Integer]
ks, Double
err) = ErrorImpact -> [ErrorImpact] -> Double -> ([Integer], Double)
lessErrSimpleDecomp5PG ErrorImpact
0 [] (Double
k forall a. Num a => a -> a -> a
- Double
2.0forall a. Fractional a => a -> a -> a
/Double
3.0) in ((Integer
2,Integer
3) forall a. a -> [a] -> [a]
: forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. [a] -> [a]
cycle [Integer
1]) [Integer]
ks, Double
err)
  | Bool
otherwise = let ([Integer]
ks, Double
err) = ErrorImpact -> [ErrorImpact] -> Double -> ([Integer], Double)
lessErrSimpleDecomp5PG ErrorImpact
0 [] Double
k in (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. [a] -> [a]
cycle [Integer
1]) [Integer]
ks, Double
err)

-- | A variant of 'egyptianFractionDecomposition' where the fractions does not sum to some other
-- unit fraction instead (e. g. 1/3 + 1/10 + 1/15 == 1/2). More appropriate from the historical
-- point  of view. 
egyptianFractionDecomposition1G :: Double -> ([(Integer,Integer)], Double)
egyptianFractionDecomposition1G :: Double -> ([(Integer, Integer)], Double)
egyptianFractionDecomposition1G Double
k 
  | Double
k forall a. Ord a => a -> a -> Bool
> Double
2.0forall a. Fractional a => a -> a -> a
/Double
3.0 Bool -> Bool -> Bool
&& Double
k forall a. Ord a => a -> a -> Bool
<= Double
1.0 = 
       let ([Integer]
ks, Double
err) = ErrorImpact -> [ErrorImpact] -> Double -> ([Integer], Double)
lessErrSimpleDecomp5PG ErrorImpact
0 [] (Double
k forall a. Num a => a -> a -> a
- Double
2.0forall a. Fractional a => a -> a -> a
/Double
3.0) 
           sorted :: [Integer]
sorted = forall a. Ord a => [a] -> [a]
sort [Integer]
ks
           ([Integer]
qs,[Integer]
js) = forall a. ErrorImpact -> [a] -> ([a], [a])
splitAt ErrorImpact
3 [Integer]
sorted
           ks1 :: [Integer]
ks1 = [Integer] -> [Integer]
simplifiesToUnitFraction [Integer]
qs in ((Integer
2,Integer
3) forall a. a -> [a] -> [a]
: forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. [a] -> [a]
cycle [Integer
1]) ([Integer]
ks1 forall a. Monoid a => a -> a -> a
`mappend` [Integer]
js), Double
err)
  | Bool
otherwise = 
       let ([Integer]
ks, Double
err) = ErrorImpact -> [ErrorImpact] -> Double -> ([Integer], Double)
lessErrSimpleDecomp5PG ErrorImpact
0 [] Double
k
           sorted :: [Integer]
sorted = forall a. Ord a => [a] -> [a]
sort [Integer]
ks
           ([Integer]
qs,[Integer]
js) = forall a. ErrorImpact -> [a] -> ([a], [a])
splitAt ErrorImpact
3 [Integer]
sorted
           ks1 :: [Integer]
ks1 = [Integer] -> [Integer]
simplifiesToUnitFraction [Integer]
qs in (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. [a] -> [a]
cycle [Integer
1]) ([Integer]
ks1 forall a. Monoid a => a -> a -> a
`mappend` [Integer]
js), Double
err)


-- | The list must be sorted in the ascending order of the positive 'Integer' values greater or
-- equal to 2.
simplifiesToUnitFraction :: [Integer] -> [Integer]
simplifiesToUnitFraction :: [Integer] -> [Integer]
simplifiesToUnitFraction xs :: [Integer]
xs@(Integer
x:Integer
y:Integer
t:[Integer]
_) 
 | Integer
g4 forall a. Eq a => a -> a -> Bool
== Integer
s3 = [(Integer
xforall a. Num a => a -> a -> a
*Integer
yforall a. Num a => a -> a -> a
*Integer
t) forall a. Integral a => a -> a -> a
`quot` Integer
s3] 
 | Bool
g2 = [Integer] -> [Integer]
simplifiesToUnitFraction (Integer
xforall a. a -> [a] -> [a]
:[(Integer
y forall a. Num a => a -> a -> a
* Integer
t) forall a. Integral a => a -> a -> a
`quot` (Integer
y forall a. Num a => a -> a -> a
+ Integer
t)])
 | Bool
g3 = [Integer] -> [Integer]
simplifiesToUnitFraction [forall a. Ord a => a -> a -> a
min Integer
y ((Integer
x forall a. Num a => a -> a -> a
* Integer
t) forall a. Integral a => a -> a -> a
`quot` (Integer
x forall a. Num a => a -> a -> a
+ Integer
t)), forall a. Ord a => a -> a -> a
max Integer
y ((Integer
x forall a. Num a => a -> a -> a
* Integer
t) forall a. Integral a => a -> a -> a
`quot` (Integer
x forall a. Num a => a -> a -> a
+ Integer
t))]
 | Bool
g1 = [Integer] -> [Integer]
simplifiesToUnitFraction (((Integer
x forall a. Num a => a -> a -> a
* Integer
y) forall a. Integral a => a -> a -> a
`quot` (Integer
x forall a. Num a => a -> a -> a
+ Integer
y))forall a. a -> [a] -> [a]
:[Integer
t])
 | Bool
otherwise = [Integer]
xs
  where s3 :: Integer
s3 = (Integer
x forall a. Num a => a -> a -> a
* Integer
y forall a. Num a => a -> a -> a
+ Integer
y forall a. Num a => a -> a -> a
* Integer
t forall a. Num a => a -> a -> a
+ Integer
t forall a. Num a => a -> a -> a
* Integer
x)
        g4 :: Integer
g4 = forall a. Integral a => a -> a -> a
gcd Integer
s3 (Integer
x forall a. Num a => a -> a -> a
* Integer
y forall a. Num a => a -> a -> a
* Integer
t)
        g2 :: Bool
g2 = forall a. Integral a => a -> a -> a
gcd (Integer
y forall a. Num a => a -> a -> a
+ Integer
t) (Integer
y forall a. Num a => a -> a -> a
* Integer
t) forall a. Eq a => a -> a -> Bool
== (Integer
y forall a. Num a => a -> a -> a
+ Integer
t)
        g3 :: Bool
g3 = forall a. Integral a => a -> a -> a
gcd (Integer
x forall a. Num a => a -> a -> a
+ Integer
t) (Integer
x forall a. Num a => a -> a -> a
* Integer
t) forall a. Eq a => a -> a -> Bool
== (Integer
x forall a. Num a => a -> a -> a
+ Integer
t)
        g1 :: Bool
g1 = forall a. Integral a => a -> a -> a
gcd (Integer
x forall a. Num a => a -> a -> a
+ Integer
y) (Integer
x forall a. Num a => a -> a -> a
* Integer
y) forall a. Eq a => a -> a -> Bool
== (Integer
x forall a. Num a => a -> a -> a
+ Integer
y)
simplifiesToUnitFraction xs :: [Integer]
xs@(Integer
x:Integer
y:[Integer]
_) 
  = let s2 :: Integer
s2 = (Integer
x forall a. Num a => a -> a -> a
+ Integer
y)
        g2 :: Integer
g2 = forall a. Integral a => a -> a -> a
gcd Integer
s2 (Integer
x forall a. Num a => a -> a -> a
* Integer
y) in 
          if Integer
g2 forall a. Eq a => a -> a -> Bool
== Integer
s2 
              then [(Integer
xforall a. Num a => a -> a -> a
*Integer
y) forall a. Integral a => a -> a -> a
`quot` Integer
s2] 
              else [Integer]
xs
simplifiesToUnitFraction [Integer]
xs = [Integer]
xs
{-# INLiNABLE simplifiesToUnitFraction #-}