{-# LANGUAGE RebindableSyntax #-}
{- |
This module computes power series for
representing some means as generalized $f$-means.
-}
module MathObj.PowerSeries.Mean where

import qualified MathObj.PowerSeries2        as PS2
import qualified MathObj.PowerSeries2.Core   as PS2Core
import qualified MathObj.PowerSeries         as PS
import qualified MathObj.PowerSeries.Core    as PSCore
import qualified MathObj.PowerSeries.Example as PSE

import qualified Algebra.Field as Field
import qualified Algebra.Ring  as Ring

import Data.List.HT (shearTranspose)

import NumericPrelude.Numeric
import NumericPrelude.Base

{-
$M_f$ is a generalized $f$-mean (quasi-arithmetic) if
\[M_f x = f^{ -1}\right(\frac{1}{n}\cdot\sum_{k=1}^{n} f(x_k)\left)\]

For instance there is the logarithmic mean
defined by
\[\frac{x-y}{\ln x - \ln y}\]
whose definition is inherently bound to two variables.
If we find a representation as a generalized $f$-mean
we can generalize this mean to more than two variables.

Btw. we can easily see that the logarithmic mean is not a quasi-arithmetic mean,
because \[ \anonymfunc{(a,b,c,d)}{L(L(a,b),L(c,d))} \]
is not commutative, but quasi-arithmetic means are always commutative.

First we note that an arbitrary constant offset and
an arbitrary scaling of $f$ does not alter the mean.
Therefore we choose $f(1)=0, f'(1)=1$
and we expand $f$ into a Taylor series with respect to 1.

For the logarithmic mean we will choose $y=0$.
This way we might get additional virtual solutions,
but we can identify them afterwards by a test.
\begin{eqnarray*}
f^{ -1}\left(\frac{f(1+x)+f(1+y)}{2}\right)
 &=& \frac{x-y}{\ln(1+x) - \ln(1+y)} \\
f^{ -1}\left(\frac{f(1+x)}{2}\right)
 &=& \frac{x}{\ln(1+x)} \\
f(1+x)
 &=& 2 \cdot f\left(\frac{x}{\ln(1+x)}\right)
\end{eqnarray*}
This cannot be solved immediately
because in the power series expansions on both sides
unknown coefficients occur at the same monomials.
We can resolve that by subtracting the series of $2\cdot f(1+x/2)$
off both sides.
\begin{eqnarray*}
f(1+x) - 2\cdot f(1+x/2)
 &=& 2 \cdot (f\left(\frac{x}{\ln(1+x)}\right) - f(1+x/2))
\end{eqnarray*}
We note that $1+x/2$ is the truncated series of $\frac{x}{\ln(1+x)}$.
This is also necessary in order to obtain an equation.

Now we have to derive an implementation of the right-hand side.
This is a difference of two series compositions, namely
$f(x+a*x^2+b*x^3+\dots) - f(x)$ .
The implementation takes care that the vanishing terms are not computed
and thus allows solution of series fixed point equations.
It is just done by throwing away the leading terms of all powers
of the series $x+a*x^2+b*x^3+\dots$.
In $x$ the constant monomial is omitted,
in the result both the constant and the linear term are omitted.
-}

diffComp :: (Ring.C a) => [a] -> [a] -> [a]
diffComp :: [a] -> [a] -> [a]
diffComp [a]
ys [a]
x =
   ([a] -> a) -> [[a]] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> a
forall a. C a => [a] -> a
sum ([[a]] -> [[a]]
forall a. [[a]] -> [[a]]
shearTranspose ([[a]] -> [[a]]
forall a. [a] -> [a]
tail ((a -> [a] -> [a]) -> [a] -> [[a]] -> [[a]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> [a] -> [a]
forall a. C a => a -> [a] -> [a]
PSCore.scale [a]
ys
                    (([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> [a]
forall a. [a] -> [a]
tail (([a] -> [a]) -> [a] -> [[a]]
forall a. (a -> a) -> a -> [a]
iterate ([a] -> [a] -> [a]
forall a. C a => [a] -> [a] -> [a]
PSCore.mul [a]
x) [a
1])))))

{-
Now we solve
\[
\frac{1}{2}\cdot f(1+2\cdot x) - f(1+x)
 &=& f\left(\frac{2\cdot x}{\ln(1+2\cdot x)}\right) - f(1+x)
\]
-}

logarithmic :: (Field.C a) => [a]
logarithmic :: [a]
logarithmic =
   let -- series for \frac{2\cdot x}{\ln(1+2\cdot x)}
       fracLn :: [a]
fracLn = [a] -> [a] -> [a]
forall a. C a => [a] -> [a] -> [a]
PSCore.divide [a
2]
                      ([a] -> [a]
forall a. [a] -> [a]
tail ((a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> a
forall a. C a => a -> a -> a
(*) ((a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate (a
2a -> a -> a
forall a. C a => a -> a -> a
*) a
1) [a]
forall a. C a => [a]
PSE.log))
       fDiffFracLn :: [a]
fDiffFracLn = [a] -> [a] -> [a]
forall a. C a => [a] -> [a] -> [a]
diffComp [a]
f ([a] -> [a]
forall a. [a] -> [a]
tail [a]
fracLn)
       f :: [a]
f = a
0 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
1 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> a
forall a. C a => a -> a -> a
(/) [a]
fDiffFracLn
                      ((a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a -> a
forall a. C a => a -> a -> a
subtract a
1) ((a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate (a
2a -> a -> a
forall a. C a => a -> a -> a
*) a
2))
   in  [a]
f

elemSym3_2 :: (Field.C a) => [a]
elemSym3_2 :: [a]
elemSym3_2 =
   let -- series for \frac{2\cdot x}{\ln(1+2\cdot x)}
       root :: [a]
root = (a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> a
forall a. C a => a -> a -> a
(*) ((a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate (a
2a -> a -> a
forall a. C a => a -> a -> a
*) a
1) [a]
forall a. C a => [a]
PSE.sqrt
       fDiffRoot :: [a]
fDiffRoot = [a] -> [a] -> [a]
forall a. C a => [a] -> [a] -> [a]
diffComp [a]
f ([a] -> [a]
forall a. [a] -> [a]
tail [a]
root)
       f :: [a]
f = a
0 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
1 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> a
forall a. C a => a -> a -> a
(/) [a]
fDiffRoot
                      ((a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a -> a
forall a. C a => a -> a -> a
subtract a
1) ((a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate (a
3a -> a -> a
forall a. C a => a -> a -> a
*) a
3))
   in  [a]
f


{-
Means constructed by mean value theorem.

\[ M(x,y) = f'^{ -1}((f(x)-f(y))/(x-y)) \]

\[ f(x) = x^2  \implies M - arithmetic mean \]
\[ f(x) = 1/x  \implies M - geometric mean \]

Try to find a power series for $f$ for $M(x,y) = \sqrt{(x^2+y^2)/2}$
(quadratic mean).
Expansion point: 1.
$M(1+t,1) = \sqrt{1+t+t^2/2}$
-}
quadratic :: (Field.C a, Eq a) => [a]
quadratic :: [a]
quadratic = (a -> a) -> [a] -> [a]
forall a. C a => (a -> a) -> [a] -> [a]
PSCore.sqrt (\a
1 -> a
1) [a
1,a
1,a
1a -> a -> a
forall a. C a => a -> a -> a
/a
2]

quadraticMVF :: (Field.C a) => [a]
quadraticMVF :: [a]
quadraticMVF =
   -- [1,1,1,1,1/2,3/23,2/143]
   -- [1,1,1,1,1/2,1/2]
   [a
1,a
1,a
1,a
1,a
1a -> a -> a
forall a. C a => a -> a -> a
/a
2,-a
1a -> a -> a
forall a. C a => a -> a -> a
/a
14]

-- map (\x -> PSCore.coeffs (meanValueDiff2 quadratic2 [1,1,1,1,1/2,x] !! 4) !! 2) (GNUPlot.linearScale 10 (-0.071429,-1/14::Double))
-- take 20 $ Numerics.ZeroFinder.RegulaFalsi.zero (-1,0) (\x -> PSCore.coeffs (meanValueDiff2 quadratic2 [1::Double,1,1,1,1/2,x] !! 4) !! 2)

{-
Result: It seems,
that we cannot find an appropriate coefficient for the 5th power.
This indicates that it is not possible to represent
the quadratic mean as mean value mean.
-}

quadraticDiff :: (Field.C a, Eq a) => [a]
quadraticDiff :: [a]
quadraticDiff =
   let divDiffPS :: [a]
divDiffPS = [a] -> [a]
forall a. [a] -> [a]
tail [a]
forall a. C a => [a]
quadraticMVF -- (f(1+t)-f(1))/((1+t)-1)
       (a
1, [a]
invPS) = [a] -> (a, [a])
forall a. (Eq a, C a) => [a] -> (a, [a])
PSCore.inv ([a] -> [a]
forall a. C a => [a] -> [a]
PSCore.differentiate [a]
forall a. C a => [a]
quadraticMVF)
       meanValuePS :: [a]
meanValuePS = (a -> [a]) -> [a] -> [a]
forall a. C a => (a -> [a]) -> [a] -> [a]
PSCore.composeTaylor (\a
1 -> [a]
invPS) [a]
divDiffPS
       {- instead of computing an inverse series
          we could also apply (compose) the derived series
          to the series of the quadratic mean. -}
   in  [a]
forall a. (C a, Eq a) => [a]
quadratic [a] -> [a] -> [a]
forall a. C a => a -> a -> a
- [a]
meanValuePS

{-
Represent quadratic mean with a two-variate power series.

$M(1+x,1+y) = \sqrt{1+x+y+(x^2+y^2)/2}$
-}
quadratic2 :: (Field.C a, Eq a) => PS2Core.T a
quadratic2 :: T a
quadratic2 =
   (a -> a) -> T a -> T a
forall a. C a => (a -> a) -> T a -> T a
PS2Core.sqrt (\a
1 -> a
1) [[a
1],[a
1,a
1],[a
1a -> a -> a
forall a. C a => a -> a -> a
/a
2,a
0,a
1a -> a -> a
forall a. C a => a -> a -> a
/a
2]]

quadraticDiff2 :: (Field.C a, Eq a) => PS2Core.T a
quadraticDiff2 :: T a
quadraticDiff2 =
   T a -> [a] -> T a
forall a. (C a, Eq a) => T a -> [a] -> T a
meanValueDiff2 T a
forall a. (C a, Eq a) => T a
quadratic2 [a]
forall a. C a => [a]
quadraticMVF



{-
We can alter the square coefficient,
but consequently we have to scale the sub-sequent coefficients.
If the square coefficient is zero then the equation is fulfilled,
but this is a non-solution because it is degenerate.
-}
harmonicMVF :: (Field.C a) => [a]
harmonicMVF :: [a]
harmonicMVF =
   -- [1,1,1,-2,7/2,-62/11]
   -- [1,1,2,-4,7,-124/11]
   [a
1,a
1,a
3,-a
6,a
21a -> a -> a
forall a. C a => a -> a -> a
/a
2,-a
186a -> a -> a
forall a. C a => a -> a -> a
/a
11]

{-
$M(1+x,1+y) = 2/(recip (1+x) + recip (1+y))$
-}
harmonic2 :: (Field.C a, Eq a) => PS2Core.T a
harmonic2 :: T a
harmonic2 =
   let rec :: T a
rec = [a] -> T a
forall a. [a] -> T a
PS.fromCoeffs [a]
forall a. C a => [a]
PSE.recip
   in  T a -> T a -> T a
forall a. C a => T a -> T a -> T a
PS2Core.divide [[a
2]] (T a -> T a) -> T a -> T a
forall a b. (a -> b) -> a -> b
$
       T a -> T a
forall a. T a -> T a
PS2.coeffs (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
PS2.fromPowerSeries0 T a
rec T a -> T a -> T a
forall a. C a => a -> a -> a
+
          T a -> T a
forall a. C a => T a -> T a
PS2.fromPowerSeries1 T a
rec

harmonicDiff2 :: (Field.C a, Eq a) => PS2Core.T a
harmonicDiff2 :: T a
harmonicDiff2 =
   T a -> [a] -> T a
forall a. (C a, Eq a) => T a -> [a] -> T a
meanValueDiff2 T a
forall a. (C a, Eq a) => T a
harmonic2 [a]
forall a. C a => [a]
harmonicMVF



arithmeticMVF :: (Field.C a) => [a]
arithmeticMVF :: [a]
arithmeticMVF = [a
1,a
2,a
1]

{-
$M(1+x,1+y) = 1+x/2+y/2$
-}
arithmetic2 :: (Field.C a, Eq a) => PS2Core.T a
arithmetic2 :: T a
arithmetic2 = [[a
1],[a
1a -> a -> a
forall a. C a => a -> a -> a
/a
2,a
1a -> a -> a
forall a. C a => a -> a -> a
/a
2]]

arithmeticDiff2 :: (Field.C a, Eq a) => PS2Core.T a
arithmeticDiff2 :: T a
arithmeticDiff2 =
   T a -> [a] -> T a
forall a. (C a, Eq a) => T a -> [a] -> T a
meanValueDiff2 T a
forall a. (C a, Eq a) => T a
arithmetic2 [a]
forall a. C a => [a]
arithmeticMVF


geometricMVF :: (Field.C a) => [a]
geometricMVF :: [a]
geometricMVF = [a]
forall a. C a => [a]
PSE.recip

{-
$M(1+x,1+y) = \sqrt{(1+x)·(1+y)}$
-}
geometric2 :: (Field.C a, Eq a) => PS2Core.T a
geometric2 :: T a
geometric2 =
   (a -> a) -> T a -> T a
forall a. C a => (a -> a) -> T a -> T a
PS2Core.sqrt (\a
1 -> a
1) [[a
1],[a
1,a
1],[a
0,a
1,a
0]]

geometricDiff2 :: (Field.C a, Eq a) => PS2Core.T a
geometricDiff2 :: T a
geometricDiff2 =
   T a -> [a] -> T a
forall a. (C a, Eq a) => T a -> [a] -> T a
meanValueDiff2 T a
forall a. (C a, Eq a) => T a
geometric2 [a]
forall a. C a => [a]
geometricMVF




meanValueDiff2 :: (Field.C a, Eq a) =>
   PS2Core.T a -> [a] -> PS2Core.T a
meanValueDiff2 :: T a -> [a] -> T a
meanValueDiff2 T a
mean2 [a]
curve =
   let -- (f(1+x)-f(1+y)) / (x-y)
       divDiffPS :: T a
divDiffPS =
          (Int -> a -> [a]) -> [Int] -> [a] -> T a
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> a -> [a]
forall a. Int -> a -> [a]
replicate [Int
1..] ([a] -> T a) -> [a] -> T a
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
tail [a]
curve
       meanValuePS :: T a
meanValuePS =
          [a] -> T a -> T a
forall a. C a => [a] -> T a -> T a
PS2Core.compose ([a] -> [a]
forall a. C a => [a] -> [a]
PSCore.differentiate [a]
curve) (T a -> T a
forall a. [a] -> [a]
tail T a
mean2)
   in  T a
meanValuePS T a -> T a -> T a
forall a. C a => a -> a -> a
- T a
divDiffPS