{-# LANGUAGE RebindableSyntax #-}
{- |
Copyright    :   (c) Henning Thielemann 2007
Maintainer   :   numericprelude@henning-thielemann.de
Stability    :   provisional
Portability  :   portable

Implementation of partial fractions.
Useful e.g. for fractions of integers and fractions of polynomials.

For the considered ring the prime factorization must be unique.
-}

module MathObj.PartialFraction where

import qualified Algebra.PrincipalIdealDomain as PID
import qualified Algebra.IntegralDomain       as Integral
import qualified Number.Ratio                 as Ratio
import qualified Algebra.Ring                 as Ring
import qualified Algebra.Additive             as Additive
import qualified Algebra.ZeroTestable         as ZeroTestable
import qualified Algebra.Indexable            as Indexable

import Number.Ratio((%))
import Algebra.IntegralDomain(divMod, divModZero, decomposeVarPositionalInf)
import Algebra.Units(stdAssociate, stdUnitInv)
import Algebra.Field((/))
import Algebra.Ring((*), one, product)
import Algebra.Additive((+), zero, negate)
import Algebra.ZeroTestable (isZero)

import qualified Data.List.Reverse.StrictSpine as Rev
import qualified Data.List.Match as Match
import qualified Data.List as List
import qualified Data.Map as Map
import Data.Map (Map)
import Data.List (group, sortBy, mapAccumR)
import Data.Maybe (fromMaybe)

import NumericPrelude.Base hiding (zipWith)

import NumericPrelude.Numeric(Int, fromInteger)


{- $setup
>>> import qualified MathObj.PartialFraction as PartialFraction
>>> import qualified MathObj.Polynomial.Core as PolyCore
>>> import qualified MathObj.Polynomial as Poly
>>> import qualified Algebra.PrincipalIdealDomain as PID
>>> import qualified Algebra.Indexable as Indexable
>>> import qualified Algebra.Laws as Laws
>>> import qualified Number.Ratio as Ratio
>>> import Test.NumericPrelude.Utility ((/\))
>>> import qualified Test.QuickCheck as QC
>>> import NumericPrelude.Numeric as NP
>>> import NumericPrelude.Base as P
>>> import Prelude ()
>>>
>>> import Control.Applicative (liftA2)
>>>
>>> {- |
>>> Generator of irreducible elements for tests.
>>> Choosing from a list of examples is a simple yet effective design.
>>> If we would construct irreducible elements by a clever algorithm
>>> we might obtain multiple primes only rarely.
>>> -} --
>>> genSmallPrime :: QC.Gen Integer
>>> genSmallPrime =
>>>    let primes = [2,3,5,7,11,13]
>>>    in  QC.elements (primes ++ map negate primes)
>>>
>>> genPartialFractionInt :: QC.Gen (PartialFraction.T Integer)
>>> genPartialFractionInt =
>>>    liftA2 PartialFraction.fromFactoredFraction
>>>       (QC.listOf genSmallPrime) QC.arbitrary
>>>
>>>
>>> genIrreduciblePolynomial :: QC.Gen (Poly.T Rational)
>>> genIrreduciblePolynomial = do
>>>    QC.NonZero unit <- QC.arbitrary
>>>    fmap (Poly.fromCoeffs . map (unit*)) $
>>>       QC.elements [[2,3],[2,0,1],[3,0,1],[1,-3,0,1]]
>>>
>>> genPartialFractionPoly :: QC.Gen (PartialFraction.T (Poly.T Rational))
>>> genPartialFractionPoly =
>>>    liftA2 PartialFraction.fromFactoredFraction
>>>       (fmap (take 3) $ QC.listOf genIrreduciblePolynomial)
>>>       (fmap (Poly.fromCoeffs . PolyCore.normalize . take 5) QC.arbitrary)
>>>
>>>
>>> fractionConv :: (PID.C a, Indexable.C a) => [a] -> a -> Bool
>>> fractionConv xs y =
>>>    PartialFraction.toFraction (PartialFraction.fromFactoredFraction xs y) ==
>>>    y % product xs
>>>
>>> fractionConvAlt :: (PID.C a, Indexable.C a) => [a] -> a -> Bool
>>> fractionConvAlt xs y =
>>>    PartialFraction.fromFactoredFraction xs y ==
>>>    PartialFraction.fromFactoredFractionAlt xs y
>>>
>>> scaleInt :: (PID.C a, Indexable.C a) => a -> PartialFraction.T a -> Bool
>>> scaleInt k a =
>>>    PartialFraction.toFraction (PartialFraction.scaleInt k a) ==
>>>    Ratio.scale k (PartialFraction.toFraction a)
>>>
>>> add, sub, mul ::
>>>    (PID.C a, Indexable.C a) =>
>>>    PartialFraction.T a -> PartialFraction.T a -> Bool
>>> add = Laws.homomorphism PartialFraction.toFraction (+) (+)
>>> sub = Laws.homomorphism PartialFraction.toFraction (-) (-)
>>> mul = Laws.homomorphism PartialFraction.toFraction (*) (*)
-}


{- |
@Cons z (indexMapFromList [(x0,[y00,y01]), (x1,[y10]), (x2,[y20,y21,y22])])@
represents the partial fraction
@z + y00/x0 + y01/x0^2 + y10/x1 + y20/x2 + y21/x2^2 + y22/x2^3@
The denominators @x0, x1, x2, ...@ must be irreducible,
but we can't check this in general.
It is also not enough to have relatively prime denominators,
because when adding two partial fraction representations
there might concur denominators that have non-trivial common divisors.
-}
data T a =
   Cons a (Map (Indexable.ToOrd a) [a])
      deriving (T a -> T a -> Bool
(T a -> T a -> Bool) -> (T a -> T a -> Bool) -> Eq (T a)
forall a. Eq a => T a -> T a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: T a -> T a -> Bool
$c/= :: forall a. Eq a => T a -> T a -> Bool
== :: T a -> T a -> Bool
$c== :: forall a. Eq a => T a -> T a -> Bool
Eq)

{- |
Unchecked construction.
-}
fromFractionSum :: (Indexable.C a) => a -> [(a,[a])] -> T a
fromFractionSum :: a -> [(a, [a])] -> T a
fromFractionSum a
z [(a, [a])]
m =
   a -> Map (ToOrd a) [a] -> T a
forall a. a -> Map (ToOrd a) [a] -> T a
Cons a
z ([(a, [a])] -> Map (ToOrd a) [a]
forall a b. C a => [(a, b)] -> Map (ToOrd a) b
indexMapFromList [(a, [a])]
m)

toFractionSum :: (Indexable.C a) => T a -> (a, [(a,[a])])
toFractionSum :: T a -> (a, [(a, [a])])
toFractionSum (Cons a
z Map (ToOrd a) [a]
m) =
   (a
z, Map (ToOrd a) [a] -> [(a, [a])]
forall a b. Map (ToOrd a) b -> [(a, b)]
indexMapToList Map (ToOrd a) [a]
m)

appPrec :: Int
appPrec :: Int
appPrec  = Int
10

instance (Show a) => Show (T a) where
  showsPrec :: Int -> T a -> ShowS
showsPrec Int
p (Cons a
z Map (ToOrd a) [a]
m) =
    Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
appPrec)
       (String -> ShowS
showString String
"PartialFraction.fromFractionSum " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int -> Int
forall a. Enum a => a -> a
succ Int
appPrec) a
z ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        [(a, [a])] -> ShowS
forall a. Show a => a -> ShowS
shows (Map (ToOrd a) [a] -> [(a, [a])]
forall a b. Map (ToOrd a) b -> [(a, b)]
indexMapToList Map (ToOrd a) [a]
m))


