-----------------------------------------------------------------------------
-- Copyright 2019, Ideas project team. This file is distributed under the
-- terms of the Apache License 2.0. For more information, see the files
-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
-----------------------------------------------------------------------------
-- |
-- Maintainer  :  bastiaan.heeren@ou.nl
-- Stability   :  provisional
-- Portability :  portable (depends on ghc)
--
-----------------------------------------------------------------------------

module Domain.Math.Numeric.Views
   ( -- * Natural numbers
     naturalView, naturalNF
     -- * Integers
   , integerView, integerNF
     -- * Decimal fractions
   , decimalFractionView
     -- * Rational numbers
   , rationalView, rationalNF
   , rationalRelaxedForm, fractionForm, rationalApproxView
     -- * Mixed fractions
   , mixedFractionView, mixedFractionNF
     -- * Double
   , doubleView, doubleNF
   ) where

import Control.Monad
import Data.Ratio
import Domain.Math.Expr hiding ((^))
import Domain.Math.Safe
import Ideas.Common.Id
import Ideas.Common.Rewriting (function)
import Ideas.Common.View
import Ideas.Utils.Uniplate (descend)
import qualified Domain.Math.Data.DecimalFraction as DF
import qualified Domain.Math.Data.MixedFraction as MF

-------------------------------------------------------------------
-- Natural numbers

-- |Non-negative numbers only, also for intermediate results
naturalView :: View Expr Integer
naturalView = "num.natural" @> makeView rec (fromInteger . abs)
 where
   rec :: Expr -> Maybe Integer
   rec expr = do
      x <- matchInteger rec expr
      guard (x >= 0)
      return x

naturalNF :: View Expr Integer
naturalNF = "num.natural.nf" @> makeView f (build naturalView)
 where
   f (Nat n) = Just n
   f _       = Nothing

-------------------------------------------------------------------
-- Integers

integerView :: View Expr Integer
integerView = "num.integer" @> makeView (fix matchInteger) fromIntegral

-- N or -N (where n is a natural number)
integerNF :: View Expr Integer
integerNF = "num.integer.nf" @> makeView (optionNegate f) fromInteger
 where
   f (Nat n) = Just n
   f _       = Nothing

matchInteger :: (Expr -> Maybe Integer) -> Expr -> Maybe Integer
matchInteger f expr =
   case expr of
      a :/: b -> join (safeDiv <$> f a <*> f b)
      Sqrt a  -> f a >>= safeSqrt
      Sym s [a, b]
         | isPowerSymbol s -> join (safePower <$> f a <*> f b)
         | isRootSymbol  s -> join (safeRoot  <$> f a <*> f b)
      _ -> matchNum f expr

matchNum :: Num a => (Expr -> Maybe a) -> Expr -> Maybe a
matchNum f expr =
   case expr of
      Nat n    -> return (fromInteger n)
      a :+: b  -> (+) <$> f a <*> f b
      a :-: b  -> (-) <$> f a <*> f b
      Negate a -> negate <$> f a
      a :*: b  -> (*) <$> f a <*> f b
      _        -> Nothing

-------------------------------------------------------------------
-- Decimal fractions

decimalFractionView :: View Expr DF.DecimalFraction
decimalFractionView = "num.decimal" @> makeView (fix matchDecimal) f
 where
   f = fromDouble . fromRational . toRational

matchDecimal :: (Expr -> Maybe DF.DecimalFraction) -> Expr -> Maybe DF.DecimalFraction
matchDecimal f expr =
   case expr of
      Number d -> Just (DF.fromDouble d)
      a :/: b  -> join (safeDiv <$> f a <*> f b)
      Sym s [a, b]
         | isPowerSymbol s -> join (safePower <$> f a <*> f b)
      Sym s [a, b, c]
         | isMixedFractionSymbol s -> f (a+b/c)
      _ -> matchNum f expr

-------------------------------------------------------------------
-- Rational numbers

-- |like  the original defintion, except that this view
-- now also converts floating point numbers (using an exact approximation)
rationalView :: View Expr Rational
rationalView = describe "Interpret an expression as a (normalized) rational \
   \number, performing computations such as addition and multiplication if \
   \necessary." $
   "number.rational" @> makeView f fromRational
 where
   f a = matchExact a >>= either (const Nothing) Just

matchRational :: (Expr -> Maybe Rational) -> Expr -> Maybe Rational
matchRational f expr =
   case expr of
      Number d -> return $ fromRational $ toRational $ DF.fromDouble d
      a :/: b  -> join (safeDiv <$> f a <*> f b)
      Sqrt a   -> f a >>= safeSqrt
      Sym s [a, b]
         | isPowerSymbol s -> join (safePower <$> f a <*> f b)
         | isRootSymbol  s -> join (safeRoot  <$> f a <*> f b)
      Sym s [a, b, c]
         | isMixedFractionSymbol s -> f (a+b/c)
      _ -> matchNum f expr

