module MathObj.PowerSeries2 where
import qualified MathObj.PowerSeries as PS
import qualified MathObj.Polynomial as Poly
import qualified Algebra.Differential as Differential
import qualified Algebra.Vector as Vector
import qualified Algebra.Algebraic as Algebraic
import qualified Algebra.Field as Field
import qualified Algebra.Ring as Ring
import qualified Algebra.Additive as Additive
import qualified Algebra.ZeroTestable as ZeroTestable
import qualified NumericPrelude as NP
import qualified PreludeBase as P
import Data.List (isPrefixOf, )
import qualified Data.List.Match as Match
import PreludeBase hiding (const)
import NumericPrelude hiding (negate, stdUnit,
sqrt, exp, log,
sin, cos, tan, asin, acos, atan)
newtype T a = Cons {coeffs :: Core a} deriving (Ord)
type Core a = [[a]]
isValid :: [[a]] -> Bool
isValid = flip isPrefixOf [1..] . map length
check :: [[a]] -> [[a]]
check xs =
zipWith (\n x ->
if Match.compareLength n x == EQ
then x
else error "PowerSeries2.check: invalid length of sub-list")
(iterate (():) [()]) xs
fromCoeffs :: [[a]] -> T a
fromCoeffs = Cons . check
fromPowerSeries0 :: Ring.C a => PS.T a -> T a
fromPowerSeries0 x =
fromCoeffs $
zipWith (:) (PS.coeffs x) $
iterate (0:) []
fromPowerSeries1 :: Ring.C a => PS.T a -> T a
fromPowerSeries1 x =
fromCoeffs $
zipWith (++) (iterate (0:) []) $
map (:[]) (PS.coeffs x)
lift0 :: Core a -> T a
lift0 = Cons
lift1 :: (Core a -> Core a) -> (T a -> T a)
lift1 f (Cons x0) = Cons (f x0)
lift2 :: (Core a -> Core a -> Core a) -> (T a -> T a -> T a)
lift2 f (Cons x0) (Cons x1) = Cons (f x0 x1)
lift0fromPowerSeries :: [PS.T a] -> Core a
lift0fromPowerSeries = map PS.coeffs
lift1fromPowerSeries :: ([PS.T a] -> [PS.T a]) -> (Core a -> Core a)
lift1fromPowerSeries f x0 = map PS.coeffs (f (map PS.fromCoeffs x0))
lift2fromPowerSeries :: ([PS.T a] -> [PS.T a] -> [PS.T a]) -> (Core a -> Core a -> Core a)
lift2fromPowerSeries f x0 x1 = map PS.coeffs (f (map PS.fromCoeffs x0) (map PS.fromCoeffs x1))
const :: a -> T a
const x = lift0 [[x]]
instance Functor T where
fmap f (Cons xs) = Cons (map (map f) xs)
appPrec :: Int
appPrec = 10
instance (Show a) => Show (T a) where
showsPrec p (Cons xs) =
showParen (p >= appPrec) (showString "PowerSeries2.fromCoeffs " . shows xs)
add, sub :: (Additive.C a) => Core a -> Core a -> Core a
add = PS.add
sub = PS.sub
negate :: (Additive.C a) => Core a -> Core a
negate = PS.negate
instance (Eq a, ZeroTestable.C a) => Eq (T a) where
(Cons x) == (Cons y) = Poly.equal x y
instance (Additive.C a) => Additive.C (T a) where
negate = lift1 PS.negate
(+) = lift2 PS.add
() = lift2 PS.sub
zero = lift0 []
scale :: Ring.C a => a -> Core a -> Core a
scale = map . (Vector.*>)
mul :: Ring.C a => Core a -> Core a -> Core a
mul = lift2fromPowerSeries PS.mul
instance (Ring.C a) => Ring.C (T a) where
one = const one
fromInteger n = const (fromInteger n)
(*) = lift2 mul
instance Vector.C T where
zero = zero
(<+>) = (+)
(*>) = Vector.functorScale
divide :: (Field.C a) =>
Core a -> Core a -> Core a
divide = lift2fromPowerSeries PS.divide
instance (Field.C a) => Field.C (T a) where
(/) = lift2 divide
sqrt :: (Field.C a) =>
(a -> a) -> Core a -> Core a
sqrt fSqRt = lift1fromPowerSeries $ PS.sqrt (PS.const . (\[x] -> fSqRt x) . PS.coeffs)
instance (Algebraic.C a) => Algebraic.C (T a) where
sqrt = lift1 (sqrt Algebraic.sqrt)
swapVariables :: Core a -> Core a
swapVariables = map reverse
differentiate0 :: (Ring.C a) => Core a -> Core a
differentiate0 =
swapVariables . differentiate1 . swapVariables
differentiate1 :: (Ring.C a) => Core a -> Core a
differentiate1 = lift1fromPowerSeries $ map Differential.differentiate
integrate0 :: (Field.C a) => [a] -> Core a -> Core a
integrate0 cs =
swapVariables . integrate1 cs . swapVariables
integrate1 :: (Field.C a) => [a] -> Core a -> Core a
integrate1 = zipWith PS.integrate
comp :: (Ring.C a) => [a] -> Core a -> Core a
comp = lift1fromPowerSeries . PS.comp . map PS.const