toFraction :: PID.C a => T a -> Ratio.T a
toFraction :: T a -> T a
toFraction (Cons a
z Map (ToOrd a) [a]
m) =
   let fracs :: [T a]
fracs = ((a, [a]) -> T a) -> [(a, [a])] -> [T a]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> [a] -> T a) -> (a, [a]) -> T a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> [a] -> T a
forall a. C a => a -> [a] -> T a
multiToFraction) (Map (ToOrd a) [a] -> [(a, [a])]
forall a b. Map (ToOrd a) b -> [(a, b)]
indexMapToList Map (ToOrd a) [a]
m)
   in  (T a -> T a -> T a) -> T a -> [T a] -> T a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl T a -> T a -> T a
forall a. C a => a -> a -> a
(+) (a -> T a
forall a. C a => a -> T a
Ratio.fromValue a
z) [T a]
fracs

{- |
'PrincipalIdealDomain.C' is not really necessary here and
only due to invokation of 'toFraction'.
-}
toFactoredFraction :: (PID.C a) => T a -> ([a], a)
toFactoredFraction :: T a -> ([a], a)
toFactoredFraction x :: T a
x@(Cons a
_ Map (ToOrd a) [a]
m) =
   let r :: T a
r = T a -> T a
forall a. C a => T a -> T a
toFraction T a
x
       denoms :: [a]
denoms = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$ Map (ToOrd a) [a] -> [[a]]
forall k a. Map k a -> [a]
Map.elems (Map (ToOrd a) [a] -> [[a]]) -> Map (ToOrd a) [a] -> [[a]]
forall a b. (a -> b) -> a -> b
$ (a -> [a] -> [a]) -> Map (ToOrd a) [a] -> Map (ToOrd a) [a]
forall a b c. (a -> b -> c) -> Map (ToOrd a) b -> Map (ToOrd a) c
indexMapMapWithKey (([a] -> a -> [a]) -> a -> [a] -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [a] -> a -> [a]
forall a b. [a] -> b -> [b]
Match.replicate) Map (ToOrd a) [a]
m
       numer :: T a
numer = (T a -> a -> T a) -> T a -> [a] -> T a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((a -> T a -> T a) -> T a -> a -> T a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> T a -> T a
forall a. C a => a -> T a -> T a
Ratio.scale) T a
r [a]
denoms
       {- From the theory it must be Ratio.denominator denom==1.
          We could check this dynamically, if there would be an Eq instance.
          We could omit this completely,
          if we would reimplement Ratio addition. -}
   in  ([a]
denoms, T a -> a
forall a. T a -> a
Ratio.numerator T a
numer)

{- |
'PrincipalIdealDomain.C' is not really necessary here and
only due to invokation of 'Ratio.%'.
-}
multiToFraction :: PID.C a => a -> [a] -> Ratio.T a
multiToFraction :: a -> [a] -> T a
multiToFraction a
denom =
   (a -> T a -> T a) -> T a -> [a] -> T a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
numer T a
acc ->
            (a -> T a
forall a. C a => a -> T a
Ratio.fromValue a
numer T a -> T a -> T a
forall a. C a => a -> a -> a
+ T a
acc) T a -> T a -> T a
forall a. C a => a -> a -> a
/ a -> T a
forall a. C a => a -> T a
Ratio.fromValue a
denom) T a
forall a. C a => a
zero

hornerRev :: Ring.C a => a -> [a] -> a
hornerRev :: a -> [a] -> a
hornerRev a
x = (a -> a -> a) -> a -> [a] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\a
val a
c -> a
vala -> a -> a
forall a. C a => a -> a -> a
*a
xa -> a -> a
forall a. C a => a -> a -> a
+a
c) a
forall a. C a => a
zero