matchExact :: Expr -> Maybe (Either Double Rational)
matchExact expr =
   fmap Left (match doubleNF expr) `mplus`
   fmap Right (fix matchRational expr)

-- first convert (approximate!) all numbers to their decimal representation
rationalApproxView :: View Expr Rational
rationalApproxView = makeView (match rationalView . f) fromRational
 where
   f (Number d) = fromRational $ toRational $ DF.fromDouble d
   f expr       = descend f expr

-- 5, -(2/5), (-2)/5, but not 2/(-5), 6/8, or -((-2)/5)
rationalNF :: View Expr Rational
rationalNF = "num.rational.nf" @> makeView f fromRational
 where
   f (Nat a :/: Nat b) = simpleRational a b
   f (Negate (Nat a :/: Nat b)) = fmap negate (simpleRational a b)
   f (Negate (Nat a) :/: Nat b) = fmap negate (simpleRational a b)
   f a = fmap fromInteger (match integerNF a)

simpleRational :: Integer -> Integer -> Maybe Rational
simpleRational a b = do
   guard (a > 0 && b > 1 && gcd a b == 1)
   return (fromInteger a / fromInteger b)

fractionForm :: View Expr (Integer, Integer)
fractionForm = "num.fraction-form" @> makeView f g
 where
   f = match (divView >>> integerNF *** integerNF)
   g (a, b) = fromInteger a ./. fromInteger b

rationalRelaxedForm :: View Expr Rational
rationalRelaxedForm = "num.rational-relaxed" @> makeView (optionNegate f) fromRational
 where
   f (e1 :/: e2) = do
      a <- match integerNF e1
      b <- match integerNF e2
      safeDiv (fromInteger a) (fromInteger b)
   f (Nat n) = Just (fromInteger n)
   f _       = Nothing

-------------------------------------------------------------------
-- Mixed fractions

mixedFractionView :: View Expr MF.MixedFraction
mixedFractionView = "num.mixed-fraction" @> makeView f (sign g)
 where
   f = fmap fromRational . fix matchRational

   sign k a | a < 0     = negate (k (abs a))
            | otherwise = k a

   g a
      | frac  == 0 = fromInteger  whole
      | whole == 0 = fromRational frac
      | otherwise  = function mixedFractionSymbol $ map fromInteger parts
    where
      whole = MF.wholeNumber a
      frac  = MF.fractionPart a
      parts = [whole, numerator frac, denominator frac]

mixedFractionNF :: View Expr MF.MixedFraction
mixedFractionNF = describe "A normal form for mixed fractions. \
   \Improper fractions (numerator greater or equal to denominator) are not \
   \allowed." $
   "number.mixed-fraction.nf" @> makeView f (build mixedFractionView)
 where
   f (Sym s [Nat a, Nat b, Nat c])
      | isMixedFractionSymbol s = simple a b c
   f (Negate (Sym s [Nat a, Nat b, Nat c]))
      | isMixedFractionSymbol s = negate <$> simple a b c
   f expr = do r <- match rationalNF expr
               guard ((-1 < r && r < 1) || denominator r == 1)
               return (fromRational r)

   simple a b c = do
      guard (a > 0 && b > 0 && b < c)
      r <- simpleRational b c
      return (fromInteger a + fromRational r)

-------------------------------------------------------------------
-- Double (imprecise floating-points)

doubleView :: View Expr Double
doubleView = "num.double" @> makeView (fix matchDouble) fromDouble

doubleNF :: View Expr Double
doubleNF = "num.double.nf" @> makeView (optionNegate f) fromDouble
 where
   f (Number d) = Just d
   f _          = Nothing

matchDouble :: (Expr -> Maybe Double) -> Expr -> Maybe Double
matchDouble f expr =
   case expr of
      Number d -> Just d
      a :/: b  -> join (safeDiv <$> f a <*> f b)
      Sqrt a   -> f a >>= safeSqrt
      Sym s [a]
         | absSymbol == s  -> liftM abs (f a)
      Sym s [a, b]
         | isPowerSymbol s -> join (safePower <$> f a <*> f b)
         | isRootSymbol s  -> join (safeRoot  <$> f a <*> f b)
      Sym s [a, b, c]
         | isMixedFractionSymbol s -> f (a+b/c)
      _ -> matchNum f expr

-------------------------------------------------------------------
-- Helper functions

optionNegate :: (Eq a,Num a) => (Expr -> Maybe a) -> Expr -> Maybe a
optionNegate f (Negate a) = do b <- f a; guard (b /= 0); return (negate b)
optionNegate f a          = f a

fix :: (a -> a) -> a
fix f = f (fix f)