{-# 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 k 
  | k > 2.0/3.0 && k <= 1.0 = let (ks, err) = lessErrSimpleDecomp5PG 0 [] (k - 2.0/3.0) in ((2,3) : zip (cycle [1]) ks, err)
  | otherwise = let (ks, err) = lessErrSimpleDecomp5PG 0 [] k in (zip (cycle [1]) ks, 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 k 
  | k > 2.0/3.0 && k <= 1.0 = 
       let (ks, err) = lessErrSimpleDecomp5PG 0 [] (k - 2.0/3.0) 
           sorted = sort ks
           (qs,js) = splitAt 3 sorted
           ks1 = simplifiesToUnitFraction qs in ((2,3) : zip (cycle [1]) (ks1 `mappend` js), err)
  | otherwise = 
       let (ks, err) = lessErrSimpleDecomp5PG 0 [] k
           sorted = sort ks
           (qs,js) = splitAt 3 sorted
           ks1 = simplifiesToUnitFraction qs in (zip (cycle [1]) (ks1 `mappend` js), err)


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