{- |
@fromFactoredFraction x y@
computes the partial fraction representation of @y % product x@,
where the elements of @x@ must be irreducible.
The function transforms the factors into their standard form
with respect to unit factors.

There are more direct methods for special cases
like polynomials over rational numbers
where the denominators are linear factors.

prop> QC.listOf genSmallPrime /\ fractionConv
prop> fmap (take 3) (QC.listOf genIrreduciblePolynomial) /\ fractionConv
-}
fromFactoredFraction :: (PID.C a, Indexable.C a) => [a] -> a -> T a
fromFactoredFraction :: [a] -> a -> T a
fromFactoredFraction [a]
denoms0 a
numer0 =
   let denoms :: [[a]]
denoms = [a] -> [[a]]
forall a. Eq a => [a] -> [[a]]
group ([a] -> [[a]]) -> [a] -> [[a]]
forall a b. (a -> b) -> a -> b
$ (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy a -> a -> Ordering
forall a. C a => a -> a -> Ordering
Indexable.compare ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map a -> a
forall a. C a => a -> a
stdAssociate [a]
denoms0
       numer :: a
numer  = (a -> a -> a) -> a -> [a] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl a -> a -> a
forall a. C a => a -> a -> a
(*) a
numer0 ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map a -> a
forall a. C a => a -> a
stdUnitInv [a]
denoms0
       denomPowers :: [a]
denomPowers = ([a] -> a) -> [[a]] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> a
forall a. C a => [a] -> a
product [[a]]
denoms
          {- since the sub-lists contain the same value,
             the products are powers,
             which could be computed more efficiently -}
       partProdLeft :: [a]
partProdLeft         = (a -> a -> a) -> a -> [a] -> [a]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl a -> a -> a
forall a. C a => a -> a -> a
(*) a
forall a. C a => a
one [a]
denomPowers
       (a
prod:[a]
partProdRight) = (a -> a -> a) -> a -> [a] -> [a]
forall a b. (a -> b -> b) -> b -> [a] -> [b]
scanr a -> a -> a
forall a. C a => a -> a -> a
(*) a
forall a. C a => a
one [a]
denomPowers
       (a
intPart,a
numerRed) = a -> a -> (a, a)
forall a. C a => a -> a -> (a, a)
divMod a
numer a
prod
       facs :: [a]
facs = (a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
List.zipWith a -> a -> a
forall a. C a => a -> a -> a
(*) [a]
partProdLeft [a]
partProdRight
       numers :: [a]
numers =
          [a] -> Maybe [a] -> [a]
forall a. a -> Maybe a -> a
fromMaybe
             (String -> [a]
forall a. HasCallStack => String -> a
error (String -> [a]) -> String -> [a]
forall a b. (a -> b) -> a -> b
$ String
"PartialFraction.fromFactoredFraction: " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                      String
"denominators must be relatively prime")
             (a -> [a] -> Maybe [a]
forall a. C a => a -> [a] -> Maybe [a]
PID.diophantineMulti a
numerRed [a]
facs)
       pairs :: [(a, [a])]
pairs = ([a] -> a -> (a, [a])) -> [[a]] -> [a] -> [(a, [a])]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
List.zipWith [a] -> a -> (a, [a])
forall a. C a => [a] -> a -> (a, [a])
multiFromFraction [[a]]
denoms [a]
numers
       -- Is reduceHeads also necessary for polynomial partial fractions?
   in  T a -> T a
forall a. (C a, C a) => T a -> T a
removeZeros (T a -> T a) -> T a -> T a
forall a b. (a -> b) -> a -> b
$ T a -> T a
forall a. C a => T a -> T a
reduceHeads (T a -> T a) -> T a -> T a
forall a b. (a -> b) -> a -> b
$ a -> Map (ToOrd a) [a] -> T a
forall a. a -> Map (ToOrd a) [a] -> T a
Cons a
intPart ([(a, [a])] -> Map (ToOrd a) [a]
forall a b. C a => [(a, b)] -> Map (ToOrd a) b
indexMapFromList [(a, [a])]
pairs)

{- |
prop> QC.listOf genSmallPrime /\ fractionConvAlt
prop> fmap (take 3) (QC.listOf genIrreduciblePolynomial) /\ fractionConvAlt
-}
fromFactoredFractionAlt :: (PID.C a, Indexable.C a) => [a] -> a -> T a
fromFactoredFractionAlt :: [a] -> a -> T a
fromFactoredFractionAlt [a]
denoms a
numer =
   (T a -> a -> T a) -> T a -> [a] -> T a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\T a
p a
d -> T a -> T a -> T a
forall a. (C a, C a) => T a -> T a -> T a
scaleFrac (a
forall a. C a => a
onea -> a -> T a
forall a. C a => a -> a -> T a
%a
d) T a
p) (a -> T a
forall a. a -> T a
fromValue a
numer) [a]
denoms

{- |
The list of denominators must contain equal elements.
Sorry for this hack.
-}
multiFromFraction :: PID.C a => [a] -> a -> (a,[a])
multiFromFraction :: [a] -> a -> (a, [a])
multiFromFraction (a
d:[a]
ds) a
n =
   (a
d, [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a] -> a -> [a]
forall a. C a => [a] -> a -> [a]
decomposeVarPositionalInf [a]
ds a
n)
multiFromFraction [] a
_ =
   String -> (a, [a])
forall a. HasCallStack => String -> a
error String
"PartialFraction.multiFromFraction: there must be one denominator"

fromValue :: a -> T a
fromValue :: a -> T a
fromValue a
x = a -> Map (ToOrd a) [a] -> T a
forall a. a -> Map (ToOrd a) [a] -> T a
Cons a
x Map (ToOrd a) [a]
forall k a. Map k a
Map.empty


{- |
A normalization step which separates the integer part
from the leading fraction of each sub-list.
-}
reduceHeads :: Integral.C a => T a -> T a
reduceHeads :: T a -> T a
reduceHeads (Cons a
z Map (ToOrd a) [a]
m0) =
   let m1 :: Map (ToOrd a) (a, [a])
m1 = (a -> [a] -> (a, [a]))
-> Map (ToOrd a) [a] -> Map (ToOrd a) (a, [a])
forall a b c. (a -> b -> c) -> Map (ToOrd a) b -> Map (ToOrd a) c
indexMapMapWithKey (\a
x (a
y:[a]
ys) -> let (a
q,a
r) = a -> a -> (a, a)
forall a. C a => a -> a -> (a, a)
divMod a
y a
x in (a
q,a
ra -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys)) Map (ToOrd a) [a]
m0
   in  a -> Map (ToOrd a) [a] -> T a
forall a. a -> Map (ToOrd a) [a] -> T a
Cons
          ((a -> a -> a) -> a -> [a] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl a -> a -> a
forall a. C a => a -> a -> a
(+) a
z (((a, [a]) -> a) -> [(a, [a])] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, [a]) -> a
forall a b. (a, b) -> a
fst ([(a, [a])] -> [a]) -> [(a, [a])] -> [a]
forall a b. (a -> b) -> a -> b
$ Map (ToOrd a) (a, [a]) -> [(a, [a])]
forall k a. Map k a -> [a]
Map.elems Map (ToOrd a) (a, [a])
m1))
          (((a, [a]) -> [a]) -> Map (ToOrd a) (a, [a]) -> Map (ToOrd a) [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, [a]) -> [a]
forall a b. (a, b) -> b
snd Map (ToOrd a) (a, [a])
m1)

{- |
Cf. Number.Positional
-}
carryRipple :: Integral.C a => a -> [a] -> (a,[a])
carryRipple :: a -> [a] -> (a, [a])
carryRipple a
b =
   (a -> a -> (a, a)) -> a -> [a] -> (a, [a])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumR (\a
carry a
y -> a -> a -> (a, a)
forall a. C a => a -> a -> (a, a)
divMod (a
ya -> a -> a
forall a. C a => a -> a -> a
+a
carry) a
b) a
forall a. C a => a
zero


{- |
A normalization step which reduces all elements in sub-lists
modulo their denominators.
Zeros might be the result, that must be remove with 'removeZeros'.
-}
normalizeModulo :: Integral.C a => T a -> T a
normalizeModulo :: T a -> T a
normalizeModulo (Cons a
z0 Map (ToOrd a) [a]
m0) =
   let m1 :: Map (ToOrd a) (a, [a])
m1 = (a -> [a] -> (a, [a]))
-> Map (ToOrd a) [a] -> Map (ToOrd a) (a, [a])
forall a b c. (a -> b -> c) -> Map (ToOrd a) b -> Map (ToOrd a) c
indexMapMapWithKey a -> [a] -> (a, [a])
forall a. C a => a -> [a] -> (a, [a])
carryRipple Map (ToOrd a) [a]
m0
       -- would be nice to have a Map.unzip function
       ints :: [a]
ints = Map (ToOrd a) a -> [a]
forall k a. Map k a -> [a]
Map.elems (Map (ToOrd a) a -> [a]) -> Map (ToOrd a) a -> [a]
forall a b. (a -> b) -> a -> b
$ ((a, [a]) -> a) -> Map (ToOrd a) (a, [a]) -> Map (ToOrd a) a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, [a]) -> a
forall a b. (a, b) -> a
fst Map (ToOrd a) (a, [a])
m1
   in  a -> Map (ToOrd a) [a] -> T a
forall a. a -> Map (ToOrd a) [a] -> T a
Cons ((a -> a -> a) -> a -> [a] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl a -> a -> a
forall a. C a => a -> a -> a
(+) a
z0 [a]
ints) (((a, [a]) -> [a]) -> Map (ToOrd a) (a, [a]) -> Map (ToOrd a) [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, [a]) -> [a]
forall a b. (a, b) -> b
snd Map (ToOrd a) (a, [a])
m1)



{- |
Remove trailing zeros in sub-lists
because if lists are converted to fractions by 'multiToFraction'
we must be sure that the denominator of the (cancelled) fraction
is indeed the stored power of the irreducible denominator.
Otherwise 'mulFrac' leads to wrong results.
-}
removeZeros :: (Indexable.C a, ZeroTestable.C a) => T a -> T a
removeZeros :: T a -> T a
removeZeros (Cons a
z Map (ToOrd a) [a]
m) =
   a -> Map (ToOrd a) [a] -> T a
forall a. a -> Map (ToOrd a) [a] -> T a
Cons a
z (Map (ToOrd a) [a] -> T a) -> Map (ToOrd a) [a] -> T a
forall a b. (a -> b) -> a -> b
$ ([a] -> Bool) -> Map (ToOrd a) [a] -> Map (ToOrd a) [a]
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (Map (ToOrd a) [a] -> Map (ToOrd a) [a])
-> Map (ToOrd a) [a] -> Map (ToOrd a) [a]
forall a b. (a -> b) -> a -> b
$ ([a] -> [a]) -> Map (ToOrd a) [a] -> Map (ToOrd a) [a]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
Rev.dropWhile a -> Bool
forall a. C a => a -> Bool
isZero) Map (ToOrd a) [a]
m


{-
instance Functor (T a) where
   fmap f (Cons x) = Cons (fmap f x)
-}

zipWith :: (Indexable.C a) => (a -> a -> a) -> ([a] -> [a] -> [a]) ->
   (T a -> T a -> T a)
zipWith :: (a -> a -> a) -> ([a] -> [a] -> [a]) -> T a -> T a -> T a
zipWith a -> a -> a
opS [a] -> [a] -> [a]
opV (Cons a
za Map (ToOrd a) [a]
ma) (Cons a
zb Map (ToOrd a) [a]
mb) =
   a -> Map (ToOrd a) [a] -> T a
forall a. a -> Map (ToOrd a) [a] -> T a
Cons (a -> a -> a
opS a
za a
zb) (([a] -> [a] -> [a])
-> Map (ToOrd a) [a] -> Map (ToOrd a) [a] -> Map (ToOrd a) [a]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith [a] -> [a] -> [a]
opV Map (ToOrd a) [a]
ma Map (ToOrd a) [a]
mb)

{- |
prop> genPartialFractionInt /\ \x -> genPartialFractionInt /\ \y -> add x y
prop> genPartialFractionInt /\ \x -> genPartialFractionInt /\ \y -> sub x y

prop> genPartialFractionPoly /\ \x -> genPartialFractionPoly /\ \y -> add x y
prop> genPartialFractionPoly /\ \x -> genPartialFractionPoly /\ \y -> sub x y
-}
instance
   (Indexable.C a, Integral.C a, ZeroTestable.C a) =>
      Additive.C (T a) where
   T a
a + :: T a -> T a -> T a
+ T a
b = T a -> T a
forall a. (C a, C a) => T a -> T a
removeZeros (T a -> T a) -> T a -> T a
forall a b. (a -> b) -> a -> b
$ T a -> T a
forall a. C a => T a -> T a
normalizeModulo (T a -> T a) -> T a -> T a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> ([a] -> [a] -> [a]) -> T a -> T a -> T a
forall a.
C a =>
(a -> a -> a) -> ([a] -> [a] -> [a]) -> T a -> T a -> T a
zipWith a -> a -> a
forall a. C a => a -> a -> a
(+) [a] -> [a] -> [a]
forall a. C a => a -> a -> a
(+) T a
a T a
b
   {- This implementation is attracting but wrong.
     It fails if terms are present in b that are missing in a.
     Default implementation is better here.
     a - b = removeZeros $ normalizeModulo $ zipWith (-) (-) a b
   -}
   negate :: T a -> T a
negate (Cons a
z Map (ToOrd a) [a]
m) = a -> Map (ToOrd a) [a] -> T a
forall a. a -> Map (ToOrd a) [a] -> T a
Cons (a -> a
forall a. C a => a -> a
negate a
z) (([a] -> [a]) -> Map (ToOrd a) [a] -> Map (ToOrd a) [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> [a]
forall a. C a => a -> a
negate Map (ToOrd a) [a]
m)
   zero :: T a
zero = a -> T a
forall a. a -> T a
fromValue a
forall a. C a => a
zero

{- |
Transforms a product of two partial fractions
into a sum of two fractions.
The denominators must be at least relatively prime.
Since 'T' requires irreducible denominators,
these are also relatively prime.

Example: @mulFrac (1%6) (1%4)@ fails because of the common divisor @2@.
-}
mulFrac :: (PID.C a) => Ratio.T a -> Ratio.T a -> (a, a)
mulFrac :: T a -> T a -> (a, a)
mulFrac T a
x T a
y =
   let dx :: a
dx = T a -> a
forall a. T a -> a
Ratio.denominator T a
x
       dy :: a
dy = T a -> a
forall a. T a -> a
Ratio.denominator T a
y
   in  (a, a) -> Maybe (a, a) -> (a, a)
forall a. a -> Maybe a -> a
fromMaybe
          (String -> (a, a)
forall a. HasCallStack => String -> a
error String
"PartialFraction.mulFrac: denominators must be relatively prime")
          (a -> a -> a -> Maybe (a, a)
forall a. C a => a -> a -> a -> Maybe (a, a)
PID.diophantine (T a -> a
forall a. T a -> a
Ratio.numerator T a
x a -> a -> a
forall a. C a => a -> a -> a
* T a -> a
forall a. T a -> a
Ratio.numerator T a
y) a
dy a
dx)

{-
nx/dx * ny/dy = a/dx + b/dy
nx*ny = a*dy + b*dx
-}

mulFrac' :: (PID.C a) => Ratio.T a -> Ratio.T a -> (Ratio.T a, Ratio.T a)
mulFrac' :: T a -> T a -> (T a, T a)
mulFrac' T a
x T a
y =
   let (a
na,a
nb) = T a -> T a -> (a, a)
forall a. C a => T a -> T a -> (a, a)
mulFrac T a
x T a
y
   in  (a
na a -> a -> T a
forall a. C a => a -> a -> T a
% T a -> a
forall a. T a -> a
Ratio.denominator T a
x, a
nb a -> a -> T a
forall a. C a => a -> a -> T a
% T a -> a
forall a. T a -> a
Ratio.denominator T a
y)

{-
Also works if the operands share a non-trivial divisor.

mulFracOverlap :: (PID.C a) =>
   Ratio.T a -> Ratio.T a -> ((Ratio.T a, Ratio.T a), Ratio.T a)
mulFracOverlap x y =
   let dx = Ratio.denominator x
       dy = Ratio.denominator y
       (g,(a0,b0)) = extendedGCD dy dx
       (q,r) = divModZero (Ratio.numerator x * Ratio.numerator y) g
   in  if (isZero r)
         then ((q*a, q*b), zero)
         else
           let fx = divChecked dx g
               fy = divChecked dy g
               (g,(k,c)) = extendedGCD (g^2) (fx*fy)

given dx=fx*g and dy=fy*g with fx and fy are relatively prime:
nx/(g*fx) * ny/(g*fy) = a/fx + b/fy + c/g^2
nx*ny = a*fy*g^2 + b*fx*g^2 + c*fx*fy
      = a*dy*g   + b*dx*g   + c*fx*fy
a0*dy + b0*dx = g
a=a0*k
b=b0*k

This approach does still fail on 1%2 * 1%4.
-}

{- |
Works always but simply puts the product into the last fraction.
-}
mulFracStupid :: (PID.C a) =>
   Ratio.T a -> Ratio.T a -> ((Ratio.T a, Ratio.T a), Ratio.T a)
mulFracStupid :: T a -> T a -> ((T a, T a), T a)
mulFracStupid T a
x T a
y =
   let dx :: a
dx = T a -> a
forall a. T a -> a
Ratio.denominator T a
x
       dy :: a
dy = T a -> a
forall a. T a -> a
Ratio.denominator T a
y
       [a
a,a
b,a
c] =
          [a] -> Maybe [a] -> [a]
forall a. a -> Maybe a -> a
fromMaybe
             (String -> [a]
forall a. HasCallStack => String -> a
error String
"PartialFraction.mulFracOverlap: (gcd 1 x) must always be a unit")
             (a -> [a] -> Maybe [a]
forall a. C a => a -> [a] -> Maybe [a]
PID.diophantineMulti
                 (T a -> a
forall a. T a -> a
Ratio.numerator T a
x a -> a -> a
forall a. C a => a -> a -> a
* T a -> a
forall a. T a -> a
Ratio.numerator T a
y) [a
dy, a
dx, a
forall a. C a => a
one])
   in  ((a
a a -> a -> T a
forall a. C a => a -> a -> T a
% a
dx, a
b a -> a -> T a
forall a. C a => a -> a -> T a
% a
dy), a
ca -> a -> T a
forall a. C a => a -> a -> T a
%(a
dxa -> a -> a
forall a. C a => a -> a -> a
*a
dy))

{- |
Also works if the operands share a non-trivial divisor.
However the results are quite arbitrary.
-}
mulFracOverlap :: (PID.C a) =>
   Ratio.T a -> Ratio.T a -> ((Ratio.T a, Ratio.T a), Ratio.T a)
mulFracOverlap :: T a -> T a -> ((T a, T a), T a)
mulFracOverlap T a
x T a
y =
   let dx :: a
dx = T a -> a
forall a. T a -> a
Ratio.denominator T a
x
       dy :: a
dy = T a -> a
forall a. T a -> a
Ratio.denominator T a
y
       nx :: a
nx = T a -> a
forall a. T a -> a
Ratio.numerator T a
x
       ny :: a
ny = T a -> a
forall a. T a -> a
Ratio.numerator T a
y
       (a
g,(a
a,a
b)) = a -> a -> (a, (a, a))
forall a. C a => a -> a -> (a, (a, a))
PID.extendedGCD a
dy a
dx
       (a
q,a
r) = a -> a -> (a, a)
forall a. (C a, C a) => a -> a -> (a, a)
divModZero (a
nxa -> a -> a
forall a. C a => a -> a -> a
*a
ny) a
g
   in  (((a
qa -> a -> a
forall a. C a => a -> a -> a
*a
a)a -> a -> T a
forall a. C a => a -> a -> T a
%a
dx, (a
qa -> a -> a
forall a. C a => a -> a -> a
*a
b)a -> a -> T a
forall a. C a => a -> a -> T a
%a
dy), a
ra -> a -> T a
forall a. C a => a -> a -> T a
%(a
dxa -> a -> a
forall a. C a => a -> a -> a
*a
dy))


{- |
Expects an irreducible denominator as associate in standard form.
-}
scaleFrac :: (PID.C a, Indexable.C a) => Ratio.T a -> T a -> T a
scaleFrac :: T a -> T a -> T a
scaleFrac T a
s (Cons a
z0 Map (ToOrd a) [a]
m) =
   let ns :: a
ns = T a -> a
forall a. T a -> a
Ratio.numerator T a
s
       ds :: a
ds = T a -> a
forall a. T a -> a
Ratio.denominator T a
s
       dsOrd :: ToOrd a
dsOrd = a -> ToOrd a
forall a. a -> ToOrd a
Indexable.toOrd a
ds
       -- (z,zr) = Ratio.split (Ratio.scale z0 s)
       (a
z,a
zr) = a -> a -> (a, a)
forall a. C a => a -> a -> (a, a)
divMod (a
z0a -> a -> a
forall a. C a => a -> a -> a
*a
ns) a
ds
       scaleFracs :: Map (ToOrd a) [a] -> Map (ToOrd a) [a]
scaleFracs =
          (\([a]
scs,[([a], a)]
fracs) ->
             ToOrd a -> [a] -> Map (ToOrd a) [a] -> Map (ToOrd a) [a]
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ToOrd a
dsOrd [(a -> a -> a) -> a -> [a] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl a -> a -> a
forall a. C a => a -> a -> a
(+) a
zr [a]
scs] (Map (ToOrd a) [a] -> Map (ToOrd a) [a])
-> Map (ToOrd a) [a] -> Map (ToOrd a) [a]
forall a b. (a -> b) -> a -> b
$
                [(a, [a])] -> Map (ToOrd a) [a]
forall a b. C a => [(a, b)] -> Map (ToOrd a) b
indexMapFromList ([(a, [a])] -> Map (ToOrd a) [a])
-> [(a, [a])] -> Map (ToOrd a) [a]
forall a b. (a -> b) -> a -> b
$
                   (([a], a) -> (a, [a])) -> [([a], a)] -> [(a, [a])]
forall a b. (a -> b) -> [a] -> [b]
map (([a] -> a -> (a, [a])) -> ([a], a) -> (a, [a])
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [a] -> a -> (a, [a])
forall a. C a => [a] -> a -> (a, [a])
multiFromFraction) [([a], a)]
fracs) (([a], [([a], a)]) -> Map (ToOrd a) [a])
-> (Map (ToOrd a) [a] -> ([a], [([a], a)]))
-> Map (ToOrd a) [a]
-> Map (ToOrd a) [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          [(a, ([a], a))] -> ([a], [([a], a)])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(a, ([a], a))] -> ([a], [([a], a)]))
-> (Map (ToOrd a) [a] -> [(a, ([a], a))])
-> Map (ToOrd a) [a]
-> ([a], [([a], a)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          (([a], T a) -> (a, ([a], a))) -> [([a], T a)] -> [(a, ([a], a))]
forall a b. (a -> b) -> [a] -> [b]
map (\([a]
dis,T a
r) ->
                 let (a
sc,a
rc) = T a -> T a -> (a, a)
forall a. C a => T a -> T a -> (a, a)
mulFrac T a
s T a
r
                 in  (a
sc, ([a]
dis, a
rc))) ([([a], T a)] -> [(a, ([a], a))])
-> (Map (ToOrd a) [a] -> [([a], T a)])
-> Map (ToOrd a) [a]
-> [(a, ([a], a))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          Map (ToOrd a) ([a], T a) -> [([a], T a)]
forall k a. Map k a -> [a]
Map.elems (Map (ToOrd a) ([a], T a) -> [([a], T a)])
-> (Map (ToOrd a) [a] -> Map (ToOrd a) ([a], T a))
-> Map (ToOrd a) [a]
-> [([a], T a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          (a -> [a] -> ([a], T a))
-> Map (ToOrd a) [a] -> Map (ToOrd a) ([a], T a)
forall a b c. (a -> b -> c) -> Map (ToOrd a) b -> Map (ToOrd a) c
indexMapMapWithKey
             (\a
d [a]
l -> ([a] -> a -> [a]
forall a b. [a] -> b -> [b]
Match.replicate [a]
l a
d, a -> [a] -> T a
forall a. C a => a -> [a] -> T a
multiToFraction a
d [a]
l))
   in  T a -> T a
forall a. (C a, C a) => T a -> T a
removeZeros (T a -> T a) -> T a -> T a
forall a b. (a -> b) -> a -> b
$ T a -> T a
forall a. C a => T a -> T a
reduceHeads (T a -> T a) -> T a -> T a
forall a b. (a -> b) -> a -> b
$ a -> Map (ToOrd a) [a] -> T a
forall a. a -> Map (ToOrd a) [a] -> T a
Cons a
z
          (ToOrd a
-> ([a] -> [a] -> [a])
-> ([a] -> [a])
-> (Map (ToOrd a) [a] -> Map (ToOrd a) [a])
-> Map (ToOrd a) [a]
-> Map (ToOrd a) [a]
forall a c b.
Ord a =>
a
-> (c -> c -> c)
-> (b -> c)
-> (Map a b -> Map a c)
-> Map a b
-> Map a c
mapApplySplit ToOrd a
dsOrd [a] -> [a] -> [a]
forall a. C a => a -> a -> a
(+)
             ((a -> [a] -> [a]) -> (a, [a]) -> [a]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) ((a, [a]) -> [a]) -> ([a] -> (a, [a])) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a] -> (a, [a])
forall a. C a => a -> [a] -> (a, [a])
carryRipple a
ds ([a] -> (a, [a])) -> ([a] -> [a]) -> [a] -> (a, [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a
nsa -> a -> a
forall a. C a => a -> a -> a
*))
             Map (ToOrd a) [a] -> Map (ToOrd a) [a]
scaleFracs Map (ToOrd a) [a]
m)

{- |
prop> genPartialFractionInt /\ \x k -> scaleInt k x
prop> genPartialFractionPoly /\ \x k -> scaleInt k x
-}
scaleInt :: (PID.C a, Indexable.C a) => a -> T a -> T a
scaleInt :: a -> T a -> T a
scaleInt a
x (Cons a
z Map (ToOrd a) [a]
m) =
   T a -> T a
forall a. (C a, C a) => T a -> T a
removeZeros (T a -> T a) -> T a -> T a
forall a b. (a -> b) -> a -> b
$ T a -> T a
forall a. C a => T a -> T a
normalizeModulo (T a -> T a) -> T a -> T a
forall a b. (a -> b) -> a -> b
$
      a -> Map (ToOrd a) [a] -> T a
forall a. a -> Map (ToOrd a) [a] -> T a
Cons (a
xa -> a -> a
forall a. C a => a -> a -> a
*a
z) (([a] -> [a]) -> Map (ToOrd a) [a] -> Map (ToOrd a) [a]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a
xa -> a -> a
forall a. C a => a -> a -> a
*)) Map (ToOrd a) [a]
m)


mul :: (PID.C a, Indexable.C a) => T a -> T a -> T a
mul :: T a -> T a -> T a
mul (Cons a
z Map (ToOrd a) [a]
m) T a
a =
   (T a -> T a -> T a) -> T a -> [T a] -> T a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
      T a -> T a -> T a
forall a. C a => a -> a -> a
(+) (a -> T a -> T a
forall a. (C a, C a) => a -> T a -> T a
scaleInt a
z T a
a)
      (((a, [a]) -> T a) -> [(a, [a])] -> [T a]
forall a b. (a -> b) -> [a] -> [b]
map (\(a
d,[a]
l) ->
              -- cf. to multiToFraction
              (a -> T a -> T a) -> T a -> [a] -> T a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
numer T a
acc ->
                 T a -> T a -> T a
forall a. (C a, C a) => T a -> T a -> T a
scaleFrac (a
forall a. C a => a
onea -> a -> T a
forall a. C a => a -> a -> T a
%a
d) (a -> T a -> T a
forall a. (C a, C a) => a -> T a -> T a
scaleInt a
numer T a
a T a -> T a -> T a
forall a. C a => a -> a -> a
+ T a
acc)) T a
forall a. C a => a
zero [a]
l)
           (Map (ToOrd a) [a] -> [(a, [a])]
forall a b. Map (ToOrd a) b -> [(a, b)]
indexMapToList Map (ToOrd a) [a]
m))

{- |
prop> genPartialFractionInt /\ \x -> genPartialFractionInt /\ \y -> mul x y
prop> genPartialFractionPoly /\ \x -> genPartialFractionPoly /\ \y -> mul x y
-}
mulFast :: (PID.C a, Indexable.C a) => T a -> T a -> T a
mulFast :: T a -> T a -> T a
mulFast T a
pa T a
pb =
   let ra :: ([a], a)
ra = T a -> ([a], a)
forall a. C a => T a -> ([a], a)
toFactoredFraction T a
pa
       rb :: ([a], a)
rb = T a -> ([a], a)
forall a. C a => T a -> ([a], a)
toFactoredFraction T a
pb
   in  [a] -> a -> T a
forall a. (C a, C a) => [a] -> a -> T a
fromFactoredFraction (([a], a) -> [a]
forall a b. (a, b) -> a
fst ([a], a)
ra [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ ([a], a) -> [a]
forall a b. (a, b) -> a
fst ([a], a)
rb) (([a], a) -> a
forall a b. (a, b) -> b
snd ([a], a)
ra a -> a -> a
forall a. C a => a -> a -> a
* ([a], a) -> a
forall a b. (a, b) -> b
snd ([a], a)
rb)


instance (PID.C a, Indexable.C a) => Ring.C (T a) where
   one :: T a
one = a -> T a
forall a. a -> T a
fromValue a
forall a. C a => a
one
   * :: T a -> T a -> T a
(*) = T a -> T a -> T a
forall a. (C a, C a) => T a -> T a -> T a
mulFast


{- * Helper functions for work with Maps with Indexable keys -}

indexMapMapWithKey :: (a -> b -> c)
                      -> Map (Indexable.ToOrd a) b
                      -> Map (Indexable.ToOrd a) c
indexMapMapWithKey :: (a -> b -> c) -> Map (ToOrd a) b -> Map (ToOrd a) c
indexMapMapWithKey a -> b -> c
f = (ToOrd a -> b -> c) -> Map (ToOrd a) b -> Map (ToOrd a) c
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (a -> b -> c
f (a -> b -> c) -> (ToOrd a -> a) -> ToOrd a -> b -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ToOrd a -> a
forall a. ToOrd a -> a
Indexable.fromOrd)

indexMapToList :: Map (Indexable.ToOrd a) b -> [(a, b)]
indexMapToList :: Map (ToOrd a) b -> [(a, b)]
indexMapToList = ((ToOrd a, b) -> (a, b)) -> [(ToOrd a, b)] -> [(a, b)]
forall a b. (a -> b) -> [a] -> [b]
map (\(ToOrd a
k,b
e) -> (ToOrd a -> a
forall a. ToOrd a -> a
Indexable.fromOrd ToOrd a
k, b
e)) ([(ToOrd a, b)] -> [(a, b)])
-> (Map (ToOrd a) b -> [(ToOrd a, b)])
-> Map (ToOrd a) b
-> [(a, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (ToOrd a) b -> [(ToOrd a, b)]
forall k a. Map k a -> [(k, a)]
Map.toList

indexMapFromList :: Indexable.C a => [(a, b)] -> Map (Indexable.ToOrd a) b
indexMapFromList :: [(a, b)] -> Map (ToOrd a) b
indexMapFromList = [(ToOrd a, b)] -> Map (ToOrd a) b
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ToOrd a, b)] -> Map (ToOrd a) b)
-> ([(a, b)] -> [(ToOrd a, b)]) -> [(a, b)] -> Map (ToOrd a) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> (ToOrd a, b)) -> [(a, b)] -> [(ToOrd a, b)]
forall a b. (a -> b) -> [a] -> [b]
map (\(a
k,b
e) -> (a -> ToOrd a
forall a. a -> ToOrd a
Indexable.toOrd a
k, b
e))

{- |
Apply a function on a specific element if it exists,
and another function to the rest of the map.
-}
mapApplySplit :: Ord a =>
   a -> (c -> c -> c) -> 
   (b -> c) -> (Map a b -> Map a c) -> Map a b -> Map a c
mapApplySplit :: a
-> (c -> c -> c)
-> (b -> c)
-> (Map a b -> Map a c)
-> Map a b
-> Map a c
mapApplySplit a
key c -> c -> c
addOp b -> c
f Map a b -> Map a c
g Map a b
m =
   Map a c -> (b -> Map a c) -> Maybe b -> Map a c
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      (Map a b -> Map a c
g Map a b
m)
      (\b
x -> (c -> c -> c) -> a -> c -> Map a c -> Map a c
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith c -> c -> c
addOp a
key (b -> c
f b
x) (Map a c -> Map a c) -> Map a c -> Map a c
forall a b. (a -> b) -> a -> b
$ Map a b -> Map a c
g (a -> Map a b -> Map a b
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete a
key Map a b
m))
      (a -> Map a b -> Maybe b
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup a
key Map a b
m)