numeric-prelude 0.2 → 0.2.1

raw patch · 217 files changed

+20212/−283 lines, 217 filesdep ~basedep ~containersdep ~utility-htPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, containers, utility-ht

API changes (from Hackage documentation)

- Algebra.Additive: instance (C v) => C (b -> v)

- Algebra.Additive: instance (C v) => C [v]

- Algebra.Additive: instance (Integral a) => C (Ratio a)

- Algebra.DimensionTerm: instance (C a) => C (Recip a)

- Algebra.DimensionTerm: instance (Show a) => Show (Recip a)

- Algebra.Field: instance (C a) => C (T a)

- Algebra.Field: instance (Integral a) => C (Ratio a)

- Algebra.Indexable: instance (C a) => C [a]

- Algebra.Indexable: instance (C a) => Ord (ToOrd a)

- Algebra.Indexable: instance (Eq a) => Eq (ToOrd a)

- Algebra.Indexable: instance (Show a) => Show (ToOrd a)

- Algebra.Module: instance (C a v) => C a (c -> v)

- Algebra.Module: instance (C a v) => C a [v]

- Algebra.Module: instance (C a) => C (T a) (T a)

- Algebra.Module: instance (C a) => C Integer (T a)

- Algebra.ModuleBasis: instance (C a) => C (T a) (T a)

- Algebra.Monoid: instance (C a) => C (Dual a)

- Algebra.Monoid: instance (C a) => C (Product a)

- Algebra.Monoid: instance (C a) => C (Sum a)

- Algebra.NormedSpace.Euclidean: instance (Sqr a v) => Sqr a [v]

- Algebra.Ring: instance (Integral a) => C (Ratio a)

- Algebra.VectorSpace: instance (C a b) => C a (c -> b)

- Algebra.VectorSpace: instance (C a b) => C a [b]

- Algebra.VectorSpace: instance (C a) => C (T a) (T a)

- Algebra.ZeroTestable: instance (C v) => C [v]

- MathObj.Algebra: instance (Ord a) => C (T a)

- MathObj.DiscreteMap: instance (Ord i) => C (Map i)

- MathObj.LaurentPolynomial: instance (C a b) => C a (T b)

- MathObj.LaurentPolynomial: instance (C a) => C (T a)

- MathObj.LaurentPolynomial: instance (Show a) => Show (T a)

- MathObj.Matrix: instance (C a b) => C a (T b)

- MathObj.Matrix: instance (C a) => C (T a)

- MathObj.Matrix: instance (Eq a) => Eq (T a)

- MathObj.Matrix: instance (Ord a) => Ord (T a)

- MathObj.Matrix: instance (Read a) => Read (T a)

- MathObj.Matrix: instance (Show a) => Show (T a)

- MathObj.Monoid: instance (C a) => C (GCD a)

- MathObj.Monoid: instance (C a) => C (LCM a)

- MathObj.Monoid: instance (Eq a) => Eq (GCD a)

- MathObj.Monoid: instance (Eq a) => Eq (LCM a)

- MathObj.Monoid: instance (Eq a) => Eq (Max a)

- MathObj.Monoid: instance (Eq a) => Eq (Min a)

- MathObj.Monoid: instance (Ord a) => C (Max a)

- MathObj.Monoid: instance (Ord a) => C (Min a)

- MathObj.Monoid: instance (Show a) => Show (GCD a)

- MathObj.Monoid: instance (Show a) => Show (LCM a)

- MathObj.Monoid: instance (Show a) => Show (Max a)

- MathObj.Monoid: instance (Show a) => Show (Min a)

- MathObj.PartialFraction: instance (Eq a) => Eq (T a)

- MathObj.PartialFraction: instance (Show a) => Show (T a)

- MathObj.Permutation.CycleList.Check: instance (Eq i) => Eq (Cycle i)

- MathObj.Permutation.CycleList.Check: instance (Ix i) => C (T i)

- MathObj.Permutation.CycleList.Check: instance (Ix i) => Eq (T i)

- MathObj.Permutation.CycleList.Check: instance (Ix i) => Ord (T i)

- MathObj.Permutation.CycleList.Check: instance (Read i) => Read (Cycle i)

- MathObj.Permutation.CycleList.Check: instance (Show i) => Show (Cycle i)

- MathObj.Permutation.CycleList.Check: instance (Show i) => Show (T i)

- MathObj.Polynomial: instance (C a b) => C a (T b)

- MathObj.Polynomial: instance (C a) => C (T a)

- MathObj.Polynomial: instance (Show a) => Show (T a)

- MathObj.PowerSeries: instance (C a b) => C a (T b)

- MathObj.PowerSeries: instance (C a) => C (T a)

- MathObj.PowerSeries: instance (Show a) => Show (T a)

- MathObj.PowerSeries2: instance (C a) => C (T a)

- MathObj.PowerSeries2: instance (Show a) => Show (T a)

- MathObj.PowerSum: instance (C a) => C (T a)

- MathObj.PowerSum: instance (Show a) => Show (T a)

- MathObj.RefinementMask2: instance (Show a) => Show (T a)

- MathObj.RootSet: instance (Show a) => Show (T a)

- Number.Complex: instance (Arbitrary a) => Arbitrary (T a)

- Number.Complex: instance (C a b) => C a (T b)

- Number.Complex: instance (C a) => C (T a)

- Number.Complex: instance (Eq a) => Eq (T a)

- Number.Complex: instance (Read a) => Read (T a)

- Number.Complex: instance (Show a) => Show (T a)

- Number.Complex: instance (Sqr a b) => Sqr a (T b)

- Number.Complex: instance (Storable a) => Storable (T a)

- Number.DimensionTerm: instance (Eq a) => Eq (T u a)

- Number.DimensionTerm: instance (Ord a) => Ord (T u a)

- Number.NonNegative: instance (C a) => C (T a)

- Number.NonNegativeChunky: instance (C a) => C (T a)

- Number.NonNegativeChunky: instance (C a) => Eq (T a)

- Number.NonNegativeChunky: instance (C a) => Monoid (T a)

- Number.NonNegativeChunky: instance (C a) => Ord (T a)

- Number.NonNegativeChunky: instance (Show a) => Show (T a)

- Number.OccasionallyScalarExpression: instance (C v) => C (T a v)

- Number.OccasionallyScalarExpression: instance (Eq v) => Eq (T a v)

- Number.OccasionallyScalarExpression: instance (Ord v) => Ord (T a v)

- Number.OccasionallyScalarExpression: instance (Show v) => Show (T a v)

- Number.PartiallyTranscendental: instance (C a) => C (T a)

- Number.PartiallyTranscendental: instance (Eq a) => Eq (T a)

- Number.PartiallyTranscendental: instance (Num a) => Fractional (T a)

- Number.PartiallyTranscendental: instance (Num a) => Num (T a)

- Number.PartiallyTranscendental: instance (Ord a) => Ord (T a)

- Number.PartiallyTranscendental: instance (Show a) => Show (T a)

- Number.Peano: instance (Eq a) => Eq (Valuable a)

- Number.Peano: instance (Ord a) => Ord (Valuable a)

- Number.Peano: instance (Show a) => Show (Valuable a)

- Number.Physical: instance (C a v) => C a (T i v)

- Number.Physical: instance (C v) => C (T a v)

- Number.Physical: instance (Ord i) => C (T i)

- Number.Physical.UnitDatabase: instance (Show a) => Show (Scale a)

- Number.Quaternion: instance (C a b) => C a (T b)

- Number.Quaternion: instance (C a) => C (T a)

- Number.Quaternion: instance (Eq a) => Eq (T a)

- Number.Quaternion: instance (Read a) => Read (T a)

- Number.Quaternion: instance (Show a) => Show (T a)

- Number.Quaternion: instance (Sqr a b) => Sqr a (T b)

- Number.Ratio: instance (C a) => C (T a)

- Number.Ratio: instance (Eq a) => Eq (T a)

- Number.ResidueClass.Check: instance (C a) => C (T a)

- Number.ResidueClass.Check: instance (Eq a) => Eq (T a)

- Number.ResidueClass.Check: instance (Show a) => Show (T a)

- Number.ResidueClass.Func: instance (C a) => C (T a)

- Number.ResidueClass.Maybe: instance (Read a) => Read (T a)

- Number.ResidueClass.Maybe: instance (Show a) => Show (T a)

- Number.SI: instance (C a v) => C a (T b v)

- Number.SI: instance (C v) => C (T a v)

- Number.SI: instance (Eq v) => Eq (T a v)

- Number.SI: instance (Ord v) => Ord (T a v)

+ Algebra.Additive: instance C v => C (b -> v)

+ Algebra.Additive: instance C v => C [v]

+ Algebra.Additive: instance Integral a => C (Ratio a)

+ Algebra.DimensionTerm: instance C a => C (Recip a)

+ Algebra.DimensionTerm: instance Show a => Show (Recip a)

+ Algebra.Field: instance C a => C (T a)

+ Algebra.Field: instance Integral a => C (Ratio a)

+ Algebra.Indexable: instance C a => C [a]

+ Algebra.Indexable: instance C a => Ord (ToOrd a)

+ Algebra.Indexable: instance Eq a => Eq (ToOrd a)

+ Algebra.Indexable: instance Show a => Show (ToOrd a)

+ Algebra.IntegralDomain: divChecked :: (C a, C a) => a -> a -> a

+ Algebra.IntegralDomain: divUp :: C a => a -> a -> a

+ Algebra.IntegralDomain: roundDown :: C a => a -> a -> a

+ Algebra.IntegralDomain: roundUp :: C a => a -> a -> a

+ Algebra.Module: instance C a => C (T a) (T a)

+ Algebra.Module: instance C a => C Integer (T a)

+ Algebra.Module: instance C a v => C a (c -> v)

+ Algebra.Module: instance C a v => C a [v]

+ Algebra.ModuleBasis: instance C a => C (T a) (T a)

+ Algebra.Monoid: instance C a => C (Dual a)

+ Algebra.Monoid: instance C a => C (Product a)

+ Algebra.Monoid: instance C a => C (Sum a)

+ Algebra.NormedSpace.Euclidean: instance Sqr a v => Sqr a [v]

+ Algebra.PrincipalIdealDomain: coprime :: C a => a -> a -> Bool

+ Algebra.Ring: instance Integral a => C (Ratio a)

+ Algebra.VectorSpace: instance C a => C (T a) (T a)

+ Algebra.VectorSpace: instance C a b => C a (c -> b)

+ Algebra.VectorSpace: instance C a b => C a [b]

+ Algebra.ZeroTestable: instance C v => C [v]

+ MathObj.Algebra: instance Ord a => C (T a)

+ MathObj.DiscreteMap: instance Ord i => C (Map i)

+ MathObj.LaurentPolynomial: instance C a => C (T a)

+ MathObj.LaurentPolynomial: instance C a b => C a (T b)

+ MathObj.LaurentPolynomial: instance Show a => Show (T a)

+ MathObj.Matrix: index :: T a -> Dimension -> Dimension -> a

+ MathObj.Matrix: instance C a => C (T a)

+ MathObj.Matrix: instance C a b => C a (T b)

+ MathObj.Matrix: instance Eq a => Eq (T a)

+ MathObj.Matrix: instance Ord a => Ord (T a)

+ MathObj.Matrix: instance Read a => Read (T a)

+ MathObj.Matrix: instance Show a => Show (T a)

+ MathObj.Monoid: instance C a => C (GCD a)

+ MathObj.Monoid: instance C a => C (LCM a)

+ MathObj.Monoid: instance Eq a => Eq (GCD a)

+ MathObj.Monoid: instance Eq a => Eq (LCM a)

+ MathObj.Monoid: instance Eq a => Eq (Max a)

+ MathObj.Monoid: instance Eq a => Eq (Min a)

+ MathObj.Monoid: instance Ord a => C (Max a)

+ MathObj.Monoid: instance Ord a => C (Min a)

+ MathObj.Monoid: instance Show a => Show (GCD a)

+ MathObj.Monoid: instance Show a => Show (LCM a)

+ MathObj.Monoid: instance Show a => Show (Max a)

+ MathObj.Monoid: instance Show a => Show (Min a)

+ MathObj.PartialFraction: instance Eq a => Eq (T a)

+ MathObj.PartialFraction: instance Show a => Show (T a)

+ MathObj.Permutation.CycleList.Check: instance Eq i => Eq (Cycle i)

+ MathObj.Permutation.CycleList.Check: instance Ix i => C (T i)

+ MathObj.Permutation.CycleList.Check: instance Ix i => Eq (T i)

+ MathObj.Permutation.CycleList.Check: instance Ix i => Ord (T i)

+ MathObj.Permutation.CycleList.Check: instance Read i => Read (Cycle i)

+ MathObj.Permutation.CycleList.Check: instance Show i => Show (Cycle i)

+ MathObj.Permutation.CycleList.Check: instance Show i => Show (T i)

+ MathObj.Polynomial: instance C a => C (T a)

+ MathObj.Polynomial: instance C a b => C a (T b)

+ MathObj.Polynomial: instance Show a => Show (T a)

+ MathObj.PowerSeries: instance C a => C (T a)

+ MathObj.PowerSeries: instance C a b => C a (T b)

+ MathObj.PowerSeries: instance Show a => Show (T a)

+ MathObj.PowerSeries2: instance C a => C (T a)

+ MathObj.PowerSeries2: instance Show a => Show (T a)

+ MathObj.PowerSum: instance C a => C (T a)

+ MathObj.PowerSum: instance Show a => Show (T a)

+ MathObj.RefinementMask2: instance Show a => Show (T a)

+ MathObj.RootSet: instance Show a => Show (T a)

+ Number.Complex: instance Arbitrary a => Arbitrary (T a)

+ Number.Complex: instance C a => C (T a)

+ Number.Complex: instance C a b => C a (T b)

+ Number.Complex: instance Eq a => Eq (T a)

+ Number.Complex: instance Functor T

+ Number.Complex: instance Read a => Read (T a)

+ Number.Complex: instance Show a => Show (T a)

+ Number.Complex: instance Sqr a b => Sqr a (T b)

+ Number.Complex: instance Storable a => Storable (T a)

+ Number.DimensionTerm: instance Eq a => Eq (T u a)

+ Number.DimensionTerm: instance Ord a => Ord (T u a)

+ Number.NonNegative: instance C a => C (T a)

+ Number.NonNegativeChunky: instance C a => C (T a)

+ Number.NonNegativeChunky: instance C a => Eq (T a)

+ Number.NonNegativeChunky: instance C a => Monoid (T a)

+ Number.NonNegativeChunky: instance C a => Ord (T a)

+ Number.NonNegativeChunky: instance Show a => Show (T a)

+ Number.OccasionallyScalarExpression: instance C v => C (T a v)

+ Number.OccasionallyScalarExpression: instance Eq v => Eq (T a v)

+ Number.OccasionallyScalarExpression: instance Ord v => Ord (T a v)

+ Number.OccasionallyScalarExpression: instance Show v => Show (T a v)

+ Number.PartiallyTranscendental: instance C a => C (T a)

+ Number.PartiallyTranscendental: instance Eq a => Eq (T a)

+ Number.PartiallyTranscendental: instance Num a => Fractional (T a)

+ Number.PartiallyTranscendental: instance Num a => Num (T a)

+ Number.PartiallyTranscendental: instance Ord a => Ord (T a)

+ Number.PartiallyTranscendental: instance Show a => Show (T a)

+ Number.Peano: instance Eq a => Eq (Valuable a)

+ Number.Peano: instance Ord a => Ord (Valuable a)

+ Number.Peano: instance Show a => Show (Valuable a)

+ Number.Physical: instance C a v => C a (T i v)

+ Number.Physical: instance C v => C (T a v)

+ Number.Physical: instance Ord i => C (T i)

+ Number.Physical.UnitDatabase: instance Show a => Show (Scale a)

+ Number.Quaternion: instance C a => C (T a)

+ Number.Quaternion: instance C a b => C a (T b)

+ Number.Quaternion: instance Eq a => Eq (T a)

+ Number.Quaternion: instance Read a => Read (T a)

+ Number.Quaternion: instance Show a => Show (T a)

+ Number.Quaternion: instance Sqr a b => Sqr a (T b)

+ Number.Ratio: instance C a => C (T a)

+ Number.Ratio: instance Eq a => Eq (T a)

+ Number.ResidueClass.Check: instance C a => C (T a)

+ Number.ResidueClass.Check: instance Eq a => Eq (T a)

+ Number.ResidueClass.Check: instance Show a => Show (T a)

+ Number.ResidueClass.Func: instance C a => C (T a)

+ Number.ResidueClass.Maybe: instance Read a => Read (T a)

+ Number.ResidueClass.Maybe: instance Show a => Show (T a)

+ Number.Root: Cons :: Integer -> a -> T a

+ Number.Root: cardinalPower :: C a => Integer -> T a -> T a

+ Number.Root: commonDegree :: C a => T a -> T a -> T (a, a)

+ Number.Root: data T a

+ Number.Root: div :: C a => T a -> T a -> T a

+ Number.Root: fromNumber :: a -> T a

+ Number.Root: instance (Eq a, C a) => Eq (T a)

+ Number.Root: instance (Ord a, C a) => Ord (T a)

+ Number.Root: instance Functor T

+ Number.Root: instance Show a => Show (T a)

+ Number.Root: integerPower :: C a => Integer -> T a -> T a

+ Number.Root: mul :: C a => T a -> T a -> T a

+ Number.Root: rationalPower :: C a => Rational -> T a -> T a

+ Number.Root: recip :: C a => T a -> T a

+ Number.Root: root :: C a => Integer -> T a -> T a

+ Number.Root: sqrt :: C a => T a -> T a

+ Number.Root: toNumber :: C a => T a -> a

+ Number.Root: toRootSet :: C a => T a -> T a

+ Number.SI: instance C a v => C a (T b v)

+ Number.SI: instance C v => C (T a v)

+ Number.SI: instance Eq v => Eq (T a v)

+ Number.SI: instance Ord v => Ord (T a v)

+ NumericPrelude.Base: ifThenElse :: Bool -> a -> a -> a

- Algebra.Absolute: abs :: (C a) => a -> a

+ Algebra.Absolute: abs :: C a => a -> a

- Algebra.Absolute: signum :: (C a) => a -> a

+ Algebra.Absolute: signum :: C a => a -> a

- Algebra.Additive: (+) :: (C a) => a -> a -> a

+ Algebra.Additive: (+) :: C a => a -> a -> a

- Algebra.Additive: (-) :: (C a) => a -> a -> a

+ Algebra.Additive: (-) :: C a => a -> a -> a

- Algebra.Additive: (<*>.+) :: (C x) => T (v, v) (x -> a) -> (v -> x) -> T (v, v) a

+ Algebra.Additive: (<*>.+) :: C x => T (v, v) (x -> a) -> (v -> x) -> T (v, v) a

- Algebra.Additive: (<*>.-$) :: (C x) => T v (x -> a) -> (v -> x) -> T v a

+ Algebra.Additive: (<*>.-$) :: C x => T v (x -> a) -> (v -> x) -> T v a

- Algebra.Additive: (<*>.-) :: (C x) => T (v, v) (x -> a) -> (v -> x) -> T (v, v) a

+ Algebra.Additive: (<*>.-) :: C x => T (v, v) (x -> a) -> (v -> x) -> T (v, v) a

- Algebra.Additive: elementAdd :: (C x) => (v -> x) -> T (v, v) x

+ Algebra.Additive: elementAdd :: C x => (v -> x) -> T (v, v) x

- Algebra.Additive: elementNeg :: (C x) => (v -> x) -> T v x

+ Algebra.Additive: elementNeg :: C x => (v -> x) -> T v x

- Algebra.Additive: elementSub :: (C x) => (v -> x) -> T (v, v) x

+ Algebra.Additive: elementSub :: C x => (v -> x) -> T (v, v) x

- Algebra.Additive: negate :: (C a) => a -> a

+ Algebra.Additive: negate :: C a => a -> a

- Algebra.Additive: subtract :: (C a) => a -> a -> a

+ Algebra.Additive: subtract :: C a => a -> a -> a

- Algebra.Additive: sum :: (C a) => [a] -> a

+ Algebra.Additive: sum :: C a => [a] -> a

- Algebra.Additive: sum1 :: (C a) => [a] -> a

+ Algebra.Additive: sum1 :: C a => [a] -> a

- Algebra.Additive: zero :: (C a) => a

+ Algebra.Additive: zero :: C a => a

- Algebra.Algebraic: (^/) :: (C a) => a -> Rational -> a

+ Algebra.Algebraic: (^/) :: C a => a -> Rational -> a

- Algebra.Algebraic: class (C a) => C a

+ Algebra.Algebraic: class C a => C a

- Algebra.Algebraic: root :: (C a) => Integer -> a -> a

+ Algebra.Algebraic: root :: C a => Integer -> a -> a

- Algebra.Algebraic: sqrt :: (C a) => a -> a

+ Algebra.Algebraic: sqrt :: C a => a -> a

- Algebra.Differential: class (C a) => C a

+ Algebra.Differential: class C a => C a

- Algebra.Differential: differentiate :: (C a) => a -> a

+ Algebra.Differential: differentiate :: C a => a -> a

- Algebra.DimensionTerm: cancelLeft :: (C u) => Mul (Recip u) u -> Scalar

+ Algebra.DimensionTerm: cancelLeft :: C u => Mul (Recip u) u -> Scalar

- Algebra.DimensionTerm: cancelRight :: (C u) => Mul u (Recip u) -> Scalar

+ Algebra.DimensionTerm: cancelRight :: C u => Mul u (Recip u) -> Scalar

- Algebra.DimensionTerm: class (Show a) => C a

+ Algebra.DimensionTerm: class Show a => C a

- Algebra.DimensionTerm: class (C dim) => IsScalar dim

+ Algebra.DimensionTerm: class C dim => IsScalar dim

- Algebra.DimensionTerm: doubleRecip :: (C u) => u -> Recip (Recip u)

+ Algebra.DimensionTerm: doubleRecip :: C u => u -> Recip (Recip u)

- Algebra.DimensionTerm: fromScalar :: (IsScalar dim) => Scalar -> dim

+ Algebra.DimensionTerm: fromScalar :: IsScalar dim => Scalar -> dim

- Algebra.DimensionTerm: identityLeft :: (C u) => Mul Scalar u -> u

+ Algebra.DimensionTerm: identityLeft :: C u => Mul Scalar u -> u

- Algebra.DimensionTerm: identityRight :: (C u) => Mul u Scalar -> u

+ Algebra.DimensionTerm: identityRight :: C u => Mul u Scalar -> u

- Algebra.DimensionTerm: invertRecip :: (C u) => Recip (Recip u) -> u

+ Algebra.DimensionTerm: invertRecip :: C u => Recip (Recip u) -> u

- Algebra.DimensionTerm: noValue :: (C a) => a

+ Algebra.DimensionTerm: noValue :: C a => a

- Algebra.DimensionTerm: recip :: (C a) => a -> Recip a

+ Algebra.DimensionTerm: recip :: C a => a -> Recip a

- Algebra.DimensionTerm: toScalar :: (IsScalar dim) => dim -> Scalar

+ Algebra.DimensionTerm: toScalar :: IsScalar dim => dim -> Scalar

- Algebra.DivisibleSpace: (</>) :: (C a b) => b -> b -> a

+ Algebra.DivisibleSpace: (</>) :: C a b => b -> b -> a

- Algebra.DivisibleSpace: class (C a b) => C a b

+ Algebra.DivisibleSpace: class C a b => C a b

- Algebra.Field: (/) :: (C a) => a -> a -> a

+ Algebra.Field: (/) :: C a => a -> a -> a

- Algebra.Field: (^-) :: (C a) => a -> Integer -> a

+ Algebra.Field: (^-) :: C a => a -> Integer -> a

- Algebra.Field: class (C a) => C a

+ Algebra.Field: class C a => C a

- Algebra.Field: fromRational :: (C a) => Rational -> a

+ Algebra.Field: fromRational :: C a => Rational -> a

- Algebra.Field: fromRational' :: (C a) => Rational -> a

+ Algebra.Field: fromRational' :: C a => Rational -> a

- Algebra.Field: recip :: (C a) => a -> a

+ Algebra.Field: recip :: C a => a -> a

- Algebra.Indexable: class (Eq a) => C a

+ Algebra.Indexable: class Eq a => C a

- Algebra.Indexable: compare :: (C a) => a -> a -> Ordering

+ Algebra.Indexable: compare :: C a => a -> a -> Ordering

- Algebra.Indexable: liftCompare :: (C b) => (a -> b) -> a -> a -> Ordering

+ Algebra.Indexable: liftCompare :: C b => (a -> b) -> a -> a -> Ordering

- Algebra.Indexable: ordCompare :: (Ord a) => a -> a -> Ordering

+ Algebra.Indexable: ordCompare :: Ord a => a -> a -> Ordering

- Algebra.IntegralDomain: class (C a) => C a

+ Algebra.IntegralDomain: class C a => C a

- Algebra.IntegralDomain: decomposeVarPositionalInf :: (C a) => [a] -> a -> [a]

+ Algebra.IntegralDomain: decomposeVarPositionalInf :: C a => [a] -> a -> [a]

- Algebra.IntegralDomain: div :: (C a) => a -> a -> a

+ Algebra.IntegralDomain: div :: C a => a -> a -> a

- Algebra.IntegralDomain: divMod :: (C a) => a -> a -> (a, a)

+ Algebra.IntegralDomain: divMod :: C a => a -> a -> (a, a)

- Algebra.IntegralDomain: mod :: (C a) => a -> a -> a

+ Algebra.IntegralDomain: mod :: C a => a -> a -> a

- Algebra.Lattice: dn :: (C a) => a -> a -> a

+ Algebra.Lattice: dn :: C a => a -> a -> a

- Algebra.Lattice: max :: (C a) => a -> a -> a

+ Algebra.Lattice: max :: C a => a -> a -> a

- Algebra.Lattice: min :: (C a) => a -> a -> a

+ Algebra.Lattice: min :: C a => a -> a -> a

- Algebra.Lattice: up :: (C a) => a -> a -> a

+ Algebra.Lattice: up :: C a => a -> a -> a

- Algebra.Laws: associative :: (Eq a) => (a -> a -> a) -> a -> a -> a -> Bool

+ Algebra.Laws: associative :: Eq a => (a -> a -> a) -> a -> a -> a -> Bool

- Algebra.Laws: commutative :: (Eq a) => (b -> b -> a) -> b -> b -> Bool

+ Algebra.Laws: commutative :: Eq a => (b -> b -> a) -> b -> b -> Bool

- Algebra.Laws: homomorphism :: (Eq a) => (b -> a) -> (b -> b -> b) -> (a -> a -> a) -> b -> b -> Bool

+ Algebra.Laws: homomorphism :: Eq a => (b -> a) -> (b -> b -> b) -> (a -> a -> a) -> b -> b -> Bool

- Algebra.Laws: identity :: (Eq a) => (a -> a -> a) -> a -> a -> Bool

+ Algebra.Laws: identity :: Eq a => (a -> a -> a) -> a -> a -> Bool

- Algebra.Laws: inverse :: (Eq a) => (b -> b -> a) -> (b -> b) -> a -> b -> Bool

+ Algebra.Laws: inverse :: Eq a => (b -> b -> a) -> (b -> b) -> a -> b -> Bool

- Algebra.Laws: leftCascade :: (Eq a) => (b -> b -> b) -> (b -> a -> a) -> a -> b -> b -> Bool

+ Algebra.Laws: leftCascade :: Eq a => (b -> b -> b) -> (b -> a -> a) -> a -> b -> b -> Bool

- Algebra.Laws: leftDistributive :: (Eq a) => (a -> b -> a) -> (a -> a -> a) -> b -> a -> a -> Bool

+ Algebra.Laws: leftDistributive :: Eq a => (a -> b -> a) -> (a -> a -> a) -> b -> a -> a -> Bool

- Algebra.Laws: leftIdentity :: (Eq a) => (b -> a -> a) -> b -> a -> Bool

+ Algebra.Laws: leftIdentity :: Eq a => (b -> a -> a) -> b -> a -> Bool

- Algebra.Laws: leftInverse :: (Eq a) => (b -> b -> a) -> (b -> b) -> a -> b -> Bool

+ Algebra.Laws: leftInverse :: Eq a => (b -> b -> a) -> (b -> b) -> a -> b -> Bool

- Algebra.Laws: leftZero :: (Eq a) => (a -> a -> a) -> a -> a -> Bool

+ Algebra.Laws: leftZero :: Eq a => (a -> a -> a) -> a -> a -> Bool

- Algebra.Laws: rightCascade :: (Eq a) => (b -> b -> b) -> (a -> b -> a) -> a -> b -> b -> Bool

+ Algebra.Laws: rightCascade :: Eq a => (b -> b -> b) -> (a -> b -> a) -> a -> b -> b -> Bool

- Algebra.Laws: rightDistributive :: (Eq a) => (b -> a -> a) -> (a -> a -> a) -> b -> a -> a -> Bool

+ Algebra.Laws: rightDistributive :: Eq a => (b -> a -> a) -> (a -> a -> a) -> b -> a -> a -> Bool

- Algebra.Laws: rightIdentity :: (Eq a) => (a -> b -> a) -> b -> a -> Bool

+ Algebra.Laws: rightIdentity :: Eq a => (a -> b -> a) -> b -> a -> Bool

- Algebra.Laws: rightInverse :: (Eq a) => (b -> b -> a) -> (b -> b) -> a -> b -> Bool

+ Algebra.Laws: rightInverse :: Eq a => (b -> b -> a) -> (b -> b) -> a -> b -> Bool

- Algebra.Laws: rightZero :: (Eq a) => (a -> a -> a) -> a -> a -> Bool

+ Algebra.Laws: rightZero :: Eq a => (a -> a -> a) -> a -> a -> Bool

- Algebra.Laws: zero :: (Eq a) => (a -> a -> a) -> a -> a -> Bool

+ Algebra.Laws: zero :: Eq a => (a -> a -> a) -> a -> a -> Bool

- Algebra.Module: (*>) :: (C a v) => a -> v -> v

+ Algebra.Module: (*>) :: C a v => a -> v -> v

- Algebra.Module: (<*>.*>) :: (C a x) => T (a, v) (x -> c) -> (v -> x) -> T (a, v) c

+ Algebra.Module: (<*>.*>) :: C a x => T (a, v) (x -> c) -> (v -> x) -> T (a, v) c

- Algebra.Module: linearComb :: (C a v) => [a] -> [v] -> v

+ Algebra.Module: linearComb :: C a v => [a] -> [v] -> v

- Algebra.ModuleBasis: basis :: (C a v) => a -> [v]

+ Algebra.ModuleBasis: basis :: C a v => a -> [v]

- Algebra.ModuleBasis: class (C a v) => C a v

+ Algebra.ModuleBasis: class C a v => C a v

- Algebra.ModuleBasis: dimension :: (C a v) => a -> v -> Int

+ Algebra.ModuleBasis: dimension :: C a v => a -> v -> Int

- Algebra.ModuleBasis: flatten :: (C a v) => v -> [a]

+ Algebra.ModuleBasis: flatten :: C a v => v -> [a]

- Algebra.ModuleBasis: propDimension :: (C a v) => a -> v -> Bool

+ Algebra.ModuleBasis: propDimension :: C a v => a -> v -> Bool

- Algebra.Monoid: (<*>) :: (C a) => a -> a -> a

+ Algebra.Monoid: (<*>) :: C a => a -> a -> a

- Algebra.Monoid: cumulate :: (C a) => [a] -> a

+ Algebra.Monoid: cumulate :: C a => [a] -> a

- Algebra.Monoid: idt :: (C a) => a

+ Algebra.Monoid: idt :: C a => a

- Algebra.NonNegative: (-|) :: (C a) => a -> a -> a

+ Algebra.NonNegative: (-|) :: C a => a -> a -> a

- Algebra.NonNegative: add :: (C a) => a -> a -> a

+ Algebra.NonNegative: add :: C a => a -> a -> a

- Algebra.NonNegative: split :: (C a) => a -> a -> (a, (Bool, a))

+ Algebra.NonNegative: split :: C a => a -> a -> (a, (Bool, a))

- Algebra.NonNegative: sum :: (C a) => [a] -> a

+ Algebra.NonNegative: sum :: C a => [a] -> a

- Algebra.NonNegative: zero :: (C a) => a

+ Algebra.NonNegative: zero :: C a => a

- Algebra.NormedSpace.Euclidean: class (Sqr a v) => C a v

+ Algebra.NormedSpace.Euclidean: class Sqr a v => C a v

- Algebra.NormedSpace.Euclidean: norm :: (C a v) => v -> a

+ Algebra.NormedSpace.Euclidean: norm :: C a v => v -> a

- Algebra.NormedSpace.Euclidean: normSqr :: (Sqr a v) => v -> a

+ Algebra.NormedSpace.Euclidean: normSqr :: Sqr a v => v -> a

- Algebra.NormedSpace.Maximum: norm :: (C a v) => v -> a

+ Algebra.NormedSpace.Maximum: norm :: C a v => v -> a

- Algebra.NormedSpace.Sum: norm :: (C a v) => v -> a

+ Algebra.NormedSpace.Sum: norm :: C a v => v -> a

- Algebra.OccasionallyScalar: fromScalar :: (C a v) => a -> v

+ Algebra.OccasionallyScalar: fromScalar :: C a v => a -> v

- Algebra.OccasionallyScalar: toMaybeScalar :: (C a v) => v -> Maybe a

+ Algebra.OccasionallyScalar: toMaybeScalar :: C a v => v -> Maybe a

- Algebra.OccasionallyScalar: toScalar :: (C a v) => v -> a

+ Algebra.OccasionallyScalar: toScalar :: C a v => v -> a

- Algebra.OccasionallyScalar: toScalarDefault :: (C a v) => v -> a

+ Algebra.OccasionallyScalar: toScalarDefault :: C a v => v -> a

- Algebra.PrincipalIdealDomain: chineseRemainder :: (C a) => (a, a) -> (a, a) -> Maybe (a, a)

+ Algebra.PrincipalIdealDomain: chineseRemainder :: C a => (a, a) -> (a, a) -> Maybe (a, a)

- Algebra.PrincipalIdealDomain: chineseRemainderMulti :: (C a) => [(a, a)] -> Maybe (a, a)

+ Algebra.PrincipalIdealDomain: chineseRemainderMulti :: C a => [(a, a)] -> Maybe (a, a)

- Algebra.PrincipalIdealDomain: diophantine :: (C a) => a -> a -> a -> Maybe (a, a)

+ Algebra.PrincipalIdealDomain: diophantine :: C a => a -> a -> a -> Maybe (a, a)

- Algebra.PrincipalIdealDomain: diophantineMin :: (C a) => a -> a -> a -> Maybe (a, a)

+ Algebra.PrincipalIdealDomain: diophantineMin :: C a => a -> a -> a -> Maybe (a, a)

- Algebra.PrincipalIdealDomain: diophantineMulti :: (C a) => a -> [a] -> Maybe [a]

+ Algebra.PrincipalIdealDomain: diophantineMulti :: C a => a -> [a] -> Maybe [a]

- Algebra.PrincipalIdealDomain: extendedGCD :: (C a) => a -> a -> (a, (a, a))

+ Algebra.PrincipalIdealDomain: extendedGCD :: C a => a -> a -> (a, (a, a))

- Algebra.PrincipalIdealDomain: extendedGCDMulti :: (C a) => [a] -> (a, [a])

+ Algebra.PrincipalIdealDomain: extendedGCDMulti :: C a => [a] -> (a, [a])

- Algebra.PrincipalIdealDomain: gcd :: (C a) => a -> a -> a

+ Algebra.PrincipalIdealDomain: gcd :: C a => a -> a -> a

- Algebra.PrincipalIdealDomain: lcm :: (C a) => a -> a -> a

+ Algebra.PrincipalIdealDomain: lcm :: C a => a -> a -> a

- Algebra.PrincipalIdealDomain: propDivisibleGCD :: (C a) => a -> a -> Bool

+ Algebra.PrincipalIdealDomain: propDivisibleGCD :: C a => a -> a -> Bool

- Algebra.PrincipalIdealDomain: propDivisibleLCM :: (C a) => a -> a -> Bool

+ Algebra.PrincipalIdealDomain: propDivisibleLCM :: C a => a -> a -> Bool

- Algebra.PrincipalIdealDomain: propMaximalDivisor :: (C a) => a -> a -> a -> Property

+ Algebra.PrincipalIdealDomain: propMaximalDivisor :: C a => a -> a -> a -> Property

- Algebra.RealIntegral: quot :: (C a) => a -> a -> a

+ Algebra.RealIntegral: quot :: C a => a -> a -> a

- Algebra.RealIntegral: quotRem :: (C a) => a -> a -> (a, a)

+ Algebra.RealIntegral: quotRem :: C a => a -> a -> (a, a)

- Algebra.RealIntegral: rem :: (C a) => a -> a -> a

+ Algebra.RealIntegral: rem :: C a => a -> a -> a

- Algebra.RealRing: fraction :: (C a) => a -> a

+ Algebra.RealRing: fraction :: C a => a -> a

- Algebra.RealRing: powersOfTwo :: (C a) => [a]

+ Algebra.RealRing: powersOfTwo :: C a => [a]

- Algebra.RealTranscendental: atan2 :: (C a) => a -> a -> a

+ Algebra.RealTranscendental: atan2 :: C a => a -> a -> a

- Algebra.RightModule: (<*) :: (C a b) => b -> a -> b

+ Algebra.RightModule: (<*) :: C a b => b -> a -> b

- Algebra.Ring: (*) :: (C a) => a -> a -> a

+ Algebra.Ring: (*) :: C a => a -> a -> a

- Algebra.Ring: (^) :: (C a) => a -> Integer -> a

+ Algebra.Ring: (^) :: C a => a -> Integer -> a

- Algebra.Ring: class (C a) => C a

+ Algebra.Ring: class C a => C a

- Algebra.Ring: fromInteger :: (C a) => Integer -> a

+ Algebra.Ring: fromInteger :: C a => Integer -> a

- Algebra.Ring: one :: (C a) => a

+ Algebra.Ring: one :: C a => a

- Algebra.Ring: product :: (C a) => [a] -> a

+ Algebra.Ring: product :: C a => [a] -> a

- Algebra.Ring: product1 :: (C a) => [a] -> a

+ Algebra.Ring: product1 :: C a => [a] -> a

- Algebra.Ring: scalarProduct :: (C a) => [a] -> [a] -> a

+ Algebra.Ring: scalarProduct :: C a => [a] -> [a] -> a

- Algebra.Ring: sqr :: (C a) => a -> a

+ Algebra.Ring: sqr :: C a => a -> a

- Algebra.ToInteger: toInteger :: (C a) => a -> Integer

+ Algebra.ToInteger: toInteger :: C a => a -> Integer

- Algebra.ToRational: class (C a) => C a

+ Algebra.ToRational: class C a => C a

- Algebra.ToRational: toRational :: (C a) => a -> Rational

+ Algebra.ToRational: toRational :: C a => a -> Rational

- Algebra.Transcendental: (**) :: (C a) => a -> a -> a

+ Algebra.Transcendental: (**) :: C a => a -> a -> a

- Algebra.Transcendental: (^?) :: (C a) => a -> a -> a

+ Algebra.Transcendental: (^?) :: C a => a -> a -> a

- Algebra.Transcendental: acos :: (C a) => a -> a

+ Algebra.Transcendental: acos :: C a => a -> a

- Algebra.Transcendental: acosh :: (C a) => a -> a

+ Algebra.Transcendental: acosh :: C a => a -> a

- Algebra.Transcendental: asin :: (C a) => a -> a

+ Algebra.Transcendental: asin :: C a => a -> a

- Algebra.Transcendental: asinh :: (C a) => a -> a

+ Algebra.Transcendental: asinh :: C a => a -> a

- Algebra.Transcendental: atan :: (C a) => a -> a

+ Algebra.Transcendental: atan :: C a => a -> a

- Algebra.Transcendental: atanh :: (C a) => a -> a

+ Algebra.Transcendental: atanh :: C a => a -> a

- Algebra.Transcendental: class (C a) => C a

+ Algebra.Transcendental: class C a => C a

- Algebra.Transcendental: cos :: (C a) => a -> a

+ Algebra.Transcendental: cos :: C a => a -> a

- Algebra.Transcendental: cosh :: (C a) => a -> a

+ Algebra.Transcendental: cosh :: C a => a -> a

- Algebra.Transcendental: exp :: (C a) => a -> a

+ Algebra.Transcendental: exp :: C a => a -> a

- Algebra.Transcendental: log :: (C a) => a -> a

+ Algebra.Transcendental: log :: C a => a -> a

- Algebra.Transcendental: logBase :: (C a) => a -> a -> a

+ Algebra.Transcendental: logBase :: C a => a -> a -> a

- Algebra.Transcendental: pi :: (C a) => a

+ Algebra.Transcendental: pi :: C a => a

- Algebra.Transcendental: sin :: (C a) => a -> a

+ Algebra.Transcendental: sin :: C a => a -> a

- Algebra.Transcendental: sinh :: (C a) => a -> a

+ Algebra.Transcendental: sinh :: C a => a -> a

- Algebra.Transcendental: tan :: (C a) => a -> a

+ Algebra.Transcendental: tan :: C a => a -> a

- Algebra.Transcendental: tanh :: (C a) => a -> a

+ Algebra.Transcendental: tanh :: C a => a -> a

- Algebra.Units: class (C a) => C a

+ Algebra.Units: class C a => C a

- Algebra.Units: isUnit :: (C a) => a -> Bool

+ Algebra.Units: isUnit :: C a => a -> Bool

- Algebra.Units: stdAssociate :: (C a) => a -> a

+ Algebra.Units: stdAssociate :: C a => a -> a

- Algebra.Units: stdUnit :: (C a) => a -> a

+ Algebra.Units: stdUnit :: C a => a -> a

- Algebra.Units: stdUnitInv :: (C a) => a -> a

+ Algebra.Units: stdUnitInv :: C a => a -> a

- Algebra.ZeroTestable: isZero :: (C a) => a -> Bool

+ Algebra.ZeroTestable: isZero :: C a => a -> Bool

- MathObj.Algebra: zipWith :: (Ord a) => (b -> b -> b) -> (T a b -> T a b -> T a b)

+ MathObj.Algebra: zipWith :: Ord a => (b -> b -> b) -> (T a b -> T a b -> T a b)

- MathObj.LaurentPolynomial: (!) :: (C a) => T a -> Int -> a

+ MathObj.LaurentPolynomial: (!) :: C a => T a -> Int -> a

- MathObj.LaurentPolynomial: add :: (C a) => T a -> T a -> T a

+ MathObj.LaurentPolynomial: add :: C a => T a -> T a -> T a

- MathObj.LaurentPolynomial: addShifted :: (C a) => Int -> [a] -> [a] -> [a]

+ MathObj.LaurentPolynomial: addShifted :: C a => Int -> [a] -> [a] -> [a]

- MathObj.LaurentPolynomial: addShiftedMany :: (C a) => [Int] -> [[a]] -> [a]

+ MathObj.LaurentPolynomial: addShiftedMany :: C a => [Int] -> [[a]] -> [a]

- MathObj.LaurentPolynomial: adjoint :: (C a) => T (T a) -> T (T a)

+ MathObj.LaurentPolynomial: adjoint :: C a => T (T a) -> T (T a)

- MathObj.LaurentPolynomial: alternate :: (C a) => T a -> T a

+ MathObj.LaurentPolynomial: alternate :: C a => T a -> T a

- MathObj.LaurentPolynomial: identical :: (Eq a) => T a -> T a -> Bool

+ MathObj.LaurentPolynomial: identical :: Eq a => T a -> T a -> Bool

- MathObj.LaurentPolynomial: isAbsolute :: (C a) => T a -> Bool

+ MathObj.LaurentPolynomial: isAbsolute :: C a => T a -> Bool

- MathObj.LaurentPolynomial: mul :: (C a) => T a -> T a -> T a

+ MathObj.LaurentPolynomial: mul :: C a => T a -> T a -> T a

- MathObj.LaurentPolynomial: negate :: (C a) => T a -> T a

+ MathObj.LaurentPolynomial: negate :: C a => T a -> T a

- MathObj.LaurentPolynomial: series :: (C a) => [T a] -> T a

+ MathObj.LaurentPolynomial: series :: C a => [T a] -> T a

- MathObj.LaurentPolynomial: sub :: (C a) => T a -> T a -> T a

+ MathObj.LaurentPolynomial: sub :: C a => T a -> T a -> T a

- MathObj.Matrix: diagonal :: (C a) => [a] -> T a

+ MathObj.Matrix: diagonal :: C a => [a] -> T a

- MathObj.Matrix: format :: (Show a) => T a -> String

+ MathObj.Matrix: format :: Show a => T a -> String

- MathObj.Matrix: one :: (C a) => Dimension -> T a

+ MathObj.Matrix: one :: C a => Dimension -> T a

- MathObj.Matrix: scale :: (C a) => a -> T a -> T a

+ MathObj.Matrix: scale :: C a => a -> T a -> T a

- MathObj.Matrix: zero :: (C a) => Dimension -> Dimension -> T a

+ MathObj.Matrix: zero :: C a => Dimension -> Dimension -> T a

- MathObj.PartialFraction: carryRipple :: (C a) => a -> [a] -> (a, [a])

+ MathObj.PartialFraction: carryRipple :: C a => a -> [a] -> (a, [a])

- MathObj.PartialFraction: fromFractionSum :: (C a) => a -> [(a, [a])] -> T a

+ MathObj.PartialFraction: fromFractionSum :: C a => a -> [(a, [a])] -> T a

- MathObj.PartialFraction: hornerRev :: (C a) => a -> [a] -> a

+ MathObj.PartialFraction: hornerRev :: C a => a -> [a] -> a

- MathObj.PartialFraction: indexMapFromList :: (C a) => [(a, b)] -> Map (ToOrd a) b

+ MathObj.PartialFraction: indexMapFromList :: C a => [(a, b)] -> Map (ToOrd a) b

- MathObj.PartialFraction: mapApplySplit :: (Ord a) => a -> (c -> c -> c) -> (b -> c) -> (Map a b -> Map a c) -> Map a b -> Map a c

+ MathObj.PartialFraction: mapApplySplit :: Ord a => a -> (c -> c -> c) -> (b -> c) -> (Map a b -> Map a c) -> Map a b -> Map a c

- MathObj.PartialFraction: mulFrac :: (C a) => T a -> T a -> (a, a)

+ MathObj.PartialFraction: mulFrac :: C a => T a -> T a -> (a, a)

- MathObj.PartialFraction: mulFrac' :: (C a) => T a -> T a -> (T a, T a)

+ MathObj.PartialFraction: mulFrac' :: C a => T a -> T a -> (T a, T a)

- MathObj.PartialFraction: mulFracOverlap :: (C a) => T a -> T a -> ((T a, T a), T a)

+ MathObj.PartialFraction: mulFracOverlap :: C a => T a -> T a -> ((T a, T a), T a)

- MathObj.PartialFraction: mulFracStupid :: (C a) => T a -> T a -> ((T a, T a), T a)

+ MathObj.PartialFraction: mulFracStupid :: C a => T a -> T a -> ((T a, T a), T a)

- MathObj.PartialFraction: multiFromFraction :: (C a) => [a] -> a -> (a, [a])

+ MathObj.PartialFraction: multiFromFraction :: C a => [a] -> a -> (a, [a])

- MathObj.PartialFraction: multiToFraction :: (C a) => a -> [a] -> T a

+ MathObj.PartialFraction: multiToFraction :: C a => a -> [a] -> T a

- MathObj.PartialFraction: normalizeModulo :: (C a) => T a -> T a

+ MathObj.PartialFraction: normalizeModulo :: C a => T a -> T a

- MathObj.PartialFraction: reduceHeads :: (C a) => T a -> T a

+ MathObj.PartialFraction: reduceHeads :: C a => T a -> T a

- MathObj.PartialFraction: toFactoredFraction :: (C a) => T a -> ([a], a)

+ MathObj.PartialFraction: toFactoredFraction :: C a => T a -> ([a], a)

- MathObj.PartialFraction: toFraction :: (C a) => T a -> T a

+ MathObj.PartialFraction: toFraction :: C a => T a -> T a

- MathObj.PartialFraction: toFractionSum :: (C a) => T a -> (a, [(a, [a])])

+ MathObj.PartialFraction: toFractionSum :: C a => T a -> (a, [(a, [a])])

- MathObj.PartialFraction: zipWith :: (C a) => (a -> a -> a) -> ([a] -> [a] -> [a]) -> (T a -> T a -> T a)

+ MathObj.PartialFraction: zipWith :: C a => (a -> a -> a) -> ([a] -> [a] -> [a]) -> (T a -> T a -> T a)

- MathObj.Permutation.CycleList: (*>) :: (Eq i) => T i -> i -> i

+ MathObj.Permutation.CycleList: (*>) :: Eq i => T i -> i -> i

- MathObj.Permutation.CycleList: cycleAction :: (Eq i) => [i] -> i -> i

+ MathObj.Permutation.CycleList: cycleAction :: Eq i => [i] -> i -> i

- MathObj.Permutation.CycleList: cycleLeftAction :: (Eq i) => Cycle i -> i -> i

+ MathObj.Permutation.CycleList: cycleLeftAction :: Eq i => Cycle i -> i -> i

- MathObj.Permutation.CycleList: cycleOrbit :: (Ord i) => Cycle i -> i -> [i]

+ MathObj.Permutation.CycleList: cycleOrbit :: Ord i => Cycle i -> i -> [i]

- MathObj.Permutation.CycleList: cycleRightAction :: (Eq i) => i -> Cycle i -> i

+ MathObj.Permutation.CycleList: cycleRightAction :: Eq i => i -> Cycle i -> i

- MathObj.Permutation.CycleList: cyclesOrbit :: (Ord i) => T i -> i -> [i]

+ MathObj.Permutation.CycleList: cyclesOrbit :: Ord i => T i -> i -> [i]

- MathObj.Permutation.CycleList: fromFunction :: (Ix i) => (i, i) -> (i -> i) -> T i

+ MathObj.Permutation.CycleList: fromFunction :: Ix i => (i, i) -> (i -> i) -> T i

- MathObj.Permutation.CycleList: orbit :: (Ord i) => (i -> i) -> i -> [i]

+ MathObj.Permutation.CycleList: orbit :: Ord i => (i -> i) -> i -> [i]

- MathObj.Permutation.CycleList: takeUntilRepetition :: (Ord a) => [a] -> [a]

+ MathObj.Permutation.CycleList: takeUntilRepetition :: Ord a => [a] -> [a]

- MathObj.Permutation.CycleList: takeUntilRepetitionSlow :: (Eq a) => [a] -> [a]

+ MathObj.Permutation.CycleList: takeUntilRepetitionSlow :: Eq a => [a] -> [a]

- MathObj.Permutation.CycleList.Check: closure :: (Ix i) => [T i] -> [T i]

+ MathObj.Permutation.CycleList.Check: closure :: Ix i => [T i] -> [T i]

- MathObj.Permutation.CycleList.Check: fromTable :: (Ix i) => T i -> T i

+ MathObj.Permutation.CycleList.Check: fromTable :: Ix i => T i -> T i

- MathObj.Permutation.CycleList.Check: liftCmpTable2 :: (Ix i) => (T i -> T i -> a) -> T i -> T i -> a

+ MathObj.Permutation.CycleList.Check: liftCmpTable2 :: Ix i => (T i -> T i -> a) -> T i -> T i -> a

- MathObj.Permutation.CycleList.Check: liftTable2 :: (Ix i) => (T i -> T i -> T i) -> T i -> T i -> T i

+ MathObj.Permutation.CycleList.Check: liftTable2 :: Ix i => (T i -> T i -> T i) -> T i -> T i -> T i

- MathObj.Permutation.CycleList.Check: toTable :: (Ix i) => T i -> T i

+ MathObj.Permutation.CycleList.Check: toTable :: Ix i => T i -> T i

- MathObj.Permutation.Table: closure :: (Ix i) => [T i] -> [T i]

+ MathObj.Permutation.Table: closure :: Ix i => [T i] -> [T i]

- MathObj.Permutation.Table: closureSlow :: (Ix i) => [T i] -> [T i]

+ MathObj.Permutation.Table: closureSlow :: Ix i => [T i] -> [T i]

- MathObj.Permutation.Table: compose :: (Ix i) => T i -> T i -> T i

+ MathObj.Permutation.Table: compose :: Ix i => T i -> T i -> T i

- MathObj.Permutation.Table: cycle :: (Ix i) => [i] -> T i -> T i

+ MathObj.Permutation.Table: cycle :: Ix i => [i] -> T i -> T i

- MathObj.Permutation.Table: fromCycles :: (Ix i) => (i, i) -> [[i]] -> T i

+ MathObj.Permutation.Table: fromCycles :: Ix i => (i, i) -> [[i]] -> T i

- MathObj.Permutation.Table: fromFunction :: (Ix i) => (i, i) -> (i -> i) -> T i

+ MathObj.Permutation.Table: fromFunction :: Ix i => (i, i) -> (i -> i) -> T i

- MathObj.Permutation.Table: identity :: (Ix i) => (i, i) -> T i

+ MathObj.Permutation.Table: identity :: Ix i => (i, i) -> T i

- MathObj.Permutation.Table: inverse :: (Ix i) => T i -> T i

+ MathObj.Permutation.Table: inverse :: Ix i => T i -> T i

- MathObj.Permutation.Table: toFunction :: (Ix i) => T i -> (i -> i)

+ MathObj.Permutation.Table: toFunction :: Ix i => T i -> (i -> i)

- MathObj.Polynomial: compose :: (C a) => T a -> T a -> T a

+ MathObj.Polynomial: compose :: C a => T a -> T a -> T a

- MathObj.Polynomial: degree :: (C a) => T a -> Maybe Int

+ MathObj.Polynomial: degree :: C a => T a -> Maybe Int

- MathObj.Polynomial: dilate :: (C a) => a -> T a -> T a

+ MathObj.Polynomial: dilate :: C a => a -> T a -> T a

- MathObj.Polynomial: evaluate :: (C a) => T a -> a -> a

+ MathObj.Polynomial: evaluate :: C a => T a -> a -> a

- MathObj.Polynomial: evaluateCoeffVector :: (C a v) => T v -> a -> v

+ MathObj.Polynomial: evaluateCoeffVector :: C a v => T v -> a -> v

- MathObj.Polynomial: fromRoots :: (C a) => [a] -> T a

+ MathObj.Polynomial: fromRoots :: C a => [a] -> T a

- MathObj.Polynomial: integrate :: (C a) => a -> T a -> T a

+ MathObj.Polynomial: integrate :: C a => a -> T a -> T a

- MathObj.Polynomial: reverse :: (C a) => T a -> T a

+ MathObj.Polynomial: reverse :: C a => T a -> T a

- MathObj.Polynomial: shrink :: (C a) => a -> T a -> T a

+ MathObj.Polynomial: shrink :: C a => a -> T a -> T a

- MathObj.Polynomial: translate :: (C a) => a -> T a -> T a

+ MathObj.Polynomial: translate :: C a => a -> T a -> T a

- MathObj.Polynomial.Core: add :: (C a) => [a] -> [a] -> [a]

+ MathObj.Polynomial.Core: add :: C a => [a] -> [a] -> [a]

- MathObj.Polynomial.Core: alternate :: (C a) => [a] -> [a]

+ MathObj.Polynomial.Core: alternate :: C a => [a] -> [a]

- MathObj.Polynomial.Core: differentiate :: (C a) => [a] -> [a]

+ MathObj.Polynomial.Core: differentiate :: C a => [a] -> [a]

- MathObj.Polynomial.Core: horner :: (C a) => a -> [a] -> a

+ MathObj.Polynomial.Core: horner :: C a => a -> [a] -> a

- MathObj.Polynomial.Core: hornerCoeffVector :: (C a v) => a -> [v] -> v

+ MathObj.Polynomial.Core: hornerCoeffVector :: C a v => a -> [v] -> v

- MathObj.Polynomial.Core: integrate :: (C a) => a -> [a] -> [a]

+ MathObj.Polynomial.Core: integrate :: C a => a -> [a] -> [a]

- MathObj.Polynomial.Core: mul :: (C a) => [a] -> [a] -> [a]

+ MathObj.Polynomial.Core: mul :: C a => [a] -> [a] -> [a]

- MathObj.Polynomial.Core: mulLinearFactor :: (C a) => a -> [a] -> [a]

+ MathObj.Polynomial.Core: mulLinearFactor :: C a => a -> [a] -> [a]

- MathObj.Polynomial.Core: mulShear :: (C a) => [a] -> [a] -> [a]

+ MathObj.Polynomial.Core: mulShear :: C a => [a] -> [a] -> [a]

- MathObj.Polynomial.Core: mulShearTranspose :: (C a) => [a] -> [a] -> [a]

+ MathObj.Polynomial.Core: mulShearTranspose :: C a => [a] -> [a] -> [a]

- MathObj.Polynomial.Core: negate :: (C a) => [a] -> [a]

+ MathObj.Polynomial.Core: negate :: C a => [a] -> [a]

- MathObj.Polynomial.Core: normalize :: (C a) => [a] -> [a]

+ MathObj.Polynomial.Core: normalize :: C a => [a] -> [a]

- MathObj.Polynomial.Core: progression :: (C a) => [a]

+ MathObj.Polynomial.Core: progression :: C a => [a]

- MathObj.Polynomial.Core: scale :: (C a) => a -> [a] -> [a]

+ MathObj.Polynomial.Core: scale :: C a => a -> [a] -> [a]

- MathObj.Polynomial.Core: shift :: (C a) => [a] -> [a]

+ MathObj.Polynomial.Core: shift :: C a => [a] -> [a]

- MathObj.Polynomial.Core: sub :: (C a) => [a] -> [a] -> [a]

+ MathObj.Polynomial.Core: sub :: C a => [a] -> [a] -> [a]

- MathObj.Polynomial.Core: tensorProduct :: (C a) => [a] -> [a] -> [[a]]

+ MathObj.Polynomial.Core: tensorProduct :: C a => [a] -> [a] -> [[a]]

- MathObj.Polynomial.Core: tensorProductAlt :: (C a) => [a] -> [a] -> [[a]]

+ MathObj.Polynomial.Core: tensorProductAlt :: C a => [a] -> [a] -> [[a]]

- MathObj.PowerSeries: approximate :: (C a) => T a -> a -> [a]

+ MathObj.PowerSeries: approximate :: C a => T a -> a -> [a]

- MathObj.PowerSeries: approximateCoeffVector :: (C a v) => T v -> a -> [v]

+ MathObj.PowerSeries: approximateCoeffVector :: C a v => T v -> a -> [v]

- MathObj.PowerSeries: evaluate :: (C a) => T a -> a -> a

+ MathObj.PowerSeries: evaluate :: C a => T a -> a -> a

- MathObj.PowerSeries: evaluateCoeffVector :: (C a v) => T v -> a -> v

+ MathObj.PowerSeries: evaluateCoeffVector :: C a v => T v -> a -> v

- MathObj.PowerSeries.Core: acos :: (C a) => (a -> a) -> (a -> a) -> [a] -> [a]

+ MathObj.PowerSeries.Core: acos :: C a => (a -> a) -> (a -> a) -> [a] -> [a]

- MathObj.PowerSeries.Core: add :: (C a) => [a] -> [a] -> [a]

+ MathObj.PowerSeries.Core: add :: C a => [a] -> [a] -> [a]

- MathObj.PowerSeries.Core: alternate :: (C a) => [a] -> [a]

+ MathObj.PowerSeries.Core: alternate :: C a => [a] -> [a]

- MathObj.PowerSeries.Core: approximate :: (C a) => [a] -> a -> [a]

+ MathObj.PowerSeries.Core: approximate :: C a => [a] -> a -> [a]

- MathObj.PowerSeries.Core: approximateCoeffVector :: (C a v) => [v] -> a -> [v]

+ MathObj.PowerSeries.Core: approximateCoeffVector :: C a v => [v] -> a -> [v]

- MathObj.PowerSeries.Core: asin :: (C a) => (a -> a) -> (a -> a) -> [a] -> [a]

+ MathObj.PowerSeries.Core: asin :: C a => (a -> a) -> (a -> a) -> [a] -> [a]

- MathObj.PowerSeries.Core: atan :: (C a) => (a -> a) -> [a] -> [a]

+ MathObj.PowerSeries.Core: atan :: C a => (a -> a) -> [a] -> [a]

- MathObj.PowerSeries.Core: compose :: (C a) => [a] -> [a] -> [a]

+ MathObj.PowerSeries.Core: compose :: C a => [a] -> [a] -> [a]

- MathObj.PowerSeries.Core: composeTaylor :: (C a) => (a -> [a]) -> [a] -> [a]

+ MathObj.PowerSeries.Core: composeTaylor :: C a => (a -> [a]) -> [a] -> [a]

- MathObj.PowerSeries.Core: cos :: (C a) => (a -> (a, a)) -> [a] -> [a]

+ MathObj.PowerSeries.Core: cos :: C a => (a -> (a, a)) -> [a] -> [a]

- MathObj.PowerSeries.Core: derivedLog :: (C a) => [a] -> [a]

+ MathObj.PowerSeries.Core: derivedLog :: C a => [a] -> [a]

- MathObj.PowerSeries.Core: differentiate :: (C a) => [a] -> [a]

+ MathObj.PowerSeries.Core: differentiate :: C a => [a] -> [a]

- MathObj.PowerSeries.Core: divide :: (C a) => [a] -> [a] -> [a]

+ MathObj.PowerSeries.Core: divide :: C a => [a] -> [a] -> [a]

- MathObj.PowerSeries.Core: evaluate :: (C a) => [a] -> a -> a

+ MathObj.PowerSeries.Core: evaluate :: C a => [a] -> a -> a

- MathObj.PowerSeries.Core: evaluateCoeffVector :: (C a v) => [v] -> a -> v

+ MathObj.PowerSeries.Core: evaluateCoeffVector :: C a v => [v] -> a -> v

- MathObj.PowerSeries.Core: exp :: (C a) => (a -> a) -> [a] -> [a]

+ MathObj.PowerSeries.Core: exp :: C a => (a -> a) -> [a] -> [a]

- MathObj.PowerSeries.Core: holes2 :: (C a) => [a] -> [a]

+ MathObj.PowerSeries.Core: holes2 :: C a => [a] -> [a]

- MathObj.PowerSeries.Core: holes2alternate :: (C a) => [a] -> [a]

+ MathObj.PowerSeries.Core: holes2alternate :: C a => [a] -> [a]

- MathObj.PowerSeries.Core: integrate :: (C a) => a -> [a] -> [a]

+ MathObj.PowerSeries.Core: integrate :: C a => a -> [a] -> [a]

- MathObj.PowerSeries.Core: inv :: (C a) => [a] -> (a, [a])

+ MathObj.PowerSeries.Core: inv :: C a => [a] -> (a, [a])

- MathObj.PowerSeries.Core: log :: (C a) => (a -> a) -> [a] -> [a]

+ MathObj.PowerSeries.Core: log :: C a => (a -> a) -> [a] -> [a]

- MathObj.PowerSeries.Core: mul :: (C a) => [a] -> [a] -> [a]

+ MathObj.PowerSeries.Core: mul :: C a => [a] -> [a] -> [a]

- MathObj.PowerSeries.Core: negate :: (C a) => [a] -> [a]

+ MathObj.PowerSeries.Core: negate :: C a => [a] -> [a]

- MathObj.PowerSeries.Core: pow :: (C a) => (a -> a) -> a -> [a] -> [a]

+ MathObj.PowerSeries.Core: pow :: C a => (a -> a) -> a -> [a] -> [a]

- MathObj.PowerSeries.Core: progression :: (C a) => [a]

+ MathObj.PowerSeries.Core: progression :: C a => [a]

- MathObj.PowerSeries.Core: recipProgression :: (C a) => [a]

+ MathObj.PowerSeries.Core: recipProgression :: C a => [a]

- MathObj.PowerSeries.Core: scale :: (C a) => a -> [a] -> [a]

+ MathObj.PowerSeries.Core: scale :: C a => a -> [a] -> [a]

- MathObj.PowerSeries.Core: sin :: (C a) => (a -> (a, a)) -> [a] -> [a]

+ MathObj.PowerSeries.Core: sin :: C a => (a -> (a, a)) -> [a] -> [a]

- MathObj.PowerSeries.Core: sinCos :: (C a) => (a -> (a, a)) -> [a] -> ([a], [a])

+ MathObj.PowerSeries.Core: sinCos :: C a => (a -> (a, a)) -> [a] -> ([a], [a])

- MathObj.PowerSeries.Core: sinCosScalar :: (C a) => a -> (a, a)

+ MathObj.PowerSeries.Core: sinCosScalar :: C a => a -> (a, a)

- MathObj.PowerSeries.Core: sqrt :: (C a) => (a -> a) -> [a] -> [a]

+ MathObj.PowerSeries.Core: sqrt :: C a => (a -> a) -> [a] -> [a]

- MathObj.PowerSeries.Core: stripLeadZero :: (C a) => [a] -> [a] -> ([a], [a])

+ MathObj.PowerSeries.Core: stripLeadZero :: C a => [a] -> [a] -> ([a], [a])

- MathObj.PowerSeries.Core: sub :: (C a) => [a] -> [a] -> [a]

+ MathObj.PowerSeries.Core: sub :: C a => [a] -> [a] -> [a]

- MathObj.PowerSeries.Core: tan :: (C a) => (a -> (a, a)) -> [a] -> [a]

+ MathObj.PowerSeries.Core: tan :: C a => (a -> (a, a)) -> [a] -> [a]

- MathObj.PowerSeries.DifferentialEquation: solveDiffEq0 :: (C a) => [a]

+ MathObj.PowerSeries.DifferentialEquation: solveDiffEq0 :: C a => [a]

- MathObj.PowerSeries.DifferentialEquation: verifyDiffEq0 :: (C a) => [a]

+ MathObj.PowerSeries.DifferentialEquation: verifyDiffEq0 :: C a => [a]

- MathObj.PowerSeries.Example: acos :: (C a) => [a]

+ MathObj.PowerSeries.Example: acos :: C a => [a]

- MathObj.PowerSeries.Example: acosODE :: (C a) => [a]

+ MathObj.PowerSeries.Example: acosODE :: C a => [a]

- MathObj.PowerSeries.Example: asin :: (C a) => [a]

+ MathObj.PowerSeries.Example: asin :: C a => [a]

- MathObj.PowerSeries.Example: asinODE :: (C a) => [a]

+ MathObj.PowerSeries.Example: asinODE :: C a => [a]

- MathObj.PowerSeries.Example: atan :: (C a) => [a]

+ MathObj.PowerSeries.Example: atan :: C a => [a]

- MathObj.PowerSeries.Example: atanExpl :: (C a) => [a]

+ MathObj.PowerSeries.Example: atanExpl :: C a => [a]

- MathObj.PowerSeries.Example: atanODE :: (C a) => [a]

+ MathObj.PowerSeries.Example: atanODE :: C a => [a]

- MathObj.PowerSeries.Example: atanh :: (C a) => [a]

+ MathObj.PowerSeries.Example: atanh :: C a => [a]

- MathObj.PowerSeries.Example: atanhExpl :: (C a) => [a]

+ MathObj.PowerSeries.Example: atanhExpl :: C a => [a]

- MathObj.PowerSeries.Example: atanhODE :: (C a) => [a]

+ MathObj.PowerSeries.Example: atanhODE :: C a => [a]

- MathObj.PowerSeries.Example: cos :: (C a) => [a]

+ MathObj.PowerSeries.Example: cos :: C a => [a]

- MathObj.PowerSeries.Example: cosExpl :: (C a) => [a]

+ MathObj.PowerSeries.Example: cosExpl :: C a => [a]

- MathObj.PowerSeries.Example: cosODE :: (C a) => [a]

+ MathObj.PowerSeries.Example: cosODE :: C a => [a]

- MathObj.PowerSeries.Example: cosh :: (C a) => [a]

+ MathObj.PowerSeries.Example: cosh :: C a => [a]

- MathObj.PowerSeries.Example: coshExpl :: (C a) => [a]

+ MathObj.PowerSeries.Example: coshExpl :: C a => [a]

- MathObj.PowerSeries.Example: coshODE :: (C a) => [a]

+ MathObj.PowerSeries.Example: coshODE :: C a => [a]

- MathObj.PowerSeries.Example: erf :: (C a) => [a]

+ MathObj.PowerSeries.Example: erf :: C a => [a]

- MathObj.PowerSeries.Example: exp :: (C a) => [a]

+ MathObj.PowerSeries.Example: exp :: C a => [a]

- MathObj.PowerSeries.Example: expExpl :: (C a) => [a]

+ MathObj.PowerSeries.Example: expExpl :: C a => [a]

- MathObj.PowerSeries.Example: expODE :: (C a) => [a]

+ MathObj.PowerSeries.Example: expODE :: C a => [a]

- MathObj.PowerSeries.Example: log :: (C a) => [a]

+ MathObj.PowerSeries.Example: log :: C a => [a]

- MathObj.PowerSeries.Example: logExpl :: (C a) => [a]

+ MathObj.PowerSeries.Example: logExpl :: C a => [a]

- MathObj.PowerSeries.Example: logODE :: (C a) => [a]

+ MathObj.PowerSeries.Example: logODE :: C a => [a]

- MathObj.PowerSeries.Example: pow :: (C a) => a -> [a]

+ MathObj.PowerSeries.Example: pow :: C a => a -> [a]

- MathObj.PowerSeries.Example: powExpl :: (C a) => a -> [a]

+ MathObj.PowerSeries.Example: powExpl :: C a => a -> [a]

- MathObj.PowerSeries.Example: powODE :: (C a) => a -> [a]

+ MathObj.PowerSeries.Example: powODE :: C a => a -> [a]

- MathObj.PowerSeries.Example: recip :: (C a) => [a]

+ MathObj.PowerSeries.Example: recip :: C a => [a]

- MathObj.PowerSeries.Example: recipCircle :: (C a) => [a]

+ MathObj.PowerSeries.Example: recipCircle :: C a => [a]

- MathObj.PowerSeries.Example: recipExpl :: (C a) => [a]

+ MathObj.PowerSeries.Example: recipExpl :: C a => [a]

- MathObj.PowerSeries.Example: sin :: (C a) => [a]

+ MathObj.PowerSeries.Example: sin :: C a => [a]

- MathObj.PowerSeries.Example: sinExpl :: (C a) => [a]

+ MathObj.PowerSeries.Example: sinExpl :: C a => [a]

- MathObj.PowerSeries.Example: sinODE :: (C a) => [a]

+ MathObj.PowerSeries.Example: sinODE :: C a => [a]

- MathObj.PowerSeries.Example: sinh :: (C a) => [a]

+ MathObj.PowerSeries.Example: sinh :: C a => [a]

- MathObj.PowerSeries.Example: sinhExpl :: (C a) => [a]

+ MathObj.PowerSeries.Example: sinhExpl :: C a => [a]

- MathObj.PowerSeries.Example: sinhODE :: (C a) => [a]

+ MathObj.PowerSeries.Example: sinhODE :: C a => [a]

- MathObj.PowerSeries.Example: sqrt :: (C a) => [a]

+ MathObj.PowerSeries.Example: sqrt :: C a => [a]

- MathObj.PowerSeries.Example: sqrtExpl :: (C a) => [a]

+ MathObj.PowerSeries.Example: sqrtExpl :: C a => [a]

- MathObj.PowerSeries.Example: sqrtODE :: (C a) => [a]

+ MathObj.PowerSeries.Example: sqrtODE :: C a => [a]

- MathObj.PowerSeries.Example: tanODE :: (C a) => [a]

+ MathObj.PowerSeries.Example: tanODE :: C a => [a]

- MathObj.PowerSeries.Example: tanODESieve :: (C a) => [a]

+ MathObj.PowerSeries.Example: tanODESieve :: C a => [a]

- MathObj.PowerSeries.Mean: arithmeticMVF :: (C a) => [a]

+ MathObj.PowerSeries.Mean: arithmeticMVF :: C a => [a]

- MathObj.PowerSeries.Mean: diffComp :: (C a) => [a] -> [a] -> [a]

+ MathObj.PowerSeries.Mean: diffComp :: C a => [a] -> [a] -> [a]

- MathObj.PowerSeries.Mean: elemSym3_2 :: (C a) => [a]

+ MathObj.PowerSeries.Mean: elemSym3_2 :: C a => [a]

- MathObj.PowerSeries.Mean: geometricMVF :: (C a) => [a]

+ MathObj.PowerSeries.Mean: geometricMVF :: C a => [a]

- MathObj.PowerSeries.Mean: harmonicMVF :: (C a) => [a]

+ MathObj.PowerSeries.Mean: harmonicMVF :: C a => [a]

- MathObj.PowerSeries.Mean: logarithmic :: (C a) => [a]

+ MathObj.PowerSeries.Mean: logarithmic :: C a => [a]

- MathObj.PowerSeries.Mean: quadraticMVF :: (C a) => [a]

+ MathObj.PowerSeries.Mean: quadraticMVF :: C a => [a]

- MathObj.PowerSeries2: fromPowerSeries0 :: (C a) => T a -> T a

+ MathObj.PowerSeries2: fromPowerSeries0 :: C a => T a -> T a

- MathObj.PowerSeries2: fromPowerSeries1 :: (C a) => T a -> T a

+ MathObj.PowerSeries2: fromPowerSeries1 :: C a => T a -> T a

- MathObj.PowerSeries2.Core: add :: (C a) => T a -> T a -> T a

+ MathObj.PowerSeries2.Core: add :: C a => T a -> T a -> T a

- MathObj.PowerSeries2.Core: compose :: (C a) => [a] -> T a -> T a

+ MathObj.PowerSeries2.Core: compose :: C a => [a] -> T a -> T a

- MathObj.PowerSeries2.Core: differentiate0 :: (C a) => T a -> T a

+ MathObj.PowerSeries2.Core: differentiate0 :: C a => T a -> T a

- MathObj.PowerSeries2.Core: differentiate1 :: (C a) => T a -> T a

+ MathObj.PowerSeries2.Core: differentiate1 :: C a => T a -> T a

- MathObj.PowerSeries2.Core: divide :: (C a) => T a -> T a -> T a

+ MathObj.PowerSeries2.Core: divide :: C a => T a -> T a -> T a

- MathObj.PowerSeries2.Core: integrate0 :: (C a) => [a] -> T a -> T a

+ MathObj.PowerSeries2.Core: integrate0 :: C a => [a] -> T a -> T a

- MathObj.PowerSeries2.Core: integrate1 :: (C a) => [a] -> T a -> T a

+ MathObj.PowerSeries2.Core: integrate1 :: C a => [a] -> T a -> T a

- MathObj.PowerSeries2.Core: mul :: (C a) => T a -> T a -> T a

+ MathObj.PowerSeries2.Core: mul :: C a => T a -> T a -> T a

- MathObj.PowerSeries2.Core: negate :: (C a) => T a -> T a

+ MathObj.PowerSeries2.Core: negate :: C a => T a -> T a

- MathObj.PowerSeries2.Core: scale :: (C a) => a -> T a -> T a

+ MathObj.PowerSeries2.Core: scale :: C a => a -> T a -> T a

- MathObj.PowerSeries2.Core: sqrt :: (C a) => (a -> a) -> T a -> T a

+ MathObj.PowerSeries2.Core: sqrt :: C a => (a -> a) -> T a -> T a

- MathObj.PowerSeries2.Core: sub :: (C a) => T a -> T a -> T a

+ MathObj.PowerSeries2.Core: sub :: C a => T a -> T a -> T a

- MathObj.PowerSum: add :: (C a) => [a] -> [a] -> [a]

+ MathObj.PowerSum: add :: C a => [a] -> [a] -> [a]

- MathObj.PowerSum: approxSeries :: (C a b) => [b] -> [a] -> [b]

+ MathObj.PowerSum: approxSeries :: C a b => [b] -> [a] -> [b]

- MathObj.PowerSum: binomials :: (C a) => [[a]]

+ MathObj.PowerSum: binomials :: C a => [[a]]

- MathObj.PowerSum: const :: (C a) => a -> T a

+ MathObj.PowerSum: const :: C a => a -> T a

- MathObj.PowerSum: elemSymFromPolynomial :: (C a) => T a -> [a]

+ MathObj.PowerSum: elemSymFromPolynomial :: C a => T a -> [a]

- MathObj.PowerSum: mul :: (C a) => [a] -> [a] -> [a]

+ MathObj.PowerSum: mul :: C a => [a] -> [a] -> [a]

- MathObj.PowerSum: root :: (C a) => Integer -> [a] -> [a]

+ MathObj.PowerSum: root :: C a => Integer -> [a] -> [a]

- MathObj.RefinementMask2: fromPolynomial :: (C a) => T a -> T a

+ MathObj.RefinementMask2: fromPolynomial :: C a => T a -> T a

- MathObj.RefinementMask2: refinePolynomial :: (C a) => T a -> T a -> T a

+ MathObj.RefinementMask2: refinePolynomial :: C a => T a -> T a -> T a

- MathObj.RefinementMask2: toPolynomial :: (C a) => T a -> Maybe (T a)

+ MathObj.RefinementMask2: toPolynomial :: C a => T a -> Maybe (T a)

- MathObj.RefinementMask2: toPolynomialFast :: (C a) => T a -> Maybe (T a)

+ MathObj.RefinementMask2: toPolynomialFast :: C a => T a -> Maybe (T a)

- MathObj.RootSet: addRoot :: (C a) => a -> [a] -> [a]

+ MathObj.RootSet: addRoot :: C a => a -> [a] -> [a]

- MathObj.RootSet: const :: (C a) => a -> T a

+ MathObj.RootSet: const :: C a => a -> T a

- MathObj.RootSet: fromRoots :: (C a) => [a] -> [a]

+ MathObj.RootSet: fromRoots :: C a => [a] -> [a]

- Number.Complex: (-:) :: (C a) => a -> a -> T a

+ Number.Complex: (-:) :: C a => a -> a -> T a

- Number.Complex: cis :: (C a) => a -> T a

+ Number.Complex: cis :: C a => a -> T a

- Number.Complex: class (C a) => Power a

+ Number.Complex: class C a => Power a

- Number.Complex: conjugate :: (C a) => T a -> T a

+ Number.Complex: conjugate :: C a => T a -> T a

- Number.Complex: defltPow :: (C a) => Rational -> T a -> T a

+ Number.Complex: defltPow :: C a => Rational -> T a -> T a

- Number.Complex: exp :: (C a) => T a -> T a

+ Number.Complex: exp :: C a => T a -> T a

- Number.Complex: fromPolar :: (C a) => a -> a -> T a

+ Number.Complex: fromPolar :: C a => a -> a -> T a

- Number.Complex: fromReal :: (C a) => a -> T a

+ Number.Complex: fromReal :: C a => a -> T a

- Number.Complex: imaginaryUnit :: (C a) => T a

+ Number.Complex: imaginaryUnit :: C a => T a

- Number.Complex: magnitude :: (C a) => T a -> a

+ Number.Complex: magnitude :: C a => T a -> a

- Number.Complex: magnitudeSqr :: (C a) => T a -> a

+ Number.Complex: magnitudeSqr :: C a => T a -> a

- Number.Complex: power :: (Power a) => Rational -> T a -> T a

+ Number.Complex: power :: Power a => Rational -> T a -> T a

- Number.Complex: propPolar :: (C a) => T a -> Bool

+ Number.Complex: propPolar :: C a => T a -> Bool

- Number.Complex: quarterLeft :: (C a) => T a -> T a

+ Number.Complex: quarterLeft :: C a => T a -> T a

- Number.Complex: quarterRight :: (C a) => T a -> T a

+ Number.Complex: quarterRight :: C a => T a -> T a

- Number.Complex: scale :: (C a) => a -> T a -> T a

+ Number.Complex: scale :: C a => a -> T a -> T a

- Number.Complex: toPolar :: (C a) => T a -> (a, a)

+ Number.Complex: toPolar :: C a => T a -> (a, a)

- Number.DimensionTerm: cancelToScalar :: (C u) => T (Mul u (Recip u)) a -> a

+ Number.DimensionTerm: cancelToScalar :: C u => T (Mul u (Recip u)) a -> a

- Number.DimensionTerm: fromNumberWithDimension :: (C u) => u -> a -> T u a

+ Number.DimensionTerm: fromNumberWithDimension :: C u => u -> a -> T u a

- Number.DimensionTerm: toNumberWithDimension :: (C u) => u -> T u a -> a

+ Number.DimensionTerm: toNumberWithDimension :: C u => u -> T u a -> a

- Number.DimensionTerm.SI: astronomicUnit :: (C a) => Length a

+ Number.DimensionTerm.SI: astronomicUnit :: C a => Length a

- Number.DimensionTerm.SI: atto :: (C a) => a

+ Number.DimensionTerm.SI: atto :: C a => a

- Number.DimensionTerm.SI: bit :: (C a) => Information a

+ Number.DimensionTerm.SI: bit :: C a => Information a

- Number.DimensionTerm.SI: byte :: (C a) => Information a

+ Number.DimensionTerm.SI: byte :: C a => Information a

- Number.DimensionTerm.SI: centi :: (C a) => a

+ Number.DimensionTerm.SI: centi :: C a => a

- Number.DimensionTerm.SI: coulomb :: (C a) => Charge a

+ Number.DimensionTerm.SI: coulomb :: C a => Charge a

- Number.DimensionTerm.SI: day :: (C a) => Time a

+ Number.DimensionTerm.SI: day :: C a => Time a

- Number.DimensionTerm.SI: deca :: (C a) => a

+ Number.DimensionTerm.SI: deca :: C a => a

- Number.DimensionTerm.SI: deci :: (C a) => a

+ Number.DimensionTerm.SI: deci :: C a => a

- Number.DimensionTerm.SI: exa :: (C a) => a

+ Number.DimensionTerm.SI: exa :: C a => a

- Number.DimensionTerm.SI: femto :: (C a) => a

+ Number.DimensionTerm.SI: femto :: C a => a

- Number.DimensionTerm.SI: foot :: (C a) => Length a

+ Number.DimensionTerm.SI: foot :: C a => Length a

- Number.DimensionTerm.SI: giga :: (C a) => a

+ Number.DimensionTerm.SI: giga :: C a => a

- Number.DimensionTerm.SI: gramm :: (C a) => Mass a

+ Number.DimensionTerm.SI: gramm :: C a => Mass a

- Number.DimensionTerm.SI: hecto :: (C a) => a

+ Number.DimensionTerm.SI: hecto :: C a => a

- Number.DimensionTerm.SI: hertz :: (C a) => Frequency a

+ Number.DimensionTerm.SI: hertz :: C a => Frequency a

- Number.DimensionTerm.SI: hour :: (C a) => Time a

+ Number.DimensionTerm.SI: hour :: C a => Time a

- Number.DimensionTerm.SI: inch :: (C a) => Length a

+ Number.DimensionTerm.SI: inch :: C a => Length a

- Number.DimensionTerm.SI: kelvin :: (C a) => Temperature a

+ Number.DimensionTerm.SI: kelvin :: C a => Temperature a

- Number.DimensionTerm.SI: kilo :: (C a) => a

+ Number.DimensionTerm.SI: kilo :: C a => a

- Number.DimensionTerm.SI: mega :: (C a) => a

+ Number.DimensionTerm.SI: mega :: C a => a

- Number.DimensionTerm.SI: meter :: (C a) => Length a

+ Number.DimensionTerm.SI: meter :: C a => Length a

- Number.DimensionTerm.SI: micro :: (C a) => a

+ Number.DimensionTerm.SI: micro :: C a => a

- Number.DimensionTerm.SI: milli :: (C a) => a

+ Number.DimensionTerm.SI: milli :: C a => a

- Number.DimensionTerm.SI: minute :: (C a) => Time a

+ Number.DimensionTerm.SI: minute :: C a => Time a

- Number.DimensionTerm.SI: nano :: (C a) => a

+ Number.DimensionTerm.SI: nano :: C a => a

- Number.DimensionTerm.SI: one :: (C a) => a

+ Number.DimensionTerm.SI: one :: C a => a

- Number.DimensionTerm.SI: parsec :: (C a) => Length a

+ Number.DimensionTerm.SI: parsec :: C a => Length a

- Number.DimensionTerm.SI: peta :: (C a) => a

+ Number.DimensionTerm.SI: peta :: C a => a

- Number.DimensionTerm.SI: pico :: (C a) => a

+ Number.DimensionTerm.SI: pico :: C a => a

- Number.DimensionTerm.SI: second :: (C a) => Time a

+ Number.DimensionTerm.SI: second :: C a => Time a

- Number.DimensionTerm.SI: tera :: (C a) => a

+ Number.DimensionTerm.SI: tera :: C a => a

- Number.DimensionTerm.SI: tonne :: (C a) => Mass a

+ Number.DimensionTerm.SI: tonne :: C a => Mass a

- Number.DimensionTerm.SI: volt :: (C a) => Voltage a

+ Number.DimensionTerm.SI: volt :: C a => Voltage a

- Number.DimensionTerm.SI: yard :: (C a) => Length a

+ Number.DimensionTerm.SI: yard :: C a => Length a

- Number.DimensionTerm.SI: year :: (C a) => Time a

+ Number.DimensionTerm.SI: year :: C a => Time a

- Number.DimensionTerm.SI: yocto :: (C a) => a

+ Number.DimensionTerm.SI: yocto :: C a => a

- Number.DimensionTerm.SI: yotta :: (C a) => a

+ Number.DimensionTerm.SI: yotta :: C a => a

- Number.DimensionTerm.SI: zepto :: (C a) => a

+ Number.DimensionTerm.SI: zepto :: C a => a

- Number.DimensionTerm.SI: zetta :: (C a) => a

+ Number.DimensionTerm.SI: zetta :: C a => a

- Number.FixedPoint: fromFloat :: (C a) => Integer -> a -> Integer

+ Number.FixedPoint: fromFloat :: C a => Integer -> a -> Integer

- Number.FixedPoint.Check: fromFloat :: (C a) => Integer -> a -> T

+ Number.FixedPoint.Check: fromFloat :: C a => Integer -> a -> T

- Number.FixedPoint.Check: fromFloatBasis :: (C a) => Integer -> Int -> a -> T

+ Number.FixedPoint.Check: fromFloatBasis :: C a => Integer -> Int -> a -> T

- Number.GaloisField2p32m5: base :: (C a) => a

+ Number.GaloisField2p32m5: base :: C a => a

- Number.NonNegativeChunky: fromChunks :: (C a) => [a] -> T a

+ Number.NonNegativeChunky: fromChunks :: C a => [a] -> T a

- Number.NonNegativeChunky: fromNumber :: (C a) => a -> T a

+ Number.NonNegativeChunky: fromNumber :: C a => a -> T a

- Number.NonNegativeChunky: isNull :: (C a) => T a -> Bool

+ Number.NonNegativeChunky: isNull :: C a => T a -> Bool

- Number.NonNegativeChunky: isPositive :: (C a) => T a -> Bool

+ Number.NonNegativeChunky: isPositive :: C a => T a -> Bool

- Number.NonNegativeChunky: minMaxDiff :: (C a) => T a -> T a -> (T a, (Bool, T a))

+ Number.NonNegativeChunky: minMaxDiff :: C a => T a -> T a -> (T a, (Bool, T a))

- Number.NonNegativeChunky: normalize :: (C a) => T a -> T a

+ Number.NonNegativeChunky: normalize :: C a => T a -> T a

- Number.NonNegativeChunky: toChunks :: (C a) => T a -> [a]

+ Number.NonNegativeChunky: toChunks :: C a => T a -> [a]

- Number.NonNegativeChunky: toNumber :: (C a) => T a -> a

+ Number.NonNegativeChunky: toNumber :: C a => T a -> a

- Number.OccasionallyScalarExpression: showUnitError :: (Show v) => Bool -> Int -> v -> T a v -> String

+ Number.OccasionallyScalarExpression: showUnitError :: Show v => Bool -> Int -> v -> T a v -> String

- Number.Physical: lift2 :: (Eq i) => String -> (a -> b -> c) -> T i a -> T i b -> T i c

+ Number.Physical: lift2 :: Eq i => String -> (a -> b -> c) -> T i a -> T i b -> T i c

- Number.Physical: lift2Gen :: (Eq i) => String -> (a -> b -> c) -> T i a -> T i b -> c

+ Number.Physical: lift2Gen :: Eq i => String -> (a -> b -> c) -> T i a -> T i b -> c

- Number.Physical: lift2Maybe :: (Eq i) => (a -> b -> c) -> T i a -> T i b -> Maybe (T i c)

+ Number.Physical: lift2Maybe :: Eq i => (a -> b -> c) -> T i a -> T i b -> Maybe (T i c)

- Number.Physical: ratPow :: (C a) => T Int -> T i a -> T i a

+ Number.Physical: ratPow :: C a => T Int -> T i a -> T i a

- Number.Physical: ratPowMaybe :: (C a) => T Int -> T i a -> Maybe (T i a)

+ Number.Physical: ratPowMaybe :: C a => T Int -> T i a -> Maybe (T i a)

- Number.Physical.Show: getUnit :: (C a) => String -> T i a -> T i a

+ Number.Physical.Show: getUnit :: C a => String -> T i a -> T i a

- Number.Physical.Show: totalDefScale :: (C a) => T i a -> a

+ Number.Physical.Show: totalDefScale :: C a => T i a -> a

- Number.Physical.UnitDatabase: distances :: (Ord i) => T i -> [(Int, T i)] -> [(Int, Int)]

+ Number.Physical.UnitDatabase: distances :: Ord i => T i -> [(Int, T i)] -> [(Int, Int)]

- Number.Physical.UnitDatabase: findBestExp :: (Ord i) => T i -> T i -> (Int, Int)

+ Number.Physical.UnitDatabase: findBestExp :: Ord i => T i -> T i -> (Int, Int)

- Number.Physical.UnitDatabase: findIndep :: (Eq i) => T i -> T i a -> Maybe (UnitSet i a)

+ Number.Physical.UnitDatabase: findIndep :: Eq i => T i -> T i a -> Maybe (UnitSet i a)

- Number.Physical.UnitDatabase: powerOfScale :: (C a) => Int -> Scale a -> Scale a

+ Number.Physical.UnitDatabase: powerOfScale :: C a => Int -> Scale a -> Scale a

- Number.Positional: mantissaFromCard :: (C a) => Basis -> a -> Mantissa

+ Number.Positional: mantissaFromCard :: C a => Basis -> a -> Mantissa

- Number.Positional: mantissaFromInt :: (C a) => Basis -> a -> Mantissa

+ Number.Positional: mantissaFromInt :: C a => Basis -> a -> Mantissa

- Number.Positional: mantissaToNum :: (C a) => Basis -> Mantissa -> a

+ Number.Positional: mantissaToNum :: C a => Basis -> Mantissa -> a

- Number.Quaternion: conjugate :: (C a) => T a -> T a

+ Number.Quaternion: conjugate :: C a => T a -> T a

- Number.Quaternion: crossProduct :: (C a) => (a, a, a) -> (a, a, a) -> (a, a, a)

+ Number.Quaternion: crossProduct :: C a => (a, a, a) -> (a, a, a) -> (a, a, a)

- Number.Quaternion: fromComplexMatrix :: (C a) => Array (Int, Int) (T a) -> T a

+ Number.Quaternion: fromComplexMatrix :: C a => Array (Int, Int) (T a) -> T a

- Number.Quaternion: fromReal :: (C a) => a -> T a

+ Number.Quaternion: fromReal :: C a => a -> T a

- Number.Quaternion: fromRotationMatrix :: (C a) => Array (Int, Int) a -> T a

+ Number.Quaternion: fromRotationMatrix :: C a => Array (Int, Int) a -> T a

- Number.Quaternion: fromRotationMatrixDenorm :: (C a) => Array (Int, Int) a -> T a

+ Number.Quaternion: fromRotationMatrixDenorm :: C a => Array (Int, Int) a -> T a

- Number.Quaternion: norm :: (C a) => T a -> a

+ Number.Quaternion: norm :: C a => T a -> a

- Number.Quaternion: normSqr :: (C a) => T a -> a

+ Number.Quaternion: normSqr :: C a => T a -> a

- Number.Quaternion: normalize :: (C a) => T a -> T a

+ Number.Quaternion: normalize :: C a => T a -> T a

- Number.Quaternion: scalarProduct :: (C a) => (a, a, a) -> (a, a, a) -> a

+ Number.Quaternion: scalarProduct :: C a => (a, a, a) -> (a, a, a) -> a

- Number.Quaternion: scale :: (C a) => a -> T a -> T a

+ Number.Quaternion: scale :: C a => a -> T a -> T a

- Number.Quaternion: similarity :: (C a) => T a -> T a -> T a

+ Number.Quaternion: similarity :: C a => T a -> T a -> T a

- Number.Quaternion: slerp :: (C a) => a -> (a, a, a) -> (a, a, a) -> (a, a, a)

+ Number.Quaternion: slerp :: C a => a -> (a, a, a) -> (a, a, a) -> (a, a, a)

- Number.Quaternion: toComplexMatrix :: (C a) => T a -> Array (Int, Int) (T a)

+ Number.Quaternion: toComplexMatrix :: C a => T a -> Array (Int, Int) (T a)

- Number.Quaternion: toRotationMatrix :: (C a) => T a -> Array (Int, Int) a

+ Number.Quaternion: toRotationMatrix :: C a => T a -> Array (Int, Int) a

- Number.Ratio: (%) :: (C a) => a -> a -> T a

+ Number.Ratio: (%) :: C a => a -> a -> T a

- Number.Ratio: fromValue :: (C a) => a -> T a

+ Number.Ratio: fromValue :: C a => a -> T a

- Number.Ratio: scale :: (C a) => a -> T a -> T a

+ Number.Ratio: scale :: C a => a -> T a -> T a

- Number.Ratio: split :: (C a) => T a -> (a, T a)

+ Number.Ratio: split :: C a => T a -> (a, T a)

- Number.ResidueClass: add :: (C a) => a -> a -> a -> a

+ Number.ResidueClass: add :: C a => a -> a -> a -> a

- Number.ResidueClass: divide :: (C a) => a -> a -> a -> a

+ Number.ResidueClass: divide :: C a => a -> a -> a -> a

- Number.ResidueClass: divideMaybe :: (C a) => a -> a -> a -> Maybe a

+ Number.ResidueClass: divideMaybe :: C a => a -> a -> a -> Maybe a

- Number.ResidueClass: mul :: (C a) => a -> a -> a -> a

+ Number.ResidueClass: mul :: C a => a -> a -> a -> a

- Number.ResidueClass: neg :: (C a) => a -> a -> a

+ Number.ResidueClass: neg :: C a => a -> a -> a

- Number.ResidueClass: recip :: (C a) => a -> a -> a

+ Number.ResidueClass: recip :: C a => a -> a -> a

- Number.ResidueClass: sub :: (C a) => a -> a -> a -> a

+ Number.ResidueClass: sub :: C a => a -> a -> a -> a

- Number.ResidueClass.Check: (/:) :: (C a) => a -> a -> T a

+ Number.ResidueClass.Check: (/:) :: C a => a -> a -> T a

- Number.ResidueClass.Check: fromInteger :: (C a) => a -> Integer -> T a

+ Number.ResidueClass.Check: fromInteger :: C a => a -> Integer -> T a

- Number.ResidueClass.Check: fromRepresentative :: (C a) => a -> a -> T a

+ Number.ResidueClass.Check: fromRepresentative :: C a => a -> a -> T a

- Number.ResidueClass.Check: isCompatible :: (Eq a) => T a -> T a -> Bool

+ Number.ResidueClass.Check: isCompatible :: Eq a => T a -> T a -> Bool

- Number.ResidueClass.Check: lift1 :: (Eq a) => (a -> a -> a) -> T a -> T a

+ Number.ResidueClass.Check: lift1 :: Eq a => (a -> a -> a) -> T a -> T a

- Number.ResidueClass.Check: lift2 :: (Eq a) => (a -> a -> a -> a) -> T a -> T a -> T a

+ Number.ResidueClass.Check: lift2 :: Eq a => (a -> a -> a -> a) -> T a -> T a -> T a

- Number.ResidueClass.Check: maybeCompatible :: (Eq a) => T a -> T a -> Maybe a

+ Number.ResidueClass.Check: maybeCompatible :: Eq a => T a -> T a -> Maybe a

- Number.ResidueClass.Check: one :: (C a) => a -> T a

+ Number.ResidueClass.Check: one :: C a => a -> T a

- Number.ResidueClass.Check: zero :: (C a) => a -> T a

+ Number.ResidueClass.Check: zero :: C a => a -> T a

- Number.ResidueClass.Func: equal :: (Eq a) => a -> T a -> T a -> Bool

+ Number.ResidueClass.Func: equal :: Eq a => a -> T a -> T a -> Bool

- Number.ResidueClass.Func: fromInteger :: (C a) => Integer -> T a

+ Number.ResidueClass.Func: fromInteger :: C a => Integer -> T a

- Number.ResidueClass.Func: fromRepresentative :: (C a) => a -> T a

+ Number.ResidueClass.Func: fromRepresentative :: C a => a -> T a

- Number.ResidueClass.Func: one :: (C a) => T a

+ Number.ResidueClass.Func: one :: C a => T a

- Number.ResidueClass.Func: zero :: (C a) => T a

+ Number.ResidueClass.Func: zero :: C a => T a

- Number.ResidueClass.Maybe: (/:) :: (C a) => a -> a -> T a

+ Number.ResidueClass.Maybe: (/:) :: C a => a -> a -> T a

- Number.ResidueClass.Maybe: isCompatible :: (Eq a) => T a -> T a -> Bool

+ Number.ResidueClass.Maybe: isCompatible :: Eq a => T a -> T a -> Bool

- Number.ResidueClass.Maybe: isCompatibleMaybe :: (Eq a) => Maybe a -> Maybe a -> Bool

+ Number.ResidueClass.Maybe: isCompatibleMaybe :: Eq a => Maybe a -> Maybe a -> Bool

- Number.ResidueClass.Maybe: lift2 :: (Eq a) => (a -> a -> a -> a) -> (a -> a -> a) -> (T a -> T a -> T a)

+ Number.ResidueClass.Maybe: lift2 :: Eq a => (a -> a -> a -> a) -> (a -> a -> a) -> (T a -> T a -> T a)

- Number.ResidueClass.Reader: fromInteger :: (C a) => Integer -> T a a

+ Number.ResidueClass.Reader: fromInteger :: C a => Integer -> T a a

- Number.ResidueClass.Reader: fromRepresentative :: (C a) => a -> T a a

+ Number.ResidueClass.Reader: fromRepresentative :: C a => a -> T a a

- Number.ResidueClass.Reader: getAdd :: (C a) => T a (a -> a -> a)

+ Number.ResidueClass.Reader: getAdd :: C a => T a (a -> a -> a)

- Number.ResidueClass.Reader: getAdditiveVars :: (C a) => T a (a, a -> a -> a, a -> a -> a, a -> a)

+ Number.ResidueClass.Reader: getAdditiveVars :: C a => T a (a, a -> a -> a, a -> a -> a, a -> a)

- Number.ResidueClass.Reader: getDivide :: (C a) => T a (a -> a -> a)

+ Number.ResidueClass.Reader: getDivide :: C a => T a (a -> a -> a)

- Number.ResidueClass.Reader: getFieldVars :: (C a) => T a (a -> a -> a, a -> a)

+ Number.ResidueClass.Reader: getFieldVars :: C a => T a (a -> a -> a, a -> a)

- Number.ResidueClass.Reader: getMul :: (C a) => T a (a -> a -> a)

+ Number.ResidueClass.Reader: getMul :: C a => T a (a -> a -> a)

- Number.ResidueClass.Reader: getNeg :: (C a) => T a (a -> a)

+ Number.ResidueClass.Reader: getNeg :: C a => T a (a -> a)

- Number.ResidueClass.Reader: getOne :: (C a) => T a a

+ Number.ResidueClass.Reader: getOne :: C a => T a a

- Number.ResidueClass.Reader: getRecip :: (C a) => T a (a -> a)

+ Number.ResidueClass.Reader: getRecip :: C a => T a (a -> a)

- Number.ResidueClass.Reader: getRingVars :: (C a) => T a (a, a -> a -> a)

+ Number.ResidueClass.Reader: getRingVars :: C a => T a (a, a -> a -> a)

- Number.ResidueClass.Reader: getSub :: (C a) => T a (a -> a -> a)

+ Number.ResidueClass.Reader: getSub :: C a => T a (a -> a -> a)

- Number.ResidueClass.Reader: getZero :: (C a) => T a a

+ Number.ResidueClass.Reader: getZero :: C a => T a a

- Number.ResidueClass.Reader: monadExample :: (C a) => T a [a]

+ Number.ResidueClass.Reader: monadExample :: C a => T a [a]

- Number.SI: scale :: (C v) => v -> T a v -> T a v

+ Number.SI: scale :: C v => v -> T a v -> T a v

- Number.SI.Unit: accelerationOfEarthGravity :: (C a) => a

+ Number.SI.Unit: accelerationOfEarthGravity :: C a => a

- Number.SI.Unit: atto :: (C a) => a

+ Number.SI.Unit: atto :: C a => a

- Number.SI.Unit: bytesize :: (C a) => a

+ Number.SI.Unit: bytesize :: C a => a

- Number.SI.Unit: calorien :: (C a) => a

+ Number.SI.Unit: calorien :: C a => a

- Number.SI.Unit: centi :: (C a) => a

+ Number.SI.Unit: centi :: C a => a

- Number.SI.Unit: database :: (C a) => [InitUnitSet Dimension a]

+ Number.SI.Unit: database :: C a => [InitUnitSet Dimension a]

- Number.SI.Unit: databaseRead :: (C a) => T Dimension a

+ Number.SI.Unit: databaseRead :: C a => T Dimension a

- Number.SI.Unit: databaseShow :: (C a) => T Dimension a

+ Number.SI.Unit: databaseShow :: C a => T Dimension a

- Number.SI.Unit: deca :: (C a) => a

+ Number.SI.Unit: deca :: C a => a

- Number.SI.Unit: deci :: (C a) => a

+ Number.SI.Unit: deci :: C a => a

- Number.SI.Unit: deg180 :: (C a) => a

+ Number.SI.Unit: deg180 :: C a => a

- Number.SI.Unit: electronVolt :: (C a) => a

+ Number.SI.Unit: electronVolt :: C a => a

- Number.SI.Unit: exa :: (C a) => a

+ Number.SI.Unit: exa :: C a => a

- Number.SI.Unit: femto :: (C a) => a

+ Number.SI.Unit: femto :: C a => a

- Number.SI.Unit: fourth :: (C a) => a

+ Number.SI.Unit: fourth :: C a => a

- Number.SI.Unit: giga :: (C a) => a

+ Number.SI.Unit: giga :: C a => a

- Number.SI.Unit: grad200 :: (C a) => a

+ Number.SI.Unit: grad200 :: C a => a

- Number.SI.Unit: half :: (C a) => a

+ Number.SI.Unit: half :: C a => a

- Number.SI.Unit: hecto :: (C a) => a

+ Number.SI.Unit: hecto :: C a => a

- Number.SI.Unit: horsePower :: (C a) => a

+ Number.SI.Unit: horsePower :: C a => a

- Number.SI.Unit: k2 :: (C a) => a

+ Number.SI.Unit: k2 :: C a => a

- Number.SI.Unit: kilo :: (C a) => a

+ Number.SI.Unit: kilo :: C a => a

- Number.SI.Unit: mach :: (C a) => a

+ Number.SI.Unit: mach :: C a => a

- Number.SI.Unit: mega :: (C a) => a

+ Number.SI.Unit: mega :: C a => a

- Number.SI.Unit: meterPerAstronomicUnit :: (C a) => a

+ Number.SI.Unit: meterPerAstronomicUnit :: C a => a

- Number.SI.Unit: meterPerFoot :: (C a) => a

+ Number.SI.Unit: meterPerFoot :: C a => a

- Number.SI.Unit: meterPerInch :: (C a) => a

+ Number.SI.Unit: meterPerInch :: C a => a

- Number.SI.Unit: meterPerParsec :: (C a) => a

+ Number.SI.Unit: meterPerParsec :: C a => a

- Number.SI.Unit: meterPerYard :: (C a) => a

+ Number.SI.Unit: meterPerYard :: C a => a

- Number.SI.Unit: micro :: (C a) => a

+ Number.SI.Unit: micro :: C a => a

- Number.SI.Unit: milli :: (C a) => a

+ Number.SI.Unit: milli :: C a => a

- Number.SI.Unit: nano :: (C a) => a

+ Number.SI.Unit: nano :: C a => a

- Number.SI.Unit: one :: (C a) => a

+ Number.SI.Unit: one :: C a => a

- Number.SI.Unit: percent :: (C a) => a

+ Number.SI.Unit: percent :: C a => a

- Number.SI.Unit: peta :: (C a) => a

+ Number.SI.Unit: peta :: C a => a

- Number.SI.Unit: pico :: (C a) => a

+ Number.SI.Unit: pico :: C a => a

- Number.SI.Unit: radPerDeg :: (C a) => a

+ Number.SI.Unit: radPerDeg :: C a => a

- Number.SI.Unit: radPerGrad :: (C a) => a

+ Number.SI.Unit: radPerGrad :: C a => a

- Number.SI.Unit: secondsPerDay :: (C a) => a

+ Number.SI.Unit: secondsPerDay :: C a => a

- Number.SI.Unit: secondsPerHour :: (C a) => a

+ Number.SI.Unit: secondsPerHour :: C a => a

- Number.SI.Unit: secondsPerMinute :: (C a) => a

+ Number.SI.Unit: secondsPerMinute :: C a => a

- Number.SI.Unit: secondsPerYear :: (C a) => a

+ Number.SI.Unit: secondsPerYear :: C a => a

- Number.SI.Unit: speedOfLight :: (C a) => a

+ Number.SI.Unit: speedOfLight :: C a => a

- Number.SI.Unit: tera :: (C a) => a

+ Number.SI.Unit: tera :: C a => a

- Number.SI.Unit: threeFourth :: (C a) => a

+ Number.SI.Unit: threeFourth :: C a => a

- Number.SI.Unit: yocto :: (C a) => a

+ Number.SI.Unit: yocto :: C a => a

- Number.SI.Unit: yotta :: (C a) => a

+ Number.SI.Unit: yotta :: C a => a

- Number.SI.Unit: zepto :: (C a) => a

+ Number.SI.Unit: zepto :: C a => a

- Number.SI.Unit: zetta :: (C a) => a

+ Number.SI.Unit: zetta :: C a => a

- NumericPrelude: max :: (C a) => a -> a -> a

+ NumericPrelude: max :: C a => a -> a -> a

- NumericPrelude: min :: (C a) => a -> a -> a

+ NumericPrelude: min :: C a => a -> a -> a

- NumericPrelude.List.Checked: (!!) :: (C n) => [a] -> n -> a

+ NumericPrelude.List.Checked: (!!) :: C n => [a] -> n -> a

- NumericPrelude.List.Checked: drop :: (C n) => n -> [a] -> [a]

+ NumericPrelude.List.Checked: drop :: C n => n -> [a] -> [a]

- NumericPrelude.List.Checked: splitAt :: (C n) => n -> [a] -> ([a], [a])

+ NumericPrelude.List.Checked: splitAt :: C n => n -> [a] -> ([a], [a])

- NumericPrelude.List.Checked: take :: (C n) => n -> [a] -> [a]

+ NumericPrelude.List.Checked: take :: C n => n -> [a] -> [a]

- NumericPrelude.List.Generic: (!!) :: (C n) => [a] -> n -> a

+ NumericPrelude.List.Generic: (!!) :: C n => [a] -> n -> a

- NumericPrelude.List.Generic: drop :: (C n) => n -> [a] -> [a]

+ NumericPrelude.List.Generic: drop :: C n => n -> [a] -> [a]

- NumericPrelude.List.Generic: findIndex :: (C n) => (a -> Bool) -> [a] -> Maybe n

+ NumericPrelude.List.Generic: findIndex :: C n => (a -> Bool) -> [a] -> Maybe n

- NumericPrelude.List.Generic: findIndices :: (C n) => (a -> Bool) -> [a] -> [n]

+ NumericPrelude.List.Generic: findIndices :: C n => (a -> Bool) -> [a] -> [n]

- NumericPrelude.List.Generic: lengthLeft :: (C n) => [a] -> n

+ NumericPrelude.List.Generic: lengthLeft :: C n => [a] -> n

- NumericPrelude.List.Generic: lengthRight :: (C n) => [a] -> n

+ NumericPrelude.List.Generic: lengthRight :: C n => [a] -> n

- NumericPrelude.List.Generic: replicate :: (C n) => n -> a -> [a]

+ NumericPrelude.List.Generic: replicate :: C n => n -> a -> [a]

- NumericPrelude.List.Generic: splitAt :: (C n) => n -> [a] -> ([a], [a])

+ NumericPrelude.List.Generic: splitAt :: C n => n -> [a] -> ([a], [a])

- NumericPrelude.List.Generic: take :: (C n) => n -> [a] -> [a]

+ NumericPrelude.List.Generic: take :: C n => n -> [a] -> [a]

- NumericPrelude.Numeric: (%) :: (C a) => a -> a -> T a

+ NumericPrelude.Numeric: (%) :: C a => a -> a -> T a

- NumericPrelude.Numeric: (*) :: (C a) => a -> a -> a

+ NumericPrelude.Numeric: (*) :: C a => a -> a -> a

- NumericPrelude.Numeric: (**) :: (C a) => a -> a -> a

+ NumericPrelude.Numeric: (**) :: C a => a -> a -> a

- NumericPrelude.Numeric: (*>) :: (C a v) => a -> v -> v

+ NumericPrelude.Numeric: (*>) :: C a v => a -> v -> v

- NumericPrelude.Numeric: (+) :: (C a) => a -> a -> a

+ NumericPrelude.Numeric: (+) :: C a => a -> a -> a

- NumericPrelude.Numeric: (-) :: (C a) => a -> a -> a

+ NumericPrelude.Numeric: (-) :: C a => a -> a -> a

- NumericPrelude.Numeric: (/) :: (C a) => a -> a -> a

+ NumericPrelude.Numeric: (/) :: C a => a -> a -> a

- NumericPrelude.Numeric: (^) :: (C a) => a -> Integer -> a

+ NumericPrelude.Numeric: (^) :: C a => a -> Integer -> a

- NumericPrelude.Numeric: (^-) :: (C a) => a -> Integer -> a

+ NumericPrelude.Numeric: (^-) :: C a => a -> Integer -> a

- NumericPrelude.Numeric: (^/) :: (C a) => a -> Rational -> a

+ NumericPrelude.Numeric: (^/) :: C a => a -> Rational -> a

- NumericPrelude.Numeric: (^?) :: (C a) => a -> a -> a

+ NumericPrelude.Numeric: (^?) :: C a => a -> a -> a

- NumericPrelude.Numeric: abs :: (C a) => a -> a

+ NumericPrelude.Numeric: abs :: C a => a -> a

- NumericPrelude.Numeric: acos :: (C a) => a -> a

+ NumericPrelude.Numeric: acos :: C a => a -> a

- NumericPrelude.Numeric: acosh :: (C a) => a -> a

+ NumericPrelude.Numeric: acosh :: C a => a -> a

- NumericPrelude.Numeric: asin :: (C a) => a -> a

+ NumericPrelude.Numeric: asin :: C a => a -> a

- NumericPrelude.Numeric: asinh :: (C a) => a -> a

+ NumericPrelude.Numeric: asinh :: C a => a -> a

- NumericPrelude.Numeric: atan :: (C a) => a -> a

+ NumericPrelude.Numeric: atan :: C a => a -> a

- NumericPrelude.Numeric: atan2 :: (C a) => a -> a -> a

+ NumericPrelude.Numeric: atan2 :: C a => a -> a -> a

- NumericPrelude.Numeric: atanh :: (C a) => a -> a

+ NumericPrelude.Numeric: atanh :: C a => a -> a

- NumericPrelude.Numeric: cos :: (C a) => a -> a

+ NumericPrelude.Numeric: cos :: C a => a -> a

- NumericPrelude.Numeric: cosh :: (C a) => a -> a

+ NumericPrelude.Numeric: cosh :: C a => a -> a

- NumericPrelude.Numeric: div :: (C a) => a -> a -> a

+ NumericPrelude.Numeric: div :: C a => a -> a -> a

- NumericPrelude.Numeric: divMod :: (C a) => a -> a -> (a, a)

+ NumericPrelude.Numeric: divMod :: C a => a -> a -> (a, a)

- NumericPrelude.Numeric: exp :: (C a) => a -> a

+ NumericPrelude.Numeric: exp :: C a => a -> a

- NumericPrelude.Numeric: extendedGCD :: (C a) => a -> a -> (a, (a, a))

+ NumericPrelude.Numeric: extendedGCD :: C a => a -> a -> (a, (a, a))

- NumericPrelude.Numeric: fraction :: (C a) => a -> a

+ NumericPrelude.Numeric: fraction :: C a => a -> a

- NumericPrelude.Numeric: fromInteger :: (C a) => Integer -> a

+ NumericPrelude.Numeric: fromInteger :: C a => Integer -> a

- NumericPrelude.Numeric: fromRational :: (C a) => Rational -> a

+ NumericPrelude.Numeric: fromRational :: C a => Rational -> a

- NumericPrelude.Numeric: fromRational' :: (C a) => Rational -> a

+ NumericPrelude.Numeric: fromRational' :: C a => Rational -> a

- NumericPrelude.Numeric: gcd :: (C a) => a -> a -> a

+ NumericPrelude.Numeric: gcd :: C a => a -> a -> a

- NumericPrelude.Numeric: isUnit :: (C a) => a -> Bool

+ NumericPrelude.Numeric: isUnit :: C a => a -> Bool

- NumericPrelude.Numeric: isZero :: (C a) => a -> Bool

+ NumericPrelude.Numeric: isZero :: C a => a -> Bool

- NumericPrelude.Numeric: lcm :: (C a) => a -> a -> a

+ NumericPrelude.Numeric: lcm :: C a => a -> a -> a

- NumericPrelude.Numeric: log :: (C a) => a -> a

+ NumericPrelude.Numeric: log :: C a => a -> a

- NumericPrelude.Numeric: logBase :: (C a) => a -> a -> a

+ NumericPrelude.Numeric: logBase :: C a => a -> a -> a

- NumericPrelude.Numeric: mod :: (C a) => a -> a -> a

+ NumericPrelude.Numeric: mod :: C a => a -> a -> a

- NumericPrelude.Numeric: negate :: (C a) => a -> a

+ NumericPrelude.Numeric: negate :: C a => a -> a

- NumericPrelude.Numeric: one :: (C a) => a

+ NumericPrelude.Numeric: one :: C a => a

- NumericPrelude.Numeric: pi :: (C a) => a

+ NumericPrelude.Numeric: pi :: C a => a

- NumericPrelude.Numeric: product :: (C a) => [a] -> a

+ NumericPrelude.Numeric: product :: C a => [a] -> a

- NumericPrelude.Numeric: product1 :: (C a) => [a] -> a

+ NumericPrelude.Numeric: product1 :: C a => [a] -> a

- NumericPrelude.Numeric: quot :: (C a) => a -> a -> a

+ NumericPrelude.Numeric: quot :: C a => a -> a -> a

- NumericPrelude.Numeric: quotRem :: (C a) => a -> a -> (a, a)

+ NumericPrelude.Numeric: quotRem :: C a => a -> a -> (a, a)

- NumericPrelude.Numeric: recip :: (C a) => a -> a

+ NumericPrelude.Numeric: recip :: C a => a -> a

- NumericPrelude.Numeric: rem :: (C a) => a -> a -> a

+ NumericPrelude.Numeric: rem :: C a => a -> a -> a

- NumericPrelude.Numeric: signum :: (C a) => a -> a

+ NumericPrelude.Numeric: signum :: C a => a -> a

- NumericPrelude.Numeric: sin :: (C a) => a -> a

+ NumericPrelude.Numeric: sin :: C a => a -> a

- NumericPrelude.Numeric: sinh :: (C a) => a -> a

+ NumericPrelude.Numeric: sinh :: C a => a -> a

- NumericPrelude.Numeric: sqr :: (C a) => a -> a

+ NumericPrelude.Numeric: sqr :: C a => a -> a

- NumericPrelude.Numeric: sqrt :: (C a) => a -> a

+ NumericPrelude.Numeric: sqrt :: C a => a -> a

- NumericPrelude.Numeric: stdAssociate :: (C a) => a -> a

+ NumericPrelude.Numeric: stdAssociate :: C a => a -> a

- NumericPrelude.Numeric: stdUnit :: (C a) => a -> a

+ NumericPrelude.Numeric: stdUnit :: C a => a -> a

- NumericPrelude.Numeric: stdUnitInv :: (C a) => a -> a

+ NumericPrelude.Numeric: stdUnitInv :: C a => a -> a

- NumericPrelude.Numeric: subtract :: (C a) => a -> a -> a

+ NumericPrelude.Numeric: subtract :: C a => a -> a -> a

- NumericPrelude.Numeric: sum :: (C a) => [a] -> a

+ NumericPrelude.Numeric: sum :: C a => [a] -> a

- NumericPrelude.Numeric: sum1 :: (C a) => [a] -> a

+ NumericPrelude.Numeric: sum1 :: C a => [a] -> a

- NumericPrelude.Numeric: tan :: (C a) => a -> a

+ NumericPrelude.Numeric: tan :: C a => a -> a

- NumericPrelude.Numeric: tanh :: (C a) => a -> a

+ NumericPrelude.Numeric: tanh :: C a => a -> a

- NumericPrelude.Numeric: toInteger :: (C a) => a -> Integer

+ NumericPrelude.Numeric: toInteger :: C a => a -> Integer

- NumericPrelude.Numeric: toRational :: (C a) => a -> Rational

+ NumericPrelude.Numeric: toRational :: C a => a -> Rational

- NumericPrelude.Numeric: zero :: (C a) => a

+ NumericPrelude.Numeric: zero :: C a => a

Files

Makefile +9/−0
numeric-prelude.cabal +257/−12
src-ghc-6.12/Algebra/Absolute.hs +151/−0
src-ghc-6.12/Algebra/Additive.hs +364/−0
src-ghc-6.12/Algebra/AffineSpace.hs +247/−0
src-ghc-6.12/Algebra/Algebraic.hs +65/−0
src-ghc-6.12/Algebra/Differential.hs +19/−0
src-ghc-6.12/Algebra/DimensionTerm.hs +225/−0
src-ghc-6.12/Algebra/DivisibleSpace.hs +21/−0
src-ghc-6.12/Algebra/EqualityDecision.hs +110/−0
src-ghc-6.12/Algebra/Field.hs +161/−0
src-ghc-6.12/Algebra/GenerateRules.hs +86/−0
src-ghc-6.12/Algebra/Indexable.hs +76/−0
src-ghc-6.12/Algebra/IntegralDomain.hs +339/−0
src-ghc-6.12/Algebra/Lattice.hs +69/−0
src-ghc-6.12/Algebra/Laws.hs +57/−0
src-ghc-6.12/Algebra/Module.hs +153/−0
src-ghc-6.12/Algebra/ModuleBasis.hs +95/−0
src-ghc-6.12/Algebra/Monoid.hs +72/−0
src-ghc-6.12/Algebra/NonNegative.hs +130/−0
src-ghc-6.12/Algebra/NormedSpace/Euclidean.hs +126/−0
src-ghc-6.12/Algebra/NormedSpace/Maximum.hs +85/−0
src-ghc-6.12/Algebra/NormedSpace/Sum.hs +90/−0
src-ghc-6.12/Algebra/OccasionallyScalar.hs +83/−0
src-ghc-6.12/Algebra/OrderDecision.hs +244/−0
src-ghc-6.12/Algebra/PrincipalIdealDomain.hs +384/−0
src-ghc-6.12/Algebra/RealField.hs +26/−0
src-ghc-6.12/Algebra/RealIntegral.hs +151/−0
src-ghc-6.12/Algebra/RealRing.hs +584/−0
src-ghc-6.12/Algebra/RealTranscendental.hs +37/−0
src-ghc-6.12/Algebra/RightModule.hs +17/−0
src-ghc-6.12/Algebra/Ring.hs +257/−0
src-ghc-6.12/Algebra/ToInteger.hs +141/−0
src-ghc-6.12/Algebra/ToRational.hs +100/−0
src-ghc-6.12/Algebra/Transcendental.hs +200/−0
src-ghc-6.12/Algebra/Units.hs +153/−0
src-ghc-6.12/Algebra/Vector.hs +101/−0
src-ghc-6.12/Algebra/VectorSpace.hs +34/−0
src-ghc-6.12/Algebra/ZeroTestable.hs +65/−0
src-ghc-6.12/MathObj/Algebra.hs +74/−0
src-ghc-6.12/MathObj/DiscreteMap.hs +93/−0
src-ghc-6.12/MathObj/Gaussian/Bell.hs +314/−0
src-ghc-6.12/MathObj/Gaussian/Example.hs +227/−0
src-ghc-6.12/MathObj/Gaussian/Polynomial.hs +435/−0
src-ghc-6.12/MathObj/Gaussian/Variance.hs +186/−0
src-ghc-6.12/MathObj/LaurentPolynomial.hs +288/−0
src-ghc-6.12/MathObj/Matrix.hs +278/−0
src-ghc-6.12/MathObj/Monoid.hs +56/−0
src-ghc-6.12/MathObj/PartialFraction.hs +399/−0
src-ghc-6.12/MathObj/Permutation.hs +32/−0
src-ghc-6.12/MathObj/Permutation/CycleList.hs +103/−0
src-ghc-6.12/MathObj/Permutation/CycleList/Check.hs +125/−0
src-ghc-6.12/MathObj/Permutation/Table.hs +113/−0
src-ghc-6.12/MathObj/Polynomial.hs +309/−0
src-ghc-6.12/MathObj/Polynomial/Core.hs +224/−0
src-ghc-6.12/MathObj/PowerSeries.hs +193/−0
src-ghc-6.12/MathObj/PowerSeries/Core.hs +279/−0
src-ghc-6.12/MathObj/PowerSeries/DifferentialEquation.hs +81/−0
src-ghc-6.12/MathObj/PowerSeries/Example.hs +156/−0
src-ghc-6.12/MathObj/PowerSeries/Mean.hs +234/−0
src-ghc-6.12/MathObj/PowerSeries2.hs +126/−0
src-ghc-6.12/MathObj/PowerSeries2/Core.hs +89/−0
src-ghc-6.12/MathObj/PowerSum.hs +234/−0
src-ghc-6.12/MathObj/RefinementMask2.hs +171/−0
src-ghc-6.12/MathObj/RootSet.hs +171/−0
src-ghc-6.12/Number/Complex.hs +575/−0
src-ghc-6.12/Number/ComplexSquareRoot.hs +119/−0
src-ghc-6.12/Number/DimensionTerm.hs +216/−0
src-ghc-6.12/Number/DimensionTerm/SI.hs +125/−0
src-ghc-6.12/Number/FixedPoint.hs +235/−0
src-ghc-6.12/Number/FixedPoint/Check.hs +194/−0
src-ghc-6.12/Number/GaloisField2p32m5.hs +92/−0
src-ghc-6.12/Number/NonNegative.hs +214/−0
src-ghc-6.12/Number/NonNegativeChunky.hs +311/−0
src-ghc-6.12/Number/OccasionallyScalarExpression.hs +196/−0
src-ghc-6.12/Number/PartiallyTranscendental.hs +91/−0
src-ghc-6.12/Number/Peano.hs +432/−0
src-ghc-6.12/Number/Physical.hs +236/−0
src-ghc-6.12/Number/Physical/Read.hs +99/−0
src-ghc-6.12/Number/Physical/Show.hs +105/−0
src-ghc-6.12/Number/Physical/Unit.hs +84/−0
src-ghc-6.12/Number/Physical/UnitDatabase.hs +186/−0
src-ghc-6.12/Number/Positional.hs +1465/−0
src-ghc-6.12/Number/Positional/Check.hs +260/−0
src-ghc-6.12/Number/Quaternion.hs +296/−0
src-ghc-6.12/Number/Ratio.hs +249/−0
src-ghc-6.12/Number/ResidueClass.hs +47/−0
src-ghc-6.12/Number/ResidueClass/Check.hs +118/−0
src-ghc-6.12/Number/ResidueClass/Func.hs +102/−0
src-ghc-6.12/Number/ResidueClass/Maybe.hs +80/−0
src-ghc-6.12/Number/ResidueClass/Reader.hs +96/−0
src-ghc-6.12/Number/Root.hs +97/−0
src-ghc-6.12/Number/SI.hs +271/−0
src-ghc-6.12/Number/SI/Unit.hs +293/−0
src-ghc-6.12/NumericPrelude.hs +9/−0
src-ghc-6.12/NumericPrelude/Base.hs +12/−0
src-ghc-6.12/NumericPrelude/Elementwise.hs +54/−0
src-ghc-6.12/NumericPrelude/List.hs +71/−0
src-ghc-6.12/NumericPrelude/List/Checked.hs +94/−0
src-ghc-6.12/NumericPrelude/List/Generic.hs +84/−0
src-ghc-6.12/NumericPrelude/Numeric.hs +44/−0
src/Algebra/Absolute.hs +2/−2
src/Algebra/Additive.hs +2/−2
src/Algebra/Algebraic.hs +1/−1
src/Algebra/Differential.hs +2/−2
src/Algebra/DivisibleSpace.hs +2/−2
src/Algebra/Field.hs +21/−5
src/Algebra/IntegralDomain.hs +53/−12
src/Algebra/Lattice.hs +1/−1
src/Algebra/Module.hs +2/−2
src/Algebra/ModuleBasis.hs +2/−2
src/Algebra/NormedSpace/Euclidean.hs +1/−1
src/Algebra/NormedSpace/Maximum.hs +1/−2
src/Algebra/NormedSpace/Sum.hs +1/−1
src/Algebra/OccasionallyScalar.hs +1/−1
src/Algebra/PrincipalIdealDomain.hs +32/−17
src/Algebra/RealField.hs +2/−2
src/Algebra/RealIntegral.hs +5/−5
src/Algebra/RealRing.hs +2/−4
src/Algebra/RealTranscendental.hs +1/−1
src/Algebra/RightModule.hs +2/−2
src/Algebra/Ring.hs +4/−4
src/Algebra/ToInteger.hs +2/−4
src/Algebra/ToRational.hs +2/−2
src/Algebra/Transcendental.hs +3/−3
src/Algebra/Units.hs +4/−4
src/Algebra/Vector.hs +1/−1
src/Algebra/VectorSpace.hs +1/−1
src/Algebra/ZeroTestable.hs +2/−2
src/MathObj/Algebra.hs +1/−1
src/MathObj/DiscreteMap.hs +2/−2
src/MathObj/Gaussian/Bell.hs +39/−14
src/MathObj/Gaussian/Example.hs +1/−1
src/MathObj/Gaussian/Polynomial.hs +68/−18
src/MathObj/Gaussian/Variance.hs +70/−12
src/MathObj/LaurentPolynomial.hs +1/−2
src/MathObj/Matrix.hs +17/−10
src/MathObj/Monoid.hs +1/−1
src/MathObj/PartialFraction.hs +3/−4
src/MathObj/Permutation.hs +2/−2
src/MathObj/Permutation/CycleList.hs +1/−1
src/MathObj/Permutation/CycleList/Check.hs +1/−1
src/MathObj/Permutation/Table.hs +1/−1
src/MathObj/Polynomial.hs +1/−1
src/MathObj/Polynomial/Core.hs +4/−8
src/MathObj/PowerSeries.hs +1/−2
src/MathObj/PowerSeries/Core.hs +1/−4
src/MathObj/PowerSeries/DifferentialEquation.hs +1/−1
src/MathObj/PowerSeries/Example.hs +4/−4
src/MathObj/PowerSeries/Mean.hs +1/−1
src/MathObj/PowerSeries2.hs +1/−1
src/MathObj/PowerSeries2/Core.hs +1/−1
src/MathObj/PowerSum.hs +1/−1
src/MathObj/RefinementMask2.hs +1/−1
src/MathObj/RootSet.hs +1/−1
src/Number/Complex.hs +13/−10
src/Number/ComplexSquareRoot.hs +119/−0
src/Number/DimensionTerm/SI.hs +1/−1
src/Number/FixedPoint.hs +2/−2
src/Number/FixedPoint/Check.hs +1/−1
src/Number/GaloisField2p32m5.hs +1/−1
src/Number/NonNegative.hs +1/−3
src/Number/OccasionallyScalarExpression.hs +1/−1
src/Number/PartiallyTranscendental.hs +1/−1
src/Number/Peano.hs +1/−1
src/Number/Physical.hs +1/−1
src/Number/Physical/Read.hs +2/−2
src/Number/Physical/Show.hs +1/−1
src/Number/Physical/Unit.hs +1/−1
src/Number/Physical/UnitDatabase.hs +1/−1
src/Number/Positional.hs +2/−3
src/Number/Positional/Check.hs +1/−1
src/Number/Quaternion.hs +1/−1
src/Number/Ratio.hs +22/−10
src/Number/ResidueClass.hs +3/−5
src/Number/ResidueClass/Check.hs +6/−3
src/Number/ResidueClass/Func.hs +1/−1
src/Number/ResidueClass/Maybe.hs +1/−3
src/Number/ResidueClass/Reader.hs +1/−1
src/Number/Root.hs +97/−0
src/Number/SI.hs +1/−1
src/Number/SI/Unit.hs +1/−1
src/NumericPrelude/Base.hs +2/−1
src/NumericPrelude/List.hs +7/−8
src/NumericPrelude/List/Checked.hs +3/−3
src/NumericPrelude/List/Generic.hs +1/−1
src/NumericPrelude/Numeric.hs +1/−1
test-ghc-6.12/Gaussian.hs +6/−0
test-ghc-6.12/Test.hs +173/−0
test-ghc-6.12/Test/Algebra/IntegralDomain.hs +41/−0
test-ghc-6.12/Test/Algebra/RealRing.hs +40/−0
test-ghc-6.12/Test/MathObj/Gaussian/Bell.hs +96/−0
test-ghc-6.12/Test/MathObj/Gaussian/Polynomial.hs +158/−0
test-ghc-6.12/Test/MathObj/Gaussian/Variance.hs +198/−0
test-ghc-6.12/Test/MathObj/Matrix.hs +103/−0
test-ghc-6.12/Test/MathObj/PartialFraction.hs +205/−0
test-ghc-6.12/Test/MathObj/Polynomial.hs +56/−0
test-ghc-6.12/Test/MathObj/PowerSeries.hs +103/−0
test-ghc-6.12/Test/MathObj/RefinementMask2.hs +78/−0
test-ghc-6.12/Test/Number/ComplexSquareRoot.hs +50/−0
test-ghc-6.12/Test/Number/GaloisField2p32m5.hs +37/−0
test-ghc-6.12/Test/NumericPrelude/Utility.hs +21/−0
test-ghc-6.12/Test/Run.hs +34/−0
test/Test.hs +1/−1
test/Test/Algebra/IntegralDomain.hs +41/−0
test/Test/Algebra/RealRing.hs +40/−0
test/Test/MathObj/Gaussian/Bell.hs +1/−1
test/Test/MathObj/Gaussian/Polynomial.hs +15/−1
test/Test/MathObj/Gaussian/Variance.hs +140/−4
test/Test/MathObj/Matrix.hs +8/−1
test/Test/MathObj/PartialFraction.hs +2/−2
test/Test/MathObj/Polynomial.hs +1/−1
test/Test/MathObj/PowerSeries.hs +1/−1
test/Test/MathObj/RefinementMask2.hs +1/−1
test/Test/Number/ComplexSquareRoot.hs +50/−0
test/Test/Number/GaloisField2p32m5.hs +1/−1
test/Test/Run.hs +6/−2

Makefile view

@@ -73,3 +73,12 @@ 	#scp -r docs/html/* cvs.haskell.org:$(HASKELLORG_HTMLDIR)/ 	ssh cvs.haskell.org chmod -R o+r $(HASKELLORG_HTMLDIR) 	#ssh cvs.haskell.org chmod o+x `find $(HASKELLORG_HTMLDIR) -type d`++# TARBALL = dist/numeric-prelude-0.2.1++# sdist:+#	cabal sdist+#	gunzip --stdout $(TARBALL).tar.gz >$(TARBALL)-ext.tar+#	tar rf --dereference $(TARBALL)-ext.tar src-ghc-6.12+#	gzip $(TARBALL)-ext.tar+##	gunzip --stdout $(TARBALL).tar.gz | tar r --dereference src-ghc-6.12 | gzip >$(TARBALL)-ext.tar.gz

numeric-prelude.cabal view

@@ -1,5 +1,5 @@ Name:           numeric-prelude-Version:        0.2+Version:        0.2.1 License:        GPL License-File:   LICENSE Author:         Dylan Thurston <dpt@math.harvard.edu>, Henning Thielemann <numericprelude@henning-thielemann.de>, Mikael Johansson@@ -7,7 +7,9 @@ Homepage:       http://www.haskell.org/haskellwiki/Numeric_Prelude Category:       Math Stability:      Experimental-Tested-With:    GHC==6.4.1, GHC==6.8.2+Cabal-Version:  >=1.6+Build-Type:     Simple+Tested-With:    GHC==6.4.1, GHC==6.8.2, GHC==6.10.4, GHC==6.12.3, GHC==7.0.2 Synopsis:       An experimental alternative hierarchy of numeric type classes Description:   Revisiting the Numeric Classes@@ -132,15 +134,241 @@   Additional standard libraries might include Enum, IEEEFloat (including   the bulk of the functions in Haskell 98's RealFloat class),   VectorSpace, Ratio, and Lattice.-Tested-With:    GHC==6.4.1, GHC==6.8.2-Cabal-Version:  >=1.6-Build-Type:     Simple  Extra-Source-Files:   Makefile   docs/NOTES   docs/README+  src/Algebra/Absolute.hs+  src/Algebra/Additive.hs+  src/Algebra/AffineSpace.hs+  src/Algebra/Algebraic.hs+  src/Algebra/Differential.hs+  src/Algebra/DimensionTerm.hs+  src/Algebra/DivisibleSpace.hs+  src/Algebra/EqualityDecision.hs+  src/Algebra/Field.hs   src/Algebra/GenerateRules.hs+  src/Algebra/Indexable.hs+  src/Algebra/IntegralDomain.hs+  src/Algebra/Lattice.hs+  src/Algebra/Laws.hs+  src/Algebra/Module.hs+  src/Algebra/ModuleBasis.hs+  src/Algebra/Monoid.hs+  src/Algebra/NonNegative.hs+  src/Algebra/NormedSpace/Euclidean.hs+  src/Algebra/NormedSpace/Maximum.hs+  src/Algebra/NormedSpace/Sum.hs+  src/Algebra/OccasionallyScalar.hs+  src/Algebra/OrderDecision.hs+  src/Algebra/PrincipalIdealDomain.hs+  src/Algebra/RealField.hs+  src/Algebra/RealIntegral.hs+  src/Algebra/RealRing.hs+  src/Algebra/RealTranscendental.hs+  src/Algebra/RightModule.hs+  src/Algebra/Ring.hs+  src/Algebra/ToInteger.hs+  src/Algebra/ToRational.hs+  src/Algebra/Transcendental.hs+  src/Algebra/Units.hs+  src/Algebra/Vector.hs+  src/Algebra/VectorSpace.hs+  src/Algebra/ZeroTestable.hs+  src/MathObj/Algebra.hs+  src/MathObj/DiscreteMap.hs+  src/MathObj/Gaussian/Bell.hs+  src/MathObj/Gaussian/Example.hs+  src/MathObj/Gaussian/Polynomial.hs+  src/MathObj/Gaussian/Variance.hs+  src/MathObj/LaurentPolynomial.hs+  src/MathObj/Matrix.hs+  src/MathObj/Monoid.hs+  src/MathObj/PartialFraction.hs+  src/MathObj/Permutation.hs+  src/MathObj/Permutation/CycleList.hs+  src/MathObj/Permutation/CycleList/Check.hs+  src/MathObj/Permutation/Table.hs+  src/MathObj/Polynomial.hs+  src/MathObj/Polynomial/Core.hs+  src/MathObj/PowerSeries.hs+  src/MathObj/PowerSeries/Core.hs+  src/MathObj/PowerSeries/DifferentialEquation.hs+  src/MathObj/PowerSeries/Example.hs+  src/MathObj/PowerSeries/Mean.hs+  src/MathObj/PowerSeries2.hs+  src/MathObj/PowerSeries2/Core.hs+  src/MathObj/PowerSum.hs+  src/MathObj/RefinementMask2.hs+  src/MathObj/RootSet.hs+  src/Number/Complex.hs+  src/Number/ComplexSquareRoot.hs+  src/Number/DimensionTerm.hs+  src/Number/DimensionTerm/SI.hs+  src/Number/FixedPoint.hs+  src/Number/FixedPoint/Check.hs+  src/Number/GaloisField2p32m5.hs+  src/Number/NonNegative.hs+  src/Number/NonNegativeChunky.hs+  src/Number/OccasionallyScalarExpression.hs+  src/Number/PartiallyTranscendental.hs+  src/Number/Peano.hs+  src/Number/Physical.hs+  src/Number/Physical/Read.hs+  src/Number/Physical/Show.hs+  src/Number/Physical/Unit.hs+  src/Number/Physical/UnitDatabase.hs+  src/Number/Positional.hs+  src/Number/Positional/Check.hs+  src/Number/Quaternion.hs+  src/Number/Ratio.hs+  src/Number/ResidueClass.hs+  src/Number/ResidueClass/Check.hs+  src/Number/ResidueClass/Func.hs+  src/Number/ResidueClass/Maybe.hs+  src/Number/ResidueClass/Reader.hs+  src/Number/Root.hs+  src/Number/SI.hs+  src/Number/SI/Unit.hs+  src/NumericPrelude.hs+  src/NumericPrelude/Base.hs+  src/NumericPrelude/Elementwise.hs+  src/NumericPrelude/List.hs+  src/NumericPrelude/List/Checked.hs+  src/NumericPrelude/List/Generic.hs+  src/NumericPrelude/Numeric.hs+  test/Gaussian.hs+  test/Test.hs+  test/Test/Algebra/IntegralDomain.hs+  test/Test/Algebra/RealRing.hs+  test/Test/MathObj/Gaussian/Bell.hs+  test/Test/MathObj/Gaussian/Polynomial.hs+  test/Test/MathObj/Gaussian/Variance.hs+  test/Test/MathObj/Matrix.hs+  test/Test/MathObj/PartialFraction.hs+  test/Test/MathObj/Polynomial.hs+  test/Test/MathObj/PowerSeries.hs+  test/Test/MathObj/RefinementMask2.hs+  test/Test/Number/ComplexSquareRoot.hs+  test/Test/Number/GaloisField2p32m5.hs+  test/Test/NumericPrelude/Utility.hs+  test/Test/Run.hs+  src-ghc-6.12/Algebra/Absolute.hs+  src-ghc-6.12/Algebra/Additive.hs+  src-ghc-6.12/Algebra/AffineSpace.hs+  src-ghc-6.12/Algebra/Algebraic.hs+  src-ghc-6.12/Algebra/Differential.hs+  src-ghc-6.12/Algebra/DimensionTerm.hs+  src-ghc-6.12/Algebra/DivisibleSpace.hs+  src-ghc-6.12/Algebra/EqualityDecision.hs+  src-ghc-6.12/Algebra/Field.hs+  src-ghc-6.12/Algebra/GenerateRules.hs+  src-ghc-6.12/Algebra/Indexable.hs+  src-ghc-6.12/Algebra/IntegralDomain.hs+  src-ghc-6.12/Algebra/Lattice.hs+  src-ghc-6.12/Algebra/Laws.hs+  src-ghc-6.12/Algebra/Module.hs+  src-ghc-6.12/Algebra/ModuleBasis.hs+  src-ghc-6.12/Algebra/Monoid.hs+  src-ghc-6.12/Algebra/NonNegative.hs+  src-ghc-6.12/Algebra/NormedSpace/Euclidean.hs+  src-ghc-6.12/Algebra/NormedSpace/Maximum.hs+  src-ghc-6.12/Algebra/NormedSpace/Sum.hs+  src-ghc-6.12/Algebra/OccasionallyScalar.hs+  src-ghc-6.12/Algebra/OrderDecision.hs+  src-ghc-6.12/Algebra/PrincipalIdealDomain.hs+  src-ghc-6.12/Algebra/RealField.hs+  src-ghc-6.12/Algebra/RealIntegral.hs+  src-ghc-6.12/Algebra/RealRing.hs+  src-ghc-6.12/Algebra/RealTranscendental.hs+  src-ghc-6.12/Algebra/RightModule.hs+  src-ghc-6.12/Algebra/Ring.hs+  src-ghc-6.12/Algebra/ToInteger.hs+  src-ghc-6.12/Algebra/ToRational.hs+  src-ghc-6.12/Algebra/Transcendental.hs+  src-ghc-6.12/Algebra/Units.hs+  src-ghc-6.12/Algebra/Vector.hs+  src-ghc-6.12/Algebra/VectorSpace.hs+  src-ghc-6.12/Algebra/ZeroTestable.hs+  src-ghc-6.12/MathObj/Algebra.hs+  src-ghc-6.12/MathObj/DiscreteMap.hs+  src-ghc-6.12/MathObj/Gaussian/Bell.hs+  src-ghc-6.12/MathObj/Gaussian/Example.hs+  src-ghc-6.12/MathObj/Gaussian/Polynomial.hs+  src-ghc-6.12/MathObj/Gaussian/Variance.hs+  src-ghc-6.12/MathObj/LaurentPolynomial.hs+  src-ghc-6.12/MathObj/Matrix.hs+  src-ghc-6.12/MathObj/Monoid.hs+  src-ghc-6.12/MathObj/PartialFraction.hs+  src-ghc-6.12/MathObj/Permutation.hs+  src-ghc-6.12/MathObj/Permutation/CycleList.hs+  src-ghc-6.12/MathObj/Permutation/CycleList/Check.hs+  src-ghc-6.12/MathObj/Permutation/Table.hs+  src-ghc-6.12/MathObj/Polynomial.hs+  src-ghc-6.12/MathObj/Polynomial/Core.hs+  src-ghc-6.12/MathObj/PowerSeries.hs+  src-ghc-6.12/MathObj/PowerSeries/Core.hs+  src-ghc-6.12/MathObj/PowerSeries/DifferentialEquation.hs+  src-ghc-6.12/MathObj/PowerSeries/Example.hs+  src-ghc-6.12/MathObj/PowerSeries/Mean.hs+  src-ghc-6.12/MathObj/PowerSeries2.hs+  src-ghc-6.12/MathObj/PowerSeries2/Core.hs+  src-ghc-6.12/MathObj/PowerSum.hs+  src-ghc-6.12/MathObj/RefinementMask2.hs+  src-ghc-6.12/MathObj/RootSet.hs+  src-ghc-6.12/Number/Complex.hs+  src-ghc-6.12/Number/ComplexSquareRoot.hs+  src-ghc-6.12/Number/DimensionTerm.hs+  src-ghc-6.12/Number/DimensionTerm/SI.hs+  src-ghc-6.12/Number/FixedPoint.hs+  src-ghc-6.12/Number/FixedPoint/Check.hs+  src-ghc-6.12/Number/GaloisField2p32m5.hs+  src-ghc-6.12/Number/NonNegative.hs+  src-ghc-6.12/Number/NonNegativeChunky.hs+  src-ghc-6.12/Number/OccasionallyScalarExpression.hs+  src-ghc-6.12/Number/PartiallyTranscendental.hs+  src-ghc-6.12/Number/Peano.hs+  src-ghc-6.12/Number/Physical.hs+  src-ghc-6.12/Number/Physical/Read.hs+  src-ghc-6.12/Number/Physical/Show.hs+  src-ghc-6.12/Number/Physical/Unit.hs+  src-ghc-6.12/Number/Physical/UnitDatabase.hs+  src-ghc-6.12/Number/Positional.hs+  src-ghc-6.12/Number/Positional/Check.hs+  src-ghc-6.12/Number/Quaternion.hs+  src-ghc-6.12/Number/Ratio.hs+  src-ghc-6.12/Number/ResidueClass.hs+  src-ghc-6.12/Number/ResidueClass/Check.hs+  src-ghc-6.12/Number/ResidueClass/Func.hs+  src-ghc-6.12/Number/ResidueClass/Maybe.hs+  src-ghc-6.12/Number/ResidueClass/Reader.hs+  src-ghc-6.12/Number/Root.hs+  src-ghc-6.12/Number/SI.hs+  src-ghc-6.12/Number/SI/Unit.hs+  src-ghc-6.12/NumericPrelude.hs+  src-ghc-6.12/NumericPrelude/Base.hs+  src-ghc-6.12/NumericPrelude/Elementwise.hs+  src-ghc-6.12/NumericPrelude/List.hs+  src-ghc-6.12/NumericPrelude/List/Checked.hs+  src-ghc-6.12/NumericPrelude/List/Generic.hs+  src-ghc-6.12/NumericPrelude/Numeric.hs+  test-ghc-6.12/Gaussian.hs+  test-ghc-6.12/Test.hs+  test-ghc-6.12/Test/Algebra/IntegralDomain.hs+  test-ghc-6.12/Test/Algebra/RealRing.hs+  test-ghc-6.12/Test/MathObj/Gaussian/Bell.hs+  test-ghc-6.12/Test/MathObj/Gaussian/Polynomial.hs+  test-ghc-6.12/Test/MathObj/Gaussian/Variance.hs+  test-ghc-6.12/Test/MathObj/Matrix.hs+  test-ghc-6.12/Test/MathObj/PartialFraction.hs+  test-ghc-6.12/Test/MathObj/Polynomial.hs+  test-ghc-6.12/Test/MathObj/PowerSeries.hs+  test-ghc-6.12/Test/MathObj/RefinementMask2.hs+  test-ghc-6.12/Test/Number/ComplexSquareRoot.hs+  test-ghc-6.12/Test/Number/GaloisField2p32m5.hs+  test-ghc-6.12/Test/NumericPrelude/Utility.hs+  test-ghc-6.12/Test/Run.hs  Flag splitBase   description: Choose the new smaller, split-up base package.@@ -150,7 +378,7 @@   default:     False  Source-Repository this-  Tag:         0.2+  Tag:         0.2.1   Type:        darcs   Location:    http://code.haskell.org/numeric-prelude/ @@ -164,18 +392,21 @@     QuickCheck >=1 && <3,     storable-record >=0.0.1 && <0.1,     non-negative >=0.0.5 && <0.2,-    utility-ht >=0.0.4 && <0.1+    utility-ht >=0.0.6 && <0.1   If flag(splitBase)     Build-Depends:       base >= 2 && <6,       array >=0.1 && <0.4,-      containers >=0.1 && <0.4,+      containers >=0.1 && <0.5,       random >=1.0 && <1.1   Else     Build-Depends: base >= 1.0 && < 2    GHC-Options:    -Wall-  Hs-source-dirs: src+  If impl(ghc>=7.0)+    Hs-source-dirs: src+  Else+    Hs-source-dirs: src-ghc-6.12   Exposed-modules:     Algebra.Absolute     Algebra.Additive@@ -251,6 +482,7 @@     Number.ResidueClass.Maybe     Number.ResidueClass.Func     Number.ResidueClass.Reader+    Number.Root     Number.OccasionallyScalarExpression     Number.SI.Unit     Number.SI@@ -271,23 +503,33 @@     MathObj.Gaussian.Variance     MathObj.Gaussian.Bell     MathObj.Gaussian.Polynomial+    Number.ComplexSquareRoot     -- I think I won't add them this way.     -- It is certainly better to split the class into comparison and selection.     Algebra.EqualityDecision     Algebra.OrderDecision  Executable test-  Hs-Source-Dirs: src, test+  If impl(ghc>=7.0)+    Hs-source-dirs: src, test+  Else+    Hs-source-dirs: src-ghc-6.12, test-ghc-6.12   Main-Is: Test.hs   If !flag(buildTests)     Buildable:         False  Executable testsuite-  Hs-Source-Dirs: src, test+  If impl(ghc>=7.0)+    Hs-source-dirs: src, test+  Else+    Hs-source-dirs: src-ghc-6.12, test-ghc-6.12   GHC-Options:    -Wall   Other-modules:     Test.NumericPrelude.Utility     Test.Number.GaloisField2p32m5+    Test.Number.ComplexSquareRoot+    Test.Algebra.IntegralDomain+    Test.Algebra.RealRing     Test.MathObj.RefinementMask2     Test.MathObj.PartialFraction     Test.MathObj.Matrix@@ -303,7 +545,10 @@     Buildable: False  Executable test-gaussian-  Hs-Source-Dirs: src, test+  If impl(ghc>=7.0)+    Hs-source-dirs: src, test+  Else+    Hs-source-dirs: src-ghc-6.12, test-ghc-6.12   Main-Is: Gaussian.hs   Other-Modules:     MathObj.Gaussian.Example

+ src-ghc-6.12/Algebra/Absolute.hs view

@@ -0,0 +1,151 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Algebra.Absolute (+   C(abs, signum),+   absOrd, signumOrd,+   ) where++import qualified Algebra.Ring         as Ring+import qualified Algebra.Additive     as Additive+import qualified Algebra.ZeroTestable as ZeroTestable++import Algebra.Ring (one, ) -- fromInteger+import Algebra.Additive (zero, negate,)++import Data.Int  (Int,  Int8,  Int16,  Int32,  Int64,  )+import Data.Word (Word, Word8, Word16, Word32, Word64, )++import NumericPrelude.Base+import qualified Prelude as P+import Prelude (Integer, Float, Double, )+++{- |+This is the type class of a ring with a notion of an absolute value,+satisfying the laws++>                        a * b === b * a+>   a /= 0  =>  abs (signum a) === 1+>             abs a * signum a === a++Minimal definition: 'abs', 'signum'.++If the type is in the 'Ord' class+we expect 'abs' = 'absOrd' and 'signum' = 'signumOrd'+and we expect the following laws to hold:++>      a + (max b c) === max (a+b) (a+c)+>   negate (max b c) === min (negate b) (negate c)+>      a * (max b c) === max (a*b) (a*c) where a >= 0+>           absOrd a === max a (-a)++We do not require 'Ord' as superclass+since we also want to have "Number.Complex" as instance.+'abs' for complex numbers alone may have an inappropriate type,+because it does not reflect that the absolute value is a real number.+You might prefer 'Number.Complex.magnitude'.+This type class is intended for unifying algorithms+that work for both real and complex numbers.+Note the similarity to "Algebra.Units":+'abs' plays the role of @stdAssociate@+and 'signum' plays the role of @stdUnit@.++Actually, since 'abs' can be defined using 'max' and 'negate'+we could relax the superclasses to @Additive@ and 'Ord'+if his class would only contain 'signum'.+-}+class (Ring.C a, ZeroTestable.C a) => C a where+    abs    :: a -> a+    signum :: a -> a+++absOrd :: (Additive.C a, Ord a) => a -> a+absOrd x = max x (negate x)++signumOrd :: (Ring.C a, Ord a) => a -> a+signumOrd x =+   case compare x zero of+      GT ->        one+      EQ ->        zero+      LT -> negate one+++instance C Integer where+   {-# INLINE abs #-}+   {-# INLINE signum #-}+   abs = P.abs+   signum = P.signum++instance C Float   where+   {-# INLINE abs #-}+   {-# INLINE signum #-}+   abs = P.abs+   signum = P.signum++instance C Double  where+   {-# INLINE abs #-}+   {-# INLINE signum #-}+   abs = P.abs+   signum = P.signum+++instance C Int     where+   {-# INLINE abs #-}+   {-# INLINE signum #-}+   abs = P.abs+   signum = P.signum++instance C Int8    where+   {-# INLINE abs #-}+   {-# INLINE signum #-}+   abs = P.abs+   signum = P.signum++instance C Int16   where+   {-# INLINE abs #-}+   {-# INLINE signum #-}+   abs = P.abs+   signum = P.signum++instance C Int32   where+   {-# INLINE abs #-}+   {-# INLINE signum #-}+   abs = P.abs+   signum = P.signum++instance C Int64   where+   {-# INLINE abs #-}+   {-# INLINE signum #-}+   abs = P.abs+   signum = P.signum+++instance C Word    where+   {-# INLINE abs #-}+   {-# INLINE signum #-}+   abs = P.abs+   signum = P.signum++instance C Word8   where+   {-# INLINE abs #-}+   {-# INLINE signum #-}+   abs = P.abs+   signum = P.signum++instance C Word16  where+   {-# INLINE abs #-}+   {-# INLINE signum #-}+   abs = P.abs+   signum = P.signum++instance C Word32  where+   {-# INLINE abs #-}+   {-# INLINE signum #-}+   abs = P.abs+   signum = P.signum++instance C Word64  where+   {-# INLINE abs #-}+   {-# INLINE signum #-}+   abs = P.abs+   signum = P.signum+

+ src-ghc-6.12/Algebra/Additive.hs view

@@ -0,0 +1,364 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Algebra.Additive (+    -- * Class+    C,+    zero,+    (+), (-),+    negate, subtract,++    -- * Complex functions+    sum, sum1,++    -- * Instance definition helpers+    elementAdd, elementSub, elementNeg,+    (<*>.+), (<*>.-), (<*>.-$),++    -- * Instances for atomic types+    propAssociative,+    propCommutative,+    propIdentity,+    propInverse,+  ) where++import qualified Algebra.Laws as Laws++import Data.Int  (Int,  Int8,  Int16,  Int32,  Int64,  )+import Data.Word (Word, Word8, Word16, Word32, Word64, )++import qualified NumericPrelude.Elementwise as Elem+import Control.Applicative (Applicative(pure, (<*>)), )+import Data.Tuple.HT (fst3, snd3, thd3, )++import qualified Data.Ratio as Ratio98+import qualified Prelude as P+import Prelude (Integer, Float, Double, fromInteger, )+import NumericPrelude.Base+++infixl 6  +, -++{- |+Additive a encapsulates the notion of a commutative group, specified+by the following laws:++@+          a + b === b + a+    (a + b) + c === a + (b + c)+       zero + a === a+   a + negate a === 0+@++Typical examples include integers, dollars, and vectors.++Minimal definition: '+', 'zero', and ('negate' or '(-)')+-}++class C a where+    -- | zero element of the vector space+    zero     :: a+    -- | add and subtract elements+    (+), (-) :: a -> a -> a+    -- | inverse with respect to '+'+    negate   :: a -> a++    {-# INLINE negate #-}+    negate a = zero - a+    {-# INLINE (-) #-}+    a - b    = a + negate b++{- |+'subtract' is @(-)@ with swapped operand order.+This is the operand order which will be needed in most cases+of partial application.+-}+subtract :: C a => a -> a -> a+subtract = flip (-)+++++{- |+Sum up all elements of a list.+An empty list yields zero.++This function is inappropriate for number types like Peano.+Maybe we should make 'sum' a method of Additive.+This would also make 'lengthLeft' and 'lengthRight' superfluous.+-}+sum :: (C a) => [a] -> a+sum = foldl (+) zero++{- |+Sum up all elements of a non-empty list.+This avoids including a zero which is useful for types+where no universal zero is available.+-}+sum1 :: (C a) => [a] -> a+sum1 = foldl1 (+)++++{- |+Instead of baking the add operation into the element function,+we could use higher rank types+and pass a generic @uncurry (+)@ to the run function.+We do not do so in order to stay Haskell 98+at least for parts of NumericPrelude.+-}+{-# INLINE elementAdd #-}+elementAdd ::+   (C x) =>+   (v -> x) -> Elem.T (v,v) x+elementAdd f =+   Elem.element (\(x,y) -> f x + f y)++{-# INLINE elementSub #-}+elementSub ::+   (C x) =>+   (v -> x) -> Elem.T (v,v) x+elementSub f =+   Elem.element (\(x,y) -> f x - f y)++{-# INLINE elementNeg #-}+elementNeg ::+   (C x) =>+   (v -> x) -> Elem.T v x+elementNeg f =+   Elem.element (negate . f)+++-- like <*>+infixl 4 <*>.+, <*>.-, <*>.-$++{- |+> addPair :: (Additive.C a, Additive.C b) => (a,b) -> (a,b) -> (a,b)+> addPair = Elem.run2 $ Elem.with (,) <*>.+  fst <*>.+  snd+-}+{-# INLINE (<*>.+) #-}+(<*>.+) ::+   (C x) =>+   Elem.T (v,v) (x -> a) -> (v -> x) -> Elem.T (v,v) a+(<*>.+) f acc =+   f <*> elementAdd acc++{-# INLINE (<*>.-) #-}+(<*>.-) ::+   (C x) =>+   Elem.T (v,v) (x -> a) -> (v -> x) -> Elem.T (v,v) a+(<*>.-) f acc =+   f <*> elementSub acc++{-# INLINE (<*>.-$) #-}+(<*>.-$) ::+   (C x) =>+   Elem.T v (x -> a) -> (v -> x) -> Elem.T v a+(<*>.-$) f acc =+   f <*> elementNeg acc+++-- * Instances for atomic types++instance C Integer where+   {-# INLINE zero #-}+   {-# INLINE negate #-}+   {-# INLINE (+) #-}+   {-# INLINE (-) #-}+   zero   = P.fromInteger 0+   negate = P.negate+   (+)    = (P.+)+   (-)    = (P.-)++instance C Float   where+   {-# INLINE zero #-}+   {-# INLINE negate #-}+   {-# INLINE (+) #-}+   {-# INLINE (-) #-}+   zero   = P.fromInteger 0+   negate = P.negate+   (+)    = (P.+)+   (-)    = (P.-)++instance C Double  where+   {-# INLINE zero #-}+   {-# INLINE negate #-}+   {-# INLINE (+) #-}+   {-# INLINE (-) #-}+   zero   = P.fromInteger 0+   negate = P.negate+   (+)    = (P.+)+   (-)    = (P.-)+++instance C Int     where+   {-# INLINE zero #-}+   {-# INLINE negate #-}+   {-# INLINE (+) #-}+   {-# INLINE (-) #-}+   zero   = P.fromInteger 0+   negate = P.negate+   (+)    = (P.+)+   (-)    = (P.-)++instance C Int8    where+   {-# INLINE zero #-}+   {-# INLINE negate #-}+   {-# INLINE (+) #-}+   {-# INLINE (-) #-}+   zero   = P.fromInteger 0+   negate = P.negate+   (+)    = (P.+)+   (-)    = (P.-)++instance C Int16   where+   {-# INLINE zero #-}+   {-# INLINE negate #-}+   {-# INLINE (+) #-}+   {-# INLINE (-) #-}+   zero   = P.fromInteger 0+   negate = P.negate+   (+)    = (P.+)+   (-)    = (P.-)++instance C Int32   where+   {-# INLINE zero #-}+   {-# INLINE negate #-}+   {-# INLINE (+) #-}+   {-# INLINE (-) #-}+   zero   = P.fromInteger 0+   negate = P.negate+   (+)    = (P.+)+   (-)    = (P.-)++instance C Int64   where+   {-# INLINE zero #-}+   {-# INLINE negate #-}+   {-# INLINE (+) #-}+   {-# INLINE (-) #-}+   zero   = P.fromInteger 0+   negate = P.negate+   (+)    = (P.+)+   (-)    = (P.-)+++instance C Word    where+   {-# INLINE zero #-}+   {-# INLINE negate #-}+   {-# INLINE (+) #-}+   {-# INLINE (-) #-}+   zero   = P.fromInteger 0+   negate = P.negate+   (+)    = (P.+)+   (-)    = (P.-)++instance C Word8   where+   {-# INLINE zero #-}+   {-# INLINE negate #-}+   {-# INLINE (+) #-}+   {-# INLINE (-) #-}+   zero   = P.fromInteger 0+   negate = P.negate+   (+)    = (P.+)+   (-)    = (P.-)++instance C Word16  where+   {-# INLINE zero #-}+   {-# INLINE negate #-}+   {-# INLINE (+) #-}+   {-# INLINE (-) #-}+   zero   = P.fromInteger 0+   negate = P.negate+   (+)    = (P.+)+   (-)    = (P.-)++instance C Word32  where+   {-# INLINE zero #-}+   {-# INLINE negate #-}+   {-# INLINE (+) #-}+   {-# INLINE (-) #-}+   zero   = P.fromInteger 0+   negate = P.negate+   (+)    = (P.+)+   (-)    = (P.-)++instance C Word64  where+   {-# INLINE zero #-}+   {-# INLINE negate #-}+   {-# INLINE (+) #-}+   {-# INLINE (-) #-}+   zero   = P.fromInteger 0+   negate = P.negate+   (+)    = (P.+)+   (-)    = (P.-)+++++-- * Instances for composed types++instance (C v0, C v1) => C (v0, v1) where+   {-# INLINE zero #-}+   {-# INLINE negate #-}+   {-# INLINE (+) #-}+   {-# INLINE (-) #-}+   zero   = (,) zero zero+   (+)    = Elem.run2 $ pure (,) <*>.+  fst <*>.+  snd+   (-)    = Elem.run2 $ pure (,) <*>.-  fst <*>.-  snd+   negate = Elem.run  $ pure (,) <*>.-$ fst <*>.-$ snd++instance (C v0, C v1, C v2) => C (v0, v1, v2) where+   {-# INLINE zero #-}+   {-# INLINE negate #-}+   {-# INLINE (+) #-}+   {-# INLINE (-) #-}+   zero   = (,,) zero zero zero+   (+)    = Elem.run2 $ pure (,,) <*>.+  fst3 <*>.+  snd3 <*>.+  thd3+   (-)    = Elem.run2 $ pure (,,) <*>.-  fst3 <*>.-  snd3 <*>.-  thd3+   negate = Elem.run  $ pure (,,) <*>.-$ fst3 <*>.-$ snd3 <*>.-$ thd3+++instance (C v) => C [v] where+   zero   = []+   negate = map negate+   (+) (x:xs) (y:ys) = (+) x y : (+) xs ys+   (+) xs     []     = xs+   (+) []     ys     = ys+   (-) (x:xs) (y:ys) = (-) x y : (-) xs ys+   (-) xs     []     = xs+   (-) []     ys     = negate ys+++instance (C v) => C (b -> v) where+   {-# INLINE zero #-}+   {-# INLINE negate #-}+   {-# INLINE (+) #-}+   {-# INLINE (-) #-}+   zero       _ = zero+   (+)    f g x = (+) (f x) (g x)+   (-)    f g x = (-) (f x) (g x)+   negate f   x = negate (f x)++-- * Properties++propAssociative :: (Eq a, C a) => a -> a -> a -> Bool+propCommutative :: (Eq a, C a) => a -> a -> Bool+propIdentity    :: (Eq a, C a) => a -> Bool+propInverse     :: (Eq a, C a) => a -> Bool++propCommutative  =  Laws.commutative (+)+propAssociative  =  Laws.associative (+)+propIdentity     =  Laws.identity (+) zero+propInverse      =  Laws.inverse (+) negate zero++++-- legacy++instance (P.Integral a) => C (Ratio98.Ratio a) where+   {-# INLINE zero #-}+   {-# INLINE negate #-}+   {-# INLINE (+) #-}+   {-# INLINE (-) #-}+   zero                =  0+   (+)                 =  (P.+)+   (-)                 =  (P.-)+   negate              =  P.negate

+ src-ghc-6.12/Algebra/AffineSpace.hs view

@@ -0,0 +1,247 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{- |+This module is not yet exported+since its interface is not mature.+There are two approaches for representing affine spaces:++[1] Two sets: A set of points and a set of vectors.+    Examples: Absolute potential and voltage,+    absolute temperature and temperature difference.+    Operations are+      add :: vector -> point -> point+      sub :: point -> point -> vector++[2] One set for points, no vectors.+    Examples: Interpolation+    Operation:+      combine :: [(coefficient, vector)] -> vector+    Where it must be asserted,+    that the coefficients sum up to 1.++The second one is the one we follow here.+It is more similar to Module and VectorSpace.+-}+module Algebra.AffineSpace where++import qualified Algebra.PrincipalIdealDomain as PID+import qualified Algebra.Additive as Additive+import qualified Algebra.Module as Module+import qualified Number.Ratio as Ratio++import qualified Number.Complex as Complex++import Control.Applicative (Applicative(pure, (<*>)), )++import NumericPrelude.Numeric hiding (zero, )+import NumericPrelude.Base+import Prelude ()++{- |+The type class is for representing affine spaces via affine combinations.+However, we didn't find a way to both ensure the property+that the combination coefficients sum up to 1,+and keep it efficient.++We propose this class instead of a combination of Additive and Module+for interpolation for those types,+where scaling and addition alone makes no sense.+Such types are e.g. internal filter parameters in signal processing:+For these types interpolation makes definitely sense,+but addition and scaling make not.++That is, both classes are isomorphic+(you can define one in terms of the other),+but instances of this class are more easily defined,+and using an AffineSpace constraint instead of Module in a type signature+is important for documentation purposes.+AffineSpace should be superclass of Module.+(But then you may ask, why not adding another superclass for Convex spaces.+This class would provide a linear combination operation,+where the coefficients sum up to one+and all of them are non-negative.)++We may add a safety layer that ensures+that the coefficients sum up to 1,+using start points on the simplex+and functions to move on the simplex.+Start points have components that sum up to 1, e.g.++> (1, 0, 0, 0)+> (0, 1, 0, 0)+> (0, 0, 1, 0)+> (0, 0, 0, 1)+> (1/4, 1/4, 1/4, 1/4)++Then you may move along the simplex in the directions++> (1,  -1, 0,  0)+> (0,   1, 0, -1)+> (-1, -1, 3, -1)++which are characterized by components that sum up to 0.++For example linear combination is defined by++> lerp k (a,b) = (1-k)*>a + k*>b++that is the coefficients are (1-k) and k.+The pair (1-k, k) can be constructed+by starting at pair (1,0)+and moving k units in direction (-1,1).++> (1-k, k) = (1,0) + k*(-1,1)++It is however a challenge to manage the coefficient tuples+in a type safe and efficient way.+For small numbers of interpolation nodes+(constant, linear, cubic interpolation)+a type level list would appropriate,+but what to do for large tuples+like for Whittaker interpolation?+++As side note:+In principle it would be sufficient+to provide an affine combination of two points,+since all affine combinations of more points+can be decomposed into such simple combinations.++> lerp a x y = (1-a)*>x + a*>y++E.g. @a*>x + b*>y + c*>z@ with @a+b+c=1@+can be written as @lerp c (lerp (b/(1-c)) x y) z@.+More generally you can use++> lerpnorm a b x y+>    = lerp (b/(a+b)) x y+>    = (a/(a+b))*>x + (b/(a+b))*>y++for writing++> a*>x + b*>y + c*>z ==+>    lerpnorm (a+b) c (lerpnorm a b x y) z++or++> a*>x + b*>y + c*>z + d*>w ==+>    lerpnorm (a+b+c) d (lerpnorm (a+b) c (lerpnorm a b x y) z) w++with @a+b+c+d=1@.++The downside is, that lerpnorm requires division, that is, a field,+whereas the computation of the coefficients+sometimes only requires ring operations.+-}+class Zero v => C a v where+   multiplyAccumulate :: (a,v) -> v -> v++class Zero v where+   zero :: v+++instance Zero Float where+   {-# INLINE zero #-}+   zero = Additive.zero++instance Zero Double where+   {-# INLINE zero #-}+   zero = Additive.zero++instance (Zero a) => Zero (Complex.T a) where+   {-# INLINE zero #-}+   zero = zero Complex.+: zero++instance (PID.C a) => Zero (Ratio.T a) where+   {-# INLINE zero #-}+   zero = Additive.zero+++instance C Float Float where+   {-# INLINE multiplyAccumulate #-}+   multiplyAccumulate (a,x) y = a*x+y++instance C Double Double where+   {-# INLINE multiplyAccumulate #-}+   multiplyAccumulate (a,x) y = a*x+y++instance (C a v) => C a (Complex.T v) where+   {-# INLINE multiplyAccumulate #-}+   multiplyAccumulate =+      makeMac2 (Complex.+:) Complex.real Complex.imag++instance (PID.C a) => C (Ratio.T a) (Ratio.T a) where+   {-# INLINE multiplyAccumulate #-}+   multiplyAccumulate (a,x) y = a*x+y+++infixl 6 *.+++{- |+Infix variant of 'multiplyAccumulate'.+-}+{-# INLINE (*.+) #-}+(*.+) :: C a v => v -> (a,v) -> v+(*.+) = flip multiplyAccumulate+++-- * convenience functions for defining multiplyAccumulate++{-# INLINE multiplyAccumulateModule #-}+multiplyAccumulateModule ::+   Module.C a v =>+   (a,v) -> v -> v+multiplyAccumulateModule (a,x) y =+   a *> x + y+++{- |+A special reader monad.+-}+newtype MAC a v x = MAC {runMac :: (a,v) -> v -> x}++{-# INLINE element #-}+element ::+   (C a x) =>+   (v -> x) -> MAC a v x+element f =+   MAC (\(a,x) y -> multiplyAccumulate (a, f x) (f y))++instance Functor (MAC a v) where+   {-# INLINE fmap #-}+   fmap f (MAC x) =+      MAC $ \av v -> f $ x av v++instance Applicative (MAC a v) where+   {-# INLINE pure #-}+   {-# INLINE (<*>) #-}+   pure x = MAC $ \ _av _v -> x+   MAC f <*> MAC x =+      MAC $ \av v -> f av v $ x av v++{-# INLINE makeMac #-}+makeMac ::+   (C a x) =>+   (x -> v) ->+   (v -> x) ->+   (a,v) -> v -> v+makeMac cons x =+   runMac $ pure cons <*> element x++{-# INLINE makeMac2 #-}+makeMac2 ::+   (C a x, C a y) =>+   (x -> y -> v) ->+   (v -> x) -> (v -> y) ->+   (a,v) -> v -> v+makeMac2 cons x y =+   runMac $ pure cons <*> element x <*> element y++{-# INLINE makeMac3 #-}+makeMac3 ::+   (C a x, C a y, C a z) =>+   (x -> y -> z -> v) ->+   (v -> x) -> (v -> y) -> (v -> z) ->+   (a,v) -> v -> v+makeMac3 cons x y z =+   runMac $ pure cons <*> element x <*> element y <*> element z

+ src-ghc-6.12/Algebra/Algebraic.hs view

@@ -0,0 +1,65 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Algebra.Algebraic where++import qualified Algebra.Field as Field+-- import qualified Algebra.Units as Units+import qualified Algebra.Laws as Laws+import qualified Algebra.ToRational as ToRational+import qualified Algebra.ToInteger  as ToInteger++import Number.Ratio (Rational, (%), numerator, denominator)+import Algebra.Field ((^-), recip, fromRational')+import Algebra.Ring ((*), (^), fromInteger)+import Algebra.Additive((+))++import NumericPrelude.Base+import qualified Prelude as P+++infixr 8  ^/++{- | Minimal implementation: 'root' or '(^\/)'. -}++class (Field.C a) => C a where+    sqrt :: a -> a+    sqrt = root 2+    -- sqrt x  =  x ** (1/2)++    root :: P.Integer -> a -> a+    root n x = x ^/ (1 % n)++    (^/) :: a -> Rational -> a+    x ^/ y = root (denominator y) (x ^- numerator y)++genericRoot :: (C a, ToInteger.C b) => b -> a -> a+genericRoot n = root (ToInteger.toInteger n)++power :: (C a, ToRational.C b) => b -> a -> a+power r = (^/ ToRational.toRational r)++instance C P.Float where+    sqrt     = P.sqrt+    root n x = x P.** recip (P.fromInteger n)+    x ^/ y   = x P.** fromRational' y++instance C P.Double where+    sqrt     = P.sqrt+    root n x = x P.** recip (P.fromInteger n)+    x ^/ y   = x P.** fromRational' y+++{- * Properties -}++-- propSqrtSqr :: (Eq a, C a, Units.C a) => a -> Bool+-- propSqrtSqr x = sqrt (x^2) == Units.stdAssociate x++propSqrSqrt :: (Eq a, C a) => a -> Bool+propSqrSqrt x = sqrt x ^ 2 == x++propPowerCascade      :: (Eq a, C a) => a -> Rational -> Rational -> Bool+propPowerProduct      :: (Eq a, C a) => a -> Rational -> Rational -> Bool+propPowerDistributive :: (Eq a, C a) => Rational -> a -> a -> Bool++propPowerCascade      x i j  =  Laws.rightCascade (*) (^/) x i j+propPowerProduct      x i j  =  Laws.homomorphism (x^/) (+) (*) i j+propPowerDistributive i x y  =  Laws.leftDistributive (^/) (*) i x y

+ src-ghc-6.12/Algebra/Differential.hs view

@@ -0,0 +1,19 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Algebra.Differential where++import qualified Algebra.Ring as Ring++-- import NumericPrelude.Numeric+-- import qualified Prelude++{- |+'differentiate' is a general differentation operation+It must fulfill the Leibnitz condition++>   differentiate (x * y) == differentiate x * y + x * differentiate y++Unfortunately, this scheme cannot be easily extended to more than two variables,+e.g. "MathObj.PowerSeries2".+-}+class Ring.C a => C a where+   differentiate :: a -> a

+ src-ghc-6.12/Algebra/DimensionTerm.hs view

@@ -0,0 +1,225 @@+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  numericprelude@henning-thielemann.de+Stability   :  provisional+Portability :  portable+++We already have the dynamically checked physical units+provided by "Number.Physical"+and the statically checked ones of the @dimensional@ package of Buckwalter,+which require multi-parameter type classes with functional dependencies.++Here we provide a poor man's approach:+The units are presented by type terms.+There is no canonical form and thus the type checker+can not automatically check for equal units.+However, if two unit terms represent the same unit,+then you can tell the type checker to rewrite one into the other.++You can add more dimensions by introducing more types of class 'C'.++This approach is not entirely safe+because you can write your own flawed rewrite rules.+It is however more safe than with no units at all.+-}++module Algebra.DimensionTerm where++import Prelude hiding (recip)+++{- Haddock does not like 'where' clauses before empty declarations -}+class Show a => C a -- where+++noValue :: C a => a+noValue =+   let x = error ("there is no value of type " ++ show x)+   in  x++{- * Type constructors -}++data Scalar  = Scalar+data Mul a b = Mul+data Recip a = Recip+type Sqr   a = Mul a a++appPrec :: Int+appPrec = 10++instance Show Scalar where+   show _ = "scalar"++instance (Show a, Show b) => Show (Mul a b) where+   showsPrec p x =+      let disect :: Mul a b -> (a,b)+          disect _ = undefined+          (y,z) = disect x+      in  showParen (p >= appPrec)+            (showString "mul " . showsPrec appPrec y .+             showString " " . showsPrec appPrec z)++instance (Show a) => Show (Recip a) where+   showsPrec p x =+      let disect :: Recip a -> a+          disect _ = undefined+      in  showParen (p >= appPrec)+            (showString "recip " . showsPrec appPrec (disect x))+++instance C Scalar -- where++instance (C a, C b) => C (Mul a b) -- where++instance (C a) => C (Recip a) -- where+++scalar :: Scalar+scalar = noValue++mul :: (C a, C b) => a -> b -> Mul a b+mul _ _ = noValue++recip :: (C a) => a -> Recip a+recip _ = noValue+++infixl 7 %*%+infixl 7 %/%++(%*%) :: (C a, C b) => a -> b -> Mul a b+(%*%) = mul++(%/%) :: (C a, C b) => a -> b -> Mul a (Recip b)+(%/%) x y = mul x (recip y)+++{- * Rewrites -}++applyLeftMul :: (C u0, C u1, C v) => (u0 -> u1) -> Mul u0 v -> Mul u1 v+applyLeftMul _ _ = noValue+applyRightMul :: (C u0, C u1, C v) => (u0 -> u1) -> Mul v u0 -> Mul v u1+applyRightMul _ _ = noValue+applyRecip :: (C u0, C u1) => (u0 -> u1) -> Recip u0 -> Recip u1+applyRecip _ _ = noValue++commute :: (C u0, C u1) => Mul u0 u1 -> Mul u1 u0+commute _ = noValue+associateLeft :: (C u0, C u1, C u2) => Mul u0 (Mul u1 u2) -> Mul (Mul u0 u1) u2+associateLeft _ = noValue+associateRight :: (C u0, C u1, C u2) => Mul (Mul u0 u1) u2 -> Mul u0 (Mul u1 u2)+associateRight _ = noValue+recipMul :: (C u0, C u1) => Recip (Mul u0 u1) -> Mul (Recip u0) (Recip u1)+recipMul _ = noValue+mulRecip :: (C u0, C u1) => Mul (Recip u0) (Recip u1) -> Recip (Mul u0 u1)+mulRecip _ = noValue++identityLeft :: C u => Mul Scalar u -> u+identityLeft _ = noValue+identityRight :: C u => Mul u Scalar -> u+identityRight _ = noValue+cancelLeft :: C u => Mul (Recip u) u -> Scalar+cancelLeft _ = noValue+cancelRight :: C u => Mul u (Recip u) -> Scalar+cancelRight _ = noValue+invertRecip :: C u => Recip (Recip u) -> u+invertRecip _ = noValue+doubleRecip :: C u => u -> Recip (Recip u)+doubleRecip _ = noValue+recipScalar :: Recip Scalar -> Scalar+recipScalar _ = noValue+++{- * Example dimensions -}++{- ** Scalar -}++{- |+This class allows defining instances that are exclusively for 'Scalar' dimension.+You won't want to define instances by yourself.+-}+class C dim => IsScalar dim where+   toScalar :: dim -> Scalar+   fromScalar :: Scalar -> dim++instance IsScalar Scalar where+   toScalar = id+   fromScalar = id+++{- ** Basis dimensions -}++data Length      = Length+data Time        = Time+data Mass        = Mass+data Charge      = Charge+data Angle       = Angle+data Temperature = Temperature+data Information = Information++length :: Length+length = noValue++time :: Time+time = noValue++mass :: Mass+mass = noValue++charge :: Charge+charge = noValue++angle :: Angle+angle = noValue++temperature :: Temperature+temperature = noValue++information :: Information+information = noValue+++instance Show Length      where show _ = "length"+instance Show Time        where show _ = "time"+instance Show Mass        where show _ = "mass"+instance Show Charge      where show _ = "charge"+instance Show Angle       where show _ = "angle"+instance Show Temperature where show _ = "temperature"+instance Show Information where show _ = "information"++instance C Length      -- where+instance C Time        -- where+instance C Mass        -- where+instance C Charge      -- where+instance C Angle       -- where+instance C Temperature -- where+instance C Information -- where++{- ** Derived dimensions -}++type Frequency = Recip Time++frequency :: Frequency+frequency = noValue+++data Voltage = Voltage++type VoltageAnalytical =+        Mul (Mul (Sqr Length) Mass) (Recip (Mul (Sqr Time) Charge))++voltage :: Voltage+voltage = noValue++instance Show Voltage where show _ = "voltage"++instance C Voltage -- where++unpackVoltage :: Voltage -> VoltageAnalytical+unpackVoltage _ = noValue++packVoltage :: VoltageAnalytical -> Voltage+packVoltage _ = noValue

+ src-ghc-6.12/Algebra/DivisibleSpace.hs view

@@ -0,0 +1,21 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+module Algebra.DivisibleSpace where++import qualified Algebra.VectorSpace as VectorSpace++-- Is this right?+infix 7 </>++{-|+DivisibleSpace is used for free one-dimensional vector spaces.  It+satisfies++>  (a </> b) *> b = a++Examples include dollars and kilometers.+-}+class (VectorSpace.C a b) => C a b where+    (</>) :: b -> b -> a+

+ src-ghc-6.12/Algebra/EqualityDecision.hs view

@@ -0,0 +1,110 @@+{- |+Combination of @(==)@ and @if then else@+that can be instantiated for more types than @Eq@+or can be instantiated in a way+that allows more defined results (\"more total\" functions):++* Reader like types for representing a context+  like 'Number.ResidueClass.Reader'++* Expressions in an EDSL++* More generally every type based on an applicative functor++* Tuples and Vector types++* Positional and Peano numbers,+  a common prefix of two numbers can be emitted+  before the comparison is done.+  (This could also be done with an overloaded 'if',+   what we also do not have.)+-}+module Algebra.EqualityDecision where++import qualified NumericPrelude.Elementwise as Elem+import Control.Applicative (Applicative(pure, (<*>)), )+import Data.Tuple.HT (fst3, snd3, thd3, )+import Data.List (zipWith4, )+++{- |+For atomic types this could be a superclass of 'Eq'.+However for composed types like tuples, lists, functions+we do elementwise comparison+which is incompatible with the complete comparison performed by '(==)'.+-}+class C a where+   {- |+   It holds++   > (a ==? b) eq noteq  ==  if a==b then eq else noteq++   for atomic types where the right hand side can be defined.+   -}+   (==?) :: a -> a -> a -> a -> a++++{-# INLINE deflt #-}+deflt :: Eq a => a -> a -> a -> a -> a+deflt a b eq noteq =+   if a==b then eq else noteq++++instance C Int where+   {-# INLINE (==?) #-}+   (==?) = deflt++instance C Integer where+   {-# INLINE (==?) #-}+   (==?) = deflt++instance C Float where+   {-# INLINE (==?) #-}+   (==?) = deflt++instance C Double where+   {-# INLINE (==?) #-}+   (==?) = deflt++instance C Bool where+   {-# INLINE (==?) #-}+   (==?) = deflt++instance C Ordering where+   {-# INLINE (==?) #-}+   (==?) = deflt++++{-# INLINE element #-}+element ::+   (C x) =>+   (v -> x) -> Elem.T (v,v,v,v) x+element f =+   Elem.element (\(x,y,eq,noteq) -> (f x ==? f y) (f eq) (f noteq))++{-# INLINE (<*>.==?) #-}+(<*>.==?) ::+   (C x) =>+   Elem.T (v,v,v,v) (x -> a) -> (v -> x) -> Elem.T (v,v,v,v) a+(<*>.==?) f acc =+   f <*> element acc+++instance (C a, C b) => C (a,b) where+   {-# INLINE (==?) #-}+   (==?) = Elem.run4 $ pure (,) <*>.==?  fst <*>.==?  snd++instance (C a, C b, C c) => C (a,b,c) where+   {-# INLINE (==?) #-}+   (==?) = Elem.run4 $ pure (,,) <*>.==?  fst3 <*>.==?  snd3 <*>.==?  thd3++instance C a => C [a] where+   {-# INLINE (==?) #-}+   (==?) = zipWith4 (==?)++instance (C a) => C (b -> a) where+   {-# INLINE (==?) #-}+   (==?) x y eq noteq c  =  (x c ==? y c) (eq c) (noteq c)

+ src-ghc-6.12/Algebra/Field.hs view

@@ -0,0 +1,161 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Algebra.Field (+    {- * Class -}+    C,++    (/),+    recip,+    fromRational',+    fromRational,+    (^-),++    {- * Properties -}+    propDivision,+    propReciprocal,+  ) where++import Number.Ratio (T((:%)), Rational, (%), numerator, denominator, )+import qualified Number.Ratio as Ratio+import qualified Data.Ratio as Ratio98+import qualified Algebra.PrincipalIdealDomain as PID+import qualified Algebra.Units as Unit++import qualified Algebra.Ring         as Ring+-- import qualified Algebra.Additive     as Additive+import qualified Algebra.ZeroTestable as ZeroTestable++import Algebra.Ring ((*), (^), one, fromInteger)+import Algebra.Additive (zero, negate)+import Algebra.ZeroTestable (isZero)++import NumericPrelude.Base+import Prelude (Integer, Float, Double)+import qualified Prelude as P+import Test.QuickCheck ((==>), Property)+++infixr 8 ^-+infixl 7 /+++{- |+Field again corresponds to a commutative ring.+Division is partially defined and satisfies++>    not (isZero b)  ==>  (a * b) / b === a+>    not (isZero a)  ==>  a * recip a === one++when it is defined. +To safely call division,+the program must take type-specific action;+e.g., the following is appropriate in many cases:++> safeRecip :: (Integral a, Eq a, Field.C a) => a -> Maybe a+> safeRecip x =+>     let (q,r) = one `divMod` x+>     in  toMaybe (isZero r) q++Typical examples include rationals, the real numbers,+and rational functions (ratios of polynomial functions).+An instance should be typically declared+only if most elements are invertible.++Actually, we have also used this type class for non-fields+containing lots of units,+e.g. residue classes with respect to non-primes and power series.+So the restriction @not (isZero a)@ must be better @isUnit a@.++Minimal definition: 'recip' or ('/')+-}++class (Ring.C a) => C a where+    (/)           :: a -> a -> a+    recip         :: a -> a+    fromRational' :: Rational -> a+    (^-)          :: a -> Integer -> a++    {-# INLINE recip #-}+    recip a = one / a+    {-# INLINE (/) #-}+    a / b = a * recip b+    {-# INLINE fromRational' #-}+    fromRational' r = fromInteger (numerator r) / fromInteger (denominator r)+    {-# INLINE (^-) #-}+    a ^- n = if n < zero+               then recip (a^(-n))+               else a^n+ -- a ^ n | n < 0 = reduceRepeated (^) one (recip a) (negate (toInteger n))+ --       | True  = reduceRepeated (^) one a (toInteger n)++++-- | Needed to work around shortcomings in GHC.++{-# INLINE fromRational #-}+fromRational :: (C a) => P.Rational -> a+fromRational x = fromRational' (Ratio98.numerator x :% Ratio98.denominator x)+++{- * Instances for atomic types -}++{-+fromRational must be implemented explicitly for Float and Double!+It may be that numerator or denominator cannot be represented as Float+due to size constraints, but the fraction can.+-}++instance C Float where+    {-# INLINE (/) #-}+    {-# INLINE recip #-}+    (/)    = (P./)+    recip  = (P.recip)+    -- using Ratio98.:% would be more efficient but it is not exported.+    fromRational' x =+       P.fromRational (numerator x Ratio98.% denominator x)++instance C Double where+    {-# INLINE (/) #-}+    {-# INLINE recip #-}+    (/)    = (P./)+    recip  = (P.recip)+    fromRational' x =+       P.fromRational (numerator x Ratio98.% denominator x)++instance (PID.C a) => C (Ratio.T a) where+    {-# INLINE (/) #-}+    {-# INLINE recip #-}+    {-# INLINE fromRational' #-}+--    (/)                  =  Ratio.liftOrd (%)+    x / y                =  x * recip y+{-+This is efficient and almost correct in the sense,+that all admissible cases yield a correct result.+However it will hide division by zero and thus may hide bugs.+Unfortunately 'x' might not be a standard associate,+thus (y:%x) may deviate from the canonical representation.++    recip (x:%y)         =  (y:%x)+-}+    recip (x:%y)         =+       if isZero y+         then error "Ratio./: division by zero"+         else (y * Unit.stdUnitInv x) :% Unit.stdAssociate x+    fromRational' (x:%y) =  fromInteger x % fromInteger y+++-- | the restriction on the divisor should be @isUnit a@ instead of @not (isZero a)@+propDivision   :: (Eq a, ZeroTestable.C a, C a) => a -> a -> Property+propReciprocal :: (Eq a, ZeroTestable.C a, C a) => a -> Property++propDivision   a b   =   not (isZero b)  ==>  (a * b) / b == a+propReciprocal a     =   not (isZero a)  ==>  a * recip a == one++++-- legacy++instance (P.Integral a) => C (Ratio98.Ratio a) where+    {-# INLINE (/) #-}+    {-# INLINE recip #-}+    (/)    = (P./)+    recip  = (P.recip)

+ src-ghc-6.12/Algebra/GenerateRules.hs view

@@ -0,0 +1,86 @@+{- |+Poor man's Template Haskell:+Generate RULES for handling of primitive number types.+-}+module Main where++import Data.Maybe (fromMaybe, )++import Prelude hiding (fromIntegral, )+++pad :: Int -> String -> String+pad n str =+   zipWith fromMaybe+      (replicate n ' ')+      (map Just str ++ repeat Nothing)+++machineIntegerTypes :: [String]+machineIntegerTypes =+   do typeSign <- "Int" : "Word" : []+      typeSize <- "" : "8" : "16" : "32" : "64" : []+      return $ typeSign ++ typeSize++functionSignature :: String -> String -> String -> String+functionSignature functionName sourceType targetType =+   functionName ++ " :: " ++ sourceType ++ " -> " ++ targetType++{-+Simply replace NumericPrelude.roundFunc by Prelude98.roundFunc.+This is only sensible where Prelude functions are optimized.+Unfortunately there seems to be no optimization for target type Int8 et.al.+-}+realField :: [String]+realField =+   do sourceType <- "Float" : "Double" : []+      targetType <- machineIntegerTypes+      method <- "round" : "truncate" : "floor" : "ceiling" : []+      let methodPad = pad 8 method+      let signature = functionSignature methodPad sourceType targetType+      return $ "     " +++         pad 40 ("\"NP." ++ signature ++ "\"") +++         methodPad ++ " = P." ++ signature ++ ";"++realFieldIndirect :: [String]+realFieldIndirect =+   do targetType <- tail machineIntegerTypes+      method <- "round" : "roundSimple" : "truncate" : "floor" : "ceiling" : []+      let methodPad = pad 11 method+      let signature = functionSignature methodPad "a" targetType+      return $ "     " +++         pad 33 ("\"NP." ++ signature ++ "\"") +++         methodPad ++ " = (" ++ functionSignature "P.fromIntegral" "Int" targetType ++ ") . "+             ++ method ++ ";"++splitFractionIndirect :: [String]+splitFractionIndirect =+   do targetType <- tail machineIntegerTypes+      method <- "splitFraction" : []+      let methodPad = pad 13 method+      let signature = functionSignature methodPad "a" ("("++targetType++",a)")+      return $ "     " +++         pad 40 ("\"NP." ++ signature ++ "\"") +++         methodPad ++ " = mapFst (" ++ functionSignature "P.fromIntegral" "Int" targetType ++ ") . "+             ++ method ++ ";"+++fromIntegral :: [String]+fromIntegral =+   do sourceType <- "Integer" : machineIntegerTypes+      targetType <- "Int" : "Integer" : "Float" : "Double" : []+      let function = "fromIntegral"+      let signature = functionSignature function sourceType targetType+      return $ "     " +++         pad 40 ("\"NP." ++ signature ++ "\"") +++         function ++ " = P." ++ signature ++ ";"+++main :: IO ()+main =+   putStrLn "module Algebra.RealRing" >>+   mapM_ putStrLn realFieldIndirect >>+   mapM_ putStrLn splitFractionIndirect >>++   putStrLn "module Algebra.ToInteger" >>+   mapM_ putStrLn fromIntegral

+ src-ghc-6.12/Algebra/Indexable.hs view

@@ -0,0 +1,76 @@+{- |+Copyright    :   (c) Henning Thielemann 2007+Maintainer   :   numericprelude@henning-thielemann.de+Stability    :   provisional+Portability  :   portable++An alternative type class for Ord+which allows an ordering for dictionaries like "Data.Map" and "Data.Set"+independently from the ordering with respect to a magnitude.+-}++module Algebra.Indexable (+    C(compare),+    ordCompare,+    liftCompare,+    ToOrd,+    toOrd,+    fromOrd,+    ) where++import Prelude hiding (compare)++import qualified Prelude as P+++{- |+Definition of an alternative ordering of objects+independent from a notion of magnitude.+For an application see "MathObj.PartialFraction".+-}+class Eq a => C a where+   compare :: a -> a -> Ordering++{- |+If the type has already an 'Ord' instance+it is certainly the most easiest to define 'Algebra.Indexable.compare'+to be equal to @Ord@'s 'compare'.+-}+ordCompare :: Ord a => a -> a -> Ordering+ordCompare = P.compare++{- |+Lift 'compare' implementation from a wrapped object.+-}+liftCompare :: C b => (a -> b) -> a -> a -> Ordering+liftCompare f x y = compare (f x) (f y)+++instance (C a, C b) => C (a,b) where+   compare (x0,x1) (y0,y1) =+      let res = compare x0 y0+      in  case res of+             EQ -> compare x1 y1+             _  -> res++instance C a => C [a] where+   compare [] [] = EQ+   compare [] _  = LT+   compare _  [] = GT+   compare (x:xs) (y:ys) = compare (x,xs) (y,ys)++instance C Integer where+   compare = ordCompare+++{- |+Wrap an indexable object such that it can be used in "Data.Map" and "Data.Set".+-}+newtype ToOrd a = ToOrd {fromOrd :: a} deriving (Eq, Show)++toOrd :: a -> ToOrd a+toOrd = ToOrd+++instance C a => Ord (ToOrd a) where+   compare (ToOrd x) (ToOrd y) = compare x y

+ src-ghc-6.12/Algebra/IntegralDomain.hs view

@@ -0,0 +1,339 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Algebra.IntegralDomain (+    {- * Class -}+    C,+    div, mod, divMod,++    {- * Derived functions -}+    divModZero,+    divides,+    sameResidueClass,+    divChecked, safeDiv,+    even,+    odd,++    divUp,+    roundDown,+    roundUp,++    {- * Algorithms -}+    decomposeVarPositional,+    decomposeVarPositionalInf,++    {- * Properties -}+    propInverse,+    propMultipleDiv,+    propMultipleMod,+    propProjectAddition,+    propProjectMultiplication,+    propUniqueRepresentative,+    propZeroRepresentative,+    propSameResidueClass,+  ) where++import qualified Algebra.Ring         as Ring+-- import qualified Algebra.Additive     as Additive+import qualified Algebra.ZeroTestable as ZeroTestable++import Algebra.Ring     ((*), fromInteger, )+import Algebra.Additive (zero, (+), (-), negate, )+import Algebra.ZeroTestable (isZero, )++import Data.Bool.HT (implies, )+import Data.List (mapAccumL, )++import Test.QuickCheck ((==>), Property)++import Data.Int  (Int,  Int8,  Int16,  Int32,  Int64,  )+import Data.Word (Word, Word8, Word16, Word32, Word64, )++import NumericPrelude.Base+import Prelude (Integer, )+import qualified Prelude as P++++infixl 7 `div`, `mod`+++{-+Shall we require+                   @ a `mod` 0 === a @   (divModZero)+or+                   @ a `mod` 0 === undefined @+?+-}+++{- |+@IntegralDomain@ corresponds to a commutative ring,+where @a `mod` b@ picks a canonical element+of the equivalence class of @a@ in the ideal generated by @b@.+'div' and 'mod' satisfy the laws++>                         a * b === b * a+> (a `div` b) * b + (a `mod` b) === a+>               (a+k*b) `mod` b === a `mod` b+>                     0 `mod` b === 0++Typical examples of @IntegralDomain@ include integers and+polynomials over a field.+Note that for a field, there is a canonical instance+defined by the above rules; e.g.,++> instance IntegralDomain.C Rational where+>     divMod a b =+>        if isZero b+>          then (undefined,a)+>          else (a\/b,0)++It shall be noted, that 'div', 'mod', 'divMod' have a parameter order+which is unfortunate for partial application.+But it is adapted to mathematical conventions,+where the operators are used in infix notation.++Minimal definition: 'divMod' or ('div' and 'mod')+-}+class (Ring.C a) => C a where+    div, mod :: a -> a -> a+    divMod :: a -> a -> (a,a)++    {-# INLINE div #-}+    {-# INLINE mod #-}+    {-# INLINE divMod #-}+    div a b = fst (divMod a b)+    mod a b = snd (divMod a b)+    divMod a b = (div a b, mod a b)+++{-# INLINE divides #-}+divides :: (C a, ZeroTestable.C a) => a -> a -> Bool+divides y x  =  isZero (mod x y)++{-# INLINE sameResidueClass #-}+sameResidueClass :: (C a, ZeroTestable.C a) => a -> a -> a -> Bool+sameResidueClass m x y = divides m (x-y)++++{- |+@decomposeVarPositional [b0,b1,b2,...] x@+decomposes @x@ into a positional representation with mixed bases+@x0 + b0*(x1 + b1*(x2 + b2*x3))@+E.g. @decomposeVarPositional (repeat 10) 123 == [3,2,1]@+-}+decomposeVarPositional :: (C a, ZeroTestable.C a) => [a] -> a -> [a]+decomposeVarPositional bs x =+   map fst $+   takeWhile (not . isZero . snd) $+   decomposeVarPositionalInfAux bs x++decomposeVarPositionalInf :: (C a) => [a] -> a -> [a]+decomposeVarPositionalInf bs =+   map fst . decomposeVarPositionalInfAux bs++decomposeVarPositionalInfAux :: (C a) => [a] -> a -> [(a,a)]+decomposeVarPositionalInfAux bs x =+   let (endN,digits) =+          mapAccumL+             (\n b -> let (q,r) = divMod n b in (q,(r,n)))+             x bs+   in  digits ++ [(endN,endN)]++++{- |+Returns the result of the division, if divisible.+Otherwise undefined.+-}+{-# INLINE divChecked #-}+divChecked, safeDiv :: (ZeroTestable.C a, C a) => a -> a -> a+divChecked a b =+   let (q,r) = divMod a b+   in  if isZero r+         then q+         else error "safeDiv: indivisible term"++{-# DEPRECATED safeDiv "use divChecked instead" #-}+safeDiv = divChecked++{- |+Allows division by zero.+If the divisor is zero, then the dividend is returned as remainder.+-}+{-# INLINE divModZero #-}+divModZero :: (C a, ZeroTestable.C a) => a -> a -> (a,a)+divModZero x y =+   if isZero y+     then (zero,x)+     else divMod x y++++{-# INLINE even #-}+{-# INLINE odd #-}+even, odd :: (C a, ZeroTestable.C a) => a -> Bool+even n    =  divides 2 n+odd       =  not . even+++{- |+@roundDown n m@ rounds @n@ down to the next multiple of @m@.+That is, @roundDown n m@ is the greatest multiple of @m@+that is at most @n@.+The parameter order is consistent with @div@ and friends,+but maybe not useful for partial application.+-}+roundDown :: C a => a -> a -> a+roundDown n m = n - mod n m++{- |+@roundUp n m@ rounds @n@ up to the next multiple of @m@.+That is, @roundUp n m@ is the greatest multiple of @m@+that is at most @n@.+-}+roundUp :: C a => a -> a -> a+roundUp n m = n + mod (-n) m++{- |+@divUp n m@ is similar to @div@+but it rounds up the quotient,+such that @divUp n m * m = roundUp n m@.+-}+divUp :: C a => a -> a -> a+divUp n m = - div (-n) m++{-+What sign of the remainder is most appropriate?++divModUp :: C a => a -> a -> (a,a)+divModUp n m = mapFst negate $ divMod (-n) m+-}+++{- * Instances for atomic types -}++instance C Integer where+   {-# INLINE div #-}+   {-# INLINE mod #-}+   {-# INLINE divMod #-}+   div = P.div+   mod = P.mod+   divMod = P.divMod++instance C Int     where+   {-# INLINE div #-}+   {-# INLINE mod #-}+   {-# INLINE divMod #-}+   div = P.div+   mod = P.mod+   divMod = P.divMod++instance C Int8    where+   {-# INLINE div #-}+   {-# INLINE mod #-}+   {-# INLINE divMod #-}+   div = P.div+   mod = P.mod+   divMod = P.divMod++instance C Int16   where+   {-# INLINE div #-}+   {-# INLINE mod #-}+   {-# INLINE divMod #-}+   div = P.div+   mod = P.mod+   divMod = P.divMod++instance C Int32   where+   {-# INLINE div #-}+   {-# INLINE mod #-}+   {-# INLINE divMod #-}+   div = P.div+   mod = P.mod+   divMod = P.divMod++instance C Int64   where+   {-# INLINE div #-}+   {-# INLINE mod #-}+   {-# INLINE divMod #-}+   div = P.div+   mod = P.mod+   divMod = P.divMod+++instance C Word    where+   {-# INLINE div #-}+   {-# INLINE mod #-}+   {-# INLINE divMod #-}+   div = P.div+   mod = P.mod+   divMod = P.divMod++instance C Word8   where+   {-# INLINE div #-}+   {-# INLINE mod #-}+   {-# INLINE divMod #-}+   div = P.div+   mod = P.mod+   divMod = P.divMod++instance C Word16  where+   {-# INLINE div #-}+   {-# INLINE mod #-}+   {-# INLINE divMod #-}+   div = P.div+   mod = P.mod+   divMod = P.divMod++instance C Word32  where+   {-# INLINE div #-}+   {-# INLINE mod #-}+   {-# INLINE divMod #-}+   div = P.div+   mod = P.mod+   divMod = P.divMod++instance C Word64  where+   {-# INLINE div #-}+   {-# INLINE mod #-}+   {-# INLINE divMod #-}+   div = P.div+   mod = P.mod+   divMod = P.divMod+++++-- Ring.propCommutative and ...+propInverse               :: (Eq a, C a, ZeroTestable.C a) => a -> a -> Property+propMultipleDiv           :: (Eq a, C a, ZeroTestable.C a) => a -> a -> Property+propMultipleMod           :: (Eq a, C a, ZeroTestable.C a) => a -> a -> Property+propProjectAddition       :: (Eq a, C a, ZeroTestable.C a) => a -> a -> a -> Property+propProjectMultiplication :: (Eq a, C a, ZeroTestable.C a) => a -> a -> a -> Property+propSameResidueClass      :: (Eq a, C a, ZeroTestable.C a) => a -> a -> a -> Property+propUniqueRepresentative  :: (Eq a, C a, ZeroTestable.C a) => a -> a -> a -> Property+propZeroRepresentative    :: (Eq a, C a, ZeroTestable.C a) => a -> Property+++propInverse     m a =+   not (isZero m) ==> (a `div` m) * m + (a `mod` m)  ==  a+propMultipleDiv m a =+   not (isZero m) ==>                 (a*m) `div` m  ==  a+propMultipleMod m a =+   not (isZero m) ==>                 (a*m) `mod` m  ==  0+propProjectAddition m a b =+   not (isZero m) ==>+      (a+b) `mod` m  ==  ((a`mod`m)+(b`mod`m)) `mod` m+propProjectMultiplication m a b =+   not (isZero m) ==>+      (a*b) `mod` m  ==  ((a`mod`m)*(b`mod`m)) `mod` m+propUniqueRepresentative m k a =+   not (isZero m) ==>+      (a+k*m) `mod` m  ==  a `mod` m+propZeroRepresentative m =+   not (isZero m) ==>+      zero `mod` m  ==  zero+propSameResidueClass m a b =+   not (isZero m) ==>+      a `mod` m == b `mod` m   `implies`   sameResidueClass m a b

+ src-ghc-6.12/Algebra/Lattice.hs view

@@ -0,0 +1,69 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Algebra.Lattice (+      C(up, dn)+    , max, min, abs+    , propUpCommutative, propDnCommutative+    , propUpAssociative, propDnAssociative+    , propUpDnDistributive, propDnUpDistributive+) where++import qualified Algebra.PrincipalIdealDomain as PID+import qualified Algebra.Additive as Additive+import qualified Number.Ratio     as Ratio++import qualified Algebra.Laws as Laws++import NumericPrelude.Numeric hiding (abs)+import NumericPrelude.Base hiding (max, min)+import qualified Prelude as P++infixl 5 `up`, `dn`++class C a where+    up, dn :: a -> a -> a+++{- * Properties -}++propUpCommutative, propDnCommutative ::+ (Eq a, C a) => a -> a -> Bool+propUpCommutative  =  Laws.commutative up+propDnCommutative  =  Laws.commutative dn++propUpAssociative, propDnAssociative ::+ (Eq a, C a) => a -> a -> a -> Bool+propUpAssociative  =  Laws.associative up+propDnAssociative  =  Laws.associative dn++propUpDnDistributive, propDnUpDistributive ::+ (Eq a, C a) => a -> a -> a -> Bool+propUpDnDistributive  =  Laws.leftDistributive up dn+propDnUpDistributive  =  Laws.leftDistributive dn up+++++-- With  @up == gcd@  and  @dn == lcm@  we have also a lattice.+instance C Integer where+    up = P.max+    dn = P.min++instance (Ord a, PID.C a) => C (Ratio.T a) where+    up = P.max+    dn = P.min++instance C Bool where+    up = (P.||)+    dn = (P.&&)++instance (C a, C b) => C (a,b) where+    (x1,y1)`up`(x2,y2) = (x1`up`x2, y1`up`y2)+    (x1,y1)`dn`(x2,y2) = (x1`dn`x2, y1`dn`y2)+++max, min :: (C a) => a -> a -> a+max = up+min = dn++abs :: (C a, Additive.C a) => a -> a+abs x = x `up` negate x

+ src-ghc-6.12/Algebra/Laws.hs view

@@ -0,0 +1,57 @@+{- |+Define common properties that can be used e.g. for automated tests.+Cf. to "Test.QuickCheck.Utils".+-}+module Algebra.Laws where+++commutative :: Eq a => (b -> b -> a) -> b -> b -> Bool+commutative op x y  =  x `op` y == y `op` x++associative :: Eq a => (a -> a -> a) -> a -> a -> a -> Bool+associative op x y z  =  (x `op` y) `op` z == x `op` (y `op` z)++leftIdentity :: Eq a => (b -> a -> a) -> b -> a -> Bool+leftIdentity op y x  =  y `op` x == x++rightIdentity :: Eq a => (a -> b -> a) -> b -> a -> Bool+rightIdentity op y x  =  x `op` y == x++identity :: Eq a => (a -> a -> a) -> a -> a -> Bool+identity op x y  =  leftIdentity op x y &&  rightIdentity op x y++leftZero :: Eq a => (a -> a -> a) -> a -> a -> Bool+leftZero  =  flip . rightIdentity++rightZero :: Eq a => (a -> a -> a) -> a -> a -> Bool+rightZero  =  flip . leftIdentity++zero :: Eq a => (a -> a -> a) -> a -> a -> Bool+zero op x y  =  leftZero op x y  &&  rightZero op x y++leftInverse :: Eq a => (b -> b -> a) -> (b -> b) -> a -> b -> Bool+leftInverse op inv y x  =  inv x `op` x == y++rightInverse :: Eq a => (b -> b -> a) -> (b -> b) -> a -> b -> Bool+rightInverse op inv y x  =  x `op` inv x == y++inverse :: Eq a => (b -> b -> a) -> (b -> b) -> a -> b -> Bool+inverse op inv y x  =  leftInverse op inv y x && rightInverse op inv y x++leftDistributive :: Eq a => (a -> b -> a) -> (a -> a -> a) -> b -> a -> a -> Bool+leftDistributive ( # ) op x y z  =  (y `op` z) # x == (y # x) `op` (z # x)++rightDistributive :: Eq a => (b -> a -> a) -> (a -> a -> a) -> b -> a -> a -> Bool+rightDistributive ( # ) op x y z  =  x # (y `op` z) == (x # y) `op` (x # z)++homomorphism :: Eq a =>+   (b -> a) -> (b -> b -> b) -> (a -> a -> a) -> b -> b -> Bool+homomorphism f op0 op1 x y  =  f (x `op0` y) == f x `op1` f y++rightCascade :: Eq a =>+   (b -> b -> b) -> (a -> b -> a) -> a -> b -> b -> Bool+rightCascade ( # ) op x i j  =  (x `op` i) `op` j == x `op` (i#j)++leftCascade :: Eq a =>+   (b -> b -> b) -> (b -> a -> a) -> a -> b -> b -> Bool+leftCascade ( # ) op x i j  =  j `op` (i `op` x) == (j#i) `op` x

+ src-ghc-6.12/Algebra/Module.hs view

@@ -0,0 +1,153 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{- |+Copyright   :  (c) Dylan Thurston, Henning Thielemann 2004-2005++Maintainer  :  numericprelude@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++Abstraction of modules+-}++module Algebra.Module where++import qualified Number.Ratio as Ratio++import qualified Algebra.PrincipalIdealDomain as PID+import qualified Algebra.Ring      as Ring+import qualified Algebra.Additive  as Additive+import qualified Algebra.ToInteger as ToInteger++import qualified Algebra.Laws as Laws++import Algebra.Ring     ((*), fromInteger, )+import Algebra.Additive ((+), zero, sum, )++import qualified NumericPrelude.Elementwise as Elem+import Control.Applicative (Applicative(pure, (<*>)), )++import Data.Function.HT (powerAssociative, )+import Data.List (map, zipWith, )+import Data.Tuple.HT (fst3, snd3, thd3, )+import Data.Tuple (fst, snd, )++import Prelude((.), Eq, Bool, Int, Integer, Float, Double, ($), )+-- import qualified Prelude as P+++-- Is this right?+infixr 7 *>++{-+Functional dependency can't be used+since @Complex.T a@ is a module+with respect to both @a@ and @Complex.T a@.++class Algebra.Module.C a v | v -> a where+-}++{-|+A Module over a ring satisfies:++>   a *> (b + c) === a *> b + a *> c+>   (a * b) *> c === a *> (b *> c)+>   (a + b) *> c === a *> c + b *> c+-}+class (Ring.C a, Additive.C v) => C a v where+    -- | scale a vector by a scalar+    (*>) :: a -> v -> v+++{-# INLINE (<*>.*>) #-}+(<*>.*>) ::+   (C a x) =>+   Elem.T (a,v) (x -> c) -> (v -> x) -> Elem.T (a,v) c+(<*>.*>) f acc =+   f <*> Elem.element (\(a,v) -> a *> acc v)++++{-* Instances for atomic types -}++instance C Float Float where+   {-# INLINE (*>) #-}+   (*>) = (*)++instance C Double Double where+   {-# INLINE (*>) #-}+   (*>) = (*)++instance C Int Int where+   {-# INLINE (*>) #-}+   (*>) = (*)++instance C Integer Integer where+   {-# INLINE (*>) #-}+   (*>) = (*)++instance (PID.C a) => C (Ratio.T a) (Ratio.T a) where+   {-# INLINE (*>) #-}+   (*>) = (*)++instance (PID.C a) => C Integer (Ratio.T a) where+   {-# INLINE (*>) #-}+   x *> y = fromInteger x * y++++{-* Instances for composed types -}++instance (C a b0, C a b1) => C a (b0, b1) where+   {-# INLINE (*>) #-}+   (*>) = Elem.run2 $ pure (,) <*>.*> fst <*>.*> snd+   -- s *> (x0,x1)   = (s *> x0, s *> x1)++instance (C a b0, C a b1, C a b2) => C a (b0, b1, b2) where+   {-# INLINE (*>) #-}+   (*>) = Elem.run2 $ pure (,,) <*>.*> fst3 <*>.*> snd3 <*>.*> thd3+   -- s *> (x0,x1,x2) = (s *> x0, s *> x1, s *> x2)++instance (C a v) => C a [v] where+   {-# INLINE (*>) #-}+   (*>) = map . (*>)++instance (C a v) => C a (c -> v) where+   {-# INLINE (*>) #-}+   (*>) s f = (*>) s . f+++{-* Related functions -}++{-|+Compute the linear combination of a list of vectors.++ToDo:+Should it use 'NumericPrelude.List.Checked.zipWith' ?+-}+linearComb :: C a v => [a] -> [v] -> v+linearComb c = sum . zipWith (*>) c++{-|+This function can be used to define any+'Additive.C' as a module over 'Integer'.++Better move to "Algebra.Additive"?+-}+{-# INLINE integerMultiply #-}+integerMultiply :: (ToInteger.C a, Additive.C v) => a -> v -> v+integerMultiply a v =+   powerAssociative (+) zero v (ToInteger.toInteger a)+++{- * Properties -}++propCascade :: (Eq v, C a v) => v -> a -> a -> Bool+propCascade  =  Laws.leftCascade (*) (*>)++propRightDistributive :: (Eq v, C a v) => a -> v -> v -> Bool+propRightDistributive  =  Laws.rightDistributive (*>) (+)++propLeftDistributive :: (Eq v, C a v) => v -> a -> a -> Bool+propLeftDistributive x  =  Laws.homomorphism (*>x) (+) (+)

+ src-ghc-6.12/Algebra/ModuleBasis.hs view

@@ -0,0 +1,95 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{- |+Maintainer  :  numericprelude@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++Abstraction of bases of finite dimensional modules+-}++module Algebra.ModuleBasis where++import qualified Number.Ratio as Ratio++import qualified Algebra.PrincipalIdealDomain as PID+import qualified Algebra.Module   as Module+-- import qualified Algebra.Additive as Additive+import Algebra.Ring     (one, fromInteger)+import Algebra.Additive ((+), zero)++import Data.List (map, length, (++))++import Prelude(Eq, (==), Bool, Int, Integer, Float, Double, asTypeOf, )+-- import qualified Prelude as P++{- |+It must hold:++>   Module.linearComb (flatten v `asTypeOf` [a]) (basis a) == v+>   dimension a v == length (flatten v `asTypeOf` [a])+-}+class (Module.C a v) => C a v where+    {- | basis of the module with respect to the scalar type,+         the result must be independent of argument, 'Prelude.undefined' should suffice. -}+    basis :: a -> [v]+    -- | scale a vector by a scalar+    flatten :: v -> [a]+    {- | the size of the basis, should also work for undefined argument,+         the result must be independent of argument, 'Prelude.undefined' should suffice. -}+    dimension :: a -> v -> Int++{-* Instances for atomic types -}++instance C Float Float where+   basis _ = [one]+   flatten = (:[])+   dimension _ _ = 1++instance C Double Double where+   basis _ = [one]+   flatten = (:[])+   dimension _ _ = 1++instance C Int Int where+   basis _ = [one]+   flatten = (:[])+   dimension _ _ = 1++instance C Integer Integer where+   basis _ = [one]+   flatten = (:[])+   dimension _ _ = 1++instance (PID.C a) => C (Ratio.T a) (Ratio.T a) where+   basis _ = [one]+   flatten = (:[])+   dimension _ _ = 1++++{-* Instances for composed types -}++instance (C a v0, C a v1) => C a (v0, v1) where+   basis s = map (\v -> (v,zero)) (basis s) +++             map (\v -> (zero,v)) (basis s)+   flatten (x0,x1) = flatten x0 ++ flatten x1+   dimension s ~(x0,x1) = dimension s x0 + dimension s x1++instance (C a v0, C a v1, C a v2) => C a (v0, v1, v2) where+   basis s = map (\v -> (v,zero,zero)) (basis s) +++             map (\v -> (zero,v,zero)) (basis s) +++             map (\v -> (zero,zero,v)) (basis s)+   flatten (x0,x1,x2) = flatten x0 ++ flatten x1 ++ flatten x2+   dimension s ~(x0,x1,x2) = dimension s x0 + dimension s x1 + dimension s x2++++{- * Properties -}++propFlatten :: (Eq v, C a v) => a -> v -> Bool+propFlatten a v  =  Module.linearComb (flatten v `asTypeOf` [a]) (basis a) == v++propDimension :: (C a v) => a -> v -> Bool+propDimension a v  =  dimension a v == length (flatten v `asTypeOf` [a])

+ src-ghc-6.12/Algebra/Monoid.hs view

@@ -0,0 +1,72 @@+{- |+Copyright    :   (c) Henning Thielemann 2009-2010, Mikael Johansson 2006+Maintainer   :   numericprelude@henning-thielemann.de+Stability    :   provisional+Portability  :++Abstract concept of a Monoid.+Will be used in order to generate type classes for generic algebras.+An algebra is a vector space that also is a monoid.+Should we use the Monoid class from base library+despite its unfortunate method name @mappend@?+-}++module Algebra.Monoid where++import qualified Algebra.Additive as Additive+import qualified Algebra.Ring as Ring++import Data.Monoid as Mn++{- |+We expect a monoid to adher to associativity and+the identity behaving decently.+Nothing more, really.+-}+class C a where+  idt   :: a+  (<*>) :: a -> a -> a+  cumulate :: [a] -> a+  cumulate = foldr (<*>) idt+++instance C All where+  idt = mempty+  (<*>) = mappend+  cumulate = mconcat++instance C Any where+  idt = mempty+  (<*>) = mappend+  cumulate = mconcat++instance C a => C (Dual a) where+  idt = Mn.Dual idt+  (Mn.Dual x) <*> (Mn.Dual y) = Mn.Dual (y <*> x)+  cumulate = Mn.Dual . cumulate . reverse . map Mn.getDual++instance C (Endo a) where+  idt = mempty+  (<*>) = mappend+  cumulate = mconcat++instance C (First a) where+  idt = mempty+  (<*>) = mappend+  cumulate = mconcat++instance C (Last a) where+  idt = mempty+  (<*>) = mappend+  cumulate = mconcat+++instance Ring.C a => C (Product a) where+  idt = Mn.Product Ring.one+  (Mn.Product x) <*> (Mn.Product y) = Mn.Product (x Ring.* y)+  cumulate = Mn.Product . Ring.product . map Mn.getProduct++instance Additive.C a => C (Sum a) where+  idt = Mn.Sum Additive.zero+  (Mn.Sum x) <*> (Mn.Sum y) = Mn.Sum (x Additive.+ y)+  cumulate = Mn.Sum . Additive.sum . map Mn.getSum

+ src-ghc-6.12/Algebra/NonNegative.hs view

@@ -0,0 +1,130 @@+{- |+Copyright   :  (c) Henning Thielemann 2007-2010++Maintainer  :  haskell@henning-thielemann.de+Stability   :  stable+Portability :  Haskell 98++A type class for non-negative numbers.+Prominent instances are 'Number.NonNegative.T' and 'Number.Peano.T' numbers.+This class cannot do any checks,+but it let you show to the user what arguments your function expects.+Thus you must define class instances with care.+In fact many standard functions ('take', '(!!)', ...)+should have this type class constraint.+-}+module Algebra.NonNegative (+   C(..),+   splitDefault,++   (-|),+--   (-?),+   zero,+   add,+   sum,+   ) where++import qualified Algebra.Additive as Additive+-- import qualified Algebra.RealRing as RealRing++import qualified Algebra.Monoid as Monoid++-- import Algebra.Absolute (abs, )+import Algebra.Additive ((-), )++import Prelude hiding (sum, (-), abs, )+++infixl 6 -|  -- , -?+++{- |+Instances of this class must ensure non-negative values.+We cannot enforce this by types, but the type class constraint @NonNegative.C@+avoids accidental usage of types which allow for negative numbers.++The Monoid superclass contributes a zero and an addition.+-}+class (Ord a, Monoid.C a) => C a where+   {- |+   @split x y == (m,(b,d))@ means that+   @b == (x<=y)@,+   @m == min x y@,+   @d == max x y - min x y@, that is @d == abs(x-y)@.++   We have chosen this function as base function,+   since it provides comparison and subtraction in one go,+   which is important for replacing common structures like++   > if x<=y+   >   then f(x-y)+   >   else g(y-x)++   that lead to a memory leak for peano numbers.+   We have choosen the simple check @x<=y@+   instead of a full-blown @compare@,+   since we want @Zero <= undefined@ for peano numbers.+   Because of undefined values 'split' is in general+   not commutative in the sense++   > let (m0,(b0,d0)) = split x y+   >     (m1,(b1,d1)) = split y x+   > in  m0==m1 && d0==d1++   The result values are in the order+   in which they are generated for Peano numbers.+   We have chosen the nested pair instead of a triple+   in order to prevent a memory leak+   that occurs if you only use @b@ and @d@ and ignore @m@.+   This is demonstrated by test cases+   Chunky.splitSpaceLeak3 and Chunky.splitSpaceLeak4.+   -}+   split :: a -> a -> (a, (Bool, a))+++{- |+Default implementation for wrapped types of 'Ord' and 'Num' class.+-}+{-# INLINE splitDefault #-}+splitDefault ::+   (Ord b, Additive.C b) =>+   (a -> b) -> (b -> a) -> a -> a -> (a, (Bool, a))+splitDefault unpack pack px py =+   let x = unpack px+       y = unpack py+   in  if x<=y+         then (pack x, (True,  pack (y-x)))+         else (pack y, (False, pack (x-y)))+++zero :: C a => a+zero = Monoid.idt++-- like (+)+infixl 6 `add`++add :: C a => a -> a -> a+add = (Monoid.<*>)++sum :: C a => [a] -> a+sum = Monoid.cumulate+++{- |+@x -| y == max 0 (x-y)@++The default implementation is not efficient,+because it compares the values and then subtracts, again, if safe.+@max 0 (x-y)@ is more elegant and efficient+but not possible in the general case,+since @x-y@ may already yield a negative number.+-}+(-|) :: C a => a -> a -> a+x -| y  =+   let (b,d) = snd $ split y x+   in  if b then d else zero++{-+(-?) :: (RealRing.C a) => a -> a -> (Bool, a)+(-?) x y  =  snd $ split y x+-}

+ src-ghc-6.12/Algebra/NormedSpace/Euclidean.hs view

@@ -0,0 +1,126 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}++{- |+Copyright   :  (c) Henning Thielemann 2005-2010+License     :  GPL++Maintainer  :  numericprelude@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++Abstraction of normed vector spaces+-}++module Algebra.NormedSpace.Euclidean where++import NumericPrelude.Base+import NumericPrelude.Numeric (sqr, abs, zero, (+), sum, Float, Double, Int, Integer, )++import qualified Number.Ratio as Ratio++import qualified Algebra.PrincipalIdealDomain as PID+import qualified Algebra.Algebraic as Algebraic+import qualified Algebra.Absolute      as Absolute+import qualified Algebra.Module    as Module++import qualified Data.Foldable as Fold+++{-|+Helper class for 'C' that does not need an algebraic type @a@.++Minimal definition:+'normSqr'+-}+class (Absolute.C a, Module.C a v) => Sqr a v where+  {-| Square of the Euclidean norm of a vector.+      This is sometimes easier to implement. -}+  normSqr :: v -> a+--  normSqr = sqr . norm++{- |+Default definition for 'normSqr' that is based on 'Fold.Foldable' class.+-}+{-# INLINE normSqrFoldable #-}+normSqrFoldable ::+   (Sqr a v, Fold.Foldable f) => f v -> a+normSqrFoldable =+   Fold.foldl (\a v -> a + normSqr v) zero++{- |+Default definition for 'normSqr' that is based on 'Fold.Foldable' class+and the argument vector has at least one component.+-}+{-# INLINE normSqrFoldable1 #-}+normSqrFoldable1 ::+   (Sqr a v, Fold.Foldable f, Functor f) => f v -> a+normSqrFoldable1 =+   Fold.foldl1 (+) . fmap normSqr+++{-|+A vector space equipped with an Euclidean or a Hilbert norm.++Minimal definition:+'norm'+-}+class (Sqr a v) => C a v where+  {-| Euclidean norm of a vector. -}+  norm :: v -> a+++defltNorm :: (Algebraic.C a, Sqr a v) => v -> a+defltNorm = Algebraic.sqrt . normSqr+++{-* Instances for atomic types -}++instance Sqr Float Float where+  normSqr = sqr++instance C Float Float where+  norm    = abs++instance Sqr Double Double where+  normSqr = sqr++instance C Double Double where+  norm    = abs++instance Sqr Int Int where+  normSqr = sqr++instance C Int Int where+  norm    = abs++instance Sqr Integer Integer where+  normSqr = sqr++instance C Integer Integer where+  norm    = abs+++{-* Instances for composed types -}++instance (Absolute.C a, PID.C a) => Sqr (Ratio.T a) (Ratio.T a) where+  normSqr = sqr++instance (Sqr a v0, Sqr a v1) => Sqr a (v0, v1) where+  normSqr (x0,x1) = normSqr x0 + normSqr x1++instance (Algebraic.C a, Sqr a v0, Sqr a v1) => C a (v0, v1) where+  norm    = defltNorm++instance (Sqr a v0, Sqr a v1, Sqr a v2) => Sqr a (v0, v1, v2) where+  normSqr (x0,x1,x2) = normSqr x0 + normSqr x1 + normSqr x2++instance (Algebraic.C a, Sqr a v0, Sqr a v1, Sqr a v2) => C a (v0, v1, v2) where+  norm    = defltNorm++instance (Sqr a v) => Sqr a [v] where+  normSqr = sum . map normSqr++instance (Algebraic.C a, Sqr a v) => C a [v] where+  norm    = defltNorm

+ src-ghc-6.12/Algebra/NormedSpace/Maximum.hs view

@@ -0,0 +1,85 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}++{- |+Copyright   :  (c) Henning Thielemann 2005-2010+License     :  GPL++Maintainer  :  numericprelude@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++Abstraction of normed vector spaces+-}++module Algebra.NormedSpace.Maximum where++import NumericPrelude.Base+import NumericPrelude.Numeric++import qualified Number.Ratio as Ratio++import qualified Algebra.PrincipalIdealDomain as PID+import qualified Algebra.ToInteger as ToInteger+import qualified Algebra.RealRing as RealRing+import qualified Algebra.Module   as Module++import qualified Data.Foldable as Fold+++class (RealRing.C a, Module.C a v) => C a v where+  norm :: v -> a++{- |+Default definition for 'norm' that is based on 'Fold.Foldable' class.+-}+{-# INLINE normFoldable #-}+normFoldable ::+   (C a v, Fold.Foldable f) => f v -> a+normFoldable =+   Fold.foldl (\a v -> max a (norm v)) zero++{- |+Default definition for 'norm' that is based on 'Fold.Foldable' class+and the argument vector has at least one component.+-}+{-# INLINE normFoldable1 #-}+normFoldable1 ::+   (C a v, Fold.Foldable f, Functor f) => f v -> a+normFoldable1 =+   Fold.foldl1 max . fmap norm++{-+instance (Ring.C a, Algebra.Module a a) => C a a where+  norm = abs+-}+instance C Float Float where+  norm = abs++instance C Double Double where+  norm = abs++instance C Int Int where+  norm = abs++instance C Integer Integer where+  norm = abs+++instance (RealRing.C a, ToInteger.C a, PID.C a) => C (Ratio.T a) (Ratio.T a) where+  norm = abs++instance (Ord a, C a v0, C a v1) => C a (v0, v1) where+  norm (x0,x1) = max (norm x0) (norm x1)++instance (Ord a, C a v0, C a v1, C a v2) => C a (v0, v1, v2) where+  norm (x0,x1,x2) = (norm x0) `max` (norm x1) `max` (norm x2)++instance (Ord a, C a v) => C a [v] where+  norm = foldl max zero . map norm+{-+Since the norm is always non-negative,+we can use zero as identity element.+  norm = maximum . map norm+-}

+ src-ghc-6.12/Algebra/NormedSpace/Sum.hs view

@@ -0,0 +1,90 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}++{- |+Copyright   :  (c) Henning Thielemann 2005-2010+License     :  GPL++Maintainer  :  numericprelude@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++Abstraction of normed vector spaces+-}++module Algebra.NormedSpace.Sum where++import NumericPrelude.Base+import NumericPrelude.Numeric++import qualified Number.Ratio as Ratio++import qualified Algebra.PrincipalIdealDomain as PID+import qualified Algebra.Absolute     as Absolute+import qualified Algebra.Additive as Additive+import qualified Algebra.Module   as Module++import qualified Data.Foldable as Fold+++{-|+  The super class is only needed to state the laws+  @+     v == zero        ==   norm v == zero+     norm (scale x v) ==   abs x * norm v+     norm (u+v)       <=   norm u + norm v+  @+-}+class (Absolute.C a, Module.C a v) => C a v where+  norm :: v -> a++{- |+Default definition for 'norm' that is based on 'Fold.Foldable' class.+-}+{-# INLINE normFoldable #-}+normFoldable ::+   (C a v, Fold.Foldable f) => f v -> a+normFoldable =+   Fold.foldl (\a v -> a + norm v) zero++{- |+Default definition for 'norm' that is based on 'Fold.Foldable' class+and the argument vector has at least one component.+-}+{-# INLINE normFoldable1 #-}+normFoldable1 ::+   (C a v, Fold.Foldable f, Functor f) => f v -> a+normFoldable1 =+   Fold.foldl1 (+) . fmap norm+++{-+instance (Ring.C a, Algebra.Module a a) => C a a where+  norm = abs+-}++instance C Float Float where+  norm = abs++instance C Double Double where+  norm = abs++instance C Int Int where+  norm = abs++instance C Integer Integer where+  norm = abs+++instance (Absolute.C a, PID.C a) => C (Ratio.T a) (Ratio.T a) where+  norm = abs++instance (Additive.C a, C a v0, C a v1) => C a (v0, v1) where+  norm (x0,x1) = norm x0 + norm x1++instance (Additive.C a, C a v0, C a v1, C a v2) => C a (v0, v1, v2) where+  norm (x0,x1,x2) = norm x0 + norm x1 + norm x2++instance (Additive.C a, C a v) => C a [v] where+  norm = sum . map norm

+ src-ghc-6.12/Algebra/OccasionallyScalar.hs view

@@ -0,0 +1,83 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}++{- |++There are several types of numbers+where a subset of numbers can be considered as set of scalars.++ * A '(Complex.T Double)' value can be converted to 'Double' if the imaginary part is zero.++ * A value with physical units can be converted to a scalar if there is no unit. ++Of course this can be cascaded,+e.g. a complex number with physical units can be converted to a scalar+if there is both no imaginary part and no unit.++This is somewhat similar to the multi-type classes NormedMax.C and friends.++I hesitate to define an instance for lists+to avoid the mess known of MatLab.+But if you have an application where you think+you need this instance definitely+I'll think about that, again.++-}++module Algebra.OccasionallyScalar where++-- import qualified Algebra.RealRing    as RealRing+import qualified Algebra.ZeroTestable as ZeroTestable+import qualified Algebra.Additive     as Additive+import qualified Number.Complex       as Complex++import Data.Maybe (fromMaybe, )++import Number.Complex((+:))++import NumericPrelude.Base+import NumericPrelude.Numeric+++-- this is somehow similar to Normalized classes+class C a v where+   toScalar      :: v -> a+   toMaybeScalar :: v -> Maybe a+   fromScalar    :: a -> v++toScalarDefault :: (C a v) => v -> a+toScalarDefault v =+   fromMaybe (error ("The value is not scalar."))+             (toMaybeScalar v)++toScalarShow :: (C a v, Show v) => v -> a+toScalarShow v =+   fromMaybe (error (show v ++ " is not a scalar value."))+             (toMaybeScalar v)+++instance C Float Float where+   toScalar      = id+   toMaybeScalar = Just+   fromScalar    = id++instance C Double Double where+   toScalar      = id+   toMaybeScalar = Just+   fromScalar    = id++-- this instance should be defined in Number.Complex+instance (Show v, ZeroTestable.C v, Additive.C v, C a v) => C a (Complex.T v) where+   toScalar        = toScalarShow+   toMaybeScalar x = if isZero (Complex.imag x)+                       then toMaybeScalar (Complex.real x)+                       else Nothing+   fromScalar x    = fromScalar x +: zero++{- converting values automatically to integers is a bad idea+instance (Integral b, RealRing.C a)+      => C b a where+   toScalar        = toScalarDefault+   toMaybeScalar x = mapMaybe round (toMaybeScalar x)+-}

+ src-ghc-6.12/Algebra/OrderDecision.hs view

@@ -0,0 +1,244 @@+{- |+Combination of @compare@ and @if then else@+that can be instantiated for more types than @Ord@+or can be instantiated in a way+that allows more defined results (\"more total\" functions):++* Reader like types for representing a context+  like 'Number.ResidueClass.Reader'++* Expressions in an EDSL++* More generally every type based on an applicative functor++* Tuples and Vector types++* Positional and Peano numbers,+  a common prefix of two numbers can be emitted+  before the comparison is done.+  (This could also be done with an overloaded 'if',+   what we also do not have.)+-}+module Algebra.OrderDecision where++import qualified Algebra.EqualityDecision as Equality+import Algebra.EqualityDecision ((==?), )++import qualified NumericPrelude.Elementwise as Elem+import Control.Applicative (Applicative(pure, (<*>)), )+import Data.Tuple.HT (fst3, snd3, thd3, )+import Data.List (zipWith4, zipWith5, )++import Prelude hiding (compare, min, max, minimum, maximum, )+import qualified Prelude as P++++{- |+For atomic types this could be a superclass of 'Ord'.+However for composed types like tuples, lists, functions+we do elementwise comparison+which is incompatible with the complete comparison performed by 'P.compare'.+-}+class Equality.C a => C a where+   {- |+   It holds++   > (compare a b) lt eq gt  ==+   >    case Prelude.compare a b of+   >       LT -> lt+   >       EQ -> eq+   >       GT -> gt++   for atomic types where the right hand side can be defined.++   Minimal complete definition:+   'compare' or '(<=?)'.+   -}+   compare :: a -> a -> a -> a -> a -> a+   compare x y lt eq gt =+      (x ==? y) eq ((x <=? y) lt gt)++   {-# INLINE (<=?) #-}+   (<=?) :: a -> a -> a -> a -> a+   (<=?) x y le gt =+      compare x y le le gt++   {-# INLINE (>=?) #-}+   (>=?) :: a -> a -> a -> a -> a+   (>=?) = flip (<=?)++   (<?) :: a -> a -> a -> a -> a+   (<?) x y = flip (x >=? y)++   {-# INLINE (>?) #-}+   (>?) :: a -> a -> a -> a -> a+   (>?) = flip (<?)++{-+   (<?) :: a -> a -> a -> a -> a+   (<?) x y lt ge =+      compare x y lt ge ge++   (>?) :: a -> a -> a -> a -> a+   (>?) x y gt le =+      compare x y le le gt++   (<=?) :: a -> a -> a -> a -> a+   (<=?) x y le gt =+      compare x y le le gt++   (>=?) :: a -> a -> a -> a -> a+   (>=?) x y ge lt =+      compare x y lt ge ge+-}+++max :: C a => a -> a -> a+max x y = (x>?y) x y++min :: C a => a -> a -> a+min x y = (x<?y) x y++maximum :: C a => a -> [a] -> a+maximum x xs = foldl max x xs++minimum :: C a => a -> [a] -> a+minimum x xs = foldl min x xs++++{-# INLINE compareOrd #-}+compareOrd :: Ord a => a -> a -> a -> a -> a -> a+compareOrd a b lt eq gt =+   case P.compare a b of+      LT -> lt+      EQ -> eq+      GT -> gt++instance C Int where+   {-# INLINE compare #-}+   compare = compareOrd++instance C Integer where+   {-# INLINE compare #-}+   compare = compareOrd++instance C Float where+   {-# INLINE compare #-}+   compare = compareOrd++instance C Double where+   {-# INLINE compare #-}+   compare = compareOrd++instance C Bool where+   {-# INLINE compare #-}+   compare = compareOrd++instance C Ordering where+   {-# INLINE compare #-}+   compare = compareOrd++++{-# INLINE elementCompare #-}+elementCompare ::+   (C x) =>+   (v -> x) -> Elem.T (v,v,v,v,v) x+elementCompare f =+   Elem.element (\(x,y,lt,eq,gt) ->+      compare (f x) (f y) (f lt) (f eq) (f gt))++{-# INLINE (<*>.<=>?) #-}+(<*>.<=>?) ::+   (C x) =>+   Elem.T (v,v,v,v,v) (x -> a) -> (v -> x) -> Elem.T (v,v,v,v,v) a+(<*>.<=>?) f acc =+   f <*> elementCompare acc+++{-# INLINE element #-}+element ::+   (C x) =>+   (x -> x -> x -> x -> x) ->+   (v -> x) -> Elem.T (v,v,v,v) x+element cmp f =+   Elem.element (\(x,y,true,false) -> cmp (f x) (f y) (f true) (f false))++{-# INLINE (<*>.<=?) #-}+(<*>.<=?) ::+   (C x) =>+   Elem.T (v,v,v,v) (x -> a) -> (v -> x) -> Elem.T (v,v,v,v) a+(<*>.<=?) f acc =+   f <*> element (<=?) acc++{-# INLINE (<*>.>=?) #-}+(<*>.>=?) ::+   (C x) =>+   Elem.T (v,v,v,v) (x -> a) -> (v -> x) -> Elem.T (v,v,v,v) a+(<*>.>=?) f acc =+   f <*> element (>=?) acc++{-# INLINE (<*>.<?) #-}+(<*>.<?) ::+   (C x) =>+   Elem.T (v,v,v,v) (x -> a) -> (v -> x) -> Elem.T (v,v,v,v) a+(<*>.<?) f acc =+   f <*> element (<?) acc++{-# INLINE (<*>.>?) #-}+(<*>.>?) ::+   (C x) =>+   Elem.T (v,v,v,v) (x -> a) -> (v -> x) -> Elem.T (v,v,v,v) a+(<*>.>?) f acc =+   f <*> element (>?) acc+++instance (C a, C b) => C (a,b) where+   {-# INLINE compare #-}+   compare = Elem.run5 $ pure (,) <*>.<=>? fst <*>.<=>? snd+   {-# INLINE (<=?) #-}+   (<=?)   = Elem.run4 $ pure (,) <*>.<=?  fst <*>.<=?  snd+   {-# INLINE (>=?) #-}+   (>=?)   = Elem.run4 $ pure (,) <*>.>=?  fst <*>.>=?  snd+   {-# INLINE (<?) #-}+   (<?)    = Elem.run4 $ pure (,) <*>.<?   fst <*>.<?   snd+   {-# INLINE (>?) #-}+   (>?)    = Elem.run4 $ pure (,) <*>.>?   fst <*>.>?   snd++instance (C a, C b, C c) => C (a,b,c) where+   {-# INLINE compare #-}+   compare = Elem.run5 $ pure (,,) <*>.<=>? fst3 <*>.<=>? snd3 <*>.<=>? thd3+   {-# INLINE (<=?) #-}+   (<=?)   = Elem.run4 $ pure (,,) <*>.<=?  fst3 <*>.<=?  snd3 <*>.<=?  thd3+   {-# INLINE (>=?) #-}+   (>=?)   = Elem.run4 $ pure (,,) <*>.>=?  fst3 <*>.>=?  snd3 <*>.>=?  thd3+   {-# INLINE (<?) #-}+   (<?)    = Elem.run4 $ pure (,,) <*>.<?   fst3 <*>.<?   snd3 <*>.<?   thd3+   {-# INLINE (>?) #-}+   (>?)    = Elem.run4 $ pure (,,) <*>.>?   fst3 <*>.>?   snd3 <*>.>?   thd3++instance C a => C [a] where+   {-# INLINE compare #-}+   compare = zipWith5 compare+   {-# INLINE (<=?) #-}+   (<=?) = zipWith4 (<=?)+   {-# INLINE (>=?) #-}+   (>=?) = zipWith4 (>=?)+   {-# INLINE (<?) #-}+   (<?)  = zipWith4 (<?)+   {-# INLINE (>?) #-}+   (>?)  = zipWith4 (>?)++instance (C a) => C (b -> a) where+   {-# INLINE compare #-}+   compare x y lt eq gt c  =  compare (x c) (y c) (lt c) (eq c) (gt c)+   {-# INLINE (<=?) #-}+   (<=?) x y true false c  =  (x c <=? y c) (true c) (false c)+   {-# INLINE (>=?) #-}+   (>=?) x y true false c  =  (x c >=? y c) (true c) (false c)+   {-# INLINE (<?) #-}+   (<?)  x y true false c  =  (x c <?  y c) (true c) (false c)+   {-# INLINE (>?) #-}+   (>?)  x y true false c  =  (x c >?  y c) (true c) (false c)

+ src-ghc-6.12/Algebra/PrincipalIdealDomain.hs view

@@ -0,0 +1,384 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Algebra.PrincipalIdealDomain (+    {- * Class -}+    C,+    extendedGCD,+    gcd,+    lcm,+    coprime,++    {- * Standard implementations for instances -}+    euclid,+    extendedEuclid,++    {- * Algorithms -}+    extendedGCDMulti,+    diophantine,+    diophantineMin,+    diophantineMulti,+    chineseRemainder,+    chineseRemainderMulti,++    {- * Properties -}+    propMaximalDivisor,+    propGCDDiophantine,+    propExtendedGCDMulti,+    propDiophantine,+    propDiophantineMin,+    propDiophantineMulti,+    propDiophantineMultiMin,+    propChineseRemainder,+    propDivisibleGCD,+    propDivisibleLCM,+    propGCDIdentity,+    propGCDCommutative,+    propGCDAssociative,+    propGCDHomogeneous,+    propGCD_LCM,+  ) where++import qualified Algebra.Units          as Units+import qualified Algebra.IntegralDomain as Integral+-- import qualified Algebra.Ring           as Ring+-- import qualified Algebra.Additive       as Additive+import qualified Algebra.ZeroTestable   as ZeroTestable++import qualified Algebra.Laws as Laws++import Algebra.Units          (stdAssociate, stdUnitInv)+import Algebra.IntegralDomain (mod, divChecked, divMod, divides, divModZero)+import Algebra.Ring           (one, (*), scalarProduct)+import Algebra.Additive       (zero, (+), (-))+import Algebra.ZeroTestable   (isZero)++import Data.Maybe.HT (toMaybe, )++import Control.Monad (foldM, liftM)+import Data.List (mapAccumL, mapAccumR, unfoldr)++import Data.Int  (Int,  Int8,  Int16,  Int32,  Int64,  )++import NumericPrelude.Base+import Prelude (Integer, )+import Test.QuickCheck ((==>), Property)++++{- |+A principal ideal domain is a ring in which every ideal+(the set of multiples of some generating set of elements)+is principal:+That is,+every element can be written as the multiple of some generating element.+@gcd a b@ gives a generator for the ideal generated by @a@ and @b@.+The algorithm above works whenever @mod x y@ is smaller+(in a suitable sense) than both @x@ and @y@;+otherwise the algorithm may run forever.++Laws:++>   divides x (lcm x y)+>   x `gcd` (y `gcd` z) == (x `gcd` y) `gcd` z+>   gcd x y * z == gcd (x*z) (y*z)+>   gcd x y * lcm x y == x * y++(etc: canonical)++Minimal definition:+ * nothing, if the standard Euclidean algorithm work+ * if 'extendedGCD' is implemented customly, 'gcd' and 'lcm' make use of it+-}+class (Units.C a, ZeroTestable.C a) => C a where+    {- |+    Compute the greatest common divisor and+    solve a respective Diophantine equation.++    >   (g,(a,b)) = extendedGCD x y ==>+    >        g==a*x+b*y   &&  g == gcd x y++    TODO: This method is not appropriate for the PID class,+          because there are rings like the one of the multivariate polynomials,+          where for all x and y greatest common divisors of x and y exist,+          but they cannot be represented as a linear combination of x and y.+    TODO: The definition of extendedGCD does not return the canonical associate.+    -}+    extendedGCD :: a -> a -> (a,(a,a))+    extendedGCD = extendedEuclid divMod++    {- |+    The Greatest Common Divisor is defined by:++    >   gcd x y == gcd y x+    >   divides z x && divides z y ==> divides z (gcd x y)   (specification)+    >   divides (gcd x y) x+    -}+    gcd         :: a -> a -> a+    gcd x y     = fst $ extendedGCD x y++    {- |+    Least common multiple+    -}+    lcm         :: a -> a -> a+    lcm x y     =+       if isZero x+         then x -- avoid computing undefined (gcd 0 0)+         else divChecked x (gcd x y) * y  -- avoid big temporary results+    -- lcm x y     = divChecked (x * y) (gcd x y)+++{-+These do only work if zero and one are really identity elements.++gcdMulti :: (C a) => [a] -> a+gcdMulti = foldl gcd zero++lcmMulti :: (C a) => [a] -> a+lcmMulti = foldl lcm one+-}++coprime :: (C a) => a -> a -> Bool+coprime x y =+   Units.isUnit (gcd x y)++++{-+We could implement a helper function,+which exposes the temporary results.+This could be re-used for extendedEuclid.+-}+euclid :: (Units.C a, ZeroTestable.C a) =>+   (a -> a -> a) -> a -> a -> a+euclid genMod =+   let aux x y =+          if isZero y+            then stdAssociate x+            else aux y (x `genMod` y)+   in  aux++-- could be implemented in a tail-recursive manner+{-+Unfortunately, with the normalization to the stdAssociate,+@gcd 0@ is no longer the identity function,+since @gcd 0 (-2) = 2@.+-}+extendedEuclid :: (Units.C a, ZeroTestable.C a) =>+   (a -> a -> (a,a)) -> a -> a -> (a,(a,a))+extendedEuclid genDivMod =+   let aux x y =+          if isZero y+            then (stdAssociate x, (stdUnitInv x, zero))+            else+              let (d,m) = x `genDivMod` y   -- x == d*y + m+                  (g,(a,b)) = aux y m       -- g == a*y + b*m+              in  (g,(b,a-b*d))             -- g == a*y + b*(x-d*y)+   in aux+++{- |+Compute the greatest common divisor for multiple numbers+by repeated application of the two-operand-gcd.+-}+extendedGCDMulti :: C a => [a] -> (a,[a])+extendedGCDMulti xs =+   let (g,cs) = mapAccumL extendedGCD zero xs+   in  (g, snd $ mapAccumR (\acc (c0,c1) -> (acc*c0,acc*c1)) one cs)++{- |+A variant with small coefficients.+-}+++{- |+@Just (a,b) = diophantine z x y@+means+@a*x+b*y = z@.+It is required that @gcd(y,z) `divides` x@.+-}+diophantine :: C a => a -> a -> a -> Maybe (a,a)+diophantine z x y =+   fmap snd $ diophantineAux z x y++{- |+Like 'diophantine', but @a@ is minimal+with respect to the measure function of the Euclidean algorithm.+-}+diophantineMin :: C a => a -> a -> a -> Maybe (a,a)+diophantineMin z x y =+   fmap (uncurry (minimizeFirstOperand (x,y))) $+   diophantineAux z x y++minimizeFirstOperand :: C a => (a,a) -> a -> (a,a) -> (a,a)+minimizeFirstOperand (x,y) g (a,b) =+   if isZero g+     then (zero,zero)+     else+       let xl = divChecked x g+           yl = divChecked y g+           (d,aRed) = divModZero a yl+       in  (aRed, b + d*xl)++diophantineAux :: C a => a -> a -> a -> Maybe (a, (a,a))+diophantineAux z x y =+   let (g,(a,b)) = extendedGCD x y+       (q,r) = divModZero z g+   in  toMaybe (isZero r) (g, (q*a, q*b))+++{- |+-}+diophantineMulti :: C a => a -> [a] -> Maybe [a]+diophantineMulti z xs =+   let (g,as) = extendedGCDMulti xs+       (q,r)  = divModZero z g+   in  toMaybe (isZero r) (map (q*) as)++{- |+Not efficient because it requires duplicate computations of GCDs.+However GCDs of neighbouring list elements were not computed before.+It is also quite arbitrary,+because only neighbouring elements are used for balancing.+There are certainly more sophisticated solutions.+-}+diophantineMultiMin :: C a => a -> [a] -> Maybe [a]+diophantineMultiMin z xs =+   do as <- diophantineMulti z xs+      return $ unfoldr+         (\as' -> case as' of+           ((x0,a0):(x1,a1):aRest) ->+              let (b0,b1) = minimizeFirstOperand (x0,x1) (gcd x0 x1) (a0,a1)+              in  Just (b0, (x1,b1):aRest)+           (_,a):[] -> Just (a,[])+           [] -> Nothing) $+         zip xs as++{-+diophantineMultiMin :: C a => a -> [a] -> Maybe [a]+diophantineMultiMin z xs =+   do as <- diophantineMulti z xs+      return $+         case as of+           (c:cs'@(_:_)) ->+              let (cs,cLast) = splitLast cs'+                  (d,as') = mapAccumL (\a b -> swap $ minimizeFirstOperand (gcd a b) (a,b)) c cs+                  (d',cLast') = minimizeFirstOperand (gcd d cLast) d cLast+              in  as' ++ [d',cLast']+           _ -> as+-}++{- |+Not efficient enough, because GCD\/LCM is computed twice.+-}+chineseRemainder :: C a => (a,a) -> (a,a) -> Maybe (a,a)+chineseRemainder (m0,a0) (m1,a1) =+   liftM (\(k,_) -> let m = lcm m0 m1 in (m, mod (a0-k*m0) m)) $+   diophantineMin (a0-a1) m0 m1+{-+a0-k*m0 == a1+l*m1+a0-a1 == k*m0+l*m1+-}++{- |+For @Just (b,n) = chineseRemainder [(a0,m0), (a1,m1), ..., (an,mn)]@+and all @x@ with @x = b mod n@ the congruences+@x=a0 mod m0, x=a1 mod m1, ..., x=an mod mn@+are fulfilled.+-}+chineseRemainderMulti :: C a => [(a,a)] -> Maybe (a,a)+chineseRemainderMulti congs =+   case congs of+      [] -> Nothing+      (c:cs) -> foldM chineseRemainder c cs++++{- * Instances for atomic types -}+++{-+There is the binary GCD algorithm,+that is specialised for integers in binary representation.+It does not need a division.+However, since we have an optimized division,+the standard implementation is probably faster.++TODO: Can Integer make use of the GMP GCD routine?+-}++instance C Integer where+    -- possibly more efficient than the default method+    gcd = euclid mod++instance C Int where+    gcd = euclid mod++instance C Int8 where+    gcd = euclid mod++instance C Int16 where+    gcd = euclid mod++instance C Int32 where+    gcd = euclid mod++instance C Int64 where+    gcd = euclid mod+++propGCDIdentity     :: (Eq a, C a) => a -> Bool+propGCDAssociative :: (Eq a, C a) => a -> a -> a -> Bool+propGCDCommutative :: (Eq a, C a) => a -> a -> Bool+propGCDDiophantine :: (Eq a, C a) => a -> a -> Bool+propExtendedGCDMulti :: (Eq a, C a) => [a] -> Bool+propDiophantineGen :: (Eq a, C a) =>+   (a -> a -> a -> Maybe (a,a)) -> a -> a -> a -> a -> Bool+propDiophantine    :: (Eq a, C a) => a -> a -> a -> a -> Bool+propDiophantineMin :: (Eq a, C a) => a -> a -> a -> a -> Bool+propDiophantineMultiGen :: (Eq a, C a) =>+   (a -> [a] -> Maybe [a]) -> [(a,a)] -> Bool+propDiophantineMulti    :: (Eq a, C a) => [(a,a)] -> Bool+propDiophantineMultiMin :: (Eq a, C a) => [(a,a)] -> Bool+propDivisibleGCD   :: C a => a -> a -> Bool+propDivisibleLCM   :: C a => a -> a -> Bool+propGCD_LCM        :: (Eq a, C a) => a -> a -> Bool+propGCDHomogeneous :: (Eq a, C a) => a -> a -> a -> Bool+propMaximalDivisor :: C a => a -> a -> a -> Property+propChineseRemainder :: (Eq a, C a) => a -> a -> [a] -> Property++propMaximalDivisor x y z =+   divides z x && divides z y ==> divides z (gcd x y)+propGCDDiophantine x y =+   let (g,(a,b)) = extendedGCD x y+   in  g == gcd x y  &&  g == a*x+b*y+propExtendedGCDMulti xs =+   let (g,as) = extendedGCDMulti xs+   in  g == scalarProduct as xs  &&+       (isZero g || all (divides g) xs)+propDiophantineGen dio a b x y =+   let z = a*x+b*y+   in  maybe False (\(a',b') -> z == a'*x+b'*y) (dio z x y)+propDiophantine    = propDiophantineGen diophantine+propDiophantineMin = propDiophantineGen diophantineMin+propDiophantineMultiGen dio axs =+   let (as,xs) = unzip axs+       z = scalarProduct as xs+   in  maybe False (\as' -> z == scalarProduct as' xs) (dio z xs)+propDiophantineMulti    = propDiophantineMultiGen diophantineMulti+propDiophantineMultiMin = propDiophantineMultiGen diophantineMultiMin+propDivisibleGCD x y  =  divides (gcd x y) x+propDivisibleLCM x y  =  divides x (lcm x y)++propGCDIdentity     =  Laws.identity gcd zero . stdAssociate+propGCDCommutative  =  Laws.commutative gcd+propGCDAssociative  =  Laws.associative gcd+propGCDHomogeneous  =  Laws.leftDistributive (*) gcd . stdAssociate+propGCD_LCM x y     =  gcd x y * lcm x y == x * y+propChineseRemainder k x ms =+   not (null ms) && all (not . isZero) ms ==>+   -- cf. Useful.functionToGraph+   let congs = zip ms (map (mod x) ms)+   in  maybe False+          (\(mGlob,y) ->+             let yk = y+mGlob*k+             in  all (\(m,a) -> Integral.sameResidueClass m a yk) congs)+          (chineseRemainderMulti congs)

+ src-ghc-6.12/Algebra/RealField.hs view

@@ -0,0 +1,26 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Algebra.RealField (+   C,+   ) where++import qualified Algebra.Field as Field+import qualified Algebra.RealRing as RealRing+import qualified Algebra.PrincipalIdealDomain as PID+import qualified Algebra.ToInteger as ToInteger++import qualified Number.Ratio as Ratio++-- import NumericPrelude.Base+-- import qualified Prelude as P+import Prelude (Float, Double, )++{- |+This is a convenient class for common types+that both form a field and have a notion of ordering by magnitude.+-}+class (RealRing.C a, Field.C a) => C a where++instance C Float where+instance C Double where++instance (ToInteger.C a, PID.C a) => C (Ratio.T a) where

+ src-ghc-6.12/Algebra/RealIntegral.hs view

@@ -0,0 +1,151 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Generally before using 'quot' and 'rem', think twice.+In most cases 'divMod' and friends are the right choice,+because they fulfill more of the wanted properties.+On some systems 'quot' and 'rem' are more efficient+and if you only use positive numbers, you may be happy with them.+But we cannot warrant the efficiency advantage.++See also:+Daan Leijen: Division and Modulus for Computer Scientists+<http://www.cs.uu.nl/%7Edaan/download/papers/divmodnote-letter.pdf>,+<http://www.haskell.org/pipermail/haskell-cafe/2007-August/030394.html>+-}+module Algebra.RealIntegral (+   C(quot, rem, quotRem),+   ) where++import qualified Algebra.IntegralDomain as Integral+import qualified Algebra.Absolute       as Absolute+-- import qualified Algebra.Ring           as Ring+-- import qualified Algebra.Additive       as Additive++import Algebra.Absolute (signum, )+import Algebra.IntegralDomain (divMod, )+import Algebra.Ring (one, ) -- fromInteger+import Algebra.Additive (zero, (+), (-), )++import Data.Int  (Int,  Int8,  Int16,  Int32,  Int64,  )+import Data.Word (Word, Word8, Word16, Word32, Word64, )++import NumericPrelude.Base+import qualified Prelude as P+import Prelude (Integer, )+++infixl 7 `quot`, `rem`++{- |+Remember that 'divMod' does not specify exactly what @a `quot` b@ should be,+mainly because there is no sensible way to define it in general.+For an instance of @Algebra.RealIntegral.C a@,+it is expected that @a `quot` b@ will round towards 0 and+@a `Prelude.div` b@ will round towards minus infinity.++Minimal definition: nothing required+-}++class (Absolute.C a, Ord a, Integral.C a) => C a where+    quot, rem        :: a -> a -> a+    quotRem          :: a -> a -> (a,a)++    {-# INLINE quot #-}+    {-# INLINE rem #-}+    {-# INLINE quotRem #-}+    quot a b = fst (quotRem a b)+    rem a b  = snd (quotRem a b)+    quotRem a b = let (d,m) = divMod a b in+                   if (signum d < zero) then+                         (d+one,m-b) else (d,m)+++instance C Integer where+   {-# INLINE quot #-}+   {-# INLINE rem #-}+   {-# INLINE quotRem #-}+   quot = P.quot+   rem = P.rem+   quotRem = P.quotRem++instance C Int     where+   {-# INLINE quot #-}+   {-# INLINE rem #-}+   {-# INLINE quotRem #-}+   quot = P.quot+   rem = P.rem+   quotRem = P.quotRem++instance C Int8    where+   {-# INLINE quot #-}+   {-# INLINE rem #-}+   {-# INLINE quotRem #-}+   quot = P.quot+   rem = P.rem+   quotRem = P.quotRem++instance C Int16   where+   {-# INLINE quot #-}+   {-# INLINE rem #-}+   {-# INLINE quotRem #-}+   quot = P.quot+   rem = P.rem+   quotRem = P.quotRem++instance C Int32   where+   {-# INLINE quot #-}+   {-# INLINE rem #-}+   {-# INLINE quotRem #-}+   quot = P.quot+   rem = P.rem+   quotRem = P.quotRem++instance C Int64   where+   {-# INLINE quot #-}+   {-# INLINE rem #-}+   {-# INLINE quotRem #-}+   quot = P.quot+   rem = P.rem+   quotRem = P.quotRem+++instance C Word    where+   {-# INLINE quot #-}+   {-# INLINE rem #-}+   {-# INLINE quotRem #-}+   quot = P.quot+   rem = P.rem+   quotRem = P.quotRem++instance C Word8   where+   {-# INLINE quot #-}+   {-# INLINE rem #-}+   {-# INLINE quotRem #-}+   quot = P.quot+   rem = P.rem+   quotRem = P.quotRem++instance C Word16  where+   {-# INLINE quot #-}+   {-# INLINE rem #-}+   {-# INLINE quotRem #-}+   quot = P.quot+   rem = P.rem+   quotRem = P.quotRem++instance C Word32  where+   {-# INLINE quot #-}+   {-# INLINE rem #-}+   {-# INLINE quotRem #-}+   quot = P.quot+   rem = P.rem+   quotRem = P.quotRem++instance C Word64  where+   {-# INLINE quot #-}+   {-# INLINE rem #-}+   {-# INLINE quotRem #-}+   quot = P.quot+   rem = P.rem+   quotRem = P.quotRem+

+ src-ghc-6.12/Algebra/RealRing.hs view

@@ -0,0 +1,584 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Algebra.RealRing where++import qualified Algebra.Field              as Field+import qualified Algebra.PrincipalIdealDomain as PID+import qualified Algebra.Absolute           as Absolute+import qualified Algebra.Ring           as Ring+import qualified Algebra.ToRational     as ToRational+import qualified Algebra.ToInteger      as ToInteger++import qualified Algebra.OrderDecision as OrdDec+import Algebra.OrderDecision ((<?), (>=?), )++import Algebra.Field          (fromRational, )+import Algebra.RealIntegral   (quotRem, )+import Algebra.IntegralDomain (divMod, even, )+import Algebra.Ring           ((*), fromInteger, one, )+import Algebra.Additive       ((+), (-), negate, zero, )+import Algebra.ZeroTestable   (isZero, )+import Algebra.ToInteger      (fromIntegral, )++import qualified Number.Ratio as Ratio+import Number.Ratio (T((:%)), Rational)++import Data.Int  (Int,  Int8,  Int16,  Int32,  Int64,  )+import Data.Word (Word, Word8, Word16, Word32, Word64, )++import qualified GHC.Float as GHC+import Data.List as List+import Data.Tuple.HT (mapFst, mapPair, )+import Prelude (Integer, Float, Double, )+import qualified Prelude as P+import NumericPrelude.Base+++{- |+Minimal complete definition:+     'splitFraction' or 'floor'++There are probably more laws, but some laws are++> splitFraction x === (fromInteger (floor x), fraction x)+> fromInteger (floor x) + fraction x === x+> floor x       <= x       x <  floor x + 1+> ceiling x - 1 <  x       x <= ceiling x+> 0 <= fraction x          fraction x < 1++>               - ceiling x === floor (-x)+>                truncate x === signum x * floor (abs x)+>    ceiling (toRational x) === ceiling x :: Integer+>   truncate (toRational x) === truncate x :: Integer+>      floor (toRational x) === floor x :: Integer++The new function 'fraction' doesn't return the integer part of the number.+This also removes a type ambiguity if the integer part is not needed.++Many people will associate rounding with fractional numbers,+and thus they are surprised about the superclass being @Ring@ not @Field@.+The reason is that all of these methods can be defined+exclusively with functions from @Ord@ and @Ring@.+The implementations of 'genericFloor' and other functions demonstrate that.+They implement power-of-two-algorithms+like the one for finding the number of digits of an 'Integer'+in FixedPoint-fractions module.+They are even reasonably efficient.++I am still uncertain whether it was a good idea+to add instances for @Integer@ and friends,+since calling @floor@ or @fraction@ on an integer may well indicate a bug.+The rounding functions are just the identity function+and 'fraction' is constant zero.+However, I decided to associate our class with @Ring@ rather than @Field@,+after I found myself using repeated subtraction and testing+rather than just calling @fraction@,+just in order to get the constraint @(Ring a, Ord a)@+that was more general than @(RealField a)@.++For the results of the rounding functions+we have chosen the constraint @Ring@ instead of @ToInteger@,+since this is more flexible to use,+but it still signals to the user that only integral numbers can be returned.+This is so, because the plain @Ring@ class only provides+@zero@, @one@ and operations that allow to reach all natural numbers but not more.+++As an aside, let me note the similarities+between @splitFraction x@ and @divMod x 1@ (if that were defined).+In particular, it might make sense to unify the rounding modes somehow.++The new methods 'fraction' and 'splitFraction'+differ from 'Prelude.properFraction' semantics.+They always round to 'floor'.+This means that the fraction is always non-negative and+is always smaller than 1.+This is more useful in practice and+can be generalised to more than real numbers.+Since every 'Number.Ratio.T' denominator type+supports 'Algebra.IntegralDomain.divMod',+every 'Number.Ratio.T' can provide 'fraction' and 'splitFraction',+e.g. fractions of polynomials.+However the @Ring@ constraint for the ''integral'' part of 'splitFraction'+is too weak in order to generate polynomials.+After all, I am uncertain whether this would be useful or not.++Can there be a separate class for+'fraction', 'splitFraction', 'floor' and 'ceiling'+since they do not need reals and their ordering?++We might also add a round method,+that rounds 0.5 always up or always down.+This is much more efficient in inner loops+and is acceptable or even preferable for many applications.+-}++class (Absolute.C a, Ord a) => C a where+    splitFraction    :: (Ring.C b) => a -> (b,a)+    fraction         ::               a -> a+    ceiling, floor   :: (Ring.C b) => a -> b+    truncate         :: (Ring.C b) => a -> b+    round            :: (ToInteger.C b) => a -> b+++    splitFraction x   =  (floor x, fraction x)++    fraction x   =  x - fromInteger (floor x)++    floor x      =  fromInteger (fst (splitFraction x))++    ceiling x    =  - floor (-x)++--    truncate x   =  signum x * floor (abs x)+    truncate x =+       if x>=0+         then floor x+         else ceiling x++    {-+    The ToInteger constraint can be lifted to Ring+    if use Integer temporarily.+    I expect this would not be efficient in many cases.+    -}+    round x =+       let (n,r) = splitFraction x+       in  case compare (2*r) one of+              LT -> n+              EQ -> if even n then n else n+1+              GT -> n+1+++{- |+This function rounds to the closest integer.+For @fraction x == 0.5@ it rounds away from zero.+This function is not the result of an ingenious mathematical insight,+but is simply a kind of rounding that is the fastest+on IEEE floating point architectures.+-}+roundSimple :: (C a, Ring.C b) => a -> b+roundSimple x =+   let (n,r) = splitFraction x+   in  case compare (2*r) one of+          LT -> n+          EQ -> if x<0 then n else n+1+          GT -> n+1+++instance (ToInteger.C a, PID.C a) => C (Ratio.T a) where+    splitFraction (x:%y) = (fromIntegral q, r:%y)+                               where (q,r) = divMod x y++instance C Int where+    {-# INLINE splitFraction #-}+    {-# INLINE fraction #-}+    {-# INLINE floor #-}+    {-# INLINE ceiling #-}+    {-# INLINE round #-}+    {-# INLINE truncate #-}+    splitFraction x = (fromIntegral x, zero)+    fraction      _ = zero+    floor         x = fromIntegral x+    ceiling       x = fromIntegral x+    round         x = fromIntegral x+    truncate      x = fromIntegral x++instance C Integer where+    {-# INLINE splitFraction #-}+    {-# INLINE fraction #-}+    {-# INLINE floor #-}+    {-# INLINE ceiling #-}+    {-# INLINE round #-}+    {-# INLINE truncate #-}+    splitFraction x = (fromInteger x, zero)+    fraction      _ = zero+    floor         x = fromInteger x+    ceiling       x = fromInteger x+    round         x = fromInteger x+    truncate      x = fromInteger x++instance C Float where+    {-# INLINE splitFraction #-}+    {-# INLINE fraction #-}+    {-# INLINE floor #-}+    {-# INLINE ceiling #-}+    {-# INLINE round #-}+    {-# INLINE truncate #-}+    splitFraction = fastSplitFraction GHC.float2Int GHC.int2Float+    fraction      = fastFraction (GHC.int2Float . GHC.float2Int)+    floor         = fromInteger . P.floor+    ceiling       = fromInteger . P.ceiling+    round         = fromInteger . P.round+    truncate      = fromInteger . P.truncate++instance C Double where+    {-# INLINE splitFraction #-}+    {-# INLINE fraction #-}+    {-# INLINE floor #-}+    {-# INLINE ceiling #-}+    {-# INLINE round #-}+    {-# INLINE truncate #-}+    splitFraction = fastSplitFraction GHC.double2Int GHC.int2Double+    fraction      = fastFraction (GHC.int2Double . GHC.double2Int)+    floor         = fromInteger . P.floor+    ceiling       = fromInteger . P.ceiling+    round         = fromInteger . P.round+    truncate      = fromInteger . P.truncate+++{-# INLINE fastSplitFraction #-}+fastSplitFraction :: (P.RealFrac a, Absolute.C a, Ring.C b) =>+   (a -> Int) -> (Int -> a) -> a -> (b,a)+fastSplitFraction trunc toFloat x =+   fixSplitFraction $+   if toFloat minBound <= x && x <= toFloat maxBound+     then case trunc x of n -> (fromIntegral n, x - toFloat n)+     else case P.properFraction x of (n,f) -> (fromInteger n, f)++{-# INLINE fixSplitFraction #-}+fixSplitFraction :: (Ring.C a, Ring.C b, Ord a) => (b,a) -> (b,a)+fixSplitFraction (n,f) =+   --  if x>=0 || f==0+   if f>=0+     then (n,   f)+     else (n-1, f+1)++{-# INLINE fastFraction #-}+fastFraction :: (P.RealFrac a, Absolute.C a) => (a -> a) -> a -> a+fastFraction trunc x =+   fixFraction $+   if fromIntegral (minBound :: Int) <= x && x <= fromIntegral (maxBound :: Int)+     then x - trunc x+     else preludeFraction x++{-# INLINE preludeFraction #-}+preludeFraction :: (P.RealFrac a, Ring.C a) => a -> a+preludeFraction x =+   let second :: (Integer, a) -> a+       second = snd+   in  second (P.properFraction x)++{-# INLINE fixFraction #-}+fixFraction :: (Ring.C a, Ord a) => a -> a+fixFraction y =+   if y>=0 then y else y+1++{-+mapM_ (\n -> let x = fromInteger n / 10 in print (x, floorInt GHC.double2Int GHC.int2Double x)) [-20,-19..20]+-}++{-# INLINE splitFractionInt #-}+splitFractionInt :: (Ring.C a, Ord a) => (a -> Int) -> (Int -> a) -> a -> (Int, a)+splitFractionInt trunc toFloat x =+   let n = trunc x+   in  fixSplitFraction (n, x - toFloat n)++{-# INLINE floorInt #-}+floorInt :: (Ring.C a, Ord a) => (a -> Int) -> (Int -> a) -> a -> Int+floorInt trunc toFloat x =+   let n = trunc x+   in  if x >= toFloat n+         then n+         else pred n++{-# INLINE ceilingInt #-}+ceilingInt :: (Ring.C a, Ord a) => (a -> Int) -> (Int -> a) -> a -> Int+ceilingInt trunc toFloat x =+   let n = trunc x+   in  if x <= toFloat n+         then n+         else succ n++{-# INLINE roundInt #-}+roundInt :: (Field.C a, Ord a) => (a -> Int) -> (Int -> a) -> a -> Int+roundInt trunc toFloat x =+   let half = 0.5 -- P.fromRational+       halfUp = x+half+       n = floorInt trunc toFloat halfUp+   in  if toFloat n == halfUp  &&  P.odd n+         then pred n+         else n++{-# INLINE roundSimpleInt #-}+roundSimpleInt ::+   (Field.C a, Absolute.C a, Ord a) =>+   (a -> Int) -> (Int -> a) -> a -> Int+roundSimpleInt trunc _toFloat x =+   trunc (x + Absolute.signum x * 0.5)++++{- RULES maybe used, when Prelude implementations become more efficient+     "NP.round    :: Float -> Int"    round    = P.round    :: Float -> Int;+     "NP.truncate :: Float -> Int"    truncate = P.truncate :: Float -> Int;+     "NP.floor    :: Float -> Int"    floor    = P.floor    :: Float -> Int;+     "NP.ceiling  :: Float -> Int"    ceiling  = P.ceiling  :: Float -> Int;+     "NP.round    :: Double -> Int"   round    = P.round    :: Double -> Int;+     "NP.truncate :: Double -> Int"   truncate = P.truncate :: Double -> Int;+     "NP.floor    :: Double -> Int"   floor    = P.floor    :: Double -> Int;+     "NP.ceiling  :: Double -> Int"   ceiling  = P.ceiling  :: Double -> Int;+  -}++-- these rules will also be needed for Int16 et.al.+{-# RULES+     "NP.round       :: Float -> Int"    round    = roundInt       GHC.float2Int  GHC.int2Float;+     "NP.roundSimple :: Float -> Int"    round    = roundSimpleInt GHC.float2Int  GHC.int2Float;+     "NP.truncate    :: Float -> Int"    truncate =                GHC.float2Int               ;+     "NP.floor       :: Float -> Int"    floor    = floorInt       GHC.float2Int  GHC.int2Float;+     "NP.ceiling     :: Float -> Int"    ceiling  = ceilingInt     GHC.float2Int  GHC.int2Float;+     "NP.round       :: Double -> Int"   round    = roundInt       GHC.double2Int GHC.int2Double;+     "NP.roundSimple :: Double -> Int"   round    = roundSimpleInt GHC.double2Int GHC.int2Double;+     "NP.truncate    :: Double -> Int"   truncate =                GHC.double2Int               ;+     "NP.floor       :: Double -> Int"   floor    = floorInt       GHC.double2Int GHC.int2Double;+     "NP.ceiling     :: Double -> Int"   ceiling  = ceilingInt     GHC.double2Int GHC.int2Double;++     "NP.splitFraction :: Float ->  (Int, Float)"  splitFraction = splitFractionInt GHC.float2Int GHC.int2Float;+     "NP.splitFraction :: Double -> (Int, Double)" splitFraction = splitFractionInt GHC.double2Int GHC.int2Double;+  #-}++-- generated by GenerateRules.hs+{-# RULES+     "NP.round       :: a -> Int8"    round       = (P.fromIntegral :: Int -> Int8) . round;+     "NP.roundSimple :: a -> Int8"    roundSimple = (P.fromIntegral :: Int -> Int8) . roundSimple;+     "NP.truncate    :: a -> Int8"    truncate    = (P.fromIntegral :: Int -> Int8) . truncate;+     "NP.floor       :: a -> Int8"    floor       = (P.fromIntegral :: Int -> Int8) . floor;+     "NP.ceiling     :: a -> Int8"    ceiling     = (P.fromIntegral :: Int -> Int8) . ceiling;+     "NP.round       :: a -> Int16"   round       = (P.fromIntegral :: Int -> Int16) . round;+     "NP.roundSimple :: a -> Int16"   roundSimple = (P.fromIntegral :: Int -> Int16) . roundSimple;+     "NP.truncate    :: a -> Int16"   truncate    = (P.fromIntegral :: Int -> Int16) . truncate;+     "NP.floor       :: a -> Int16"   floor       = (P.fromIntegral :: Int -> Int16) . floor;+     "NP.ceiling     :: a -> Int16"   ceiling     = (P.fromIntegral :: Int -> Int16) . ceiling;+     "NP.round       :: a -> Int32"   round       = (P.fromIntegral :: Int -> Int32) . round;+     "NP.roundSimple :: a -> Int32"   roundSimple = (P.fromIntegral :: Int -> Int32) . roundSimple;+     "NP.truncate    :: a -> Int32"   truncate    = (P.fromIntegral :: Int -> Int32) . truncate;+     "NP.floor       :: a -> Int32"   floor       = (P.fromIntegral :: Int -> Int32) . floor;+     "NP.ceiling     :: a -> Int32"   ceiling     = (P.fromIntegral :: Int -> Int32) . ceiling;+     "NP.round       :: a -> Int64"   round       = (P.fromIntegral :: Int -> Int64) . round;+     "NP.roundSimple :: a -> Int64"   roundSimple = (P.fromIntegral :: Int -> Int64) . roundSimple;+     "NP.truncate    :: a -> Int64"   truncate    = (P.fromIntegral :: Int -> Int64) . truncate;+     "NP.floor       :: a -> Int64"   floor       = (P.fromIntegral :: Int -> Int64) . floor;+     "NP.ceiling     :: a -> Int64"   ceiling     = (P.fromIntegral :: Int -> Int64) . ceiling;+     "NP.round       :: a -> Word"    round       = (P.fromIntegral :: Int -> Word) . round;+     "NP.roundSimple :: a -> Word"    roundSimple = (P.fromIntegral :: Int -> Word) . roundSimple;+     "NP.truncate    :: a -> Word"    truncate    = (P.fromIntegral :: Int -> Word) . truncate;+     "NP.floor       :: a -> Word"    floor       = (P.fromIntegral :: Int -> Word) . floor;+     "NP.ceiling     :: a -> Word"    ceiling     = (P.fromIntegral :: Int -> Word) . ceiling;+     "NP.round       :: a -> Word8"   round       = (P.fromIntegral :: Int -> Word8) . round;+     "NP.roundSimple :: a -> Word8"   roundSimple = (P.fromIntegral :: Int -> Word8) . roundSimple;+     "NP.truncate    :: a -> Word8"   truncate    = (P.fromIntegral :: Int -> Word8) . truncate;+     "NP.floor       :: a -> Word8"   floor       = (P.fromIntegral :: Int -> Word8) . floor;+     "NP.ceiling     :: a -> Word8"   ceiling     = (P.fromIntegral :: Int -> Word8) . ceiling;+     "NP.round       :: a -> Word16"  round       = (P.fromIntegral :: Int -> Word16) . round;+     "NP.roundSimple :: a -> Word16"  roundSimple = (P.fromIntegral :: Int -> Word16) . roundSimple;+     "NP.truncate    :: a -> Word16"  truncate    = (P.fromIntegral :: Int -> Word16) . truncate;+     "NP.floor       :: a -> Word16"  floor       = (P.fromIntegral :: Int -> Word16) . floor;+     "NP.ceiling     :: a -> Word16"  ceiling     = (P.fromIntegral :: Int -> Word16) . ceiling;+     "NP.round       :: a -> Word32"  round       = (P.fromIntegral :: Int -> Word32) . round;+     "NP.roundSimple :: a -> Word32"  roundSimple = (P.fromIntegral :: Int -> Word32) . roundSimple;+     "NP.truncate    :: a -> Word32"  truncate    = (P.fromIntegral :: Int -> Word32) . truncate;+     "NP.floor       :: a -> Word32"  floor       = (P.fromIntegral :: Int -> Word32) . floor;+     "NP.ceiling     :: a -> Word32"  ceiling     = (P.fromIntegral :: Int -> Word32) . ceiling;+     "NP.round       :: a -> Word64"  round       = (P.fromIntegral :: Int -> Word64) . round;+     "NP.roundSimple :: a -> Word64"  roundSimple = (P.fromIntegral :: Int -> Word64) . roundSimple;+     "NP.truncate    :: a -> Word64"  truncate    = (P.fromIntegral :: Int -> Word64) . truncate;+     "NP.floor       :: a -> Word64"  floor       = (P.fromIntegral :: Int -> Word64) . floor;+     "NP.ceiling     :: a -> Word64"  ceiling     = (P.fromIntegral :: Int -> Word64) . ceiling;++     "NP.splitFraction :: a -> (Int8,a)"     splitFraction = mapFst (P.fromIntegral :: Int -> Int8) . splitFraction;+     "NP.splitFraction :: a -> (Int16,a)"    splitFraction = mapFst (P.fromIntegral :: Int -> Int16) . splitFraction;+     "NP.splitFraction :: a -> (Int32,a)"    splitFraction = mapFst (P.fromIntegral :: Int -> Int32) . splitFraction;+     "NP.splitFraction :: a -> (Int64,a)"    splitFraction = mapFst (P.fromIntegral :: Int -> Int64) . splitFraction;+     "NP.splitFraction :: a -> (Word,a)"     splitFraction = mapFst (P.fromIntegral :: Int -> Word) . splitFraction;+     "NP.splitFraction :: a -> (Word8,a)"    splitFraction = mapFst (P.fromIntegral :: Int -> Word8) . splitFraction;+     "NP.splitFraction :: a -> (Word16,a)"   splitFraction = mapFst (P.fromIntegral :: Int -> Word16) . splitFraction;+     "NP.splitFraction :: a -> (Word32,a)"   splitFraction = mapFst (P.fromIntegral :: Int -> Word32) . splitFraction;+     "NP.splitFraction :: a -> (Word64,a)"   splitFraction = mapFst (P.fromIntegral :: Int -> Word64) . splitFraction;+  #-}+++{- | TODO: Should be moved to a continued fraction module. -}++approxRational :: (ToRational.C a, C a) => a -> a -> Rational+approxRational rat eps    =  simplest (rat-eps) (rat+eps)+        where simplest x y | y < x      =  simplest y x+                           | x == y     =  xr+                           | x > 0      =  simplest' n d n' d'+                           | y < 0      =  - simplest' (-n') d' (-n) d+                           | otherwise  =  0 :% 1+                                        where xr@(n:%d) = ToRational.toRational x+                                              (n':%d')  = ToRational.toRational y++              simplest' n d n' d'       -- assumes 0 < n%d < n'%d'+                        | isZero r   =  q :% 1+                        | q /= q'    =  (q+1) :% 1+                        | otherwise  =  (q*n''+d'') :% n''+                                     where (q,r)      =  quotRem n d+                                           (q',r')    =  quotRem n' d'+                                           (n'':%d'') =  simplest' d' r' d r+++-- * generic implementation of round functions++powersOfTwo :: (Ring.C a) => [a]+powersOfTwo = iterate (2*) one++pairsOfPowersOfTwo :: (Ring.C a, Ring.C b) => [(a,b)]+pairsOfPowersOfTwo =+   zip powersOfTwo powersOfTwo++{- |+The generic rounding functions need a number of operations+proportional to the number of binary digits of the integer portion.+If operations like multiplication with two and comparison+need time proportional to the number of binary digits,+then the overall rounding requires quadratic time.+-}+genericFloor :: (Ord a, Ring.C a, Ring.C b) => a -> b+genericFloor a =+   if a>=zero+     then genericPosFloor a+     else negate $ genericPosCeiling $ negate a++genericCeiling :: (Ord a, Ring.C a, Ring.C b) => a -> b+genericCeiling a =+   if a>=zero+     then genericPosCeiling a+     else negate $ genericPosFloor $ negate a++genericTruncate :: (Ord a, Ring.C a, Ring.C b) => a -> b+genericTruncate a =+   if a>=zero+     then genericPosFloor a+     else negate $ genericPosFloor $ negate a++genericRound :: (Ord a, Ring.C a, Ring.C b) => a -> b+genericRound a =+   if a>=zero+     then genericPosRound a+     else negate $ genericPosRound $ negate a++genericFraction :: (Ord a, Ring.C a) => a -> a+genericFraction a =+   if a>=zero+     then genericPosFraction a+     else fixFraction $ negate $ genericPosFraction $ negate a++genericSplitFraction :: (Ord a, Ring.C a, Ring.C b) => a -> (b,a)+genericSplitFraction a =+   if a>=zero+     then genericPosSplitFraction a+     else fixSplitFraction $ mapPair (negate, negate) $+          genericPosSplitFraction $ negate a+++genericPosFloor :: (Ord a, Ring.C a, Ring.C b) => a -> b+genericPosFloor a =+   snd $+   foldr+      (\(pa,pb) acc@(accA,accB) ->+         let newA = accA+pa+         in  if newA>a then acc else (newA,accB+pb))+      (zero,zero) $+   takeWhile ((a>=) . fst) $+   pairsOfPowersOfTwo++genericPosCeiling :: (Ord a, Ring.C a, Ring.C b) => a -> b+genericPosCeiling a =+   snd $+   (\(ps,u:_) ->+      foldr+         (\(pa,pb) acc@(accA,accB) ->+            let newA = accA-pa+            in  if newA>=a then (newA,accB-pb) else acc)+         u ps) $+   span ((a>) . fst) $+   (zero,zero) : pairsOfPowersOfTwo++{-+genericPosFloorDigits :: (Ord a, Ring.C a, Ring.C b) => a -> ((a,b), [Bool])+genericPosFloorDigits a =+   List.mapAccumR+      (\acc@(accA,accB) (pa,pb) ->+         let newA = accA+pa+             b = newA<=a+         in  (if b then (newA,accB+pb) else acc, b))+      (zero,zero) $+   takeWhile ((a>=) . fst) $+   pairsOfPowersOfTwo+-}++genericHalfPosFloorDigits :: (Ord a, Ring.C a, Ring.C b) => a -> ((a,b), [Bool])+genericHalfPosFloorDigits a =+   List.mapAccumR+      (\acc@(accA,accB) (pa,pb) ->+         let newA = accA+pa+             b = newA<=a+         in  (if b then (newA,accB+pb) else acc, b))+      (zero,zero) $+   takeWhile ((a>=) . fst) $+   zip powersOfTwo (zero:powersOfTwo)++genericPosRound :: (Ord a, Ring.C a, Ring.C b) => a -> b+genericPosRound a =+   let a2 = 2*a+       ((ai,bi), ds) = genericHalfPosFloorDigits a2+   in  if ai==a2+         then+           case ds of+             True : True : _ -> bi+one+             _ -> bi+         else+           case ds of+             True : _ -> bi+one+             _ -> bi++genericPosFraction :: (Ord a, Ring.C a) => a -> a+genericPosFraction a =+   foldr+      (\p acc ->+         if p>acc then acc else acc-p)+      a $+   takeWhile (a>=) $+   powersOfTwo++genericPosSplitFraction :: (Ord a, Ring.C a, Ring.C b) => a -> (b,a)+genericPosSplitFraction a =+   foldr+      (\(pb,pa) acc@(accB,accA) ->+         if pa>accA then acc else (accB+pb,accA-pa))+      (zero,a) $+   takeWhile ((a>=) . snd) $+   pairsOfPowersOfTwo+++{- |+Needs linear time with respect to the number of digits.++This and other functions using OrderDecision+like @floor@ where argument and result are the same+may be moved to a new module.+-}+decisionPosFraction :: (OrdDec.C a, Ring.C a) => a -> a+decisionPosFraction a0 =+   (\ps ->+      foldr+         (\p cont a ->+            (a<?one) a $ cont $+            (a>=?p) (a-p) a)+         (error "decisionPosFraction: end of list should never be reached")+         ps a0) $+   concatMap (reverse . flip take powersOfTwo) powersOfTwo++{-+Works but needs quadratic time with respect to the number of digits.+I feel that there must be something more efficient.+-}+decisionPosFractionSqrTime :: (OrdDec.C a, Ring.C a) => a -> a+decisionPosFractionSqrTime a0 =+   (\ps ->+      foldr+         (\p cont a ->+            (a<?one) a $ cont $+            (a>=?p) (a-p) a)+         (error "decisionPosFraction: end of list should never be reached")+         ps a0) $+   concatMap reverse $+   inits powersOfTwo

+ src-ghc-6.12/Algebra/RealTranscendental.hs view

@@ -0,0 +1,37 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Algebra.RealTranscendental where++import qualified Algebra.Transcendental      as Trans+import qualified Algebra.RealField           as RealField++import Algebra.Transcendental (atan, pi)+import Algebra.Field          ((/))+import Algebra.Ring           (fromInteger)+import Algebra.Additive       ((+), negate)++import Data.Bool.HT (select, )++import qualified Prelude as P+import NumericPrelude.Base++++{-|+This class collects all functions for _scalar_ floating point numbers.+E.g. computing 'atan2' for complex floating numbers makes certainly no sense.+-}+class (RealField.C a, Trans.C a) => C a where+    atan2 :: a -> a -> a++    atan2 y x = select 0   -- must be after the other double zero tests+      [(x>0,          atan (y/x)),+       (x==0 && y>0,  pi/2),+       (x<0  && y>0,  pi + atan (y/x)),+       (x<=0 && y<0, -atan2 (-y) x),+       (y==0 && x<0,  pi)] -- must be after the previous test on zero y++instance C P.Float where+    atan2 = P.atan2++instance C P.Double where+    atan2 = P.atan2

+ src-ghc-6.12/Algebra/RightModule.hs view

@@ -0,0 +1,17 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+module Algebra.RightModule where++import qualified Algebra.Ring     as Ring+import qualified Algebra.Additive as Additive++-- import NumericPrelude.Numeric+-- import qualified Prelude+++-- Is this right?+infixl 7 <*++class (Ring.C a, Additive.C b) => C a b where+    (<*) :: b -> a -> b

+ src-ghc-6.12/Algebra/Ring.hs view

@@ -0,0 +1,257 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Algebra.Ring (+    {- * Class -}+    C,++    (*),+    one,+    fromInteger,+    (^), sqr,++    {- * Complex functions -}+    product, product1, scalarProduct,++    {- * Properties -}+    propAssociative,+    propLeftDistributive,+    propRightDistributive,+    propLeftIdentity,+    propRightIdentity,+    propPowerCascade,+    propPowerProduct,+    propPowerDistributive,+    propCommutative,+  ) where++import qualified Algebra.Additive as Additive+import qualified Algebra.Laws as Laws++import Algebra.Additive(zero, (+), negate, sum)++import Data.Function.HT (powerAssociative, )+import NumericPrelude.List (zipWithChecked, )++import Test.QuickCheck ((==>), Property)++import Data.Int  (Int,  Int8,  Int16,  Int32,  Int64,  )+import Data.Word (Word, Word8, Word16, Word32, Word64, )++import NumericPrelude.Base+import Prelude (Integer, Float, Double, )+import qualified Data.Ratio as Ratio98+import qualified Prelude as P+-- import Test.QuickCheck+++infixl 7 *+infixr 8 ^+++{- |+Ring encapsulates the mathematical structure+of a (not necessarily commutative) ring, with the laws++@+  a * (b * c) === (a * b) * c+      one * a === a+      a * one === a+  a * (b + c) === a * b + a * c+@++Typical examples include integers, polynomials, matrices, and quaternions.++Minimal definition: '*', ('one' or 'fromInteger')+-}++class (Additive.C a) => C a where+    (*)         :: a -> a -> a+    one         :: a+    fromInteger :: Integer -> a+    {- |+    The exponent has fixed type 'Integer' in order+    to avoid an arbitrarily limitted range of exponents,+    but to reduce the need for the compiler to guess the type (default type).+    In practice the exponent is most oftenly fixed, and is most oftenly @2@.+    Fixed exponents can be optimized away and+    thus the expensive computation of 'Integer's doesn't matter.+    The previous solution used a 'Algebra.ToInteger.C' constrained type+    and the exponent was converted to Integer before computation.+    So the current solution is not less efficient.++    A variant of '^' with more flexibility is provided by 'Algebra.Core.ringPower'.+    -}+    (^)         :: a -> Integer -> a++    {-# INLINE fromInteger #-}+    fromInteger n = if n < 0+                      then powerAssociative (+) zero (negate one) (negate n)+                      else powerAssociative (+) zero one n+    {-# INLINE (^) #-}+    a ^ n = if n >= zero+              then powerAssociative (*) one a n+              else error "(^): Illegal negative exponent"+    {-# INLINE one #-}+    one = fromInteger 1+++sqr :: C a => a -> a+sqr x = x*x++product :: (C a) => [a] -> a+product = foldl (*) one++product1 :: (C a) => [a] -> a+product1 = foldl1 (*)+++scalarProduct :: C a => [a] -> [a] -> a+scalarProduct as bs = sum (zipWithChecked (*) as bs)+++{- * Instances for atomic types -}++instance C Integer where+   {-# INLINE one #-}+   {-# INLINE fromInteger #-}+   {-# INLINE (*) #-}+   one         = P.fromInteger 1+   fromInteger = P.fromInteger+   (*)         = (P.*)++instance C Float   where+   {-# INLINE one #-}+   {-# INLINE fromInteger #-}+   {-# INLINE (*) #-}+   one         = P.fromInteger 1+   fromInteger = P.fromInteger+   (*)         = (P.*)++instance C Double  where+   {-# INLINE one #-}+   {-# INLINE fromInteger #-}+   {-# INLINE (*) #-}+   one         = P.fromInteger 1+   fromInteger = P.fromInteger+   (*)         = (P.*)+++instance C Int     where+   {-# INLINE one #-}+   {-# INLINE fromInteger #-}+   {-# INLINE (*) #-}+   one         = P.fromInteger 1+   fromInteger = P.fromInteger+   (*)         = (P.*)++instance C Int8    where+   {-# INLINE one #-}+   {-# INLINE fromInteger #-}+   {-# INLINE (*) #-}+   one         = P.fromInteger 1+   fromInteger = P.fromInteger+   (*)         = (P.*)++instance C Int16   where+   {-# INLINE one #-}+   {-# INLINE fromInteger #-}+   {-# INLINE (*) #-}+   one         = P.fromInteger 1+   fromInteger = P.fromInteger+   (*)         = (P.*)++instance C Int32   where+   {-# INLINE one #-}+   {-# INLINE fromInteger #-}+   {-# INLINE (*) #-}+   one         = P.fromInteger 1+   fromInteger = P.fromInteger+   (*)         = (P.*)++instance C Int64   where+   {-# INLINE one #-}+   {-# INLINE fromInteger #-}+   {-# INLINE (*) #-}+   one         = P.fromInteger 1+   fromInteger = P.fromInteger+   (*)         = (P.*)+++instance C Word    where+   {-# INLINE one #-}+   {-# INLINE fromInteger #-}+   {-# INLINE (*) #-}+   one         = P.fromInteger 1+   fromInteger = P.fromInteger+   (*)         = (P.*)++instance C Word8   where+   {-# INLINE one #-}+   {-# INLINE fromInteger #-}+   {-# INLINE (*) #-}+   one         = P.fromInteger 1+   fromInteger = P.fromInteger+   (*)         = (P.*)++instance C Word16  where+   {-# INLINE one #-}+   {-# INLINE fromInteger #-}+   {-# INLINE (*) #-}+   one         = P.fromInteger 1+   fromInteger = P.fromInteger+   (*)         = (P.*)++instance C Word32  where+   {-# INLINE one #-}+   {-# INLINE fromInteger #-}+   {-# INLINE (*) #-}+   one         = P.fromInteger 1+   fromInteger = P.fromInteger+   (*)         = (P.*)++instance C Word64  where+   {-# INLINE one #-}+   {-# INLINE fromInteger #-}+   {-# INLINE (*) #-}+   one         = P.fromInteger 1+   fromInteger = P.fromInteger+   (*)         = (P.*)++++++propAssociative       :: (Eq a, C a) => a -> a -> a -> Bool+propLeftDistributive  :: (Eq a, C a) => a -> a -> a -> Bool+propRightDistributive :: (Eq a, C a) => a -> a -> a -> Bool+propLeftIdentity      :: (Eq a, C a) => a -> Bool+propRightIdentity     :: (Eq a, C a) => a -> Bool++propAssociative       =  Laws.associative (*)+propLeftDistributive  =  Laws.leftDistributive  (*) (+)+propRightDistributive =  Laws.rightDistributive (*) (+)+propLeftIdentity      =  Laws.leftIdentity  (*) one+propRightIdentity     =  Laws.rightIdentity (*) one++propPowerCascade      :: (Eq a, C a) => a -> Integer -> Integer -> Property+propPowerProduct      :: (Eq a, C a) => a -> Integer -> Integer -> Property+propPowerDistributive :: (Eq a, C a) => Integer -> a -> a -> Property++propPowerCascade      x i j  =  i>=0 && j>=0 ==> Laws.rightCascade (*) (^) x i j+propPowerProduct      x i j  =  i>=0 && j>=0 ==> Laws.homomorphism (x^) (+) (*) i j+propPowerDistributive i x y  =  i>=0 ==> Laws.leftDistributive (^) (*) i x y++{- | Commutativity need not be satisfied by all instances of 'Algebra.Ring.C'. -}+propCommutative :: (Eq a, C a) => a -> a -> Bool++propCommutative  =  Laws.commutative (*)+++-- legacy++instance (P.Integral a) => C (Ratio98.Ratio a) where+   {-# INLINE one #-}+   {-# INLINE fromInteger #-}+   {-# INLINE (*) #-}+   one                 =  1+   fromInteger         =  P.fromInteger+   (*)                 =  (P.*)

+ src-ghc-6.12/Algebra/ToInteger.hs view

@@ -0,0 +1,141 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-+The orphan instance could be fixed+by making this module mutually recursive with ToRational.hs,+but that's not worth the complication.+-}++module Algebra.ToInteger where++import qualified Number.Ratio as Ratio++import qualified Algebra.ToRational     as ToRational+import qualified Algebra.Field          as Field+import qualified Algebra.PrincipalIdealDomain as PID+import qualified Algebra.RealIntegral   as RealIntegral+import qualified Algebra.Ring           as Ring++import Number.Ratio (T((:%)), )++import Algebra.Field ((^-), )+import Algebra.Ring ((^), fromInteger, )++import Data.Int  (Int,  Int8,  Int16,  Int32,  Int64,  )+import Data.Word (Word, Word8, Word16, Word32, Word64, )++import qualified Prelude as P+import NumericPrelude.Base+import Prelude (Integer, Float, Double, )+++{- |+The two classes 'Algebra.ToInteger.C' and 'Algebra.ToRational.C'+exist to allow convenient conversions,+primarily between the built-in types.+They should satisfy++>   fromInteger .  toInteger === id+>    toRational .  toInteger === toRational++Conversions must be lossless,+that is, they do not round in any way.+For rounding see "Algebra.RealRing".+With the instances for 'Prelude.Float' and 'Prelude.Double'+we acknowledge that these types actually represent rationals+rather than (approximated) real numbers.+However, this contradicts to the 'Algebra.Transcendental.C' instance.+-}+class (ToRational.C a, RealIntegral.C a) => C a where+   toInteger :: a -> Integer+++fromIntegral :: (C a, Ring.C b) => a -> b+fromIntegral = fromInteger . toInteger+++-- generated by GenerateRules.hs+{-# RULES+     "NP.fromIntegral :: Integer -> Int"     fromIntegral = P.fromIntegral :: Integer -> Int;+     "NP.fromIntegral :: Integer -> Integer" fromIntegral = P.fromIntegral :: Integer -> Integer;+     "NP.fromIntegral :: Integer -> Float"   fromIntegral = P.fromIntegral :: Integer -> Float;+     "NP.fromIntegral :: Integer -> Double"  fromIntegral = P.fromIntegral :: Integer -> Double;+     "NP.fromIntegral :: Int -> Int"         fromIntegral = P.fromIntegral :: Int -> Int;+     "NP.fromIntegral :: Int -> Integer"     fromIntegral = P.fromIntegral :: Int -> Integer;+     "NP.fromIntegral :: Int -> Float"       fromIntegral = P.fromIntegral :: Int -> Float;+     "NP.fromIntegral :: Int -> Double"      fromIntegral = P.fromIntegral :: Int -> Double;+     "NP.fromIntegral :: Int8 -> Int"        fromIntegral = P.fromIntegral :: Int8 -> Int;+     "NP.fromIntegral :: Int8 -> Integer"    fromIntegral = P.fromIntegral :: Int8 -> Integer;+     "NP.fromIntegral :: Int8 -> Float"      fromIntegral = P.fromIntegral :: Int8 -> Float;+     "NP.fromIntegral :: Int8 -> Double"     fromIntegral = P.fromIntegral :: Int8 -> Double;+     "NP.fromIntegral :: Int16 -> Int"       fromIntegral = P.fromIntegral :: Int16 -> Int;+     "NP.fromIntegral :: Int16 -> Integer"   fromIntegral = P.fromIntegral :: Int16 -> Integer;+     "NP.fromIntegral :: Int16 -> Float"     fromIntegral = P.fromIntegral :: Int16 -> Float;+     "NP.fromIntegral :: Int16 -> Double"    fromIntegral = P.fromIntegral :: Int16 -> Double;+     "NP.fromIntegral :: Int32 -> Int"       fromIntegral = P.fromIntegral :: Int32 -> Int;+     "NP.fromIntegral :: Int32 -> Integer"   fromIntegral = P.fromIntegral :: Int32 -> Integer;+     "NP.fromIntegral :: Int32 -> Float"     fromIntegral = P.fromIntegral :: Int32 -> Float;+     "NP.fromIntegral :: Int32 -> Double"    fromIntegral = P.fromIntegral :: Int32 -> Double;+     "NP.fromIntegral :: Int64 -> Int"       fromIntegral = P.fromIntegral :: Int64 -> Int;+     "NP.fromIntegral :: Int64 -> Integer"   fromIntegral = P.fromIntegral :: Int64 -> Integer;+     "NP.fromIntegral :: Int64 -> Float"     fromIntegral = P.fromIntegral :: Int64 -> Float;+     "NP.fromIntegral :: Int64 -> Double"    fromIntegral = P.fromIntegral :: Int64 -> Double;+     "NP.fromIntegral :: Word -> Int"        fromIntegral = P.fromIntegral :: Word -> Int;+     "NP.fromIntegral :: Word -> Integer"    fromIntegral = P.fromIntegral :: Word -> Integer;+     "NP.fromIntegral :: Word -> Float"      fromIntegral = P.fromIntegral :: Word -> Float;+     "NP.fromIntegral :: Word -> Double"     fromIntegral = P.fromIntegral :: Word -> Double;+     "NP.fromIntegral :: Word8 -> Int"       fromIntegral = P.fromIntegral :: Word8 -> Int;+     "NP.fromIntegral :: Word8 -> Integer"   fromIntegral = P.fromIntegral :: Word8 -> Integer;+     "NP.fromIntegral :: Word8 -> Float"     fromIntegral = P.fromIntegral :: Word8 -> Float;+     "NP.fromIntegral :: Word8 -> Double"    fromIntegral = P.fromIntegral :: Word8 -> Double;+     "NP.fromIntegral :: Word16 -> Int"      fromIntegral = P.fromIntegral :: Word16 -> Int;+     "NP.fromIntegral :: Word16 -> Integer"  fromIntegral = P.fromIntegral :: Word16 -> Integer;+     "NP.fromIntegral :: Word16 -> Float"    fromIntegral = P.fromIntegral :: Word16 -> Float;+     "NP.fromIntegral :: Word16 -> Double"   fromIntegral = P.fromIntegral :: Word16 -> Double;+     "NP.fromIntegral :: Word32 -> Int"      fromIntegral = P.fromIntegral :: Word32 -> Int;+     "NP.fromIntegral :: Word32 -> Integer"  fromIntegral = P.fromIntegral :: Word32 -> Integer;+     "NP.fromIntegral :: Word32 -> Float"    fromIntegral = P.fromIntegral :: Word32 -> Float;+     "NP.fromIntegral :: Word32 -> Double"   fromIntegral = P.fromIntegral :: Word32 -> Double;+     "NP.fromIntegral :: Word64 -> Int"      fromIntegral = P.fromIntegral :: Word64 -> Int;+     "NP.fromIntegral :: Word64 -> Integer"  fromIntegral = P.fromIntegral :: Word64 -> Integer;+     "NP.fromIntegral :: Word64 -> Float"    fromIntegral = P.fromIntegral :: Word64 -> Float;+     "NP.fromIntegral :: Word64 -> Double"   fromIntegral = P.fromIntegral :: Word64 -> Double;+  #-}+++instance C Integer where {-#INLINE toInteger #-}; toInteger = id++instance C Int     where {-#INLINE toInteger #-}; toInteger = P.toInteger+instance C Int8    where {-#INLINE toInteger #-}; toInteger = P.toInteger+instance C Int16   where {-#INLINE toInteger #-}; toInteger = P.toInteger+instance C Int32   where {-#INLINE toInteger #-}; toInteger = P.toInteger+instance C Int64   where {-#INLINE toInteger #-}; toInteger = P.toInteger++instance C Word    where {-#INLINE toInteger #-}; toInteger = P.toInteger+instance C Word8   where {-#INLINE toInteger #-}; toInteger = P.toInteger+instance C Word16  where {-#INLINE toInteger #-}; toInteger = P.toInteger+instance C Word32  where {-#INLINE toInteger #-}; toInteger = P.toInteger+instance C Word64  where {-#INLINE toInteger #-}; toInteger = P.toInteger+++instance (C a, PID.C a) => ToRational.C (Ratio.T a) where+   toRational (x:%y)   =  toInteger x :% toInteger y+++{-|+A prefix function of '(Algebra.Ring.^)'+with a parameter order that fits the needs of partial application+and function composition.+It has generalised exponent.++See: Argument order of @expNat@ on+<http://www.haskell.org/pipermail/haskell-cafe/2006-September/018022.html>+-}+ringPower :: (Ring.C a, C b) => b -> a -> a+ringPower exponent basis = basis ^ toInteger exponent++{- |+A prefix function of '(Algebra.Field.^-)'.+It has a generalised exponent.+-}+fieldPower :: (Field.C a, C b) => b -> a -> a+fieldPower exponent basis = basis ^- toInteger exponent

+ src-ghc-6.12/Algebra/ToRational.hs view

@@ -0,0 +1,100 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Algebra.ToRational where++import qualified Algebra.Field    as Field+import qualified Algebra.Absolute as Absolute+import Algebra.Field (fromRational, )+import Algebra.Ring (fromInteger, )++import Number.Ratio (Rational, )++import Data.Int  (Int,  Int8,  Int16,  Int32,  Int64,  )+import Data.Word (Word, Word8, Word16, Word32, Word64, )++import qualified Prelude as P+import NumericPrelude.Base+import Prelude (Integer, Float, Double, )++{- |+This class allows lossless conversion+from any representation of a rational to the fixed 'Rational' type.+\"Lossless\" means - don't do any rounding.+For rounding see "Algebra.RealRing".+With the instances for 'Float' and 'Double'+we acknowledge that these types actually represent rationals+rather than (approximated) real numbers.+However, this contradicts to the 'Algebra.Transcendental' class.++Laws that must be satisfied by instances:++>  fromRational' . toRational === id+-}+class (Absolute.C a) => C a where+   -- | Lossless conversion from any representation of a rational to 'Rational'+   toRational :: a -> Rational++instance C Integer where+   {-# INLINE toRational #-}+   toRational = fromInteger++instance C Float where+   {-# INLINE toRational #-}+   toRational = fromRational . P.toRational++instance C Double where+   {-# INLINE toRational #-}+   toRational = fromRational . P.toRational++instance C Int    where {-# INLINE toRational #-}; toRational = toRational . P.toInteger+instance C Int8   where {-# INLINE toRational #-}; toRational = toRational . P.toInteger+instance C Int16  where {-# INLINE toRational #-}; toRational = toRational . P.toInteger+instance C Int32  where {-# INLINE toRational #-}; toRational = toRational . P.toInteger+instance C Int64  where {-# INLINE toRational #-}; toRational = toRational . P.toInteger++instance C Word   where {-# INLINE toRational #-}; toRational = toRational . P.toInteger+instance C Word8  where {-# INLINE toRational #-}; toRational = toRational . P.toInteger+instance C Word16 where {-# INLINE toRational #-}; toRational = toRational . P.toInteger+instance C Word32 where {-# INLINE toRational #-}; toRational = toRational . P.toInteger+instance C Word64 where {-# INLINE toRational #-}; toRational = toRational . P.toInteger+++{- |+It should hold++> realToField = fromRational' . toRational++but it should be much more efficient for particular pairs of types,+such as converting 'Float' to 'Double'.+This achieved by optimizer rules.+-}+realToField :: (C a, Field.C b) => a -> b+realToField = Field.fromRational' . toRational++{-# RULES+     "NP.realToField :: Integer  -> Float "  realToField = P.realToFrac :: Integer  -> Float ;+     "NP.realToField :: Int      -> Float "  realToField = P.realToFrac :: Int      -> Float ;+     "NP.realToField :: Int8     -> Float "  realToField = P.realToFrac :: Int8     -> Float ;+     "NP.realToField :: Int16    -> Float "  realToField = P.realToFrac :: Int16    -> Float ;+     "NP.realToField :: Int32    -> Float "  realToField = P.realToFrac :: Int32    -> Float ;+     "NP.realToField :: Int64    -> Float "  realToField = P.realToFrac :: Int64    -> Float ;+     "NP.realToField :: Word     -> Float "  realToField = P.realToFrac :: Word     -> Float ;+     "NP.realToField :: Word8    -> Float "  realToField = P.realToFrac :: Word8    -> Float ;+     "NP.realToField :: Word16   -> Float "  realToField = P.realToFrac :: Word16   -> Float ;+     "NP.realToField :: Word32   -> Float "  realToField = P.realToFrac :: Word32   -> Float ;+     "NP.realToField :: Word64   -> Float "  realToField = P.realToFrac :: Word64   -> Float ;+     "NP.realToField :: Float    -> Float "  realToField = P.realToFrac :: Float    -> Float ;+     "NP.realToField :: Double   -> Float "  realToField = P.realToFrac :: Double   -> Float ;+     "NP.realToField :: Integer  -> Double"  realToField = P.realToFrac :: Integer  -> Double;+     "NP.realToField :: Int      -> Double"  realToField = P.realToFrac :: Int      -> Double;+     "NP.realToField :: Int8     -> Double"  realToField = P.realToFrac :: Int8     -> Double;+     "NP.realToField :: Int16    -> Double"  realToField = P.realToFrac :: Int16    -> Double;+     "NP.realToField :: Int32    -> Double"  realToField = P.realToFrac :: Int32    -> Double;+     "NP.realToField :: Int64    -> Double"  realToField = P.realToFrac :: Int64    -> Double;+     "NP.realToField :: Word     -> Double"  realToField = P.realToFrac :: Word     -> Double;+     "NP.realToField :: Word8    -> Double"  realToField = P.realToFrac :: Word8    -> Double;+     "NP.realToField :: Word16   -> Double"  realToField = P.realToFrac :: Word16   -> Double;+     "NP.realToField :: Word32   -> Double"  realToField = P.realToFrac :: Word32   -> Double;+     "NP.realToField :: Word64   -> Double"  realToField = P.realToFrac :: Word64   -> Double;+     "NP.realToField :: Float    -> Double"  realToField = P.realToFrac :: Float    -> Double;+     "NP.realToField :: Double   -> Double"  realToField = P.realToFrac :: Double   -> Double;+  #-}

+ src-ghc-6.12/Algebra/Transcendental.hs view

@@ -0,0 +1,200 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Algebra.Transcendental where++import qualified Algebra.Algebraic as Algebraic+-- import qualified Algebra.Ring      as Ring+-- import qualified Algebra.Additive  as Additive++import qualified Algebra.Laws as Laws++import Algebra.Algebraic (sqrt)+import Algebra.Field     ((/), recip)+import Algebra.Ring      ((*), (^), fromInteger)+import Algebra.Additive  ((+), (-), negate)++import qualified Prelude as P+import NumericPrelude.Base+++infixr 8  **, ^?++{-|+Transcendental is the type of numbers supporting the elementary+transcendental functions.  Examples include real numbers, complex+numbers, and computable reals represented as a lazy list of rational+approximations.++Note the default declaration for a superclass.  See the comments+below, under "Instance declaractions for superclasses".++The semantics of these operations are rather ill-defined because of+branch cuts, etc.++Minimal complete definition:+     pi, exp, log, sin, cos, asin, acos, atan+-}+class (Algebraic.C a) => C a where+    pi                  :: a+    exp, log            :: a -> a+    logBase, (**)       :: a -> a -> a+    sin, cos, tan       :: a -> a+    asin, acos, atan    :: a -> a+    sinh, cosh, tanh    :: a -> a+    asinh, acosh, atanh :: a -> a++    {-# INLINE pi #-}+    {-# INLINE exp #-}+    {-# INLINE log #-}+    {-# INLINE logBase #-}+    {-# INLINE (**) #-}+    {-# INLINE sin #-}+    {-# INLINE tan #-}+    {-# INLINE cos #-}+    {-# INLINE asin #-}+    {-# INLINE atan #-}+    {-# INLINE acos #-}+    {-# INLINE sinh #-}+    {-# INLINE tanh #-}+    {-# INLINE cosh #-}+    {-# INLINE asinh #-}+    {-# INLINE atanh #-}+    {-# INLINE acosh #-}++    x ** y           =  exp (log x * y)+    logBase x y      =  log y / log x++    tan  x           =  sin x / cos x++    asin x           =  atan (x / sqrt (1-x^2))+    acos x           =  pi/2 - asin x++    -- if these definitions have errors, then those in FMP.Types have them, too+    sinh x           =  (exp x - exp (-x)) / 2+    cosh x           =  (exp x + exp (-x)) / 2+    -- tanh x           =  (exp x - exp (-x)) / (exp x + exp (-x))+    tanh x           =  sinh x / cosh x++    asinh x          =  log (sqrt (x^2+1) + x)+    acosh x          =  log (sqrt (x^2-1) + x)+    atanh x          =  (log (1+x) - log (1-x)) / 2+++instance C P.Float where+    {-# INLINE pi #-}+    {-# INLINE exp #-}+    {-# INLINE log #-}+    {-# INLINE logBase #-}+    {-# INLINE (**) #-}+    {-# INLINE sin #-}+    {-# INLINE tan #-}+    {-# INLINE cos #-}+    {-# INLINE asin #-}+    {-# INLINE atan #-}+    {-# INLINE acos #-}+    {-# INLINE sinh #-}+    {-# INLINE tanh #-}+    {-# INLINE cosh #-}+    {-# INLINE asinh #-}+    {-# INLINE atanh #-}+    {-# INLINE acosh #-}++    (**)  = (P.**)+    exp   = P.exp;   log   = P.log;   logBase = P.logBase+    pi    = P.pi;+    sin   = P.sin;   cos   = P.cos;   tan     = P.tan+    asin  = P.asin;  acos  = P.acos;  atan    = P.atan+    sinh  = P.sinh;  cosh  = P.cosh;  tanh    = P.tanh+    asinh = P.asinh; acosh = P.acosh; atanh   = P.atanh++instance C P.Double where+    {-# INLINE pi #-}+    {-# INLINE exp #-}+    {-# INLINE log #-}+    {-# INLINE logBase #-}+    {-# INLINE (**) #-}+    {-# INLINE sin #-}+    {-# INLINE tan #-}+    {-# INLINE cos #-}+    {-# INLINE asin #-}+    {-# INLINE atan #-}+    {-# INLINE acos #-}+    {-# INLINE sinh #-}+    {-# INLINE tanh #-}+    {-# INLINE cosh #-}+    {-# INLINE asinh #-}+    {-# INLINE atanh #-}+    {-# INLINE acosh #-}++    (**)  = (P.**)+    exp   = P.exp;   log   = P.log;   logBase = P.logBase+    pi    = P.pi;+    sin   = P.sin;   cos   = P.cos;   tan     = P.tan+    asin  = P.asin;  acos  = P.acos;  atan    = P.atan+    sinh  = P.sinh;  cosh  = P.cosh;  tanh    = P.tanh+    asinh = P.asinh; acosh = P.acosh; atanh   = P.atanh++++{-# INLINE (^?) #-}+(^?) :: C a => a -> a -> a+(^?) = (**)+++{-* Transcendental laws, will only hold approximately on floating point numbers -}++propExpLog      :: (Eq a, C a) => a -> Bool+propLogExp      :: (Eq a, C a) => a -> Bool+propExpNeg      :: (Eq a, C a) => a -> Bool+propLogRecip    :: (Eq a, C a) => a -> Bool+propExpProduct  :: (Eq a, C a) => a -> a -> Bool+propExpLogPower :: (Eq a, C a) => a -> a -> Bool+propLogSum      :: (Eq a, C a) => a -> a -> Bool++propExpLog      x   = exp (log x)     == x+propLogExp      x   = log (exp x)     == x+propExpNeg      x   = exp (negate x)  == recip (exp x)+propLogRecip    x   = log (recip x)   == negate (log x)+propExpProduct  x y = Laws.homomorphism exp (+) (*) x y+propExpLogPower x y = exp (log x * y) == x ** y+propLogSum      x y = Laws.homomorphism log (*) (+) x y+++propPowerCascade      :: (Eq a, C a) => a -> a -> a -> Bool+propPowerProduct      :: (Eq a, C a) => a -> a -> a -> Bool+propPowerDistributive :: (Eq a, C a) => a -> a -> a -> Bool++propPowerCascade      x i j  =  Laws.rightCascade (*) (**) x i j+propPowerProduct      x i j  =  Laws.homomorphism (x**) (+) (*) i j+propPowerDistributive i x y  =  Laws.rightDistributive (**) (*) i x y++{- * Trigonometric laws, addition theorems -}++propTrigonometricPythagoras :: (Eq a, C a) => a -> Bool+propTrigonometricPythagoras x  =  cos x ^ 2 + sin x ^ 2 == 1++propSinPeriod   :: (Eq a, C a) => a -> Bool+propCosPeriod   :: (Eq a, C a) => a -> Bool+propTanPeriod   :: (Eq a, C a) => a -> Bool++propSinPeriod x = sin (x+2*pi) == sin x+propCosPeriod x = cos (x+2*pi) == cos x+propTanPeriod x = tan (x+2*pi) == tan x++propSinAngleSum  :: (Eq a, C a) => a -> a -> Bool+propCosAngleSum  :: (Eq a, C a) => a -> a -> Bool++propSinAngleSum x y  =  sin (x+y) == sin x * cos y + cos x * sin y+propCosAngleSum x y  =  cos (x+y) == cos x * cos y - sin x * sin y++propSinDoubleAngle :: (Eq a, C a) => a -> Bool+propCosDoubleAngle :: (Eq a, C a) => a -> Bool++propSinDoubleAngle x  =  sin (2*x) == 2 * sin x * cos x+propCosDoubleAngle x  =  cos (2*x) == 2 * cos x ^ 2 - 1++propSinSquare :: (Eq a, C a) => a -> Bool+propCosSquare :: (Eq a, C a) => a -> Bool++propSinSquare x  =  sin x ^ 2 == (1 - cos (2*x)) / 2+propCosSquare x  =  cos x ^ 2 == (1 + cos (2*x)) / 2+

+ src-ghc-6.12/Algebra/Units.hs view

@@ -0,0 +1,153 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Algebra.Units (+    {- * Class -}+    C,+    isUnit,+    stdAssociate,+    stdUnit,+    stdUnitInv,++    {- * Standard implementations for instances -}+    intQuery,+    intAssociate,+    intStandard,+    intStandardInverse,++    {- * Properties -}+    propComposition,+    propInverseUnit,+    propUniqueAssociate,+    propAssociateProduct,+  ) where++import qualified Algebra.IntegralDomain as Integral+import qualified Algebra.Ring           as Ring+-- import qualified Algebra.Additive       as Additive+import qualified Algebra.ZeroTestable   as ZeroTestable++import qualified Algebra.Laws           as Laws++import Algebra.IntegralDomain (div)+import Algebra.Ring           (one, (*))+import Algebra.Additive       (negate)+import Algebra.ZeroTestable   (isZero)++import Data.Int  (Int,  Int8,  Int16,  Int32,  Int64,  )++import NumericPrelude.Base+import Prelude (Integer, )+import qualified Prelude as P+import Test.QuickCheck ((==>), Property)+++{- |+This class lets us deal with the units in a ring.+'isUnit' tells whether an element is a unit.+The other operations let us canonically+write an element as a unit times another element.+Two elements a, b of a ring R are _associates_ if a=b*u for a unit u.+For an element a, we want to write it as a=b*u where b is an associate of a.+The map (a->b) is called+"StandardAssociate" by Gap,+"unitCanonical" by Axiom,+and "canAssoc" by DoCon.+The map (a->u) is called+"canInv" by DoCon and+"unitNormal(x).unit" by Axiom.++The laws are++>   stdAssociate x * stdUnit x === x+>     stdUnit x * stdUnitInv x === 1+>  isUnit u ==> stdAssociate x === stdAssociate (x*u)++Currently some algorithms assume++>  stdAssociate(x*y) === stdAssociate x * stdAssociate y++Minimal definition:+   'isUnit' and ('stdUnit' or 'stdUnitInv') and optionally 'stdAssociate'+-}++class (Integral.C a) => C a where+  isUnit :: a -> Bool+  stdAssociate, stdUnit, stdUnitInv :: a -> a++  stdAssociate x = x * stdUnitInv x+  stdUnit      x = div one (stdUnitInv x)  -- should be divChecked+  stdUnitInv   x = div one (stdUnit x)+++++{- * Instances for atomic types -}++intQuery :: (P.Integral a, Ring.C a) => a -> Bool+intQuery = flip elem [one, negate one]+{- constraint must be replaced by NumericPrelude.Absolute -}+intAssociate, intStandard, intStandardInverse ::+   (P.Integral a, Ring.C a, ZeroTestable.C a) => a -> a+intAssociate = P.abs+intStandard x = if isZero x then one else P.signum x+intStandardInverse = intStandard++instance C Int where+  isUnit       = intQuery+  stdAssociate = intAssociate+  stdUnit      = intStandard+  stdUnitInv   = intStandardInverse++instance C Integer where+  isUnit       = intQuery+  stdAssociate = intAssociate+  stdUnit      = intStandard+  stdUnitInv   = intStandardInverse++instance C Int8 where+  isUnit       = intQuery+  stdAssociate = intAssociate+  stdUnit      = intStandard+  stdUnitInv   = intStandardInverse++instance C Int16 where+  isUnit       = intQuery+  stdAssociate = intAssociate+  stdUnit      = intStandard+  stdUnitInv   = intStandardInverse++instance C Int32 where+  isUnit       = intQuery+  stdAssociate = intAssociate+  stdUnit      = intStandard+  stdUnitInv   = intStandardInverse++instance C Int64 where+  isUnit       = intQuery+  stdAssociate = intAssociate+  stdUnit      = intStandard+  stdUnitInv   = intStandardInverse+++{-+fieldQuery = not . isZero+fieldAssociate = 1+fieldStandard        x = if isZero x then 1 else x+fieldStandardInverse x = if isZero x then 1 else recip x+-}++++propComposition      :: (Eq a, C a) => a -> Bool+propInverseUnit      :: (Eq a, C a) => a -> Bool+propUniqueAssociate  :: (Eq a, C a) => a -> a -> Property+propAssociateProduct :: (Eq a, C a) => a -> a -> Bool++propComposition x  =  stdAssociate x * stdUnit x == x+propInverseUnit x  =    stdUnit x * stdUnitInv x == one+propUniqueAssociate u x =+                     isUnit u ==> stdAssociate x == stdAssociate (x*u)++{- | Currently some algorithms assume this property. -}+propAssociateProduct =+    Laws.homomorphism stdAssociate (*) (*)+

+ src-ghc-6.12/Algebra/Vector.hs view

@@ -0,0 +1,101 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Copyright   :  (c) Henning Thielemann 2004-2005++Maintainer  :  numericprelude@henning-thielemann.de+Stability   :  provisional+Portability :  portable++Abstraction of vectors+-}++module Algebra.Vector where++import qualified Algebra.Ring     as Ring+import qualified Algebra.Additive as Additive++import Algebra.Ring     ((*))+import Algebra.Additive ((+))++import Data.List (zipWith, foldl)+-- import Data.Functor (Functor, fmap)++import Prelude((.), (==), Bool, Functor, fmap)+import qualified Prelude as P+++-- Is this right?+infixr 7 *>++{-|+A Module over a ring satisfies:++>   a *> (b + c) === a *> b + a *> c+>   (a * b) *> c === a *> (b *> c)+>   (a + b) *> c === a *> c + b *> c+-}+class C v where+    -- duplicate some methods from Additive+    -- | zero element of the vector space+    zero  :: (Additive.C a) => v a+    -- | add and subtract elements+    (<+>) :: (Additive.C a) => v a -> v a -> v a+    -- | scale a vector by a scalar+    (*>)  :: (Ring.C a) => a -> v a -> v a++infixl 6 <+>+++{- |+We need a Haskell 98 type class+which provides equality test for Vector type constructors.+-}+class Eq v where+   eq :: P.Eq a => v a -> v a -> Bool+++infix 4 `eq`+++{-* Instances for standard type constructors -}++functorScale :: (Functor v, Ring.C a) => a -> v a -> v a+functorScale = fmap . (*)++instance C [] where+   zero  = Additive.zero+   (<+>) = (Additive.+)+   (*>)  = functorScale++instance C ((->) b) where+   zero     = Additive.zero+   (<+>)    = (Additive.+)+   (*>) s f = (s*) . f++instance Eq [] where+   eq = (==)++++{-* Related functions -}++{-|+Compute the linear combination of a list of vectors.+-}+linearComb :: (Ring.C a, C v) => [a] -> [v a] -> v a+linearComb c = foldl (<+>) zero . zipWith (*>) c+++{- * Properties -}++propCascade :: (C v, Eq v, Ring.C a, P.Eq a) =>+   a -> a -> v a -> Bool+propCascade a b c           = (a * b) *> c  `eq`  a *> (b *> c)++propRightDistributive :: (C v, Eq v, Ring.C a, P.Eq a) =>+   a -> v a -> v a -> Bool+propRightDistributive a b c =   a *> (b <+> c)  `eq`  a*>b <+> a*>c++propLeftDistributive :: (C v, Eq v, Ring.C a, P.Eq a) =>+   a -> a -> v a -> Bool+propLeftDistributive a b c  =   (a+b) *> c  `eq`  a*>c <+> b*>c

+ src-ghc-6.12/Algebra/VectorSpace.hs view

@@ -0,0 +1,34 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+module Algebra.VectorSpace where++import qualified Algebra.Module as Module+import qualified Algebra.Field  as Field+import qualified Algebra.PrincipalIdealDomain as PID+import qualified Number.Ratio   as Ratio++-- import NumericPrelude.Numeric+import qualified Prelude as P+++class (Field.C a, Module.C a b) => C a b+++{-* Instances for atomic types -}++instance C P.Float P.Float++instance C P.Double P.Double++{-* Instances for composed types -}++instance (PID.C a) => C (Ratio.T a) (Ratio.T a)++instance (C a b0, C a b1) => C a (b0, b1)++instance (C a b0, C a b1, C a b2) => C a (b0, b1, b2)++instance (C a b) => C a [b]++instance (C a b) => C a (c -> b)

+ src-ghc-6.12/Algebra/ZeroTestable.hs view

@@ -0,0 +1,65 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Algebra.ZeroTestable where++import qualified Algebra.Additive as Additive++import Data.Int  (Int,  Int8,  Int16,  Int32,  Int64,  )+import Data.Word (Word, Word8, Word16, Word32, Word64, )++-- import qualified Prelude as P+import Prelude (Integer, Float, Double, )+import NumericPrelude.Base++{- |+Maybe the naming should be according to Algebra.Unit:+Algebra.Zero as module name, and @query@ as method name.+-}+class C a where+   isZero :: a -> Bool++{- |+Checks if a number is the zero element.+This test is not possible for all 'Additive.C' types,+since e.g. a function type does not belong to Eq.+isZero is possible for some types where (==zero) fails+because there is no unique zero.+Examples are+vector (the length of the zero vector is unknown),+physical values (the unit of a zero quantity is unknown),+residue class (the modulus is unknown).+-}+defltIsZero :: (Eq a, Additive.C a) => a -> Bool+defltIsZero = (Additive.zero==)+++{-* Instances for atomic types -}++instance C Integer where isZero = defltIsZero+instance C Float   where isZero = defltIsZero+instance C Double  where isZero = defltIsZero++instance C Int     where isZero = defltIsZero+instance C Int8    where isZero = defltIsZero+instance C Int16   where isZero = defltIsZero+instance C Int32   where isZero = defltIsZero+instance C Int64   where isZero = defltIsZero++instance C Word    where isZero = defltIsZero+instance C Word8   where isZero = defltIsZero+instance C Word16  where isZero = defltIsZero+instance C Word32  where isZero = defltIsZero+instance C Word64  where isZero = defltIsZero++++{-* Instances for composed types -}++instance (C v0, C v1) => C (v0, v1) where+    isZero (x0,x1) = isZero x0 && isZero x1++instance (C v0, C v1, C v2) => C (v0, v1, v2) where+    isZero (x0,x1,x2) = isZero x0 && isZero x1 && isZero x2+++instance (C v) => C [v] where+    isZero = all isZero

+ src-ghc-6.12/MathObj/Algebra.hs view

@@ -0,0 +1,74 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Copyright    :   (c) Mikael Johansson 2006+Maintainer   :   mik@math.uni-jena.de+Stability    :   provisional+Portability  :   requires multi-parameter type classes++The generic case of a k-algebra generated by a monoid.+-}++module MathObj.Algebra where++import qualified Algebra.Vector   as Vector+import qualified Algebra.Ring     as Ring+import qualified Algebra.Additive as Additive+import qualified Algebra.Monoid   as Monoid++import Algebra.Ring((*))+import Algebra.Additive((+),negate,zero)+import Algebra.Monoid((<*>))++import Control.Monad(liftM2,Functor,fmap)+import Data.Map(Map)+import qualified Data.Map as Map+import Data.List(intersperse)++import NumericPrelude.Base(Ord,Eq,{-Read,-}Show,(++),($),+                   concat,map,show)+++newtype {- (Ord a, Monoid.C a, Ring.C b) => -}+     T a b = Cons (Map a b)+         deriving (Eq {- ,Read -} )++instance Functor (T a) where+   fmap f (Cons x) = Cons (fmap f x)++-- is an Indexable instance better than an Ord instance here?++instance (Ord a, Additive.C b) => Additive.C (T a b) where+   (+) = zipWith (+)+   {- This implementation is attracting but wrong.+     It fails if terms are present in b that are missing in a.+     Default implementation is better here.+   (-) = zipWith (-)+   -}+   negate = fmap negate+   zero = Cons Map.empty++zipWith :: (Ord a) => (b -> b -> b) -> (T a b -> T a b -> T a b)+zipWith op (Cons ma) (Cons mb) = Cons (Map.unionWith op ma mb)++instance Ord a => Vector.C (T a) where+   zero  = zero+   (<+>) = (+)+   (*>)  = Vector.functorScale++instance (Ord a, Monoid.C a, Ring.C b) => Ring.C (T a b) where+   one = Cons $ Map.singleton Monoid.idt Ring.one+   (Cons ma) * (Cons mb) =+      Cons $ Map.fromListWith (+) $+         liftM2 mulMonomial (Map.toList ma) (Map.toList mb)++mulMonomial :: (Monoid.C a, Ring.C b) => (a,b) -> (a,b) -> (a,b)+mulMonomial (c1,m1) (c2,m2) = (c1<*>c2,m1*m2)++instance (Show a, Show b) => Show (T a b) where+   show (Cons ma) = concat $+           intersperse "+" $+           map (\(m,c) -> show c ++ "." ++ show m)+               (Map.toList ma)++monomial :: a -> b -> (T a b)+monomial index coefficient = Cons (Map.singleton index coefficient)

+ src-ghc-6.12/MathObj/DiscreteMap.hs view

@@ -0,0 +1,93 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}++{- FIXME:+Rationale for -fno-warn-orphans:+ * The orphan instances can't be put into Numeric.NonNegative.Wrapper+   since that's in another package.+ * We had to spread the instance declarations+   over the modules defining the typeclasses instantiated.+   Do we want that?+ * We could define the DiscreteMap as newtype.+-}++{- |+DiscreteMap was originally intended as a type class+that unifies Map and Array.+One should be able to simply choose between+ - Map for sparse arrays+ - Array for full arrays.++However, the Edison package provides the class AssocX+which already exists for that purpose.++Currently I use this module for some numeric instances of Data.Map.+-}+module MathObj.DiscreteMap where++import qualified Algebra.NormedSpace.Sum       as NormedSum+import qualified Algebra.NormedSpace.Euclidean as NormedEuc+import qualified Algebra.NormedSpace.Maximum   as NormedMax+import qualified Algebra.VectorSpace           as VectorSpace+import qualified Algebra.Module                as Module+import qualified Algebra.Vector                as Vector+import qualified Algebra.Algebraic             as Algebraic+import qualified Algebra.Additive              as Additive++import Algebra.Module   ((*>))+import Algebra.Additive (zero,(+),negate)+import qualified Data.Map as Map+import Data.Map (Map)++-- import qualified Prelude as P+import NumericPrelude.Base++-- FIXME: Should this be implemented by isZero?+-- | Remove all zero values from the map.+strip :: (Ord i, Eq v, Additive.C v) => Map i v -> Map i v+strip = Map.filter (zero /=)+--strip = Map.filter (((0 /=) .) . (flip const))++instance (Ord i, Eq v, Additive.C v) => Additive.C (Map i v) where+   zero = Map.empty+   (+)  = (strip.). Map.unionWith (+)+   --(+) y x = strip (Map.unionWith (+) y x)+   (-) x y = (+) x (negate y)+   {- won't work because Map.unionWith won't negate a value from y if no x value corresponds to it+   (-) x y = strip (Map.unionWith sub x y)+   -}+   negate  = fmap negate++instance Ord i => Vector.C (Map i) where+   zero  = Map.empty+   (<+>) = Map.unionWith (+)+   -- requires Eq instance for expo+   -- expo *> x = if expo == zero then zero else Vector.functorScale expo x+   (*>)  = Vector.functorScale++instance (Ord i, Eq a, Eq v, Module.C a v)+             => Module.C a (Map i v) where+--   (*>) 0    = \_ -> zero+--   (*>) expo = fmap ((*>) expo)+   (*>) expo x = if expo == zero then zero else fmap (expo *>) x++instance (Ord i, Eq a, Eq v, VectorSpace.C a v)+             => VectorSpace.C a (Map i v)++instance (Ord i, Eq a, Eq v, NormedSum.C a v)+             => NormedSum.C a (Map i v) where+   norm = foldl (+) zero . map NormedSum.norm . Map.elems++instance (Ord i, Eq a, Eq v, NormedEuc.Sqr a v)+             => NormedEuc.Sqr a (Map i v) where+   normSqr = foldl (+) zero . map NormedEuc.normSqr . Map.elems++instance (Ord i, Eq a, Eq v, Algebraic.C a, NormedEuc.Sqr a v)+             => NormedEuc.C a (Map i v) where+   norm = NormedEuc.defltNorm++instance (Ord i, Eq a, Eq v, NormedMax.C a v)+             => NormedMax.C a (Map i v) where+   norm = foldl max zero . map NormedMax.norm . Map.elems

+ src-ghc-6.12/MathObj/Gaussian/Bell.hs view

@@ -0,0 +1,314 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-+Complex translated Gaussian bell curve+with amplitude abstracted away.+-}+module MathObj.Gaussian.Bell where++import qualified MathObj.Polynomial as Poly+import qualified Number.Complex as Complex++import qualified Algebra.Transcendental as Trans+import qualified Algebra.Field          as Field+import qualified Algebra.Absolute       as Absolute+import qualified Algebra.Ring           as Ring+import qualified Algebra.Additive       as Additive++import Number.Complex ((+:), )++import Test.QuickCheck (Arbitrary, arbitrary, )+import Control.Monad (liftM4, )++-- import Prelude (($))+import NumericPrelude.Numeric+import NumericPrelude.Base hiding (reverse, )+++data T a = Cons {amp :: a, c0, c1 :: Complex.T a, c2 :: a}+   deriving (Eq, Show)++instance (Absolute.C a, Arbitrary a) => Arbitrary (T a) where+   arbitrary =+      liftM4+         (\k a b c -> Cons (abs k) a b (1 + abs c))+         arbitrary arbitrary arbitrary arbitrary+++constant :: Ring.C a => T a+constant = Cons one zero zero zero++{- |+eigenfunction of 'fourier'+-}+unit :: Ring.C a => T a+unit = Cons one zero zero one++{-# INLINE evaluate #-}+evaluate :: (Trans.C a) =>+   T a -> a -> Complex.T a+evaluate f x =+   Complex.scale+     (sqrt (amp f))+     (Complex.exp $ Complex.scale (-pi) $+      c0 f + Complex.scale x (c1 f) + Complex.fromReal (c2 f * x^2))++evaluateSqRt :: (Trans.C a) =>+   T a -> a -> Complex.T a+evaluateSqRt f x0 =+   Complex.scale+     (sqrt (amp f))+     (let x = sqrt pi * x0+      in  Complex.exp $ negate $+          c0 f + Complex.scale x (c1 f) + Complex.fromReal (c2 f * x^2))++exponentPolynomial :: (Additive.C a) =>+   T a -> Poly.T (Complex.T a)+exponentPolynomial f =+   Poly.fromCoeffs [c0 f, c1 f, Complex.fromReal (c2 f)]+++variance :: (Trans.C a) =>+   T a -> a+variance f =+   recip $ c2 f * 2*pi++multiply :: (Ring.C a) =>+   T a -> T a -> T a+multiply f g =+   Cons+      (amp f * amp g)+      (c0 f + c0 g) (c1 f + c1 g) (c2 f + c2 g)++powerRing :: (Trans.C a) =>+   Integer -> T a -> T a+powerRing p f =+   let pa = fromInteger p+   in  Cons+          (amp f ^ p)+          (pa * c0 f) (pa * c1 f) (fromInteger p * c2 f)++{-+powerField does not makes sense,+since the reciprocal of a Gaussian diverges.+-}++powerAlgebraic :: (Trans.C a) =>+   Rational -> T a -> T a+powerAlgebraic p f =+   let pa = fromRational' p+   in  Cons+          (amp f ^/ p)+          (pa * c0 f) (pa * c1 f) (fromRational' p * c2 f)++powerTranscendental :: (Trans.C a) =>+   a -> T a -> T a+powerTranscendental p f =+   Cons+      (amp f ^? p)+      (Complex.scale p $ c0 f) (Complex.scale p $ c1 f) (p * c2 f)+++{-+let x=Cons 2 (1+:3) (4+:5) (7::Rational); y=Cons 7 (1+:4) (3+:2) (5::Rational)+-}+convolve :: (Field.C a) =>+   T a -> T a -> T a+convolve f g =+   let s = c2 f + c2 g+       {-+       fd = f1/(2*f2)+       gd = g1/(2*g2)+       c = f2*g2/(f2+g2)++       c*(fd+gd) = (f1*g2+f2*g1)/(2*(f2+g2)) = b/2++       c*(fd+gd)^2 - fd^2*f2 - gd^2*g2+         = f2*g2*(fd+gd)^2/(f2 + g2) - (fd^2*f2 + gd^2*g2)+         = (f2*g2*(fd+gd)^2 - (f2+g2)*(fd^2*f2+gd^2*g2)) / (f2 + g2)+         = (2*f2*g2*fd*gd - (fd^2*f2^2+gd^2*g2^2)) / (f2 + g2)+         = (2*f1*g1 - (f1^2+g1^2)) / (4*(f2 + g2))+         = -(f1 - g1)^2/(4*(f2 + g2))+       -}+   in  Cons+          (amp f * amp g / s)+          (c0 f + c0 g+              - Complex.scale (recip (4*s)) ((c1 f - c1 g)^2))+          (Complex.scale (c2 g / s) (c1 f) ++           Complex.scale (c2 f / s) (c1 g))+          (c2 f * c2 g / s)+            -- recip $ recip (c2 f) + recip (c2 g)+{-+   Cons+      (c0 f + c0 g) (c1 f + c1 g)+      (recip $ recip (c2 f) + recip (c2 g))+-}++convolveByTranslation :: (Field.C a) =>+   T a -> T a -> T a+convolveByTranslation f0 g0 =+   let fd = Complex.scale (recip (2 * c2 f0)) $ c1 f0+       gd = Complex.scale (recip (2 * c2 g0)) $ c1 g0+       f1 = translateComplex fd f0+       g1 = translateComplex gd g0+       s = c2 f1 + c2 g1+   in  translateComplex (negate $ fd + gd) $+       Cons+          (amp f1 * amp g1 / s)+          (c0 f1 + c0 g1) zero+          (c2 f1 * c2 g1 / s)++convolveByFourier :: (Field.C a) =>+   T a -> T a -> T a+convolveByFourier f g =+   reverse $ fourier $ multiply (fourier f) (fourier g)++fourier :: (Field.C a) =>+   T a -> T a+fourier f =+   let a = c0 f+       b = c1 f+       rc = recip $ c2 f+   in  Cons+          (amp f * rc)+          (Complex.scale (rc/4) (-b^2) + a)+          (Complex.scale rc $ Complex.quarterRight b)+          rc++fourierByTranslation :: (Field.C a) =>+   T a -> T a+fourierByTranslation f =+   translateComplex (Complex.scale (1/2) $ Complex.quarterLeft $ c1 f) $+   Cons (amp f / c2 f) (c0 f) zero (recip $ c2 f)++{-+a + b*x + c*x^2+ = c*(a/c + b/c*x + x^2)+ = c*((x-b/(2*c))^2 + (4*a*c+b^2)/(4*c^2))+ = c*(x-b/(2*c))^2 + (4*a*c+b^2)/(4*c)++fourier ->+   x^2/c - i*b/c*x + (4*a*c+b^2)/(4*c)++fourier (x -> exp(-pi*c*(x-t)^2))+ = fourier $ translate t $ shrink (sqrt c) $ x -> exp(-pi*x^2)+ = modulate t $ dilate (sqrt c) $ fourier $ x -> exp(-pi*x^2)+ = modulate t $ dilate (sqrt c) $ x -> exp(-pi*x^2)+ = modulate t $ x -> exp(-pi*x^2/c)+ = x -> exp(-pi*x^2/c) * exp(-2*pi*i*x*t)+ = x -> exp(-pi*(x^2/c - 2*i*x*t))+-}++{-+b*x + c*x^2+ = c*(b/c*x + x^2)+ = c*((x-br/(2*c))^2 + i*x*bi/c - br^2/(4*c^2))+ = c*(x-br/(2*c))^2 + i*x*bi - br^2/(4*c)++fourier ->+   (x+bi/2)^2/c - i*br/c*(x+bi/2) - br^2/(4*c)+ = (1/c) * ((x+bi/2)^2 - i*br*(x+bi/2) + (br/2)^2)+ = (1/c) * (x^2 - i*b*x + -(br/2)^2 + (bi/2)^2 - i*br*bi/2)+ = (1/c) * (x^2 - i*b*x - (br^2-bi^2+2*br*bi*i)^2 /4)+ = (1/c) * (x^2 - i*b*x - b^2 / 4)+ = (1/c) * (x^2 - i*b*x + (i*b/2)^2)+ = (1/c) * (x - i*b/2)^2++Example:+  (x-b)^2 = b^2 - 2*b*x + x^2+    ->  (- i*2*b*x + x^2)+++fourier (x -> exp(-pi*(c*(x-t)^2 + 2*i*m*x)))+ = fourier $ modulate m $ translate t $ shrink (sqrt c) $ x -> exp(-pi*x^2)+ = translate (-m) $ modulate t $ dilate (sqrt c) $ fourier $ x -> exp(-pi*x^2)+ = translate (-m) $ modulate t $ dilate (sqrt c) $ x -> exp(-pi*x^2)+ = translate (-m) $ modulate t $ x -> exp(-pi*x^2/c)+ = translate (-m) $ x -> exp(-pi*x^2/c) * exp(-2*pi*i*x*t)+ = x -> exp(-pi*(x+m)^2/c) * exp(-2*pi*i*(x+m)*t)+ = x -> exp(-pi*((x+m)^2/c - 2*i*(x+m)*t))+-}++{-+fourier (Cons a 0 0) =+  Cons a 0 infinity++fourier (Cons 0 0 c) =+  Cons 0 0 (recip c)++fourier (Cons 0 b 1) =+  Cons 0 (i*b) 1+-}++translate :: Ring.C a => a -> T a -> T a+translate d f =+   let a = c0 f+       b = c1 f+       c = c2 f+   in  Cons+          (amp f)+          (Complex.fromReal (c*d^2) - Complex.scale d b + a)+          (Complex.fromReal (-2*c*d) + b)+          c++translateComplex :: Ring.C a => Complex.T a -> T a -> T a+translateComplex d f =+   let a = c0 f+       b = c1 f+       c = c2 f+   in  Cons+          (amp f)+          (Complex.scale c (d^2) - b*d + a)+          (Complex.scale (-2*c) d + b)+          c++modulate :: Ring.C a => a -> T a -> T a+modulate d f =+   Cons+      (amp f)+      (c0 f)+      (c1 f + (zero +: 2*d))+      (c2 f)++turn :: Ring.C a => a -> T a -> T a+turn d f =+   Cons+      (amp f)+      (c0 f + (zero +: 2*d))+      (c1 f)+      (c2 f)++reverse :: Additive.C a => T a -> T a+reverse f =+   f{c1 = negate $ c1 f}+++dilate :: Field.C a => a -> T a -> T a+dilate k f =+   Cons+      (amp f)+      (c0 f)+      (Complex.scale (recip k) $ c1 f)+      (c2 f / k^2)++shrink :: Ring.C a => a -> T a -> T a+shrink k f =+   Cons+      (amp f)+      (c0 f)+      (Complex.scale k $ c1 f)+      (c2 f * k^2)++amplify :: (Ring.C a) => a -> T a -> T a+amplify k f =+   Cons+      (k^2 * amp f)+      (c0 f)+      (c1 f)+      (c2 f)+++{- laws+fourier (convolve f g) = fourier f * fourier g++fourier (fourier f) = reverse f+-}

+ src-ghc-6.12/MathObj/Gaussian/Example.hs view

@@ -0,0 +1,227 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-+Reciprocal of variance of a Gaussian bell curve.+We describe the curve only in terms of its variance+thus we represent a bell curve at the coordinate origin+neglecting its amplitude.++We could also define the amplitude as @root 4 c@,+thus preserving L2 norm being one,+but then @dilate@ and @shrink@ also include an amplification.++We could do some projective geometry in the exponent+in order to also have zero variance,+which corresponds to the dirac impulse.+-}+module MathObj.Gaussian.Example where++import qualified MathObj.Gaussian.Polynomial as PolyBell+import qualified MathObj.Gaussian.Bell as Bell+import qualified MathObj.Gaussian.Variance as Var++import qualified MathObj.Polynomial as Poly++import qualified Algebra.Transcendental as Trans+import qualified Algebra.Algebraic      as Algebraic+import qualified Algebra.Field          as Field+-- import qualified Algebra.Absolute           as Absolute+import qualified Algebra.Ring           as Ring+-- import qualified Algebra.Additive       as Additive++import qualified Number.Complex as Complex++import Algebra.Transcendental (pi, )+import Algebra.Algebraic (root, )+import Algebra.Ring ((*), (^), )++import Number.Complex ((+:), )++import qualified Numerics.Function as Func+import qualified Numerics.Fourier as Fourier+import qualified Numerics.Integration as Integ+import qualified Numerics.Differentiation as Diff++import qualified Graphics.Gnuplot.Simple as GP++import Control.Applicative (liftA2, )++-- import System.Exit (ExitCode, )++-- import Prelude (($))+import NumericPrelude.Numeric+import NumericPrelude.Base+import qualified Prelude as P+++curve0 :: Var.T Double+curve0 = curve0a++curve0a :: Var.T Double+curve0a = Var.Cons 1.4 3.3++curve0b :: Var.T Double+curve0b = Var.Cons 2.2 1.7++variance0 :: (Double, Double)+variance0 =+   (Var.variance curve0,+    (Integ.rectangular 1000 (-2,2) $ liftA2 (*) (^2) (Var.evaluate curve0)) /+    (Integ.rectangular 1000 (-2,2) $ Var.evaluate curve0))++norm10 :: (Double, Double)+norm10 =+   (Integ.rectangular 1000 (-2,2) $ Var.evaluate curve0,+    Var.norm1 curve0)++norm20 :: (Double, Double)+norm20 =+   (sqrt $ Integ.rectangular 1000 (-2,2) $ (^2) . Var.evaluate curve0,+    Var.norm2 curve0)++norm30 :: (Double, Double)+norm30 =+   (root 3 $ Integ.rectangular 1000 (-2,2) $ (^3) . Var.evaluate curve0,+    Var.normP 3 curve0)++fourier0 :: IO ()+fourier0 =+   GP.plotFuncs []+      (GP.linearScale 100 (-2,2))+      [Var.evaluate $ Var.fourier curve0,+       Fourier.analysisTransformOneReal 100 (-2,2) $ Var.evaluate curve0]++multiply0 :: IO ()+multiply0 =+   GP.plotFuncs []+      (GP.linearScale 100 (-1,1))+      [Var.evaluate $ Var.multiply curve0a curve0b,+       liftA2 (*) (Var.evaluate curve0a) (Var.evaluate curve0b)]++convolve0 :: IO ()+convolve0 =+   GP.plotFuncs []+      (GP.linearScale 100 (-2,2))+      [Var.evaluate $ Var.convolve curve0a curve0b,+       Integ.convolve 1000 (-3,3) (Var.evaluate curve0a) (Var.evaluate curve0b)]+++curve1 :: Bell.T Double+curve1 = curve1a++curve1a :: Bell.T Double+curve1a = Bell.Cons 1.4 (0.1+:0.3) ((-0.2)+:1.4) 2.3++curve1b :: Bell.T Double+curve1b = Bell.Cons 2.2 ((-0.3)+:2.1) (0.2+:(-0.4)) 1.7++variance1 :: (Double, Double)+variance1 =+   (Bell.variance curve1,+    (Integ.rectangular 1000 (-2,2) $+        liftA2 (*) (^2)+           (Complex.magnitudeSqr .+            Func.translateRight+               (Complex.real (Bell.c1 curve1) / (2 * Bell.c2 curve1))+               (Bell.evaluate curve1))) /+    (Integ.rectangular 1000 (-2,2) $ Complex.magnitude . Bell.evaluate curve1))++{- the norm depends on too much things+norm0vs1 :: (Double, Double)+norm0vs1 =+   ((Integ.rectangular 1000 (-5,5) $ Var.evaluate curve0)+         * exp (- Complex.real (Bell.c0 curve1)),+    Integ.rectangular 1000 (-5,5) $ Complex.magnitude . Bell.evaluate curve1)+-}++fourier1 :: IO ()+fourier1 =+   GP.plotFuncs []+      (GP.linearScale 100 (-5,5))+      [Complex.real . (Bell.evaluate $ Bell.fourier curve1),+       fourierAnalysisReal 100 (-2,2) $ Bell.evaluate curve1]+++curve2 :: PolyBell.T Double+curve2 =+   PolyBell.Cons+--      Bell.unit+--      (Bell.Cons 1.4 (0.1+:0.3) 0 1.2)+--      (Bell.Cons 1.4 (0.1+:0.3) ((-0.2)+:1.4) 1)+      curve1+--      (Poly.fromCoeffs [one])+--      (Poly.fromCoeffs [zero,one])+--      (Poly.fromCoeffs [zero,zero,one])+--      (Poly.fromCoeffs [0,Complex.imaginaryUnit])+      (Poly.fromCoeffs [1.4+:(-0.1),0.8+:(0.1),(-1.1)+:0.3])++differentiate2 :: IO ()+differentiate2 =+   GP.plotFuncs []+      (GP.linearScale 100 (-2,2))+      [Complex.real . (PolyBell.evaluateSqRt $ PolyBell.differentiate curve2),+       ((/ sqrt pi) . ) $ Diff.diff (1e-5) $ Complex.real . PolyBell.evaluateSqRt curve2]++fourier2 :: IO ()+fourier2 =+   GP.plotFuncs []+      (GP.linearScale 100 (-5,5))+      [Complex.real . (PolyBell.evaluateSqRt $ PolyBell.fourier curve2),+       fourierAnalysisReal 100 (-2,2) $ PolyBell.evaluateSqRt curve2]++++fourierAnalysisReal ::+   (P.Floating a) =>+   Integer -> (a, a) -> (a -> Complex.T a) -> a -> a+fourierAnalysisReal n rng f =+   liftA2 (P.-)+      (Fourier.analysisTransformOneReal n rng (Complex.real . f))+      (Fourier.analysisTransformOneImag n rng (Complex.imag . f))+++{- |+Try to approximate @\x -> exp (-x^2) * x@+by a difference of translated Gaussian bells.++exp(-x^2) * x+  ==  exp(-(a+b*x+c*x^2)) - exp(-(a-b*x+c*x^2))+  ==  exp(-(a+c*x^2)) * (exp(-b*x) - exp(b*x))+  ==  exp(-(a+c*x^2)) * 2*sinh (b*x)++It holds+  lim (\b x -> sinh (b*x) / b)  =  id+-}+diffApprox :: IO ()+diffApprox =+   let amp = (2*b)^- (-2)+       a = 0+       {-+       amp = 1+       a = log (2 * abs b)+       -}+       b = -0.1+       c = 1+       ac = Complex.fromReal a+       bc = Complex.fromReal b+   in  GP.plotFuncs []+          (GP.linearScale 100 (-2,2::Double))+          [Complex.real .+           (PolyBell.evaluateSqRt $+              PolyBell.Cons Bell.unit (Poly.fromCoeffs [zero,one])),+           Complex.real .+           liftA2 (-)+             (PolyBell.evaluateSqRt $+                PolyBell.Cons (Bell.Cons amp ac bc c) (Poly.fromCoeffs [one]))+             (PolyBell.evaluateSqRt $+                PolyBell.Cons (Bell.Cons amp ac (-bc) c) (Poly.fromCoeffs [one]))]+++polyApprox :: IO ()+polyApprox =+   GP.plotFuncs []+      (GP.linearScale 100 (-2,2::Double))+      [Complex.real .+         PolyBell.evaluateSqRt curve2,+       Complex.real . sum .+         mapM (\(amp,b) -> \x -> amp * Bell.evaluateSqRt b x)+         (PolyBell.approximateByBells 0.1 curve2)]

+ src-ghc-6.12/MathObj/Gaussian/Polynomial.hs view

@@ -0,0 +1,435 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-+Complex Gaussian bell multiplied with a polynomial.++In order to make this free of @pi@ factors,+we have to choose @recip (sqrt pi)@+as unit for translations and modulations,+for linear factors and in the differentiation.+-}+{-+ToDo:++* In order to avoid the weird @sqrt pi@ factor,+  use a polynomial expression in @pi@.++* sum of multiple bells using Data.Map from exponent polynomial to coefficient polynomial+  use of Algebra object.++* Projective geometry in order to support Dirac impulse.+-}+module MathObj.Gaussian.Polynomial where++import qualified MathObj.Gaussian.Bell as Bell++import qualified MathObj.LaurentPolynomial as LPoly+import qualified MathObj.Polynomial.Core   as PolyCore+import qualified MathObj.Polynomial        as Poly+import qualified Number.Complex     as Complex++import qualified Algebra.ZeroTestable   as ZeroTestable+import qualified Algebra.Differential   as Differential+import qualified Algebra.Transcendental as Trans+import qualified Algebra.Field          as Field+import qualified Algebra.Absolute           as Absolute+import qualified Algebra.Ring           as Ring+import qualified Algebra.Additive       as Additive++import qualified Data.Record.HT as Rec+import qualified Data.List as List+import Data.Function.HT (nest, )+import Data.Eq.HT (equating, )+import Data.List.HT (mapAdjacent, )+import Data.Tuple.HT (forcePair, )++import Test.QuickCheck (Arbitrary, arbitrary, )+import Control.Monad (liftM2, )++import NumericPrelude.Numeric+import NumericPrelude.Base hiding (reverse, )+-- import Prelude ()+++data T a = Cons {bell :: Bell.T a, polynomial :: Poly.T (Complex.T a)}+   deriving (Show)++instance (Absolute.C a, Eq a) => Eq (T a) where+   (==) = equal+++{-+Helper data type for 'equal',+that allows to call the (not quite trivial) polynomial equality check.+@RootProduct r a@ represents @sqrt r * a@.+The test using 'signum' works for real numbers,+and I do not know, whether it is correct for other mathematical objects.+However I cannot imagine other mathematical objects,+that make sense at all, here.+Maybe elements of a finite field.+-}+data RootProduct a = RootProduct a a++instance (Absolute.C a, Eq a) => Eq (RootProduct a) where+   (RootProduct xr xa) == (RootProduct yr ya)  =+      let xp = xr*xa^2+          yp = yr*ya^2+      in  xp==yp &&+          (isZero xp || signum xa == signum ya)++instance (ZeroTestable.C a) => ZeroTestable.C (RootProduct a) where+   isZero (RootProduct r a) = isZero r || isZero a+++{-+The derived Eq is not correct.+We have to combine the amplitude of the bell with the polynomial,+respecting signs and the square root of the bell amplitude.+-}+equal :: (Absolute.C a, Eq a) => T a -> T a -> Bool+equal x y =+   let bx = bell x+       by = bell y+       scaleSqr b =+          (\p ->+              (fmap (RootProduct (Bell.amp b) . Complex.real) p,+               fmap (RootProduct (Bell.amp b) . Complex.imag) p))+           . polynomial+   in  Rec.equal+          (equating Bell.c0 :+           equating Bell.c1 :+           equating Bell.c2 :+           [])+          bx by+       &&+       scaleSqr bx x == scaleSqr by y+++instance (Absolute.C a, Arbitrary a) => Arbitrary (T a) where+   arbitrary =+--      liftM2 Cons arbitrary arbitrary+      liftM2 Cons+         arbitrary+         -- we have to restrict the number of polynomial coefficients,+         -- since with the quadratic time algorithms like fourier and convolve,+         -- in connection with Rational slow down tests too much.+         (fmap (Poly.fromCoeffs . take 5 . Poly.coeffs) arbitrary)++++{-# INLINE evaluateSqRt #-}+evaluateSqRt :: (Trans.C a) =>+   T a -> a -> Complex.T a+evaluateSqRt f x =+   Bell.evaluateSqRt (bell f) x *+   Poly.evaluate (polynomial f) (Complex.fromReal $ sqrt pi * x)+{- ToDo: evaluating a complex polynomial for a real argument can be optimized -}+++constant :: (Ring.C a) => T a+constant =+   Cons Bell.constant (Poly.const one)++scale :: (Ring.C a) => a -> T a -> T a+scale x f =+   f{polynomial = fmap (Complex.scale x) $ polynomial f}++scaleComplex :: (Ring.C a) => Complex.T a -> T a -> T a+scaleComplex x f =+   f{polynomial = fmap (x*) $ polynomial f}+++eigenfunction :: (Field.C a) => Int -> T a+eigenfunction =+   eigenfunctionDifferential++eigenfunction0 :: (Ring.C a) => T a+eigenfunction0 =+   Cons Bell.unit (Poly.fromCoeffs [one])++eigenfunction1 :: (Ring.C a) => T a+eigenfunction1 =+   Cons Bell.unit (Poly.fromCoeffs [zero, one])++eigenfunction2 :: (Field.C a) => T a+eigenfunction2 =+   Cons Bell.unit (Poly.fromCoeffs [-(1/4), zero, one])++eigenfunction3 :: (Field.C a) => T a+eigenfunction3 =+   Cons Bell.unit (Poly.fromCoeffs [zero, -(3/4), zero, one])+++eigenfunctionDifferential :: (Field.C a) => Int -> T a+eigenfunctionDifferential n =+   (\f -> f{bell = Bell.unit}) $+   nest n (scale (-1/4) . differentiate) $+   Cons (Bell.Cons one zero zero 2) one++eigenfunctionIterative :: (Field.C a, Absolute.C a, Eq a) => Int -> T a+eigenfunctionIterative n =+   fst . head . dropWhile (uncurry (/=)) . mapAdjacent (,) $+   eigenfunctionIteration $+   Cons+      Bell.unit+      (Poly.fromCoeffs $ replicate n zero ++ [one])++eigenfunctionIteration :: (Field.C a) => T a -> [T a]+eigenfunctionIteration =+   iterate (\x ->+      let y = fourier x+          px = polynomial x+          py = polynomial y+          c = last (Poly.coeffs px) / last (Poly.coeffs py)+      in  y{polynomial = fmap (0.5*) (px + fmap (c*) py)})+++multiply :: (Ring.C a) =>+   T a -> T a -> T a+multiply f g =+   Cons+      (Bell.multiply (bell f) (bell g))+      (polynomial f * polynomial g)++convolve, {- convolveByDifferentiation, -} convolveByFourier :: (Field.C a) =>+   T a -> T a -> T a+convolve = convolveByFourier++{-+f <*> g =+   let (foff,fint) = integrate f+   in  fint <*> differentiate g + makeGaussPoly foff * g++In principle this would work,+but (makeGaussPoly foff * g) contains a lot of+convolutions of Gaussian with Gaussian-polynomial-product,+where the Gaussians have different parameters.++convolveByDifferentiation f g =+   case polynomial f of+      fpoly ->+         if null $ Poly.coeffs fpoly+           then ...+           else ...+-}++convolveByFourier f g =+   reverse $ fourier $ multiply (fourier f) (fourier g)++{-+We use a Horner like scheme+in order to translate multiplications with @id@+to differentations on the Fourier side.+Quadratic runtime.++fourier (Cons bell (Poly.const a + Poly.shift f))+  = fourier (Cons bell (Poly.const a)) + fourier (Cons bell (Poly.shift f))+  = fourier (Cons bell (Poly.const a)) + differentiate (fourier (Cons bell f))+-}+fourier :: (Field.C a) =>+   T a -> T a+fourier f =+   foldr+      (\c p ->+          let q = differentiate p+          in  q{polynomial =+                   Poly.const c ++                   fmap (Complex.scale (1/2) . Complex.quarterLeft) (polynomial q)})+      (Cons (Bell.fourier $ bell f) zero) $+   Poly.coeffs $ polynomial f++{- |+Differentiate and divide by @sqrt pi@ in order to stay in a ring.+This way, we do not need to fiddle with pi factors.+-}+differentiate :: (Ring.C a) => T a -> T a+differentiate f =+   f{polynomial =+        Differential.differentiate (polynomial f)+        - Differential.differentiate (Bell.exponentPolynomial (bell f))+           * polynomial f}++{-+snd $ integrate $ differentiate (Cons Bell.unit (Poly.fromCoeffs [7,7,7,7]) :: T Double)++g = (bell f * poly f)'+  = bell f * ((poly f)' - (exppoly (bell f))' * poly f)+poly g = (poly f)' - (exppoly (bell f))' * poly f++Integration means we have g and ask for f.++poly f = ((poly f)' - poly g) / (exppoly (bell f))'++However must start with the highest term of 'poly f',+and thus we need to perform the division on reversed polynomials.+-}+integrate ::+   (Field.C a, ZeroTestable.C a) =>+   T a -> (Complex.T a, T a)+integrate f =+   let fs = Poly.coeffs $ polynomial f+       (ys,~[r]) =+          PolyCore.divModRev+             {-+             We need the shortening convention of 'zipWith'+             in order to limit the result list,+             we cannot use list instance for (-).+             -}+             (zipWith (-)+                (0 : 0 : diffRev ys)+                (List.reverse fs))+             (List.reverse $ Poly.coeffs $+              Differential.differentiate $+              Bell.exponentPolynomial $ bell f)+   in  forcePair $+       if null fs+         then (zero, f)+         else (r, f{polynomial = Poly.fromCoeffs $ List.reverse ys})++diffRev :: Ring.C a => [a] -> [a]+diffRev xs =+   zipWith (*) xs+      (drop 1 (iterate (subtract 1) (fromIntegral $ length xs)))++translate :: Ring.C a => a -> T a -> T a+translate d =+   translateComplex (Complex.fromReal d)++translateComplex :: Ring.C a => Complex.T a -> T a -> T a+translateComplex d f =+   Cons+      (Bell.translateComplex d $ bell f)+      (Poly.translate d $ polynomial f)++modulate :: Ring.C a => a -> T a -> T a+modulate d f =+   Cons+      (Bell.modulate d $ bell f)+      (polynomial f)++turn :: Ring.C a => a -> T a -> T a+turn d f =+   Cons+      (Bell.turn d $ bell f)+      (polynomial f)++reverse :: Additive.C a => T a -> T a+reverse f =+   Cons+      (Bell.reverse $ bell f)+      (Poly.reverse $ polynomial f)++dilate :: Field.C a => a -> T a -> T a+dilate k f =+   Cons+      (Bell.dilate k $ bell f)+      (Poly.dilate (Complex.fromReal k) $ polynomial f)++shrink :: Ring.C a => a -> T a -> T a+shrink k f =+   Cons+      (Bell.shrink k $ bell f)+      (Poly.shrink (Complex.fromReal k) $ polynomial f)++{-+We could also amplify the polynomial coefficients.+-}+amplify :: Ring.C a => a -> T a -> T a+amplify k f =+   Cons+      (Bell.amplify k $ bell f)+      (polynomial f)+++{- |+Approximate a @T a@ using a linear combination of translated @Bell.T a@.+The smaller the unit (e.g. 0.1, 0.01, 0.001)+the better the approximation but the worse the numeric properties.++We cannot put all information into @amp@ of @Bell@,+since @amp@ must be real, but is complex here by construction.+We really need at least signed amplitudes at this place,+since we want to represent differences of Gaussians.+-}+approximateByBells ::+   Field.C a =>+   a -> T a -> [(Complex.T a, Bell.T a)]+approximateByBells unit f =+   let b = bell f+       amps =+          -- approximateByBellsByTranslation+          approximateByBellsAtOnce+             unit+             (Complex.scale (recip (2 * Bell.c2 b)) (Bell.c1 b))+             (recip (2*unit*Bell.c2 b))+             (polynomial f)+   in  zip (LPoly.coeffs amps) $+       map+          (\d -> Bell.translate d b)+          (laurentAbscissas (unit/2) amps)++approximateByBellsAtOnce ::+   Field.C a =>+   a -> Complex.T a -> a -> Poly.T (Complex.T a) -> LPoly.T (Complex.T a)+approximateByBellsAtOnce unit d s p =+   foldr+      (\x amps0 ->+         {-+         Decompose (bell t * (t-d)) = bell t * t - bell t * d+         -}+         let y = fmap (Complex.scale s) amps0+         in  -- \t -> bell t * t+             --    ~   (translate unit bell - translate (-unit) bell) / unit+             LPoly.shift 1 y -+             LPoly.shift (-1) y ++             -- bell t * d+             zipWithAbscissas+                (\t z -> (Complex.fromReal t - d) * z)+                (unit/2) amps0 ++             LPoly.const x)+      (LPoly.fromCoeffs [])+      (Poly.coeffs p)++approximateByBellsByTranslation ::+   Field.C a =>+   a -> Complex.T a -> a -> Poly.T (Complex.T a) -> LPoly.T (Complex.T a)+approximateByBellsByTranslation unit d s p =+   foldr+      (\x amps0 ->+         {-+         Decompose (bell t * (t-d)) = bell t * t - bell t * d+         -}+         let y = fmap (Complex.scale s) amps0+         in  -- \t -> bell t * t+             --    ~   (translate unit bell - translate (-unit) bell) / unit+             LPoly.shift 1 y -+             LPoly.shift (-1) y ++             -- bell t * d+             zipWithAbscissas Complex.scale (unit/2) amps0 ++             LPoly.const x)+      (LPoly.fromCoeffs [])+      (Poly.coeffs $ Poly.translate d p)++zipWithAbscissas ::+   (Ring.C a) =>+   (a -> b -> c) -> a -> LPoly.T b -> LPoly.T c+zipWithAbscissas h unit y =+   LPoly.fromShiftCoeffs (LPoly.expon y) $+   zipWith h+      (laurentAbscissas unit y)+      (LPoly.coeffs y)++laurentAbscissas :: Ring.C a => a -> LPoly.T c -> [a]+laurentAbscissas unit =+   map (\d -> fromIntegral d * unit) .+   iterate (1+) . LPoly.expon+++{- No Ring instance for Gaussians+instance (Ring.C a) => Differential.C (T a) where+   differentiate = differentiate+-}++{- laws+differentiate (f*g) =+   (differentiate f) * g + f * (differentiate g)+-}

+ src-ghc-6.12/MathObj/Gaussian/Variance.hs view

@@ -0,0 +1,186 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-+We represent a Gaussian bell curve in terms of the reciprocal of its variance+and its value at the origin.++We could do some projective geometry in the exponent+in order to also have zero variance,+which corresponds to the dirac impulse.+-}+module MathObj.Gaussian.Variance where++import qualified MathObj.Polynomial as Poly+import qualified Number.Root as Root++import qualified Algebra.Transcendental as Trans+import qualified Algebra.Algebraic      as Algebraic+import qualified Algebra.Field          as Field+import qualified Algebra.Absolute       as Absolute+import qualified Algebra.Ring           as Ring+import qualified Algebra.Additive       as Additive++{-+import Algebra.Transcendental (pi, )+import Algebra.Ring ((*), (^), )+import Algebra.Additive ((+))+-}+import Test.QuickCheck (Arbitrary, arbitrary, )+import Control.Monad (liftM2, )++-- import Prelude (($))+import NumericPrelude.Numeric+import NumericPrelude.Base+++{- |+Since @amp@ is the square of the actual amplitude it must be non-negative.+-}+data T a = Cons {amp, c :: a}+   deriving (Eq, Show)++instance (Absolute.C a, Arbitrary a) => Arbitrary (T a) where+   arbitrary =+      liftM2 Cons+         (fmap abs arbitrary)+         (fmap ((1+) . abs) arbitrary)+++constant :: Ring.C a => T a+constant = Cons one zero++{-# INLINE evaluate #-}+evaluate :: (Trans.C a) =>+   T a -> a -> a+evaluate f x =+   sqrt (amp f) * exp (-pi * c f * x^2)++exponentPolynomial :: (Additive.C a) =>+   T a -> Poly.T a+exponentPolynomial f =+   Poly.fromCoeffs [zero, zero, c f]+++norm1Root :: (Field.C a) => T a -> Root.T a+norm1Root f =+   Root.sqrt $ Root.fromNumber $ amp f / c f++norm2Root :: (Field.C a) => T a -> Root.T a+norm2Root f =+   Root.sqrt $+      Root.fromNumber (amp f)+      `Root.div`+      Root.sqrt (Root.fromNumber $ 2 * c f)++normInfRoot :: (Field.C a) => T a -> Root.T a+normInfRoot f =+   Root.sqrt $ Root.fromNumber $ amp f++normPRoot :: (Field.C a) => Rational -> T a -> Root.T a+normPRoot p f =+   Root.sqrt (Root.fromNumber (amp f))+   `Root.div`+   Root.rationalPower (recip (2*p)) (Root.fromNumber (fromRational' p * c f))+++norm1 :: (Algebraic.C a) => T a -> a+norm1 f =+   sqrt $ amp f / c f++norm2 :: (Algebraic.C a) => T a -> a+norm2 f =+   sqrt $ amp f / (sqrt $ 2 * c f)++normInf :: (Algebraic.C a) => T a -> a+normInf f =+   sqrt (amp f)++normP :: (Trans.C a) => a -> T a -> a+normP p f =+   sqrt (amp f) * (p * c f) ^? (- recip (2*p))+++variance :: (Trans.C a) =>+   T a -> a+variance f =+   recip $ c f * 2*pi++multiply :: (Ring.C a) =>+   T a -> T a -> T a+multiply f g =+   Cons (amp f * amp g) (c f + c g)++powerRing :: (Trans.C a) =>+   Integer -> T a -> T a+powerRing p f =+   Cons (amp f ^ p) (fromInteger p * c f)++{-+powerField does not makes sense,+since the reciprocal of a Gaussian diverges.+-}++powerAlgebraic :: (Trans.C a) =>+   Rational -> T a -> T a+powerAlgebraic p f =+   Cons (amp f ^/ p) (fromRational' p * c f)++powerTranscendental :: (Trans.C a) =>+   a -> T a -> T a+powerTranscendental p f =+   Cons (amp f ^? p) (p * c f)++{- |+> convolve x y t =+>    integrate $ \s -> x s * y(t-s)++Convergence only for @c f + c g > 0@.+-}+convolve :: (Field.C a) =>+   T a -> T a -> T a+convolve f g =+   let s = c f + c g+   in  Cons+          (amp f * amp g / s)+          (c f * c g / s)++{- |+> fourier x f =+>    integrate $ \t -> x t * cis (-2*pi*t*f)++Convergence only for @c f > 0@.+-}+fourier :: (Field.C a) =>+   T a -> T a+fourier f =+   Cons (amp f / c f) (recip $ c f)+{-+fourier (t -> exp(-(a*t)^2))+-}++dilate :: (Field.C a) => a -> T a -> T a+dilate k f =+   Cons (amp f) $ c f / k^2++shrink :: (Ring.C a) => a -> T a -> T a+shrink k f =+   Cons (amp f) $ c f * k^2++{- |+@amplify k@ scales by @abs k@!+-}+amplify :: (Ring.C a) => a -> T a -> T a+amplify k f =+   Cons (k^2 * amp f) $ c f+++{- laws+fourier (convolve f g) = multiply (fourier f) (fourier g)++dilate k (dilate m f) = dilate (k*m) f++dilate k (shrink k f) = f++variance (dilate k f) = k^2 * variance f++variance (convolve f g) = variance f + variance g+-}

+ src-ghc-6.12/MathObj/LaurentPolynomial.hs view

@@ -0,0 +1,288 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{- |+Copyright   :  (c) Henning Thielemann 2004-2006++Maintainer  :  numericprelude@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++Polynomials with negative and positive exponents.+-}+module MathObj.LaurentPolynomial where++import qualified MathObj.Polynomial  as Poly+import qualified MathObj.PowerSeries as PS+import qualified MathObj.PowerSeries.Core as PSCore++import qualified Algebra.VectorSpace  as VectorSpace+import qualified Algebra.Module       as Module+import qualified Algebra.Vector       as Vector+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 Number.Complex as Complex++import Algebra.Module((*>))++import qualified NumericPrelude.Base as P+import qualified NumericPrelude.Numeric as NP++import NumericPrelude.Base    hiding (const, reverse, )+import NumericPrelude.Numeric hiding (div, negate, )++import qualified Data.List as List+import Data.List.HT (mapAdjacent)+++{- | Polynomial including negative exponents -}++data T a = Cons {expon :: Int, coeffs :: [a]}+++{- * Basic Operations -}++const :: a -> T a+const x = fromCoeffs [x]++(!) :: Additive.C a => T a -> Int -> a+(!) (Cons xt x) n =+   if n<xt+     then zero+     else head (drop (n-xt) x ++ [zero])++fromCoeffs :: [a] -> T a+fromCoeffs = fromShiftCoeffs 0++fromShiftCoeffs :: Int -> [a] -> T a+fromShiftCoeffs = Cons++fromPolynomial :: Poly.T a -> T a+fromPolynomial = fromCoeffs . Poly.coeffs++fromPowerSeries :: PS.T a -> T a+fromPowerSeries = fromCoeffs . PS.coeffs++bounds :: T a -> (Int, Int)+bounds (Cons xt x) = (xt, xt + length x - 1)++shift :: Int -> T a -> T a+shift t (Cons xt x) = Cons (xt+t) x++{-# DEPRECATED translate "In order to avoid confusion with Polynomial.translate, use 'shift' instead" #-}+translate :: Int -> T a -> T a+translate = shift+++instance Functor T where+  fmap f (Cons xt xs) = Cons xt (map f xs)+++{- * Show -}++appPrec :: Int+appPrec  = 10++instance (Show a) => Show (T a) where+  showsPrec p (Cons xt xs) =+    showParen (p >= appPrec)+       (showString "LaurentPolynomial.Cons " . shows xt .+        showString " " . shows xs)++{- * Additive -}++add :: Additive.C a => T a -> T a -> T a+add (Cons _ [])  y          = y+add  x          (Cons _ []) = x+add (Cons xt x) (Cons yt y) =+   if xt < yt+     then Cons xt (addShifted (yt-xt) x y)+     else Cons yt (addShifted (xt-yt) y x)++{-+Compute the value of a series of Laurent polynomials.++Requires that the start exponents constitute a (weakly) rising sequence,+where each exponent occurs only finitely often.++Cf. Synthesizer.Cut.arrange+-}+series :: (Additive.C a) => [T a] -> T a+series [] = fromCoeffs []+series ps =+   let es = map expon  ps+       xs = map coeffs ps+       ds = mapAdjacent subtract es+   in  Cons (head es) (addShiftedMany ds xs)++{- |+Add lists of numbers respecting a relative shift between the starts of the lists.+The shifts must be non-negative.+The list of relative shifts is one element shorter+than the list of summands.+Infinitely many summands are permitted,+provided that runs of zero shifts are all finite.+++We could add the lists either with 'foldl' or with 'foldr',+'foldl' would be straightforward, but more time consuming (quadratic time)+whereas foldr is not so obvious but needs only linear time.++(stars denote the coefficients,+ frames denote what is contained in the interim results)+'foldl' sums this way:++> | | | *******************************+> | | +--------------------------------+> | |          ************************+> | +----------------------------------+> |                        ************+> +------------------------------------++I.e. 'foldl' would use much time find the time differences+by successive subtraction 1.++'foldr' mixes this way:++>     +--------------------------------+>     | *******************************+>     |      +-------------------------+>     |      | ************************+>     |      |           +-------------+>     |      |           | ************++-}+addShiftedMany :: (Additive.C a) => [Int] -> [[a]] -> [a]+addShiftedMany ds xss =+   foldr (uncurry addShifted) [] (zip (ds++[0]) xss)++++addShifted :: Additive.C a => Int -> [a] -> [a] -> [a]+addShifted del px py =+   let recurse 0 x      = PSCore.add x py+       recurse d []     = replicate d zero ++ py+       recurse d (x:xs) = x : recurse (d-1) xs+   in  if del >= 0+         then recurse del px+         else error "LaurentPolynomial.addShifted: negative shift"+++negate :: Additive.C a => T a -> T a+negate (Cons xt x) = Cons xt (map NP.negate x)++sub :: Additive.C a => T a -> T a -> T a+sub x y = add x (negate y)++instance Additive.C a => Additive.C (T a) where+   zero   = fromCoeffs []+   (+)    = add+   (-)    = sub+   negate = negate+++{- * Module -}++instance Vector.C T where+   zero  = zero+   (<+>) = (+)+   (*>)  = Vector.functorScale++instance (Module.C a b) => Module.C a (T b) where+    x *> Cons yt ys = Cons yt (x *> ys)++instance (Field.C a, Module.C a b) => VectorSpace.C a (T b)+++{- * Ring -}++mul :: Ring.C a => T a -> T a -> T a+mul (Cons xt x) (Cons yt y) = Cons (xt+yt) (PSCore.mul x y)++instance (Ring.C a) => Ring.C (T a) where+    one           = const one+    fromInteger n = const (fromInteger n)+    (*)           = mul+++{- * Field.C -}++div :: (Field.C a, ZeroTestable.C a) => T a -> T a -> T a+div (Cons xt xs) (Cons yt ys) =+   let (xzero,x) = span isZero xs+       (yzero,y) = span isZero ys+   in  Cons (xt - yt + length xzero - length yzero)+            (PSCore.divide x y)++instance (Field.C a, ZeroTestable.C a) => Field.C (T a) where+   (/) = div++divExample :: T NP.Rational+divExample = div (Cons 1 [0,0,1,2,1]) (Cons 1 [0,0,0,1,1])+++++{- * Comparisons -}++{- |+Two polynomials may be stored differently.+This function checks whether two values of type @LaurentPolynomial@+actually represent the same polynomial.+-}+equivalent :: (Eq a, ZeroTestable.C a) => T a -> T a -> Bool+equivalent xs ys =+   let (Cons xt x, Cons yt y) =+          if expon xs <= expon ys+            then (xs,ys)+            else (ys,xs)+       (xPref, xSuf) = splitAt (yt-xt) x+       aux (a:as) (b:bs) = a == b && aux as bs+       aux []     bs     = all isZero bs+       aux as     []     = all isZero as+   in  all isZero xPref  &&  aux xSuf y++instance (Eq a, ZeroTestable.C a) => Eq (T a) where+   (==) = equivalent+++identical :: (Eq a) => T a -> T a -> Bool+identical (Cons xt xs) (Cons yt ys) =+   xt==yt && xs == ys+++{- |+Check whether a Laurent polynomial has only the absolute term,+that is, it represents the constant polynomial.+-}+isAbsolute :: (ZeroTestable.C a) => T a -> Bool+isAbsolute (Cons xt x) =+   and (zipWith (\i xi -> isZero xi || i==0) [xt..] x)++++{- * Transformations of arguments -}++{- | p(z) -> p(-z) -}+alternate :: Additive.C a => T a -> T a+alternate (Cons xt x) =+   Cons xt (zipWith id (drop (mod xt 2) (cycle [id,NP.negate])) x)++{- | p(z) -> p(1\/z) -}+reverse :: T a -> T a+reverse (Cons xt x) =+   Cons (1 - xt - length x) (List.reverse x)++{- |+p(exp(i·x)) -> conjugate(p(exp(i·x)))++If you interpret @(p*)@ as a linear operator on the space of Laurent polynomials,+then @(adjoint p *)@ is the adjoint operator.+-}+adjoint :: Additive.C a => T (Complex.T a) -> T (Complex.T a)+adjoint x =+   let (Cons yt y) = reverse x+   in  (Cons yt (map Complex.conjugate y))

+ src-ghc-6.12/MathObj/Matrix.hs view

@@ -0,0 +1,278 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{- |+Copyright    :   (c) Henning Thielemann 2009, Mikael Johansson 2006+Maintainer   :   numericprelude@henning-thielemann.de+Stability    :   provisional+Portability  :   requires multi-parameter type classes++Routines and abstractions for Matrices and+basic linear algebra over fields or rings.++We stick to simple Int indices.+Although advanced indices would be nice+e.g. for matrices with sub-matrices,+this is not easily implemented since arrays+do only support a lower and an upper bound+but no additional parameters.++ToDo:+ - Matrix inverse, determinant+-}++module MathObj.Matrix (+   T, Dimension,+   format,+   transpose,+   rows,+   columns,+   index,+   fromRows,+   fromColumns,+   fromList,+   dimension,+   numRows,+   numColumns,+   zipWith,+   zero,+   one,+   diagonal,+   scale,+   random,+   randomR,+   ) where++import qualified Algebra.Module   as Module+import qualified Algebra.Vector   as Vector+import qualified Algebra.Ring     as Ring+import qualified Algebra.Additive as Additive++import Algebra.Module((*>), )+import Algebra.Ring((*), fromInteger, scalarProduct, )+import Algebra.Additive((+), (-), subtract, )++import qualified System.Random as Rnd+import Data.Array (Array, array, listArray, accumArray, elems, bounds, (!), ixmap, range, )+import qualified Data.List as List++import Control.Monad (liftM2, )+import Control.Exception (assert, )++import Data.Function.HT (powerAssociative, )+import Data.Tuple.HT (swap, mapFst, )+import Data.List.HT (outerProduct, )+import Text.Show.HT (concatS, )++import NumericPrelude.Numeric (Int, )+import NumericPrelude.Base hiding (zipWith, )+++{- |+A matrix is a twodimensional array, indexed by integers.+-}+data T a =+   Cons (Array (Dimension, Dimension) a)+      deriving (Eq,Ord,Read)++type Dimension = Int++{- |+Transposition of matrices is just transposition in the sense of Data.List.+-}+transpose :: T a -> T a+transpose (Cons m) =+   let (lower,upper) = bounds m+   in  Cons (ixmap (swap lower, swap upper) swap m)++rows :: T a -> [[a]]+rows mM@(Cons m) =+   let ((lr,lc), (ur,uc)) = bounds m+   in  outerProduct (index mM) (range (lr,ur)) (range (lc,uc))++columns :: T a -> [[a]]+columns mM@(Cons m) =+   let ((lr,lc), (ur,uc)) = bounds m+   in  outerProduct (flip (index mM)) (range (lc,uc)) (range (lr,ur))++index :: T a -> Dimension -> Dimension -> a+index (Cons m) i j = m ! (i,j)++fromRows :: Dimension -> Dimension -> [[a]] -> T a+fromRows m n =+   Cons .+   array (indexBounds m n) .+   concat .+   List.zipWith (\r -> map (\(c,x) -> ((r,c),x))) allIndices .+   map (zip allIndices)++fromColumns :: Dimension -> Dimension -> [[a]] -> T a+fromColumns m n =+   Cons .+   array (indexBounds m n) .+   concat .+   List.zipWith (\r -> map (\(c,x) -> ((c,r),x))) allIndices .+   map (zip allIndices)++fromList :: Dimension -> Dimension -> [a] -> T a+fromList m n xs = Cons (listArray (indexBounds m n) xs)++appPrec :: Int+appPrec = 10++instance (Show a) => Show (T a) where+   showsPrec p m =+      showParen (p >= appPrec)+         (showString "Matrix.fromRows " . showsPrec appPrec (rows m))++format :: (Show a) => T a -> String+format m = formatS m ""++formatS :: (Show a) => T a -> ShowS+formatS =+   concatS .+   map (\r -> showString "(" . concatS r . showString ")\n") .+   map (List.intersperse (' ':) . map (showsPrec 11)) .+   rows++dimension :: T a -> (Dimension,Dimension)+dimension (Cons m) = uncurry subtract (bounds m) + (1,1)++numRows :: T a -> Dimension+numRows = fst . dimension++numColumns :: T a -> Dimension+numColumns = snd . dimension++-- These implementations may benefit from a better exception than+-- just assertions to validate dimensionalities+instance (Additive.C a) => Additive.C (T a) where+   (+) = zipWith (+)+   (-) = zipWith (-)+   zero = zero 1 1++zipWith :: (a -> b -> c) -> T a -> T b -> T c+zipWith op mM@(Cons m) nM@(Cons n) =+   let d = dimension mM+       em = elems m+       en = elems n+   in  assert (d == dimension nM) $+         uncurry fromList d (List.zipWith op em en)++zero :: (Additive.C a) => Dimension -> Dimension -> T a+zero m n =+   fromList m n $+   List.repeat Additive.zero+--    List.replicate (fromInteger (m*n)) zero++one :: (Ring.C a) => Dimension -> T a+one n =+   Cons $+   accumArray (flip const) Additive.zero+      (indexBounds n n)+      (map (\i -> ((i,i), Ring.one)) (indexRange n))++diagonal :: (Additive.C a) => [a] -> T a+diagonal xs =+   let n = List.length xs+   in  Cons $+       accumArray (flip const) Additive.zero+          (indexBounds n n)+          (zip (map (\i -> (i,i)) allIndices) xs)++scale :: (Ring.C a) => a -> T a -> T a+scale s = Vector.functorScale s++instance (Ring.C a) => Ring.C (T a) where+   mM * nM =+      assert (numColumns mM == numRows nM) $+      fromList (numRows mM) (numColumns nM) $+      liftM2 scalarProduct (rows mM) (columns nM)+   fromInteger n = fromList 1 1 [fromInteger n]+   mM ^ n =+      assert (numColumns mM == numRows mM) $+      assert (n >= Additive.zero) $+      powerAssociative (*) (one (numColumns mM)) mM n++instance Functor T where+   fmap f (Cons m) = Cons (fmap f m)++instance Vector.C T where+   zero  = Additive.zero+   (<+>) = (+)+   (*>)  = scale++instance Module.C a b => Module.C a (T b) where+   x *> m = fmap (x*>) m+++random :: (Rnd.RandomGen g, Rnd.Random a) =>+   Dimension -> Dimension -> g -> (T a, g)+random =+   randomAux Rnd.random++randomR :: (Rnd.RandomGen g, Rnd.Random a) =>+   Dimension -> Dimension -> (a,a) -> g -> (T a, g)+randomR m n rng =+   randomAux (Rnd.randomR rng) m n++{-+could be made nicer with the State monad,+but I like to keep dependencies minimal+-}+randomAux :: (Rnd.RandomGen g, Rnd.Random a) =>+   (g -> (a,g)) -> Dimension -> Dimension -> g -> (T a, g)+randomAux rnd m n g0 =+   mapFst (fromList m n) $ swap $+   List.mapAccumL (\g _i -> swap $ rnd g) g0 (indexRange (m*n))++{-+What more do we need from our matrix type? We have addition,+subtraction and multiplication, and thus composition of generic+free-module-maps. We're going to want to solve linear equations with+or without fields underneath, so we're going to want an implementation+of the Gaussian algorithm as well as most probably Smith normal+form. Determinants are cool, and these are to be calculated either+with the Gaussian algorithm or some other goodish method.+-}++{-+{- |+ We'll want generic linear equation solving, returning one solution,+any solution really, or nothing. Basically, this is asking for the+preimage of a given vector over the given map, so++a_11 x_1 + .. + a_1n x_n = y_1+ ...+a_m1 x_1 + .. + a_mn a_n = y_m++has really x_1,...,x_n as a preimage of the vector y_1,..,y_m under+the map (a_ij), since obviously y_1,..,y_m = (a_ij) x_1,..,x_n++So, generic linear equation solving boils down to the function+-}+preimage :: (Ring.C a) => T a -> T a -> Maybe (T a)+preimage a y = assert+        (numRows a == numRows y &&     -- they match+         numColumns y == 1)               -- and y is a column vector+                Nothing+-}++{-+Cf. /usr/lib/hugs/demos/Matrix.hs+-}+++-- these functions control whether we use 0 or 1 based indices++indexRange :: Dimension -> [Dimension]+indexRange n = [0..(n-1)]++indexBounds ::+   Dimension -> Dimension ->+   ((Dimension,Dimension), (Dimension,Dimension))+indexBounds m n =+   ((0,0), (m-1,n-1))++allIndices :: [Dimension]+allIndices = [0..]

+ src-ghc-6.12/MathObj/Monoid.hs view

@@ -0,0 +1,56 @@+{-# LANGUAGE NoImplicitPrelude #-}+module MathObj.Monoid where++import qualified Algebra.PrincipalIdealDomain as PID++import Algebra.PrincipalIdealDomain (gcd, lcm, )+import Algebra.Additive (zero, )+import Algebra.Monoid (C, idt, (<*>), )++import NumericPrelude.Base++{- |+It is only a monoid for non-negative numbers.++> idt <*> GCD (-2) = GCD 2++Thus, use this Monoid only for non-negative numbers!+-}+newtype GCD a = GCD {runGCD :: a}+   deriving (Show, Eq)++instance PID.C a => C (GCD a) where+   idt = GCD zero+   (GCD x) <*> (GCD y) = GCD (gcd x y)+++newtype LCM a = LCM {runLCM :: a}+   deriving (Show, Eq)++instance PID.C a => C (LCM a) where+   idt = LCM zero+   (LCM x) <*> (LCM y) = LCM (lcm x y)+++{- |+@Nothing@ is the largest element.+-}+newtype Min a = Min {runMin :: Maybe a}+   deriving (Show, Eq)++instance Ord a => C (Min a) where+   idt = Min Nothing+   (Min x) <*> (Min y) = Min $+      maybe y (\x' -> maybe x (Just . min x') y) x+++{- |+@Nothing@ is the smallest element.+-}+newtype Max a = Max {runMax :: Maybe a}+   deriving (Show, Eq)++instance Ord a => C (Max a) where+   idt = Max Nothing+   (Max x) <*> (Max y) = Max $+      maybe y (\x' -> maybe x (Just . max x') y) x

+ src-ghc-6.12/MathObj/PartialFraction.hs view

@@ -0,0 +1,399 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+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 as List++import Data.Map(Map)+import qualified Data.Map as Map+import Data.Maybe(fromMaybe, )+import qualified Data.List.Match as Match+import Data.List.HT (dropWhileRev, )+import Data.List (group, sortBy, mapAccumR, )++import NumericPrelude.Base hiding (zipWith)++import NumericPrelude.Numeric(Int, fromInteger)++++{- |+@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 (Eq)++{- |+Unchecked construction.+-}+fromFractionSum :: (Indexable.C a) => a -> [(a,[a])] -> T a+fromFractionSum z m =+   Cons z (indexMapFromList m)++toFractionSum :: (Indexable.C a) => T a -> (a, [(a,[a])])+toFractionSum (Cons z m) =+   (z, indexMapToList m)++appPrec :: Int+appPrec  = 10++instance (Show a) => Show (T a) where+  showsPrec p (Cons z m) =+    showParen (p >= appPrec)+       (showString "PartialFraction.fromFractionSum " .+        showsPrec (succ appPrec) z . showString " " .+        shows (indexMapToList m))+++toFraction :: PID.C a => T a -> Ratio.T a+toFraction (Cons z m) =+   let fracs = map (uncurry multiToFraction) (indexMapToList m)+   in  foldl (+) (Ratio.fromValue z) fracs++{- |+'PrincipalIdealDomain.C' is not really necessary here and+only due to invokation of 'toFraction'.+-}+toFactoredFraction :: (PID.C a) => T a -> ([a], a)+toFactoredFraction x@(Cons _ m) =+   let r = toFraction x+       denoms = concat $ Map.elems $ indexMapMapWithKey (flip Match.replicate) m+       numer = foldl (flip Ratio.scale) r 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  (denoms, Ratio.numerator 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 denom =+   foldr (\numer acc ->+            (Ratio.fromValue numer + acc) / Ratio.fromValue denom) zero++hornerRev :: Ring.C a => a -> [a] -> a+hornerRev x = foldl (\val c -> val*x+c) 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.+-}+fromFactoredFraction :: (PID.C a, Indexable.C a) => [a] -> a -> T a+fromFactoredFraction denoms0 numer0 =+   let denoms = group $ sortBy Indexable.compare $ map stdAssociate denoms0+       numer  = foldl (*) numer0 $ map stdUnitInv denoms0+       denomPowers = map product denoms+          {- since the sub-lists contain the same value,+             the products are powers,+             which could be computed more efficiently -}+       partProdLeft         = scanl (*) one denomPowers+       (prod:partProdRight) = scanr (*) one denomPowers+       (intPart,numerRed) = divMod numer prod+       facs = List.zipWith (*) partProdLeft partProdRight+       numers =+          fromMaybe+             (error $ "PartialFraction.fromFactoredFraction: " +++                      "denominators must be relatively prime")+             (PID.diophantineMulti numerRed facs)+       pairs = List.zipWith multiFromFraction denoms numers+       -- Is reduceHeads also necessary for polynomial partial fractions?+   in  removeZeros $ reduceHeads $ Cons intPart (indexMapFromList pairs)++fromFactoredFractionAlt :: (PID.C a, Indexable.C a) => [a] -> a -> T a+fromFactoredFractionAlt denoms numer =+   foldl (\p d -> scaleFrac (one%d) p) (fromValue numer) denoms++{- |+The list of denominators must contain equal elements.+Sorry for this hack.+-}+multiFromFraction :: PID.C a => [a] -> a -> (a,[a])+multiFromFraction (d:ds) n =+   (d, reverse $ decomposeVarPositionalInf ds n)+multiFromFraction [] _ =+   error "PartialFraction.multiFromFraction: there must be one denominator"++fromValue :: a -> T a+fromValue x = Cons x 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 (Cons z m0) =+   let m1 = indexMapMapWithKey (\x (y:ys) -> let (q,r) = divMod y x in (q,r:ys)) m0+   in  Cons+          (foldl (+) z (map fst $ Map.elems m1))+          (fmap snd m1)++{- |+Cf. Number.Positional+-}+carryRipple :: Integral.C a => a -> [a] -> (a,[a])+carryRipple b =+   mapAccumR (\carry y -> divMod (y+carry) b) 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 (Cons z0 m0) =+   let m1 = indexMapMapWithKey carryRipple m0+       -- would be nice to have a Map.unzip function+       ints = Map.elems $ fmap fst m1+   in  Cons (foldl (+) z0 ints) (fmap snd 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 (Cons z m) =+   Cons z $+   Map.filter (not . null) $+   Map.map (dropWhileRev isZero) 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 opS opV (Cons za ma) (Cons zb mb) =+   Cons (opS za zb) (Map.unionWith opV ma mb)++instance (Indexable.C a, Integral.C a, ZeroTestable.C a) => Additive.C (T a) where+   a + b = removeZeros $ normalizeModulo $ zipWith (+) (+) 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 (Cons z m) = Cons (negate z) (fmap negate m)+   zero = fromValue 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 x y =+   let dx = Ratio.denominator x+       dy = Ratio.denominator y+   in  fromMaybe+          (error "PartialFraction.mulFrac: denominators must be relatively prime")+          (PID.diophantine (Ratio.numerator x * Ratio.numerator y) dy 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' x y =+   let (na,nb) = mulFrac x y+   in  (na % Ratio.denominator x, nb % Ratio.denominator 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 x y =+   let dx = Ratio.denominator x+       dy = Ratio.denominator y+       [a,b,c] =+          fromMaybe+             (error "PartialFraction.mulFracOverlap: (gcd 1 x) must always be a unit")+             (PID.diophantineMulti+                 (Ratio.numerator x * Ratio.numerator y) [dy, dx, one])+   in  ((a % dx, b % dy), c%(dx*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 x y =+   let dx = Ratio.denominator x+       dy = Ratio.denominator y+       nx = Ratio.numerator x+       ny = Ratio.numerator y+       (g,(a,b)) = PID.extendedGCD dy dx+       (q,r) = divModZero (nx*ny) g+   in  (((q*a)%dx, (q*b)%dy), r%(dx*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 s (Cons z0 m) =+   let ns = Ratio.numerator s+       ds = Ratio.denominator s+       dsOrd = Indexable.toOrd ds+       -- (z,zr) = Ratio.split (Ratio.scale z0 s)+       (z,zr) = divMod (z0*ns) ds+       scaleFracs =+          (\(scs,fracs) ->+             Map.insert dsOrd [foldl (+) zr scs] $+                indexMapFromList $+                   map (uncurry multiFromFraction) fracs) .+          unzip .+          map (\(dis,r) ->+                 let (sc,rc) = mulFrac s r+                 in  (sc, (dis, rc))) .+          Map.elems .+          indexMapMapWithKey+             (\d l -> (Match.replicate l d, multiToFraction d l))+   in  removeZeros $ reduceHeads $ Cons z+          (mapApplySplit dsOrd (+)+             (uncurry (:) . carryRipple ds . map (ns*))+             scaleFracs m)++scaleInt :: (PID.C a, Indexable.C a) => a -> T a -> T a+scaleInt x (Cons z m) =+   removeZeros $ normalizeModulo $+      Cons (x*z) (Map.map (map (x*)) m)+++mul :: (PID.C a, Indexable.C a) => T a -> T a -> T a+mul (Cons z m) a =+   foldl+      (+) (scaleInt z a)+      (map (\(d,l) ->+              -- cf. to multiToFraction+              foldr (\numer acc ->+                 scaleFrac (one%d) (scaleInt numer a + acc)) zero l)+           (indexMapToList m))++mulFast :: (PID.C a, Indexable.C a) => T a -> T a -> T a+mulFast pa pb =+   let ra = toFactoredFraction pa+       rb = toFactoredFraction pb+   in  fromFactoredFraction (fst ra ++ fst rb) (snd ra * snd rb)+++instance (PID.C a, Indexable.C a) => Ring.C (T a) where+   one = fromValue one+   (*) = 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 f = Map.mapWithKey (f . Indexable.fromOrd)++indexMapToList :: Map (Indexable.ToOrd a) b -> [(a, b)]+indexMapToList = map (\(k,e) -> (Indexable.fromOrd k, e)) . Map.toList++indexMapFromList :: Indexable.C a => [(a, b)] -> Map (Indexable.ToOrd a) b+indexMapFromList = Map.fromList . map (\(k,e) -> (Indexable.toOrd k, 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 key addOp f g m =+   maybe+      (g m)+      (\x -> Map.insertWith addOp key (f x) $ g (Map.delete key m))+      (Map.lookup key m)+

+ src-ghc-6.12/MathObj/Permutation.hs view

@@ -0,0 +1,32 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Copyright    :   (c) Henning Thielemann 2006+Maintainer   :   numericprelude@henning-thielemann.de+Stability    :   provisional+Portability  :++Routines and abstractions for permutations of Integers.++***+Seems to be a candidate for Algebra directory.+Algebra.PermutationGroup ?+-}++module MathObj.Permutation where++import Data.Array(Ix)++-- import NumericPrelude.Numeric (Integer)+-- import NumericPrelude.Base+++{- |+There are quite a few way we could represent elements of permutation+groups: the images in a row, a list of the cycles, et.c. All of these+differ highly in how complex various operations end up being.+-}++class C p where+   domain  :: (Ix i) => p i -> (i, i)+   apply   :: (Ix i) => p i -> i -> i+   inverse :: (Ix i) => p i -> p i

+ src-ghc-6.12/MathObj/Permutation/CycleList.hs view

@@ -0,0 +1,103 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Copyright    :   (c) Mikael Johansson 2006+Maintainer   :   mik@math.uni-jena.de+Stability    :   provisional+Portability  :   requires multi-parameter type classes++Permutation of Integers represented by cycles.+-}++module MathObj.Permutation.CycleList where++import Data.Set(Set)+import qualified Data.Set as Set++import Data.List (unfoldr)+import Data.Array(Ix)+import qualified Data.Array as Array++import qualified Data.List.Match as Match+import Data.Maybe.HT (toMaybe)+import NumericPrelude.Numeric (fromInteger)+import NumericPrelude.Base+++type Cycle i = [i]+type T i = [Cycle i]++++fromFunction :: (Ix i) =>+   (i, i) -> (i -> i) -> T i+fromFunction rng f =+   let extractCycle available =+          do el <- choose available+             let orb = orbit f el+             return (orb, Set.difference available (Set.fromList orb))+       cycles = unfoldr extractCycle (Set.fromList (Array.range rng))+   in  keepEssentials cycles++++-- right action of a cycle+cycleRightAction :: (Eq i) => i -> Cycle i -> i+x `cycleRightAction` c = cycleAction c x++-- left action of a cycle+cycleLeftAction :: (Eq i) => Cycle i -> i -> i+c `cycleLeftAction` x = cycleAction (reverse c) x++cycleAction :: (Eq i) => [i] -> i -> i+cycleAction cyc x =+   case dropWhile (x/=) (cyc ++ [head cyc]) of+      _:y:_ -> y+      _ -> x+++cycleOrbit :: (Ord i) => Cycle i -> i -> [i]+cycleOrbit cyc = orbit (flip cycleRightAction cyc)++{- |+Right (left?) group action on the Integers.+Close to, but not the same as the module action in Algebra.Module.+-}+(*>) :: (Eq i) => T i -> i -> i+p *> x = foldr (flip cycleRightAction) x p++cyclesOrbit ::(Ord i) => T i -> i -> [i]+cyclesOrbit p = orbit (p *>)++orbit :: (Ord i) => (i -> i) -> i -> [i]+orbit op x0 = takeUntilRepetition (iterate op x0)++-- | candidates for Utility ?+takeUntilRepetition :: Ord a => [a] -> [a]+takeUntilRepetition xs =+   let accs = scanl (flip Set.insert) Set.empty xs+       lenlist = takeWhile not (zipWith Set.member xs accs)+   in  Match.take lenlist xs++takeUntilRepetitionSlow :: Eq a => [a] -> [a]+takeUntilRepetitionSlow xs =+   let accs = scanl (flip (:)) [] xs+       lenlist = takeWhile not (zipWith elem xs accs)+   in  Match.take lenlist xs+++{-+Alternative to Data.Set.minView in GHC-6.6.+-}+choose :: Set a -> Maybe a+choose set =+   toMaybe (not (Set.null set)) (Set.findMin set)++keepEssentials :: T i -> T i+keepEssentials = filter isEssential++-- is more lazy than (length cyc > 1)+isEssential :: Cycle i -> Bool+isEssential = not . null . drop 1++inverse :: T i -> T i+inverse = map reverse

+ src-ghc-6.12/MathObj/Permutation/CycleList/Check.hs view

@@ -0,0 +1,125 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Copyright    :   (c) Henning Thielemann 2006+Maintainer   :   numericprelude@henning-thielemann.de+Stability    :   provisional+Portability  :   requires multi-parameter type classes+-}++module MathObj.Permutation.CycleList.Check where++import qualified MathObj.Permutation.CycleList as PermCycle+import qualified MathObj.Permutation.Table     as PermTable+import qualified MathObj.Permutation           as Perm++{-+import qualified Algebra.Ring as Ring+import qualified Algebra.Additive as Additive+import Algebra.Ring((*),one,fromInteger)+import Algebra.Additive((+))+-}+import Algebra.Monoid((<*>))+import qualified Algebra.Monoid as Monoid++import Data.Array((!), Ix)+import qualified Data.Array as Array++-- import NumericPrelude.Numeric (Integer)+import NumericPrelude.Base hiding (cycle)++{- |+We shall make a little bit of a hack here, enabling us to use additive+or multiplicative syntax for groups as we wish by simply instantiating+Num with both operations corresponding to the group operation of the+permutation group we're studying+-}++{- |+There are quite a few way we could represent elements of permutation+groups: the images in a row, a list of the cycles, et.c. All of these+differ highly in how complex various operations end up being.+-}++newtype Cycle i = Cycle { cycle :: [i] } deriving (Read,Eq)+data T i = Cons { range :: (i, i), cycles :: [Cycle i] }++{- |+Does not check whether the input values are in range.+-}+fromCycles :: (i, i) -> [[i]] -> T i+fromCycles rng = Cons rng . map Cycle++toCycles :: T i -> [[i]]+toCycles = map cycle . cycles++toTable :: (Ix i) => T i -> PermTable.T i+toTable x = PermTable.fromCycles (range x) (toCycles x)++fromTable :: (Ix i) => PermTable.T i -> T i+fromTable x =+   let rng = Array.bounds x+   in  fromCycles rng (PermCycle.fromFunction rng (x!))+++errIncompat :: a+errIncompat = error "Permutation.CycleList: Incompatible domains"++liftCmpTable2 :: (Ix i) =>+   (PermTable.T i -> PermTable.T i -> a) -> T i -> T i -> a+liftCmpTable2 f x y =+   if range x == range y+     then f (toTable x) (toTable y)+     else errIncompat++liftTable2 :: (Ix i) =>+   (PermTable.T i -> PermTable.T i -> PermTable.T i) -> T i -> T i -> T i+liftTable2 f x y = fromTable (liftCmpTable2 f x y)+++closure :: (Ix i) => [T i] -> [T i]+closure = map fromTable . PermTable.closure . map toTable+++instance Perm.C T where+   domain    = range+   apply   p = ((toCycles p) PermCycle.*>)+   inverse p = fromCycles (range p) (PermCycle.inverse (toCycles p))++instance Show i => Show (Cycle i) where+   show c = "(" +++           (unwords $+            map show $+            cycle c) ++ ")"++instance Show i => Show (T i) where+   show p =+      case cycles p of+         []  -> "Id"+         cyc -> concatMap show cyc+++{- |+These instances may need more work+They involve converting a permutation to a table.+-}+instance Ix i => Eq (T i) where+   (==)  =  liftCmpTable2 (==)++instance Ix i => Ord (T i) where+   compare  =  liftCmpTable2 compare++{- Better: Group class and instances+instance Additive.C (T i) where+   p + q = p * q+   negate = inverse+   zero = one++instance Ring.C (T i) where+   (Cons op cp) * (Cons oq cq) = reduceCycles $+           Cons (max op oq) (cp ++ cq)+   one = Cons 1 []+-}++instance Ix i => Monoid.C (T i) where+   (<*>) = liftTable2 PermTable.compose+   idt   = error "There is no generic unit element"

+ src-ghc-6.12/MathObj/Permutation/Table.hs view

@@ -0,0 +1,113 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Copyright    :   (c) Henning Thielemann 2006+Maintainer   :   numericprelude@henning-thielemann.de+Stability    :   provisional+Portability  :++Permutation represented by an array of the images.+-}++module MathObj.Permutation.Table where++import qualified MathObj.Permutation as Perm++import Data.Set(Set)+import qualified Data.Set as Set++import Data.Array(Array,(!),(//),Ix)+import qualified Data.Array as Array++import Data.List ((\\), nub, unfoldr, )++import Data.Tuple.HT (swap, )+import Data.Maybe.HT (toMaybe, )++-- import NumericPrelude.Numeric (Integer)+import NumericPrelude.Base hiding (cycle)+++type T i = Array i i+++fromFunction :: (Ix i) =>+   (i, i) -> (i -> i) -> T i+fromFunction rng f =+   Array.listArray rng (map f (Array.range rng))++toFunction :: (Ix i) => T i -> (i -> i)+toFunction = (!)++{-+Create a permutation in table form+from any other permutation representation.+-}+fromPermutation :: (Ix i, Perm.C p) => p i -> T i+fromPermutation x =+   let rng = Perm.domain x+   in  Array.listArray rng (map (Perm.apply x) (Array.range rng))++fromCycles :: (Ix i) => (i, i) -> [[i]] -> T i+fromCycles rng = foldl (flip cycle) (identity rng)+++identity :: (Ix i) => (i, i) -> T i+identity rng = Array.listArray rng (Array.range rng)++cycle :: (Ix i) => [i] -> T i -> T i+cycle cyc p =+   p // zipWith (\i j -> (j,p!i)) cyc (tail (cyc++cyc))++inverse :: (Ix i) => T i -> T i+inverse p =+   let rng = Array.bounds p+   in  Array.array rng (map swap (Array.assocs p))++compose :: (Ix i) => T i -> T i -> T i+compose p q =+   let pRng = Array.bounds p+       qRng = Array.bounds q+   in  if pRng==qRng+         then fmap (p!) q+         else error "compose: ranges differ"+--                     ++ show pRng ++ " /= " ++ show qRng)+++{- |+Extremely naïve algorithm+to generate a list of all elements in a group.+Should be replaced by a Schreier-Sims system+if this code is ever used for anything bigger than .. say ..+groups of order 512 or so.+-}+{-+Alternative to Data.Set.minView in GHC-6.6.+-}+choose :: Set a -> Maybe (a, Set a)+choose set =+   toMaybe (not (Set.null set)) (Set.deleteFindMin set)++closure :: (Ix i) => [T i] -> [T i]+closure [] = []+closure generators@(gen:_) =+   let genSet = Set.fromList generators+       idSet  = Set.singleton (identity (Array.bounds gen))+       generate (registered, candidates) =+          do (cand, remCands) <- choose candidates+             let newCands =+                    flip Set.difference registered $+                    Set.map (compose cand) genSet+             return (cand, (Set.union registered newCands,+                            Set.union remCands newCands))+   in  unfoldr generate (idSet, idSet)++closureSlow :: (Ix i) => [T i] -> [T i]+closureSlow [] = []+closureSlow generators@(gen:_) =+   let addElts grp [] = grp+       addElts grp cands@(cand:remCands) =+          let group'   = grp ++ [cand]+              newCands = map (compose cand) generators+              cands'   = nub (remCands ++ newCands) \\ (grp ++ cands)+          in  addElts group' cands'+   in  addElts [] [identity (Array.bounds gen)]

+ src-ghc-6.12/MathObj/Polynomial.hs view

@@ -0,0 +1,309 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}++{- |+Polynomials and rational functions in a single indeterminate.+Polynomials are represented by a list of coefficients.+All non-zero coefficients are listed, but there may be extra '0's at the end.++Usage:+Say you have the ring of 'Integer' numbers+and you want to add a transcendental element @x@,+that is an element, which does not allow for simplifications.+More precisely, for all positive integer exponents @n@+the power @x^n@ cannot be rewritten as a sum of powers with smaller exponents.+The element @x@ must be represented by the polynomial @[0,1]@.++In principle, you can have more than one transcendental element+by using polynomials whose coefficients are polynomials as well.+However, most algorithms on multi-variate polynomials+prefer a different (sparse) representation,+where the ordering of elements is not so fixed.++If you want division, you need "Number.Ratio"s+of polynomials with coefficients from a "Algebra.Field".++You can also compute with an algebraic element,+that is an element which satisfies an algebraic equation like+@x^3-x-1==0@.+Actually, powers of @x@ with exponents above @3@ can be simplified,+since it holds @x^3==x+1@.+You can perform these computations with "Number.ResidueClass" of polynomials,+where the divisor is the polynomial equation that determines @x@.+If the polynomial is irreducible+(in our case @x^3-x-1@ cannot be written as a non-trivial product)+then the residue classes also allow unrestricted division+(except by zero, of course).+That is, using residue classes of polynomials+you can work with roots of polynomial equations+without representing them by radicals+(powers with fractional exponents).+It is well-known, that roots of polynomials of degree above 4+may not be representable by radicals.+-}++module MathObj.Polynomial+   (T, fromCoeffs, coeffs, degree,+    showsExpressionPrec, const,+    evaluate, evaluateCoeffVector, evaluateArgVector,+    collinear,+    integrate,+    compose, fromRoots, reverse,+    translate, dilate, shrink, )+where++import qualified MathObj.Polynomial.Core as Core++import qualified Algebra.Differential         as Differential+import qualified Algebra.VectorSpace          as VectorSpace+import qualified Algebra.Module               as Module+import qualified Algebra.Vector               as Vector+import qualified Algebra.Field                as Field+import qualified Algebra.PrincipalIdealDomain as PID+import qualified Algebra.Units                as Units+import qualified Algebra.IntegralDomain       as Integral+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 Algebra.Module((*>))+import Algebra.ZeroTestable(isZero)++import Control.Monad (liftM, )+import qualified Data.List as List++import Test.QuickCheck (Arbitrary(arbitrary))++import NumericPrelude.Base    hiding (const, reverse, )+import NumericPrelude.Numeric++import qualified Prelude as P98+++newtype T a = Cons {coeffs :: [a]}+++{-# INLINE fromCoeffs #-}+fromCoeffs :: [a] -> T a+fromCoeffs = lift0++{-# INLINE lift0 #-}+lift0 :: [a] -> T a+lift0 = Cons++{-# INLINE lift1 #-}+lift1 :: ([a] -> [a]) -> (T a -> T a)+lift1 f (Cons x0) = Cons (f x0)++{-# INLINE lift2 #-}+lift2 :: ([a] -> [a] -> [a]) -> (T a -> T a -> T a)+lift2 f (Cons x0) (Cons x1) = Cons (f x0 x1)++degree :: (ZeroTestable.C a) => T a -> Maybe Int+degree x =+   case Core.normalize (coeffs x) of+      [] -> Nothing+      (_:xs) -> Just $ length xs++{-+Functor instance is e.g. useful for showing polynomials in residue rings.+@fmap (ResidueClass.concrete 7) (polynomial [1,4,4::ResidueClass.T Integer] * polynomial [1,5,6])@+-}++instance Functor T where+   fmap f (Cons xs) = Cons (map f xs)++{-# INLINE plusPrec #-}+{-# INLINE appPrec #-}+plusPrec, appPrec :: Int+plusPrec = 6+appPrec  = 10++instance (Show a) => Show (T a) where+   showsPrec p (Cons xs) =+      showParen (p >= appPrec) (showString "Polynomial.fromCoeffs " . shows xs)++{-# INLINE showsExpressionPrec #-}+showsExpressionPrec :: (Show a, ZeroTestable.C a, Additive.C a) =>+   Int -> String -> T a -> String -> String+showsExpressionPrec p var poly =+    if isZero poly+      then showString "0"+      else+        let terms = filter (not . isZero . fst)+                       (zip (coeffs poly) monomials)+            monomials = id :+                        showString "*" . showString var :+                        map (\k -> showString "*" . showString var+                                 . showString "^" . shows k)+                            [(2::Int)..]+            showsTerm x showsMon = showsPrec (plusPrec+1) x . showsMon+        in showParen (p > plusPrec)+           (foldl (.) id $ List.intersperse (showString " + ") $+            map (uncurry showsTerm) terms)+++{-# INLINE evaluate #-}+evaluate :: Ring.C a => T a -> a -> a+evaluate (Cons y) x = Core.horner x y++{- |+Here the coefficients are vectors,+for example the coefficients are real and the coefficents are real vectors.+-}+{-# INLINE evaluateCoeffVector #-}+evaluateCoeffVector :: Module.C a v => T v -> a -> v+evaluateCoeffVector (Cons y) x = Core.hornerCoeffVector x y++{- |+Here the argument is a vector,+for example the coefficients are complex numbers or square matrices+and the coefficents are reals.+-}+{-# INLINE evaluateArgVector #-}+evaluateArgVector :: (Module.C a v, Ring.C v) => T a -> v -> v+evaluateArgVector (Cons y) x = Core.hornerArgVector x y++{- |+'compose' is the functional composition of polynomials.++It fulfills+  @ eval x . eval y == eval (compose x y) @+-}++-- compose :: Module.C a b => T b -> T a -> T a+-- compose (Cons x) y = Core.horner y (map const x)+{-# INLINE compose #-}+compose :: (Ring.C a) => T a -> T a -> T a+compose (Cons x) y = Core.horner y (map const x)++{-# INLINE const #-}+const :: a -> T a+const x = lift0 [x]+++collinear :: (Eq a, Ring.C a) => T a -> T a -> Bool+collinear (Cons x) (Cons y) = Core.collinear x y+++instance (Eq a, ZeroTestable.C a) => Eq (T a) where+   (Cons x) == (Cons y) = Core.equal x y++instance (Indexable.C a, ZeroTestable.C a) => Indexable.C (T a) where+   compare = Indexable.liftCompare coeffs++instance (ZeroTestable.C a) => ZeroTestable.C (T a) where+   isZero (Cons x) = isZero x+++instance (Additive.C a) => Additive.C (T a) where+   (+)    = lift2 Core.add+   (-)    = lift2 Core.sub+   zero   = lift0 []+   negate = lift1 Core.negate+++instance Vector.C T where+   zero  = zero+   (<+>) = (+)+   (*>)  = Vector.functorScale++instance (Module.C a b) => Module.C a (T b) where+   (*>) x = lift1 (x *>)++instance (Field.C a, Module.C a b) => VectorSpace.C a (T b)+++instance (Ring.C a) => Ring.C (T a) where+   one         = const one+   fromInteger = const . fromInteger+   (*)         = lift2 Core.mul+++{- |+The 'Integral.C' instance is intensionally built+from the 'Field.C' structure of the polynomial coefficients.+If we would use @Integral.C a@ superclass,+then the Euclidean algorithm could not determine+the greatest common divisor of e.g. @[1,1]@ and @[2]@.+-}+instance (ZeroTestable.C a, Field.C a) => Integral.C (T a) where+   divMod (Cons x) (Cons y) =+      let (d,m) = Core.divMod x y+      in  (Cons d, Cons m)++instance (ZeroTestable.C a, Field.C a) => Units.C (T a) where+   isUnit (Cons []) = False+   isUnit (Cons (x0:xs)) = not (isZero x0) && all isZero xs+   stdUnit    (Cons x) = const        (Core.stdUnit x)+   stdUnitInv (Cons x) = const (recip (Core.stdUnit x))++{-+Polynomials are a Euclidean domain, so no instance is necessary+(although it might be faster).+-}++instance (ZeroTestable.C a, Field.C a) => PID.C (T a)+++instance (Ring.C a) => Differential.C (T a) where+   differentiate = lift1 Core.differentiate+++{-# INLINE integrate #-}+integrate :: (Field.C a) => a -> T a -> T a+integrate = lift1 . Core.integrate++++{-# INLINE fromRoots #-}+fromRoots :: (Ring.C a) => [a] -> T a+fromRoots = Cons . foldl (flip Core.mulLinearFactor) [one]++{-# INLINE reverse #-}+reverse :: Additive.C a => T a -> T a+reverse = lift1 Core.alternate++translate :: Ring.C a => a -> T a -> T a+translate d =+   lift1 $ foldr (\c p -> [c] + Core.mulLinearFactor d p) []++shrink :: Ring.C a => a -> T a -> T a+shrink k =+   lift1 $ zipWith (*) (iterate (k*) one)++dilate :: Field.C a => a -> T a -> T a+dilate = shrink . Field.recip+++instance (Arbitrary a, ZeroTestable.C a) => Arbitrary (T a) where+   arbitrary = liftM (fromCoeffs . Core.normalize) arbitrary+++{- * legacy instances -}++{- |+It is disputable whether polynomials shall be represented by number literals or not.+An advantage is, that one can write+let x = polynomial [0,1]+in  (x^2+x+1)*(x-1)+However the output looks much different.+-}+{-# INLINE legacyInstance #-}+legacyInstance :: a+legacyInstance =+   error "legacy Ring.C instance for simple input of numeric literals"++instance (Ring.C a, Eq a, Show a, ZeroTestable.C a) => P98.Num (T a) where+   fromInteger = const . fromInteger+   negate = Additive.negate -- for unary minus+   (+)    = legacyInstance+   (*)    = legacyInstance+   abs    = legacyInstance+   signum = legacyInstance++instance (Field.C a, Eq a, Show a, ZeroTestable.C a) => P98.Fractional (T a) where+   fromRational = const . fromRational+   (/) = legacyInstance

+ src-ghc-6.12/MathObj/Polynomial/Core.hs view

@@ -0,0 +1,224 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+This module implements polynomial functions on plain lists.+We use such functions in order to implement methods of other datatypes.++The module organization differs from that of @ResidueClass@:+Here the @Polynomial@ module exports the type+that fits to the NumericPrelude type classes,+whereas in @ResidueClass@ the sub-modules export various flavors of them.+-}+module MathObj.Polynomial.Core (+   horner, hornerCoeffVector, hornerArgVector,+   normalize,+   shift, unShift,+   equal,+   add, sub, negate,+   scale, collinear,+   tensorProduct, tensorProductAlt,+   mul, mulShear, mulShearTranspose,+   divMod, divModRev,+   stdUnit,+   progression, differentiate, integrate, integrateInt,+   mulLinearFactor,+   alternate,+   ) where++import qualified Algebra.Module               as Module+import qualified Algebra.Field                as Field+import qualified Algebra.IntegralDomain       as Integral+import qualified Algebra.Ring                 as Ring+import qualified Algebra.Additive             as Additive+import qualified Algebra.ZeroTestable         as ZeroTestable++import qualified Data.List as List+import NumericPrelude.List (zipWithOverlap, )+import Data.Tuple.HT (mapPair, mapFst, forcePair, )+import Data.List.HT+          (dropWhileRev, switchL, shear, shearTranspose, outerProduct, )++import qualified NumericPrelude.Base as P+import qualified NumericPrelude.Numeric as NP++import NumericPrelude.Base    hiding (const, reverse, )+import NumericPrelude.Numeric hiding (divMod, negate, stdUnit, )+++{- |+Horner's scheme for evaluating a polynomial in a ring.+-}+{-# INLINE horner #-}+horner :: Ring.C a => a -> [a] -> a+horner x = foldr (\c val -> c+x*val) zero++{- |+Horner's scheme for evaluating a polynomial in a module.+-}+{-# INLINE hornerCoeffVector #-}+hornerCoeffVector :: Module.C a v => a -> [v] -> v+hornerCoeffVector x = foldr (\c val -> c+x*>val) zero++{-# INLINE hornerArgVector #-}+hornerArgVector :: (Module.C a v, Ring.C v) => v -> [a] -> v+hornerArgVector x = foldr (\c val -> c*>one+val*x) zero+++{- |+It's also helpful to put a polynomial in canonical form.+'normalize' strips leading coefficients that are zero.+-}+{-# INLINE normalize #-}+normalize :: (ZeroTestable.C a) => [a] -> [a]+normalize = dropWhileRev isZero++{- |+Multiply by the variable, used internally.+-}+{-# INLINE shift #-}+shift :: (Additive.C a) => [a] -> [a]+shift [] = []+shift l  = zero : l++{-# INLINE unShift #-}+unShift :: [a] -> [a]+unShift []     = []+unShift (_:xs) = xs++{-# INLINE equal #-}+equal :: (Eq a, ZeroTestable.C a) => [a] -> [a] -> Bool+equal x y = and (zipWithOverlap isZero isZero (==) x y)+++add, sub :: (Additive.C a) => [a] -> [a] -> [a]+add = (+)+sub = (-)++{-# INLINE negate #-}+negate :: (Additive.C a) => [a] -> [a]+negate = map NP.negate+++{-# INLINE scale #-}+scale :: Ring.C a => a -> [a] -> [a]+scale s = map (s*)+++collinear :: (Eq a, Ring.C a) => [a] -> [a] -> Bool+collinear (x:xs) (y:ys) =+   if x==zero && y==zero+     then collinear xs ys+     else scale x ys == scale y xs+-- here at least one of xs and ys is empty+collinear xs ys =+   all (==zero) xs && all (==zero) ys+++{-# INLINE tensorProduct #-}+tensorProduct :: Ring.C a => [a] -> [a] -> [[a]]+tensorProduct = outerProduct (*)++tensorProductAlt :: Ring.C a => [a] -> [a] -> [[a]]+tensorProductAlt xs ys = map (flip scale ys) xs+++{- |+'mul' is fast if the second argument is a short polynomial,+'MathObj.PowerSeries.**' relies on that fact.+-}++{-# INLINE mul #-}+mul :: Ring.C a => [a] -> [a] -> [a]+{- prevent from generation of many zeros+   if the first operand is the empty list -}+mul [] = P.const []+mul xs = foldr (\y zs -> let (v:vs) = scale y xs in v : add vs zs) []+-- this one fails on infinite lists+--    mul xs = foldr (\y zs -> add (scale y xs) (shift zs)) []++{-# INLINE mulShear #-}+mulShear :: Ring.C a => [a] -> [a] -> [a]+mulShear xs ys = map sum (shear (tensorProduct xs ys))++{-# INLINE mulShearTranspose #-}+mulShearTranspose :: Ring.C a => [a] -> [a] -> [a]+mulShearTranspose xs ys = map sum (shearTranspose (tensorProduct xs ys))+++divMod :: (ZeroTestable.C a, Field.C a) => [a] -> [a] -> ([a], [a])+divMod x y =+   mapPair (List.reverse, List.reverse) $+   divModRev (List.reverse x) (List.reverse y)++{-+snd $ Poly.divMod (repeat (1::Double)) [1,1]+-}+divModRev :: (ZeroTestable.C a, Field.C a) => [a] -> [a] -> ([a], [a])+divModRev x y =+   let (y0:ys) = dropWhile isZero y+       -- the second parameter represents lazily (length x - length y)+       aux xs' =+         forcePair .+         switchL+           ([], xs')+           (P.const $+              let (x0:xs) = xs'+                  q0      = x0/y0+              in  mapFst (q0:) . aux (sub xs (scale q0 ys)))+   in  if isZero y+         then error "MathObj.Polynomial: division by zero"+         else aux x (drop (length y - 1) x)++{-# INLINE stdUnit #-}+stdUnit :: (ZeroTestable.C a, Ring.C a) => [a] -> a+stdUnit x = case normalize x of+    [] -> one+    l  -> last l+++{-# INLINE progression #-}+progression :: Ring.C a => [a]+progression = iterate (one+) one++{-# INLINE differentiate #-}+differentiate :: (Ring.C a) => [a] -> [a]+differentiate = zipWith (*) progression . drop 1++{-# INLINE integrate #-}+integrate :: (Field.C a) => a -> [a] -> [a]+integrate c x = c : zipWith (/) x progression++{- |+Integrates if it is possible to represent the integrated polynomial+in the given ring.+Otherwise undefined coefficients occur.+-}+{-# INLINE integrateInt #-}+integrateInt :: (ZeroTestable.C a, Integral.C a) => a -> [a] -> [a]+integrateInt c x =+   c : zipWith Integral.divChecked x progression+++{-# INLINE mulLinearFactor #-}+mulLinearFactor :: Ring.C a => a -> [a] -> [a]+mulLinearFactor x yt@(y:ys) = Additive.negate (x*y) : yt - scale x ys+mulLinearFactor _ [] = []++{-# INLINE alternate #-}+alternate :: Additive.C a => [a] -> [a]+alternate = zipWith ($) (cycle [id, Additive.negate])+++{-+see htam: Wavelet/DyadicResultant++resultant :: Ring.C a => [a] -> [a] -> [a]+resultant xs ys =++discriminant :: Ring.C a => [a] -> a+discriminant xs =+   let degree = genericLength xs+   in  parityFlip (divChecked (degree*(degree-1)) 2)+                  (resultant xs (differentiate xs))+          `divChecked` last xs+-}+

+ src-ghc-6.12/MathObj/PowerSeries.hs view

@@ -0,0 +1,193 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}++{- |+Power series, either finite or unbounded.+(zipWith does exactly the right thing to make it work almost transparently.)+-}+module MathObj.PowerSeries where++import qualified MathObj.PowerSeries.Core as Core+import qualified MathObj.Polynomial.Core as Poly++import qualified Algebra.Differential   as Differential+import qualified Algebra.IntegralDomain as Integral+import qualified Algebra.VectorSpace    as VectorSpace+import qualified Algebra.Module         as Module+import qualified Algebra.Vector         as Vector+import qualified Algebra.Transcendental as Transcendental+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 Algebra.Module((*>))++import NumericPrelude.Base    hiding (const)+import NumericPrelude.Numeric+++newtype T a = Cons {coeffs :: [a]} deriving (Ord)++{-# INLINE fromCoeffs #-}+fromCoeffs :: [a] -> T a+fromCoeffs = lift0++{-# INLINE lift0 #-}+lift0 :: [a] -> T a+lift0 = Cons++{-# INLINE lift1 #-}+lift1 :: ([a] -> [a]) -> (T a -> T a)+lift1 f (Cons x0) = Cons (f x0)++{-# INLINE lift2 #-}+lift2 :: ([a] -> [a] -> [a]) -> (T a -> T a -> T a)+lift2 f (Cons x0) (Cons x1) = Cons (f x0 x1)++{-# INLINE const #-}+const :: a -> T a+const x = lift0 [x]++{-+Functor instance is e.g. useful for showing power series in residue rings.+@fmap (ResidueClass.concrete 7) (powerSeries [1,4,4::ResidueClass.T Integer] * powerSeries [1,5,6])@+-}++instance Functor T where+   fmap f (Cons xs) = Cons (map f xs)++{-# INLINE appPrec #-}+appPrec :: Int+appPrec  = 10++instance (Show a) => Show (T a) where+   showsPrec p (Cons xs) =+     showParen (p >= appPrec) (showString "PowerSeries.fromCoeffs " . shows xs)+++{-# INLINE truncate #-}+truncate :: Int -> T a -> T a+truncate n = lift1 (take n)++{- |+Evaluate (truncated) power series.+-}+{-# INLINE evaluate #-}+evaluate :: Ring.C a => T a -> a -> a+evaluate (Cons y) = Core.evaluate y++{- |+Evaluate (truncated) power series.+-}+{-# INLINE evaluateCoeffVector #-}+evaluateCoeffVector :: Module.C a v => T v -> a -> v+evaluateCoeffVector (Cons y) = Core.evaluateCoeffVector y+++{-# INLINE evaluateArgVector #-}+evaluateArgVector :: (Module.C a v, Ring.C v) => T a -> v -> v+evaluateArgVector (Cons y) = Core.evaluateArgVector y++{- |+Evaluate approximations that is evaluate all truncations of the series.+-}+{-# INLINE approximate #-}+approximate :: Ring.C a => T a -> a -> [a]+approximate (Cons y) = Core.approximate y+++{- |+Evaluate approximations that is evaluate all truncations of the series.+-}+{-# INLINE approximateCoeffVector #-}+approximateCoeffVector :: Module.C a v => T v -> a -> [v]+approximateCoeffVector (Cons y) = Core.approximateCoeffVector y+++{- |+Evaluate approximations that is evaluate all truncations of the series.+-}+{-# INLINE approximateArgVector #-}+approximateArgVector :: (Module.C a v, Ring.C v) => T a -> v -> [v]+approximateArgVector (Cons y) = Core.approximateArgVector y+++{-+Note that the derived instances only make sense for finite series.+-}++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 Poly.negate+   (+)    = lift2 Poly.add+   (-)    = lift2 Poly.sub+   zero   = lift0 []++instance (Ring.C a) => Ring.C (T a) where+   one           = const one+   fromInteger n = const (fromInteger n)+   (*)           = lift2 Core.mul++instance Vector.C T where+   zero  = zero+   (<+>) = (+)+   (*>)  = Vector.functorScale++instance (Module.C a b) => Module.C a (T b) where+   (*>) x = lift1 (x *>)++instance (Field.C a, Module.C a b) => VectorSpace.C a (T b)+++instance (Field.C a) => Field.C (T a) where+   (/) = lift2 Core.divide+++instance (ZeroTestable.C a, Field.C a) => Integral.C (T a) where+   divMod (Cons x) (Cons y) =+      let (d,m) = Core.divMod x y+      in  (Cons d, Cons m)+++instance (Ring.C a) => Differential.C (T a) where+   differentiate = lift1 Core.differentiate+++instance (Algebraic.C a) => Algebraic.C (T a) where+   sqrt   = lift1 (Core.sqrt Algebraic.sqrt)+   x ^/ y = lift1 (Core.pow (Algebraic.^/ y)+                       (fromRational' y)) x+++instance (Transcendental.C a) =>+             Transcendental.C (T a) where+   pi = const Transcendental.pi+   exp = lift1 (Core.exp Transcendental.exp)+   sin = lift1 (Core.sin Core.sinCosScalar)+   cos = lift1 (Core.cos Core.sinCosScalar)+   tan = lift1 (Core.tan Core.sinCosScalar)+   x ** y = Transcendental.exp (Transcendental.log x * y)+                {- This order of multiplication is especially fast+                   when y is a singleton. -}+   log  = lift1 (Core.log  Transcendental.log)+   asin = lift1 (Core.asin Algebraic.sqrt Transcendental.asin)+   acos = lift1 (Core.acos Algebraic.sqrt Transcendental.acos)+   atan = lift1 (Core.atan Transcendental.atan)++{- |+It fulfills+  @ evaluate x . evaluate y == evaluate (compose x y) @+-}++compose :: (Ring.C a, ZeroTestable.C a) => T a -> T a -> T a+compose (Cons [])    (Cons []) = Cons []+compose (Cons (x:_)) (Cons []) = Cons [x]+compose (Cons x) (Cons (y:ys)) =+   if isZero y+     then Cons (Core.compose x ys)+     else error "PowerSeries.compose: inner series must not have an absolute term."

+ src-ghc-6.12/MathObj/PowerSeries/Core.hs view

@@ -0,0 +1,279 @@+{-# LANGUAGE NoImplicitPrelude #-}+module MathObj.PowerSeries.Core where++import qualified MathObj.Polynomial.Core as Poly++import qualified Algebra.Module         as Module+import qualified Algebra.Transcendental as Transcendental+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 Data.List.Match as Match+import qualified NumericPrelude.Numeric as NP+import qualified NumericPrelude.Base as P++import NumericPrelude.Base    hiding (const)+import NumericPrelude.Numeric hiding (negate, stdUnit, divMod,+                              sqrt, exp, log,+                              sin, cos, tan, asin, acos, atan)+++{-# INLINE evaluate #-}+evaluate :: Ring.C a => [a] -> a -> a+evaluate = flip Poly.horner++{-# INLINE evaluateCoeffVector #-}+evaluateCoeffVector :: Module.C a v => [v] -> a -> v+evaluateCoeffVector = flip Poly.hornerCoeffVector++{-# INLINE evaluateArgVector #-}+evaluateArgVector :: (Module.C a v, Ring.C v) => [a] -> v -> v+evaluateArgVector = flip Poly.hornerArgVector+++{-# INLINE approximate #-}+approximate :: Ring.C a => [a] -> a -> [a]+approximate y x =+   scanl (+) zero (zipWith (*) (iterate (x*) 1) y)++{-# INLINE approximateCoeffVector #-}+approximateCoeffVector :: Module.C a v => [v] -> a -> [v]+approximateCoeffVector y x =+   scanl (+) zero (zipWith (*>) (iterate (x*) 1) y)++{-# INLINE approximateArgVector #-}+approximateArgVector :: (Module.C a v, Ring.C v) => [a] -> v -> [v]+approximateArgVector y x =+   scanl (+) zero (zipWith (*>) y (iterate (x*) 1))+++{- * Simple series manipulation -}++{- |+For the series of a real function @f@+compute the series for @\x -> f (-x)@+-}++alternate :: Additive.C a => [a] -> [a]+alternate = zipWith id (cycle [id, NP.negate])++{- |+For the series of a real function @f@+compute the series for @\x -> (f x + f (-x)) \/ 2@+-}++holes2 :: Additive.C a => [a] -> [a]+holes2 = zipWith id (cycle [id, P.const zero])++{- |+For the series of a real function @f@+compute the real series for @\x -> (f (i*x) + f (-i*x)) \/ 2@+-}+holes2alternate :: Additive.C a => [a] -> [a]+holes2alternate =+   zipWith id (cycle [id, P.const zero, NP.negate, P.const zero])+++{- * Series arithmetic -}++add, sub :: (Additive.C a) => [a] -> [a] -> [a]+add = Poly.add+sub = Poly.sub++negate :: (Additive.C a) => [a] -> [a]+negate = Poly.negate++scale :: Ring.C a => a -> [a] -> [a]+scale = Poly.scale++mul :: Ring.C a => [a] -> [a] -> [a]+mul = Poly.mul+++stripLeadZero :: (ZeroTestable.C a) => [a] -> [a] -> ([a],[a])+stripLeadZero (x:xs) (y:ys) =+  if isZero x && isZero y+    then stripLeadZero xs ys+    else (x:xs,y:ys)+stripLeadZero xs ys = (xs,ys)+++divMod :: (ZeroTestable.C a, Field.C a) => [a] -> [a] -> ([a],[a])+divMod xs ys =+   let (yZero,yRem) = span isZero ys+       (xMod, xRem) = Match.splitAt yZero xs+   in  (divide xRem yRem, xMod)++{- |+Divide two series where the absolute term of the divisor is non-zero.+That is, power series with leading non-zero terms are the units+in the ring of power series.++Knuth: Seminumerical algorithms+-}+divide :: (Field.C a) => [a] -> [a] -> [a]+divide (x:xs) (y:ys) =+   let zs = map (/y) (x : sub xs (mul zs ys))+   in  zs+divide [] _ = []+divide _ [] = error "PowerSeries.divide: division by empty series"++{- |+Divide two series also if the divisor has leading zeros.+-}+divideStripZero :: (ZeroTestable.C a, Field.C a) => [a] -> [a] -> [a]+divideStripZero x' y' =+   let (x0,y0) = stripLeadZero x' y'+   in  if null y0 || isZero (head y0)+         then error "PowerSeries.divideStripZero: Division by zero."+         else divide x0 y0+++progression :: Ring.C a => [a]+progression = Poly.progression++recipProgression :: (Field.C a) => [a]+recipProgression = map recip progression++differentiate :: (Ring.C a) => [a] -> [a]+differentiate = Poly.differentiate++integrate :: (Field.C a) => a -> [a] -> [a]+integrate = Poly.integrate+++{- |+We need to compute the square root only of the first term.+That is, if the first term is rational,+then all terms of the series are rational.+-}+sqrt :: Field.C a => (a -> a) -> [a] -> [a]+sqrt _ [] = []+sqrt f0 (x:xs) =+   let y  = f0 x+       ys = map (/(y+y)) (xs - (0 : mul ys ys))+   in  y:ys++{-+pow alpha t = t^alpha+(pow alpha . x)' = alpha * (pow (alpha-1) . x) * x'+alpha * (pow alpha . x) = x * x' * (pow alpha . x)'+y = pow alpha . x+alpha * y = x * x' * y'+-}++{- |+Input series must start with non-zero term.+-}+pow :: (Field.C a) => (a -> a) -> a -> [a] -> [a]+pow f0 expon x =+   let y  = integrate (f0 (head x)) y'+       y' = scale expon (divide y (mul x (differentiate x)))+   in  y+++{- |+The first term needs a transcendent computation but the others do not.+That's why we accept a function which computes the first term.++> (exp . x)' =   (exp . x) * x'+> (sin . x)' =   (cos . x) * x'+> (cos . x)' = - (sin . x) * x'+-}+exp :: Field.C a => (a -> a) -> [a] -> [a]+exp f0 x =+   let x' = differentiate x+       y  = integrate (f0 (head x)) (mul y x')+   in  y++sinCos :: Field.C a => (a -> (a,a)) -> [a] -> ([a],[a])+sinCos f0 x =+   let (y0Sin, y0Cos) = f0 (head x)+       x'   = differentiate x+       ySin = integrate y0Sin         (mul yCos x')+       yCos = integrate y0Cos (negate (mul ySin x'))+   in  (ySin, yCos)++sinCosScalar :: Transcendental.C a => a -> (a,a)+sinCosScalar x = (Transcendental.sin x, Transcendental.cos x)++sin, cos :: Field.C a => (a -> (a,a)) -> [a] -> [a]+sin f0 = fst . sinCos f0+cos f0 = snd . sinCos f0++tan :: (Field.C a) => (a -> (a,a)) -> [a] -> [a]+tan f0 = uncurry divide . sinCos f0++{-+(log x)' == x'/x+(asin x)' == (acos x) == x'/sqrt(1-x^2)+(atan x)' == x'/(1+x^2)+-}++{- |+Input series must start with non-zero term.+-}+log :: (Field.C a) => (a -> a) -> [a] -> [a]+log f0 x = integrate (f0 (head x)) (derivedLog x)++{- |+Computes @(log x)'@, that is @x'\/x@+-}+derivedLog :: (Field.C a) => [a] -> [a]+derivedLog x = divide (differentiate x) x++atan :: (Field.C a) => (a -> a) -> [a] -> [a]+atan f0 x =+   let x' = differentiate x+   in  integrate (f0 (head x)) (divide x' ([1] + mul x x))++asin, acos :: (Field.C a) =>+   (a -> a) -> (a -> a) -> [a] -> [a]+asin sqrt0 f0 x =+   let x' = differentiate x+   in  integrate (f0 (head x))+                 (divide x' (sqrt sqrt0 ([1] - mul x x)))+acos = asin++{- |+Since the inner series must start with a zero,+the first term is omitted in y.+-}+compose :: (Ring.C a) => [a] -> [a] -> [a]+compose xs y = foldr (\x acc -> x : mul y acc) [] xs+++{- |+Compose two power series where the outer series+can be developed for any expansion point.+To be more precise:+The outer series must be expanded with respect to the leading term+of the inner series.+-}+composeTaylor :: Ring.C a => (a -> [a]) -> [a] -> [a]+composeTaylor x (y:ys) = compose (x y) ys+composeTaylor x []     = x 0++++{-+(x . y) = id+(x' . y) * y' = 1+y' = 1 / (x' . y)+-}++{- |+This function returns the series of the function in the form:+(point of the expansion, power series)++This is exceptionally slow and needs cubic run-time.+-}++inv :: (Field.C a) => [a] -> (a, [a])+inv x =+   let y' = divide [1] (compose (differentiate x) (tail y))+       y  = integrate 0 y'+            -- the first term is zero, which is required for composition+   in  (head x, y)

+ src-ghc-6.12/MathObj/PowerSeries/DifferentialEquation.hs view

@@ -0,0 +1,81 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Lazy evaluation allows for the solution+ of differential equations in terms of power series.+Whenever you can express the highest derivative of the solution+ as explicit expression of the lower derivatives+ where each coefficient of the solution series+ depends only on lower coefficients,+ the recursive algorithm will work.+-}++module MathObj.PowerSeries.DifferentialEquation where++import qualified MathObj.PowerSeries.Core    as PS+import qualified MathObj.PowerSeries.Example as PSE++import qualified Algebra.Field        as Field+import qualified Algebra.ZeroTestable as ZeroTestable++import NumericPrelude.Numeric+import NumericPrelude.Base+++{- |+Example for a linear equation:+   Setup a differential equation for @y@ with++>    y   t = (exp (-t)) * (sin t)+>    y'  t = -(exp (-t)) * (sin t) + (exp (-t)) * (cos t)+>    y'' t = -2 * (exp (-t)) * (cos t)++Thus the differential equation++>    y'' = -2 * (y' + y)++holds.++The following function generates+a power series for @exp (-t) * sin t@+by solving the differential equation.+-}++solveDiffEq0 :: (Field.C a) => [a]+solveDiffEq0 =+   let -- the initial conditions are passed to "PS.integrate"+       y   = PS.integrate 0 y'+       y'  = PS.integrate 1 y''+       y'' = PS.scale (-2) (PS.add y' y)+   in  y++verifyDiffEq0 :: (Field.C a) => [a]+verifyDiffEq0 =+   PS.mul (zipWith (*) (iterate negate 1) PSE.exp) PSE.sin++propDiffEq0 :: Bool+propDiffEq0 =  solveDiffEq0 == (verifyDiffEq0 :: [Rational])+++{- |+We are not restricted to linear equations!+ Let the solution be y with+  y   t =   (1-t)^-1+  y'  t =   (1-t)^-2+  y'' t = 2*(1-t)^-3+ then it holds+  y'' = 2 * y' * y+-}++solveDiffEq1 :: (ZeroTestable.C a, Field.C a) => [a]+solveDiffEq1 =+   let -- the initial conditions are passed to "PS.integrate"+       y   = PS.integrate 1 y'+       y'  = PS.integrate 1 y''+       y'' = PS.scale 2 (PS.mul y' y)+   in  y++verifyDiffEq1 :: (ZeroTestable.C a, Field.C a) => [a]+verifyDiffEq1 = PS.divide [1] [1, -1]++propDiffEq1 :: Bool+propDiffEq1 =  solveDiffEq1 == (verifyDiffEq1 :: [Rational])

+ src-ghc-6.12/MathObj/PowerSeries/Example.hs view

@@ -0,0 +1,156 @@+{-# LANGUAGE NoImplicitPrelude #-}+module MathObj.PowerSeries.Example where++import qualified MathObj.PowerSeries.Core as PS++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 Algebra.Transcendental as Transcendental++import Algebra.Additive (zero, subtract, negate)++import Data.List (intersperse, )+import Data.List.HT (sieve, )++import NumericPrelude.Numeric (one, (*), (/),+                       fromInteger, {-fromRational,-} pi)+import NumericPrelude.Base -- (Bool, const, map, zipWith, id, (&&), (==))+++{- * Default implementations. -}++recip :: (Ring.C a) => [a]+recip = recipExpl++exp, sin, cos,+  log, asin, atan, sqrt :: (Field.C a) => [a]+acos :: (Transcendental.C a) => [a]+tan :: (ZeroTestable.C a, Field.C a) => [a]+exp = expODE+sin = sinODE+cos = cosODE+tan = tanExplSieve+log = logODE+asin = asinODE+acos = acosODE+atan = atanODE++sinh, cosh, atanh :: (Field.C a) => [a]+sinh  = sinhODE+cosh  = coshODE+atanh = atanhODE++pow :: (Field.C a) => a -> [a]+pow = powExpl+sqrt = sqrtExpl+++{- * Generate Taylor series explicitly. -}++recipExpl :: (Ring.C a) => [a]+recipExpl = cycle [1,-1]++expExpl, sinExpl, cosExpl :: (Field.C a) => [a]+expExpl = scanl (*) one PS.recipProgression+sinExpl = zero : PS.holes2alternate (tail expExpl)+cosExpl =        PS.holes2alternate       expExpl++tanExpl, tanExplSieve :: (ZeroTestable.C a, Field.C a) => [a]+tanExpl = PS.divide sinExpl cosExpl+-- ignore zero values+tanExplSieve =+   concatMap+      (\x -> [zero,x])+      (PS.divide (sieve 2 (tail sin)) (sieve 2 cos))++logExpl, atanExpl, sqrtExpl :: (Field.C a) => [a]+logExpl  = zero : PS.alternate       PS.recipProgression+atanExpl = zero : PS.holes2alternate PS.recipProgression++sinhExpl, coshExpl, atanhExpl :: (Field.C a) => [a]+sinhExpl  = zero : PS.holes2 (tail expExpl)+coshExpl  =        PS.holes2       expExpl+atanhExpl = zero : PS.holes2 PS.recipProgression++{- * Power series of (1+x)^expon using the binomial series. -}++powExpl :: (Field.C a) => a -> [a]+powExpl expon =+   scanl (*) 1 (zipWith (/)+      (iterate (subtract 1) expon) PS.progression)+sqrtExpl = powExpl (1/2)++{- |+Power series of error function (almost).+More precisely @ erf = 2 \/ sqrt pi * integrate (\x -> exp (-x^2)) @,+with @erf 0 = 0@.+-}++erf :: (Field.C a) => [a]+erf = PS.integrate 0 $ intersperse 0 $ PS.alternate exp++{-+integrate (\x -> exp (-x^2/2)) :++erf = PS.integrate 0 $ intersperse 0 $+    snd $ mapAccumL (\twoPow c -> (twoPow/(-2), twoPow*c)) 1 exp+-}+++{- * Generate Taylor series from differential equations. -}++{-+exp' x == exp x+sin' x == cos x+cos' x == - sin x++tan' x == 1 + tan x ^ 2+       == cos x ^ (-2)+-}++expODE, sinODE, cosODE, tanODE, tanODESieve :: (Field.C a) => [a]+expODE = PS.integrate 1 expODE+sinODE = PS.integrate 0 cosODE+cosODE = PS.integrate 1 (PS.negate sinODE)+tanODE = PS.integrate 0 (PS.add [1] (PS.mul tanODE tanODE))+tanODESieve =+   -- sieve is too strict here because it wants to detect end of lists+   let tan2 = map head (iterate (drop 2) (tail tanODESieve))+   in  PS.integrate 0 (intersperse zero (1 : PS.mul tan2 tan2))++{-+log' (1+x) == 1/(1+x)+asin' x == acos' x == 1/sqrt(1-x^2)+atan' x == 1/(1+x^2)+-}++logODE, recipCircle, asinODE, atanODE, sqrtODE :: (Field.C a) => [a]+logODE  = PS.integrate zero recip+recipCircle = intersperse zero (PS.alternate (powODE (-1/2)))+asinODE = PS.integrate 0 recipCircle+atanODE = PS.integrate zero (cycle [1,0,-1,0])+sqrtODE = powODE (1/2)++acosODE :: (Transcendental.C a) => [a]+acosODE = PS.integrate (pi/2) recipCircle++sinhODE, coshODE, atanhODE :: (Field.C a) => [a]+sinhODE = PS.integrate 0 coshODE+coshODE = PS.integrate 1 sinhODE+atanhODE = PS.integrate zero (cycle [1,0])+++{-+Power series for y with+   y x = (1+x) ** alpha+by solving the differential equation+   alpha * y x = (1+x) * y' x+-}++powODE :: (Field.C a) => a -> [a]+powODE expon =+   let y  = PS.integrate 1 y'+       y' = PS.scale expon (scanl1 subtract y)+   in  y

+ src-ghc-6.12/MathObj/PowerSeries/Mean.hs view

@@ -0,0 +1,234 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+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 ys x =+   map sum (shearTranspose (tail (zipWith PSCore.scale ys+                    (map tail (iterate (PSCore.mul x) [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 =+   let -- series for \frac{2\cdot x}{\ln(1+2\cdot x)}+       fracLn = PSCore.divide [2]+                      (tail (zipWith (*) (iterate (2*) 1) PSE.log))+       fDiffFracLn = diffComp f (tail fracLn)+       f = 0 : 1 : zipWith (/) fDiffFracLn+                      (map (subtract 1) (iterate (2*) 2))+   in  f++elemSym3_2 :: (Field.C a) => [a]+elemSym3_2 =+   let -- series for \frac{2\cdot x}{\ln(1+2\cdot x)}+       root = zipWith (*) (iterate (2*) 1) PSE.sqrt+       fDiffRoot = diffComp f (tail root)+       f = 0 : 1 : zipWith (/) fDiffRoot+                      (map (subtract 1) (iterate (3*) 3))+   in  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 = PSCore.sqrt (\1 -> 1) [1,1,1/2]++quadraticMVF :: (Field.C a) => [a]+quadraticMVF =+   -- [1,1,1,1,1/2,3/23,2/143]+   -- [1,1,1,1,1/2,1/2]+   [1,1,1,1,1/2,-1/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 =+   let divDiffPS = tail quadraticMVF -- (f(1+t)-f(1))/((1+t)-1)+       (1, invPS) = PSCore.inv (PSCore.differentiate quadraticMVF)+       meanValuePS = PSCore.composeTaylor (\1 -> invPS) divDiffPS+       {- instead of computing an inverse series+          we could also apply (compose) the derived series+          to the series of the quadratic mean. -}+   in  quadratic - 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 =+   PS2Core.sqrt (\1 -> 1) [[1],[1,1],[1/2,0,1/2]]++quadraticDiff2 :: (Field.C a, Eq a) => PS2Core.T a+quadraticDiff2 =+   meanValueDiff2 quadratic2 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 =+   -- [1,1,1,-2,7/2,-62/11]+   -- [1,1,2,-4,7,-124/11]+   [1,1,3,-6,21/2,-186/11]++{-+$M(1+x,1+y) = 2/(recip (1+x) + recip (1+y))$+-}+harmonic2 :: (Field.C a, Eq a) => PS2Core.T a+harmonic2 =+   let rec = PS.fromCoeffs PSE.recip+   in  PS2Core.divide [[2]] $+       PS2.coeffs $+          PS2.fromPowerSeries0 rec ++          PS2.fromPowerSeries1 rec++harmonicDiff2 :: (Field.C a, Eq a) => PS2Core.T a+harmonicDiff2 =+   meanValueDiff2 harmonic2 harmonicMVF++++arithmeticMVF :: (Field.C a) => [a]+arithmeticMVF = [1,2,1]++{-+$M(1+x,1+y) = 1+x/2+y/2$+-}+arithmetic2 :: (Field.C a, Eq a) => PS2Core.T a+arithmetic2 = [[1],[1/2,1/2]]++arithmeticDiff2 :: (Field.C a, Eq a) => PS2Core.T a+arithmeticDiff2 =+   meanValueDiff2 arithmetic2 arithmeticMVF+++geometricMVF :: (Field.C a) => [a]+geometricMVF = PSE.recip++{-+$M(1+x,1+y) = \sqrt{(1+x)·(1+y)}$+-}+geometric2 :: (Field.C a, Eq a) => PS2Core.T a+geometric2 =+   PS2Core.sqrt (\1 -> 1) [[1],[1,1],[0,1,0]]++geometricDiff2 :: (Field.C a, Eq a) => PS2Core.T a+geometricDiff2 =+   meanValueDiff2 geometric2 geometricMVF+++++meanValueDiff2 :: (Field.C a, Eq a) =>+   PS2Core.T a -> [a] -> PS2Core.T a+meanValueDiff2 mean2 curve =+   let -- (f(1+x)-f(1+y)) / (x-y)+       divDiffPS =+          zipWith replicate [1..] $ tail curve+       meanValuePS =+          PS2Core.compose (PSCore.differentiate curve) (tail mean2)+   in  meanValuePS - divDiffPS

+ src-ghc-6.12/MathObj/PowerSeries2.hs view

@@ -0,0 +1,126 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}++{- |+Two-variate power series.+-}++module MathObj.PowerSeries2 where++import qualified MathObj.PowerSeries2.Core as Core+import qualified MathObj.PowerSeries as PS+import qualified MathObj.Polynomial.Core as Poly++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.Numeric as NP+import qualified NumericPrelude.Base as P++import Data.List (isPrefixOf, )+import qualified Data.List.Match as Match++import NumericPrelude.Base    hiding (const)+import NumericPrelude.Numeric++{- |+In order to handle both variables equivalently+we maintain a list of coefficients for terms of the same total degree.+That is++> eval [[a], [b,c], [d,e,f]] (x,y) ==+>    a + b*x+c*y + d*x^2+e*x*y+f*y^2++Although the sub-lists are always finite and thus are more like polynomials than power series,+division and square root computation are easier to implement for power series.+-}+newtype T a = Cons {coeffs :: Core.T a} deriving (Ord)+++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.T a -> T a+lift0 = Cons++lift1 :: (Core.T a -> Core.T a) -> (T a -> T a)+lift1 f (Cons x0) = Cons (f x0)++lift2 :: (Core.T a -> Core.T a -> Core.T a) -> (T a -> T a -> T a)+lift2 f (Cons x0) (Cons x1) = Cons (f x0 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)+++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 Core.negate+   (+)    = lift2 Core.add+   (-)    = lift2 Core.sub+   zero   = lift0 []+++instance (Ring.C a) => Ring.C (T a) where+   one           = const one+   fromInteger n = const (fromInteger n)+   (*)           = lift2 Core.mul++instance Vector.C T where+   zero  = zero+   (<+>) = (+)+   (*>)  = Vector.functorScale+++instance (Field.C a) => Field.C (T a) where+   (/) = lift2 Core.divide+++instance (Algebraic.C a) => Algebraic.C (T a) where+   sqrt   = lift1 (Core.sqrt Algebraic.sqrt)+--   x ^/ y = lift1 (Core.pow (Algebraic.^/ y)+--                       (fromRational' y)) x

+ src-ghc-6.12/MathObj/PowerSeries2/Core.hs view

@@ -0,0 +1,89 @@+{-# LANGUAGE NoImplicitPrelude #-}+module MathObj.PowerSeries2.Core where++import qualified MathObj.PowerSeries as PS+import qualified MathObj.PowerSeries.Core as PSCore++import qualified Algebra.Differential   as Differential+import qualified Algebra.Vector         as Vector+import qualified Algebra.Field          as Field+import qualified Algebra.Ring           as Ring+import qualified Algebra.Additive       as Additive++import NumericPrelude.Base+-- import NumericPrelude.Numeric hiding (negate, sqrt, )+++type T a = [[a]]+++lift0fromPowerSeries :: [PS.T a] -> T a+lift0fromPowerSeries = map PS.coeffs++lift1fromPowerSeries ::+   ([PS.T a] -> [PS.T a]) -> (T a -> T a)+lift1fromPowerSeries f x0 =+   map PS.coeffs (f (map PS.fromCoeffs x0))++lift2fromPowerSeries ::+   ([PS.T a] -> [PS.T a] -> [PS.T a]) -> (T a -> T a -> T a)+lift2fromPowerSeries f x0 x1 =+   map PS.coeffs (f (map PS.fromCoeffs x0) (map PS.fromCoeffs x1))+++{- * Series arithmetic -}++add, sub :: (Additive.C a) => T a -> T a -> T a+add = PSCore.add+sub = PSCore.sub++negate :: (Additive.C a) => T a -> T a+negate = PSCore.negate+++scale :: Ring.C a => a -> T a -> T a+scale = map . (Vector.*>)++mul :: Ring.C a => T a -> T a -> T a+mul = lift2fromPowerSeries PSCore.mul+++divide :: (Field.C a) =>+   T a -> T a -> T a+divide = lift2fromPowerSeries PSCore.divide+++sqrt :: (Field.C a) =>+   (a -> a) -> T a -> T a+sqrt fSqRt =+   lift1fromPowerSeries $+   PSCore.sqrt (PS.const . (\[x] -> fSqRt x) . PS.coeffs)++++swapVariables :: T a -> T a+swapVariables = map reverse+++differentiate0 :: (Ring.C a) => T a -> T a+differentiate0 =+   swapVariables . differentiate1 . swapVariables++differentiate1 :: (Ring.C a) => T a -> T a+differentiate1 = lift1fromPowerSeries $ map Differential.differentiate++integrate0 :: (Field.C a) => [a] -> T a -> T a+integrate0 cs =+   swapVariables . integrate1 cs . swapVariables++integrate1 :: (Field.C a) => [a] -> T a -> T a+integrate1 = zipWith PSCore.integrate++++{- |+Since the inner series must start with a zero,+the first term is omitted in y.+-}+compose :: (Ring.C a) => [a] -> T a -> T a+compose = lift1fromPowerSeries . PSCore.compose . map PS.const

+ src-ghc-6.12/MathObj/PowerSum.hs view

@@ -0,0 +1,234 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{- |+Copyright   :  (c) Henning Thielemann 2004-2005++Maintainer  :  numericprelude@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes+++For a multi-set of numbers,+we describe a sequence of the sums of powers of the numbers in the set.+These can be easily converted to polynomials and back.+Thus they provide an easy way for computations on the roots of a polynomial.+-}+module MathObj.PowerSum where++import qualified MathObj.Polynomial as Poly+import qualified MathObj.Polynomial.Core as PolyCore+import qualified MathObj.PowerSeries.Core as PS++import qualified Algebra.VectorSpace  as VectorSpace+import qualified Algebra.Module       as Module+import qualified Algebra.Algebraic    as Algebraic+import qualified Algebra.Field        as Field+import qualified Algebra.IntegralDomain as Integral+import qualified Algebra.Ring         as Ring+import qualified Algebra.Additive     as Additive+import qualified Algebra.ZeroTestable as ZeroTestable++import Algebra.Module((*>))++import Control.Monad(liftM2)+import qualified Data.List as List+import Data.List.HT (shearTranspose, sieve)++import NumericPrelude.Base as P hiding (const)+import NumericPrelude.Numeric as NP+++newtype T a = Cons {sums :: [a]}+++{- * Conversions -}++lift0 :: [a] -> T a+lift0 = Cons++lift1 :: ([a] -> [a]) -> (T a -> T a)+lift1 f (Cons x0) = Cons (f x0)++lift2 :: ([a] -> [a] -> [a]) -> (T a -> T a -> T a)+lift2 f (Cons x0) (Cons x1) = Cons (f x0 x1)+++const :: (Ring.C a) => a -> T a+const x = Cons [1,x]++{- Newton-Girard formulas,  cf. Modula-3: arithmetic/RootBasic.mg+   s'/s = p -}++{-+  s[k] - the elementary symmetric polynomial of degree k+  p[k] - sum of the k-th power++  s[0](x0,x1,x2) = 1+  s[1](x0,x1,x2) = x0+x1+x2+  s[2](x0,x1,x2) = x0*x1+x1*x2+x2*x0+  s[3](x0,x1,x2) = x0*x1*x2+  s[4](x0,x1,x2) = 0++  p[0](x0,x1,x2) =  1   +  1   +  1+  p[1](x0,x1,x2) = x0   + x1   + x2+  p[2](x0,x1,x2) = x0^2 + x1^2 + x2^2+  p[3](x0,x1,x2) = x0^3 + x1^3 + x2^3+  p[4](x0,x1,x2) = x0^4 + x1^4 + x2^4++  s(t) := s[0] + s[1]*t + s[2]*t^2 + ...+  p(t) :=        p[1]*t + p[2]*t^2 + ...++  Then it holds+    t*s'(t) + p(-t)*s(t) = 0+  This can be proven by considering p as sum of geometric series+  and differentiating s in the root-wise factored form.++  Note that we index the coefficients the other way round+  and that the coefficients of the polynomial+  are not pure elementary symmetric polynomials of the roots+  but have alternating signs, too.+-}+fromElemSym :: (Eq a, Ring.C a) => [a] -> [a]+fromElemSym s =+   fromIntegral (length s - 1) :+      PolyCore.alternate (divOneFlip s (PolyCore.differentiate s))++divOneFlip :: (Eq a, Ring.C a) => [a] -> [a] -> [a]+divOneFlip (1:xs) =+   let aux (y:ys) = y : aux (ys - PolyCore.scale y xs)+       aux [] = []+   in  aux+divOneFlip _ =+   error "divOneFlip: first element must be one"++fromElemSymDenormalized :: (Field.C a, ZeroTestable.C a) => [a] -> [a]+fromElemSymDenormalized s =+   fromIntegral (length s - 1) :+      PolyCore.alternate (PS.derivedLog s)+++toElemSym :: (Field.C a, ZeroTestable.C a) => [a] -> [a]+toElemSym p =+   let s' = PolyCore.mul (PolyCore.alternate (tail p)) s+       s  = PolyCore.integrate 1 s'+   in  s++toElemSymInt :: (Integral.C a, ZeroTestable.C a) => [a] -> [a]+toElemSymInt p =+   let s' = PolyCore.mul (PolyCore.alternate (tail p)) s+       s  = PolyCore.integrateInt 1 s'+   in  s++++fromPolynomial :: (Field.C a, ZeroTestable.C a) => Poly.T a -> [a]+fromPolynomial =+   let aux s =+          fromIntegral (length s - 1) :+             PolyCore.negate (PS.derivedLog s)+   in  aux . reverse . Poly.coeffs++elemSymFromPolynomial :: Additive.C a => Poly.T a -> [a]+elemSymFromPolynomial = PolyCore.alternate . reverse . Poly.coeffs++{- toPolynomial is not possible because this had to consume the whole sum sequence. -}++++binomials :: Ring.C a => [[a]]+binomials = [1] : binomials + map (0:) binomials++{- * Show -}++appPrec :: Int+appPrec  = 10++instance (Show a) => Show (T a) where+  showsPrec p (Cons xs) =+    showParen (p >= appPrec)+       (showString "PowerSum.Cons " . shows xs)+++{- * Additive -}++{- Use binomial expansion of (x+y)^n -}+add :: (Ring.C a) => [a] -> [a] -> [a]+add xs ys =+   let powers = shearTranspose (PolyCore.tensorProduct xs ys)+   in  zipWith Ring.scalarProduct binomials powers++instance (Ring.C a) => Additive.C (T a) where+   zero   = const zero+   (+)    = lift2 add+   negate = lift1 PolyCore.alternate+++{- * Ring -}++mul :: (Ring.C a) => [a] -> [a] -> [a]+mul xs ys = zipWith (*) xs ys++pow :: Integer -> [a] -> [a]+pow n =+   if n<0+     then error "PowerSum.pow: negative exponent"+     else sieve (fromInteger n)+       -- map head . iterate (List.genericDrop (toInteger n))++instance (Ring.C a) => Ring.C (T a) where+   one           = const one+   fromInteger n = const (fromInteger n)+   (*)           = lift2 mul+   x^n           = lift1 (pow n) x+++{- * Module -}++instance (Module.C a v, Ring.C v) => Module.C a (T v) where+   x *> y = lift1 (zipWith (*>) (iterate (x*) one)) y++instance (VectorSpace.C a v, Ring.C v) => VectorSpace.C a (T v)+++{- * Field.C -}++instance (Field.C a, ZeroTestable.C a) => Field.C (T a) where+   recip = lift1 (fromElemSymDenormalized . reverse . toElemSym)+++{- * Algebra -}++root :: (Ring.C a) => Integer -> [a] -> [a]+root n xs =+   let upsample m ys =+          concat (List.intersperse+             (List.genericReplicate (m - 1) zero)+             (map (:[]) ys))+   in  case compare n 0 of+          LT -> upsample (-n) (reverse xs)+          GT -> upsample n xs+          EQ -> [1]++instance (Field.C a, ZeroTestable.C a) => Algebraic.C (T a) where+   root n = lift1 (fromElemSymDenormalized . root n . toElemSym)+++{- given the list of power sums @x1^j + ... + xn^j@+   and a power series for the function @f@,+   compute the series approximations of @f(x1) + ... + f(xn)@. -}+approxSeries :: Module.C a b => [b] -> [a] -> [b]+approxSeries y x =+   scanl (+) zero (zipWith (*>) x y)+++{- input lists contain roots -}+propOp :: (Eq a, Field.C a, ZeroTestable.C a) =>+   ([a] -> [a] -> [a]) -> (a -> a -> a) -> [a] -> [a] -> [Bool]+propOp powerOp op xs ys =+   let zs = liftM2 op xs ys+       xp = fromPolynomial (Poly.fromRoots xs)+       yp = fromPolynomial (Poly.fromRoots ys)+       ze = elemSymFromPolynomial (Poly.fromRoots zs)+   in  zipWith (==) (toElemSym (powerOp xp yp)) ze+       -- PolyCore.equal (toElemSym (powerOp xp yp)) ze

+ src-ghc-6.12/MathObj/RefinementMask2.hs view

@@ -0,0 +1,171 @@+{-# LANGUAGE NoImplicitPrelude #-}+module MathObj.RefinementMask2 (+   T, coeffs, fromCoeffs,+   fromPolynomial,+   toPolynomial,+   toPolynomialFast,+   refinePolynomial,+   ) where++import qualified MathObj.Polynomial as Poly+import qualified Algebra.RealField as RealField+import qualified Algebra.Field  as Field+import qualified Algebra.Ring   as Ring+import qualified Algebra.Vector as Vector++import qualified Data.List as List+import qualified Data.List.HT as ListHT+import qualified Data.List.Match as Match+import Control.Monad (liftM2, )++import qualified Test.QuickCheck as QC++import qualified NumericPrelude.List.Generic as NPList+import NumericPrelude.Base+import NumericPrelude.Numeric+++newtype T a = Cons {coeffs :: [a]}+++{-# INLINE fromCoeffs #-}+fromCoeffs :: [a] -> T a+fromCoeffs = lift0++{-# INLINE lift0 #-}+lift0 :: [a] -> T a+lift0 = Cons++{-+{-# INLINE lift1 #-}+lift1 :: ([a] -> [a]) -> (T a -> T a)+lift1 f (Cons x0) = Cons (f x0)++{-# INLINE lift2 #-}+lift2 :: ([a] -> [a] -> [a]) -> (T a -> T a -> T a)+lift2 f (Cons x0) (Cons x1) = Cons (f x0 x1)+-}++{-+Functor instance is e.g. useful for converting number types,+say 'Rational' to 'Double'.+-}++instance Functor T where+   fmap f (Cons xs) = Cons (map f xs)++{-# INLINE appPrec #-}+appPrec :: Int+appPrec  = 10++instance (Show a) => Show (T a) where+   showsPrec p (Cons xs) =+      showParen (p >= appPrec)+         (showString "RefinementMask2.fromCoeffs " . shows xs)++instance (QC.Arbitrary a, Field.C a) => QC.Arbitrary (T a) where+   arbitrary =+      liftM2+         (\degree body ->+            let s = sum body+            in  Cons $ map ((2 ^- degree - s) / NPList.lengthLeft body +) body)+         (QC.choose (-5,0)) QC.arbitrary+++{- |+Determine mask by Gauss elimination.++R - alternating binomial coefficients+L - differences of translated polynomials in columns++p2 = L * R^(-1) * m++R * L^(-1) * p2 = m+-}+fromPolynomial ::+   (Field.C a) => Poly.T a -> T a+fromPolynomial poly =+   fromCoeffs $+   foldr (\p ps ->+      ListHT.mapAdjacent (-) (p:ps++[0]))+      [] $+   foldr (\(db,dp) cs ->+      ListHT.switchR+         (error "RefinementMask2.fromPolynomial: polynomial should be non-empty")+         (\dps dpe ->+            cs ++ [(db - Ring.scalarProduct dps cs) / dpe])+         dp) [] $+   zip+      (Poly.coeffs $ Poly.dilate 2 poly)+      (List.transpose $+       Match.take (Poly.coeffs poly) $+       map Poly.coeffs $+       iterate polynomialDifference poly)++polynomialDifference ::+   (Ring.C a) => Poly.T a -> Poly.T a+polynomialDifference poly =+   Poly.fromCoeffs $ init $ Poly.coeffs $+   Poly.translate 1 poly - poly++{- |+If the mask does not sum up to a power of @1/2@+then the function returns 'Nothing'.+-}+toPolynomial ::+   (RealField.C a) => T a -> Maybe (Poly.T a)+toPolynomial (Cons []) = Just $ Poly.fromCoeffs []+toPolynomial mask =+   let s = sum $ coeffs mask+       ks = reverse $ takeWhile (<=1) $ iterate (2*) s+   in  case ks of+          1:ks0 ->+             Just $+             foldl+                (\p k ->+                   let ip = Poly.integrate zero p+                   in  ip + Poly.const (correctConstant (fmap (k/s*) mask) ip))+                (Poly.const 1) ks0+          _ -> Nothing+{-+> fmap (6 Vector.*>) $ toPolynomial (Cons [0.1, 0.02, 0.005::Rational])+Just (Polynomial.fromCoeffs [-12732 % 109375, 272 % 625, -18 % 25, 1 % 1])+-}++{-+The constant term must be zero,+higher terms must already satisfy the refinement constraint.+-}+correctConstant ::+   (Field.C a) => T a -> Poly.T a -> a+correctConstant mask poly =+   let refined = refinePolynomial mask poly+   in  head (Poly.coeffs refined) / (1 - sum (coeffs mask))++toPolynomialFast ::+   (RealField.C a) => T a -> Maybe (Poly.T a)+toPolynomialFast mask =+   let s = sum $ coeffs mask+       ks = reverse $ takeWhile (<=1) $ iterate (2*) s+   in  case ks of+          1:ks0 ->+             Just $+             foldl+                (\p k ->+                   let ip = Poly.integrate zero p+                       c = head (Poly.coeffs (refinePolynomial mask ip))+                   in  ip + Poly.const (c*k / ((1-k)*s)))+                (Poly.const 1) ks0+          _ -> Nothing++refinePolynomial ::+   (Ring.C a) => T a -> Poly.T a -> Poly.T a+refinePolynomial mask =+   Poly.shrink 2 .+   Vector.linearComb (coeffs mask) .+   iterate (Poly.translate 1)+{-+> mapM_ print $ take 50 $ iterate (refinePolynomial (Cons [0.1, 0.02, 0.005])) (Poly.fromCoeffs [0,0,0,1::Double])+...+Polynomial.fromCoeffs [-0.11640685714285712,0.4351999999999999,-0.7199999999999999,1.0]+-}

+ src-ghc-6.12/MathObj/RootSet.hs view

@@ -0,0 +1,171 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Copyright   :  (c) Henning Thielemann 2004-2005++Maintainer  :  numericprelude@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++Computations on the set of roots of a polynomial.+These are represented as the list of their elementar symmetric terms.+The difference between a polynomial and the list of elementar symmetric terms+is the reversed order and the alternated signs.++Cf. /MathObj.PowerSum/ .+-}+module MathObj.RootSet where++import qualified MathObj.Polynomial      as Poly+import qualified MathObj.Polynomial.Core as PolyCore+import qualified MathObj.PowerSum        as PowerSum++import qualified Algebra.Algebraic    as Algebraic+import qualified Algebra.IntegralDomain as Integral+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 Data.List.Match as Match+import Control.Monad (liftM2)++import NumericPrelude.Base as P hiding (const)+import NumericPrelude.Numeric as NP+++newtype T a = Cons {coeffs :: [a]}+++{- * Conversions -}++lift0 :: [a] -> T a+lift0 = Cons++lift1 :: ([a] -> [a]) -> (T a -> T a)+lift1 f (Cons x0) = Cons (f x0)++lift2 :: ([a] -> [a] -> [a]) -> (T a -> T a -> T a)+lift2 f (Cons x0) (Cons x1) = Cons (f x0 x1)+++const :: (Ring.C a) => a -> T a+const x = Cons [1,x]+++toPolynomial :: T a -> Poly.T a+toPolynomial (Cons xs) = Poly.fromCoeffs (reverse xs)++fromPolynomial :: Poly.T a -> T a+fromPolynomial xs = Cons (reverse (Poly.coeffs xs))++++toPowerSums :: (Field.C a, ZeroTestable.C a) => [a] -> [a]+toPowerSums = PowerSum.fromElemSymDenormalized++fromPowerSums :: (Field.C a, ZeroTestable.C a) => [a] -> [a]+fromPowerSums = PowerSum.toElemSym+++{- | cf. 'MathObj.Polynomial.mulLinearFactor' -}+addRoot :: Ring.C a => a -> [a] -> [a]+addRoot x yt@(y:ys) =+   y : (ys + PolyCore.scale x yt)+addRoot _ [] =+   error "addRoot: list of elementar symmetric terms must consist at least of a 1"++fromRoots :: Ring.C a => [a] -> [a]+fromRoots = foldl (flip addRoot) [1]++++liftPowerSum1Gen :: ([a] -> [a]) -> ([a] -> [a]) ->+   ([a] -> [a]) -> ([a] -> [a])+liftPowerSum1Gen fromPS toPS op x =+   Match.take x (fromPS (op (toPS x)))++liftPowerSum2Gen :: ([a] -> [a]) -> ([a] -> [a]) ->+   ([a] -> [a] -> [a]) -> ([a] -> [a] -> [a])+liftPowerSum2Gen fromPS toPS op x y =+   Match.take (undefined : liftM2 (,) (tail x) (tail y))+             (fromPS (op (toPS x) (toPS y)))+++liftPowerSum1 :: (Field.C a, ZeroTestable.C a) =>+   ([a] -> [a]) -> ([a] -> [a])+liftPowerSum1 = liftPowerSum1Gen fromPowerSums toPowerSums++liftPowerSum2 :: (Field.C a, ZeroTestable.C a) =>+   ([a] -> [a] -> [a]) -> ([a] -> [a] -> [a])+liftPowerSum2 = liftPowerSum2Gen fromPowerSums toPowerSums++liftPowerSumInt1 :: (Integral.C a, Eq a, ZeroTestable.C a) =>+   ([a] -> [a]) -> ([a] -> [a])+liftPowerSumInt1 = liftPowerSum1Gen PowerSum.toElemSymInt PowerSum.fromElemSym++liftPowerSumInt2 :: (Integral.C a, Eq a, ZeroTestable.C a) =>+   ([a] -> [a] -> [a]) -> ([a] -> [a] -> [a])+liftPowerSumInt2 = liftPowerSum2Gen PowerSum.toElemSymInt PowerSum.fromElemSym+++++{- * Show -}++appPrec :: Int+appPrec  = 10++instance (Show a) => Show (T a) where+  showsPrec p (Cons xs) =+    showParen (p >= appPrec)+       (showString "RootSet.Cons " . shows xs)+++{- * Additive -}++{- Use binomial expansion of (x+y)^n -}+add :: (Field.C a, ZeroTestable.C a) => [a] -> [a] -> [a]+add = liftPowerSum2 PowerSum.add++addInt :: (Integral.C a, Eq a, ZeroTestable.C a) => [a] -> [a] -> [a]+addInt = liftPowerSumInt2 PowerSum.add++instance (Field.C a, ZeroTestable.C a) => Additive.C (T a) where+   zero   = const zero+   (+)    = lift2 add+   negate = lift1 PolyCore.alternate+++{- * Ring -}++mul :: (Field.C a, ZeroTestable.C a) => [a] -> [a] -> [a]+mul = liftPowerSum2 PowerSum.mul++mulInt :: (Integral.C a, Eq a, ZeroTestable.C a) => [a] -> [a] -> [a]+mulInt = liftPowerSumInt2 PowerSum.mul+++pow :: (Field.C a, ZeroTestable.C a) => Integer -> [a] -> [a]+pow n = liftPowerSum1 (PowerSum.pow n)++powInt :: (Integral.C a, Eq a, ZeroTestable.C a) => Integer -> [a] -> [a]+powInt n = liftPowerSumInt1 (PowerSum.pow n)+++instance (Field.C a, ZeroTestable.C a) => Ring.C (T a) where+   one           = const one+   fromInteger n = const (fromInteger n)+   (*)           = lift2 mul+   x^n           = lift1 (pow n) x+++{- * Field.C -}++instance (Field.C a, ZeroTestable.C a) => Field.C (T a) where+   recip = lift1 reverse+++{- * Algebra -}++instance (Field.C a, ZeroTestable.C a) => Algebraic.C (T a) where+   root n = lift1 (PowerSum.root n)

+ src-ghc-6.12/Number/Complex.hs view

@@ -0,0 +1,575 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{- Rules should be processed -}+{- |+Module      :  Number.Complex+Copyright   :  (c) The University of Glasgow 2001+License     :  BSD-style (see the file libraries/base/LICENSE)++Maintainer  :  numericprelude@henning-thielemann.de+Stability   :  provisional+Portability :  portable (?)++Complex numbers.+-}++module Number.Complex+        (+        -- * Cartesian form+        T(real,imag),+        imaginaryUnit,+        fromReal,++        (+:),+        (-:),+        scale,+        exp,+        quarterLeft,+        quarterRight,++        -- * Polar form+        fromPolar,+        cis,+        signum,+        signumNorm,+        toPolar,+        magnitude,+        magnitudeSqr,+        phase,+        -- * Conjugate+        conjugate,++        -- * Properties+        propPolar,++        -- * Auxiliary classes+        Power(power),+        defltPow,+        )  where++-- import qualified Number.Ratio as Ratio++import qualified Algebra.NormedSpace.Euclidean as NormedEuc+import qualified Algebra.NormedSpace.Sum       as NormedSum+import qualified Algebra.NormedSpace.Maximum   as NormedMax++import qualified Algebra.VectorSpace        as VectorSpace+import qualified Algebra.Module             as Module+import qualified Algebra.Vector             as Vector+import qualified Algebra.RealTranscendental as RealTrans+import qualified Algebra.Transcendental     as Trans+import qualified Algebra.Algebraic          as Algebraic+import qualified Algebra.Field              as Field+import qualified Algebra.Units              as Units+import qualified Algebra.PrincipalIdealDomain as PID+import qualified Algebra.IntegralDomain     as Integral+import qualified Algebra.RealRing           as RealRing+import qualified Algebra.Absolute           as Absolute+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 Algebra.ZeroTestable(isZero)+import Algebra.Module((*>), (<*>.*>), )+import Algebra.Algebraic((^/), )++import qualified NumericPrelude.Elementwise as Elem+import Algebra.Additive ((<*>.+), (<*>.-), (<*>.-$), )++import Foreign.Storable (Storable (..), )+import qualified Foreign.Storable.Record as Store+import Control.Applicative (liftA2, )++import Test.QuickCheck (Arbitrary, arbitrary, )+import Control.Monad (liftM2, )++import qualified Prelude as P+import NumericPrelude.Base+import NumericPrelude.Numeric hiding (signum, exp, )+import Text.Show.HT (showsInfixPrec, )+import Text.Read.HT (readsInfixPrec, )+++-- import qualified Data.Typeable as Ty++infix  6  +:, `Cons`++{- * The Complex type -}++-- | Complex numbers are an algebraic type.+data T a+  = Cons {real :: !a   -- ^ real part+         ,imag :: !a   -- ^ imaginary part+         }+  deriving (Eq)++{-# INLINE imaginaryUnit #-}+imaginaryUnit :: Ring.C a => T a+imaginaryUnit = zero +: one++{-# INLINE fromReal #-}+fromReal :: Additive.C a => a -> T a+fromReal x = Cons x zero+++{-# INLINE plusPrec #-}+plusPrec :: Int+plusPrec = 6++instance (Show a) => Show (T a) where+   showsPrec prec (Cons x y) = showsInfixPrec "+:" plusPrec prec x y++instance (Read a) => Read (T a) where+   readsPrec prec = readsInfixPrec "+:" plusPrec prec (+:)++instance Functor T where+   {-# INLINE fmap #-}+   fmap f (Cons x y) = Cons (f x) (f y)++instance (Arbitrary a) => Arbitrary (T a) where+   {-# INLINE arbitrary #-}+   arbitrary = liftM2 Cons arbitrary arbitrary++instance (Storable a) => Storable (T a) where+   sizeOf    = Store.sizeOf store+   alignment = Store.alignment store+   peek      = Store.peek store+   poke      = Store.poke store++store ::+   (Storable a) =>+   Store.Dictionary (T a)+store =+   Store.run $+   liftA2 (+:)+      (Store.element real)+      (Store.element imag)++++{- * Functions -}++-- | Construct a complex number from real and imaginary part.+{-# INLINE (+:) #-}+(+:) :: a -> a -> T a+(+:) = Cons++-- | Construct a complex number with negated imaginary part.+{-# INLINE (-:) #-}+(-:) :: Additive.C a => a -> a -> T a+(-:) x y = Cons x (-y)++-- | The conjugate of a complex number.+{- SPECIALISE conjugate :: T Double -> T Double -}+{-# INLINE conjugate #-}+conjugate :: (Additive.C a) => T a -> T a+conjugate (Cons x y) =  Cons x (-y)++-- | Scale a complex number by a real number.+{- SPECIALISE scale :: Double -> T Double -> T Double -}+{-# INLINE scale #-}+scale :: (Ring.C a) => a -> T a -> T a+scale r =  fmap (r*)++-- | Exponential of a complex number with minimal type class constraints.+{-# INLINE exp #-}+exp :: (Trans.C a) => T a -> T a+exp (Cons x y) =  scale (Trans.exp x) (cis y)++-- | Turn the point one quarter to the right.+{-# INLINE quarterRight #-}+{-# INLINE quarterLeft #-}+quarterRight, quarterLeft :: (Additive.C a) => T a -> T a+quarterRight (Cons x y) = Cons   y  (-x)+quarterLeft  (Cons x y) = Cons (-y)   x++{- | Scale a complex number to magnitude 1.++For a complex number @z@,+@'abs' z@ is a number with the magnitude of @z@,+but oriented in the positive real direction,+whereas @'signum' z@ has the phase of @z@, but unit magnitude.+-}++{- SPECIALISE signum :: T Double -> T Double -}+signum :: (Algebraic.C a, ZeroTestable.C a) => T a -> T a+signum z =+   if isZero z+     then zero+     else scale (recip (magnitude z)) z++{- SPECIALISE signumNorm :: T Double -> T Double -}+{-# INLINE signumNorm #-}+signumNorm :: (Algebraic.C a, NormedEuc.C a a, ZeroTestable.C a) => T a -> T a+signumNorm z =+   if isZero z+     then zero+     else scale (recip (NormedEuc.norm z)) z++-- | Form a complex number from polar components of magnitude and phase.+{- SPECIALISE fromPolar :: Double -> Double -> T Double -}+{-# INLINE fromPolar #-}+fromPolar :: (Trans.C a) => a -> a -> T a+fromPolar r theta =  scale r (cis theta)++-- | @'cis' t@ is a complex value with magnitude @1@+-- and phase @t@ (modulo @2*'pi'@).+{- SPECIALISE cis :: Double -> T Double -}+{-# INLINE cis #-}+cis :: (Trans.C a) => a -> T a+cis theta =  Cons (cos theta) (sin theta)++propPolar :: (RealTrans.C a) => T a -> Bool+propPolar z =  uncurry fromPolar (toPolar z) == z+++{- |+The nonnegative magnitude of a complex number.+This implementation respects the limited range of floating point numbers.+The trivial implementation 'magnitude'+would overflow for floating point exponents greater than+the half of the maximum admissible exponent.+We automatically drop in this implementation for 'Float' and 'Double'+by optimizer rules.+You should do so for your custom floating point types.+-}+{-# INLINE floatMagnitude #-}+floatMagnitude :: (P.RealFloat a, Algebraic.C a) => T a -> a+floatMagnitude (Cons x y) =+   let k  = max (P.exponent x) (P.exponent y)+       mk = - k+   in  P.scaleFloat k+           (sqrt (P.scaleFloat mk x ^ 2 ++                  P.scaleFloat mk y ^ 2))++{-# INLINE [1] magnitude #-}+magnitude :: (Algebraic.C a) => T a -> a+magnitude = sqrt . magnitudeSqr++{-# RULES+     "Complex.magnitude :: Double"+        magnitude = floatMagnitude :: T Double -> Double;++     "Complex.magnitude :: Float"+        magnitude = floatMagnitude :: T Float -> Float;+  #-}++-- like NormedEuc.normSqr with lifted class constraints+{-# INLINE magnitudeSqr #-}+magnitudeSqr :: (Ring.C a) => T a -> a+magnitudeSqr (Cons x y) = x^2 + y^2++-- | The phase of a complex number, in the range @(-'pi', 'pi']@.+-- If the magnitude is zero, then so is the phase.+{-# INLINE phase #-}+phase :: (RealTrans.C a, ZeroTestable.C a) => T a -> a+phase z =+   if isZero z+     then zero   -- SLPJ July 97 from John Peterson+     else case z of (Cons x y) -> atan2 y x+++{- |+The function 'toPolar' takes a complex number and+returns a (magnitude, phase) pair in canonical form:+the magnitude is nonnegative, and the phase in the range @(-'pi', 'pi']@;+if the magnitude is zero, then so is the phase.+-}+toPolar :: (RealTrans.C a) => T a -> (a,a)+toPolar z = (magnitude z, phase z)++++{- * Instances of T -}++{-+complexTc = Ty.mkTyCon "Complex.T"+instance Ty.Typeable1 T where { typeOf1 _ = Ty.mkTyConApp complexTc [] }+instance Ty.Typeable a => Ty.Typeable (T a) where { typeOf = Ty.typeOfDefault }+-}++instance  (Indexable.C a) => Indexable.C (T a) where+    {-# INLINE compare #-}+    compare (Cons x y) (Cons x' y')  =  Indexable.compare (x,y) (x',y')++instance  (ZeroTestable.C a) => ZeroTestable.C (T a)  where+    {-# INLINE isZero #-}+    isZero (Cons x y)  = isZero x && isZero y++instance  (Additive.C a) => Additive.C (T a)  where+    {- SPECIALISE instance Additive.C (T Float) -}+    {- SPECIALISE instance Additive.C (T Double) -}+    {-# INLINE zero #-}+    {-# INLINE negate #-}+    {-# INLINE (+) #-}+    {-# INLINE (-) #-}+    zero   = Cons zero zero+    (+)    = Elem.run2 $ Elem.with Cons <*>.+  real <*>.+  imag+    (-)    = Elem.run2 $ Elem.with Cons <*>.-  real <*>.-  imag+    negate = Elem.run  $ Elem.with Cons <*>.-$ real <*>.-$ imag++instance  (Ring.C a) => Ring.C (T a)  where+    {- SPECIALISE instance Ring.C (T Float) -}+    {- SPECIALISE instance Ring.C (T Double) -}+    {-# INLINE one #-}+    one                         =  Cons one zero+    {-# INLINE (*) #-}+    (Cons x y) * (Cons x' y')   =  Cons (x*x'-y*y') (x*y'+y*x')+    {-# INLINE fromInteger #-}+    fromInteger                 =  fromReal . fromInteger++instance  (Absolute.C a, Algebraic.C a) => Absolute.C (T a)  where+    {- SPECIALISE instance Absolute.C (T Float) -}+    {- SPECIALISE instance Absolute.C (T Double) -}+    {-# INLINE abs #-}+    {-# INLINE signum #-}+    abs x  = Cons (magnitude x) zero+    signum = signum++instance Vector.C T where+   {-# INLINE zero #-}+   zero  = zero+   {-# INLINE (<+>) #-}+   (<+>) = (+)+   {-# INLINE (*>) #-}+   (*>)  = scale++-- | The '(*>)' method can't replace 'scale'+--   because it requires the Algebra.Module constraint+instance (Module.C a b) => Module.C a (T b) where+   {-# INLINE (*>) #-}+   (*>) = Elem.run2 $ Elem.with Cons <*>.*> real <*>.*> imag+   -- s *> (Cons x y)  = Cons (s *> x) (s *> y)++instance (VectorSpace.C a b) => VectorSpace.C a (T b)++instance (Additive.C a, NormedSum.C a v) => NormedSum.C a (T v) where+   {-# INLINE norm #-}+   norm x = NormedSum.norm (real x) + NormedSum.norm (imag x)++instance (NormedEuc.Sqr a b) => NormedEuc.Sqr a (T b) where+   {-# INLINE normSqr #-}+   normSqr x = NormedEuc.normSqr (real x) + NormedEuc.normSqr (imag x)++instance (Algebraic.C a, NormedEuc.Sqr a b) => NormedEuc.C a (T b) where+   {-# INLINE norm #-}+   norm = NormedEuc.defltNorm++instance (Ord a, NormedMax.C a v) => NormedMax.C a (T v) where+   {-# INLINE norm #-}+   norm x = max (NormedMax.norm (real x)) (NormedMax.norm (imag x))+++{-+  In this implementation the complex plane is structured+  as an orthogonal grid induced by the divisor z'.+  The coordinate of a cell within this grid is returned as quotient+  and the position of the cell in the grid is returned as remainder.+  The magnitude of the remainder might be larger than that of the divisor+  thus the Euclidean algorithm can fail.+-}++instance  (Integral.C a) => Integral.C (T a)  where+    divMod z z' =+       let denom = magnitudeSqr z'+           zBig  = z * conjugate z'+           q     = fmap (flip div denom) zBig+       in  (q, z-q*z')+++{-+  This variant of divMod tries to come close to the origin.+  Thus the remainder has smaller magnitude than the divisor.+  This variant of divModCent can be used for Euclidean's algorithm.+-}+{-# INLINE divModCent #-}+divModCent :: (Ord a, Integral.C a) => T a -> T a -> (T a, T a)+divModCent z z' =+   let denom = magnitudeSqr z'+       zBig  = z * conjugate z'+       re    = divMod (real zBig) denom+       im    = divMod (imag zBig) denom+       q  = Cons (fst re) (fst im)+       r  = Cons (snd re) (snd im)+       q' = Cons+              (real q + if 2 * real r > denom then one else zero)+              (imag q + if 2 * imag r > denom then one else zero)+   in  (q', z-q'*z')++{-# INLINE modCent #-}+modCent :: (Ord a, Integral.C a) => T a -> T a -> T a+modCent z z' = snd (divModCent z z')++instance  (Ord a, Units.C a) => Units.C (T a)  where+    {-# INLINE isUnit #-}+    isUnit (Cons x y) =+       isUnit x && y==zero  ||+       isUnit y && x==zero+    {-# INLINE stdAssociate #-}+    stdAssociate z@(Cons x y) =+       let z' = if y<0  ||  y==0 && x<0 then negate z else z+       in  if real z'<=0 then quarterRight z' else z'+    {-# INLINE stdUnit #-}+    stdUnit z@(Cons x y) =+       if z==zero+         then 1+         else+           let (x',sgn') = if y<0  ||  y==0 && x<0+                             then (negate x, -1)+                             else (x, 1)+           in  if x'<=0 then quarterLeft sgn' else sgn'+++instance  (Ord a, ZeroTestable.C a, Units.C a) => PID.C (T a) where+   {-# INLINE gcd #-}+   gcd         = euclid modCent+   {-# INLINE extendedGCD #-}+   extendedGCD = extendedEuclid divModCent+++{-# INLINE [1] divide #-}+divide :: (Field.C a) => T a -> T a -> T a+divide (Cons x y) z'@(Cons x' y') =+   let d = magnitudeSqr z'+   in  Cons ((x*x'+y*y') / d) ((y*x'-x*y') / d)++-- | Special implementation of @(\/)@ for floating point numbers+--   which prevent intermediate overflows.+{-# INLINE floatDivide #-}+floatDivide :: (P.RealFloat a, Field.C a) => T a -> T a -> T a+floatDivide (Cons x y) (Cons x' y') =+   let k   = - max (P.exponent x') (P.exponent y')+       x'' = P.scaleFloat k x'+       y'' = P.scaleFloat k y'+       d   = x'*x'' + y'*y''+   in  Cons ((x*x''+y*y'') / d) ((y*x''-x*y'') / d)++{-# RULES+     "Complex.divide :: Double"+        divide = floatDivide :: T Double -> T Double -> T Double;++     "Complex.divide :: Float"+        divide = floatDivide :: T Float -> T Float -> T Float;+  #-}+++++instance  (Field.C a) => Field.C (T a)  where+    {-# INLINE (/) #-}+    (/)                 =  divide+    {-# INLINE fromRational' #-}+    fromRational'       =  fromReal . fromRational'++{-|+   We like to build the Complex Algebraic instance+   on top of the Algebraic instance of the scalar type.+   This poses no problem to 'sqrt'.+   However, 'Number.Complex.root' requires computing the complex argument+   which is a transcendent operation.+   In order to keep the type class dependencies clean+   for more sophisticated algebraic number types,+   we introduce a type class which actually performs the radix operation.+-}+class (Algebraic.C a) => (Power a) where+    power  ::  Rational -> T a -> T a+++{-# INLINE defltPow #-}+defltPow :: (RealTrans.C a) =>+    Rational -> T a -> T a+defltPow r x =+    let (mag,arg) = toPolar x+    in  fromPolar (mag ^/ r)+                  (arg * fromRational' r)+++instance  Power Float where+    {-# INLINE power #-}+    power  =  defltPow++instance  Power Double where+    {-# INLINE power #-}+    power  =  defltPow+++instance  (RealRing.C a, Algebraic.C a, Power a) =>+          Algebraic.C (T a)  where+    -- | the real part of the result is always non-negative+    {-# INLINE sqrt #-}+    sqrt z@(Cons x y)  =  if z == zero+                            then zero+                            else+                              let u'    = sqrt ((magnitude z + abs x) / 2)+                                  v'    = abs y / (u'*2)+                                  (u,v) = if x < 0 then (v',u') else (u',v')+                              in  Cons u (if y < 0 then -v else v)+    {-# INLINE (^/) #-}+    (^/) = flip power+++instance  (RealRing.C a, RealTrans.C a, Power a) =>+          Trans.C (T a)  where+    {- SPECIALISE instance Trans.C (T Float) -}+    {- SPECIALISE instance Trans.C (T Double) -}+    {-# INLINE pi #-}+    pi                 =  fromReal pi+    {-# INLINE exp #-}+    exp                =  exp+    {-# INLINE log #-}+    log z              =  let (m,p) = toPolar z in Cons (log m) p++    -- use defaults for tan, tanh++    {-# INLINE sin #-}+    sin (Cons x y)     =  Cons (sin x * cosh y) (  cos x * sinh y)+    {-# INLINE cos #-}+    cos (Cons x y)     =  Cons (cos x * cosh y) (- sin x * sinh y)++    {-# INLINE sinh #-}+    sinh (Cons x y)    =  Cons (cos y * sinh x) (sin y * cosh x)+    {-# INLINE cosh #-}+    cosh (Cons x y)    =  Cons (cos y * cosh x) (sin y * sinh x)++    {-# INLINE asin #-}+    asin z             =  quarterRight (log (quarterLeft z + sqrt (1 - z^2)))+    {-# INLINE acos #-}+    acos z             =  quarterRight (log (z + quarterLeft (sqrt (1 - z^2))))+    {-# INLINE atan #-}+    atan z@(Cons x y)  =  quarterRight (log (Cons (1-y) x / sqrt (1+z^2)))++{- use the default implementation+    asinh z        =  log (z + sqrt (1+z^2))+    acosh z        =  log (z + (z+1) * sqrt ((z-1)/(z+1)))+    atanh z        =  log ((1+z) / sqrt (1-z^2))+-}+++{- * legacy instances -}++{-# INLINE legacyInstance #-}+legacyInstance :: a+legacyInstance =+   error "legacy Ring.C instance for simple input of numeric literals"++instance (Ring.C a, Eq a, Show a) => P.Num (T a) where+   {-# INLINE fromInteger #-}+   fromInteger = fromReal . fromInteger+   {-# INLINE negate #-}+   negate = negate -- for unary minus+   {-# INLINE (+) #-}+   (+)    = legacyInstance+   {-# INLINE (*) #-}+   (*)    = legacyInstance+   {-# INLINE abs #-}+   abs    = legacyInstance+   {-# INLINE signum #-}+   signum = legacyInstance++instance (Field.C a, Eq a, Show a) => P.Fractional (T a) where+   {-# INLINE fromRational #-}+   fromRational = fromRational+   {-# INLINE (/) #-}+   (/) = legacyInstance

+ src-ghc-6.12/Number/ComplexSquareRoot.hs view

@@ -0,0 +1,119 @@+module Number.ComplexSquareRoot where++-- import qualified Algebra.Algebraic as Algebraic+import qualified Algebra.RealField as RealField+import qualified Algebra.RealRing as RealRing+-- 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 Number.Complex as Complex++import Algebra.ZeroTestable(isZero, )++import Test.QuickCheck (Arbitrary, arbitrary, )++import Control.Monad (liftM2, )++import qualified NumericPrelude.Numeric as NP+import NumericPrelude.Numeric hiding (recip, )+import NumericPrelude.Base+import Prelude ()++{- |+Represent the square root of a complex number+without actually having to compute a square root.+If the Bool is False,+then the square root is represented with positive real part+or zero real part and positive imaginary part.+If the Bool is True the square root is negated.+-}+data T a = Cons Bool (Complex.T a)+   deriving (Show)++{- |+You must use @fmap@ only for number type conversion.+-}+instance Functor T where+   fmap f (Cons n x) = Cons n (fmap f x)++instance (ZeroTestable.C a) => ZeroTestable.C (T a) where+   isZero (Cons _b s) = isZero s++instance (ZeroTestable.C a, Eq a) => Eq (T a) where+   (Cons xb xs) == (Cons yb ys) =+      isZero xs && isZero ys  ||+      xb==yb && xs==ys++instance (Arbitrary a) => Arbitrary (T a) where+   arbitrary = liftM2 Cons arbitrary arbitrary+++fromNumber :: (RealRing.C a) => Complex.T a -> T a+fromNumber x =+   Cons+      (case compare zero (Complex.real x) of+         LT -> False+         GT -> True+         EQ -> Complex.imag x < zero)+      (x^2)++-- htam:Wavelet.DyadicResultant.parityFlip+toNumber :: (RealRing.C a, Complex.Power a) => T a -> Complex.T a+toNumber (Cons n x) =+   case sqrt x of y -> if n then NP.negate y else y+++one :: (Ring.C a) => T a+one = Cons False NP.one++inUpperHalfplane :: (Additive.C a, Ord a) => Complex.T a -> Bool+inUpperHalfplane x =+   case compare (Complex.imag x) zero of+      GT -> True+      LT -> False+      EQ -> Complex.real x < zero++mul, mulAlt, mulAlt2 :: (RealRing.C a) => T a -> T a -> T a+mul (Cons xb xs) (Cons yb ys) =+   let zs = xs*ys+   in  Cons+          ((xb /= yb) /=+             case (inUpperHalfplane xs,+                   inUpperHalfplane ys,+                   inUpperHalfplane zs) of+                (True,True,False) -> True+                (False,False,True) -> True+                _ -> False)+          zs++mulAlt (Cons xb xs) (Cons yb ys) =+   let zs = xs*ys+   in  Cons+          ((xb /= yb) /=+             let xi = Complex.imag xs+                 yi = Complex.imag ys+                 zi = Complex.imag zs+             in  (xi>=zero) /= (yi>=zero) &&+                 (xi>=zero) /= (zi>=zero))+          zs++mulAlt2 (Cons xb xs) (Cons yb ys) =+   let zs = xs*ys+   in  Cons+          ((xb /= yb) /=+             let xi = Complex.imag xs+                 yi = Complex.imag ys+                 zi = Complex.imag zs+             in  xi*yi<zero && xi*zi<zero)+          zs++div :: (RealField.C a) => T a -> T a -> T a+div x y = mul x (recip y)++recip :: (RealField.C a) => T a -> T a+recip (Cons b s) =+   Cons+      (b /= (Complex.imag s == zero && Complex.real s < zero))+      (NP.recip s)

+ src-ghc-6.12/Number/DimensionTerm.hs view

@@ -0,0 +1,216 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{- |+Copyright   :  (c) Henning Thielemann 2008+License     :  GPL++Maintainer  :  numericprelude@henning-thielemann.de+Stability   :  provisional+Portability :  portable+++See "Algebra.DimensionTerm".+-}++module Number.DimensionTerm where++import qualified Algebra.DimensionTerm as Dim++import qualified Algebra.OccasionallyScalar as OccScalar+import qualified Algebra.Module        as Module+import qualified Algebra.Algebraic     as Algebraic+import qualified Algebra.Field         as Field+import qualified Algebra.Absolute          as Absolute+import qualified Algebra.Ring          as Ring+import qualified Algebra.Additive      as Additive++import Algebra.Field    ((/), fromRational', )+import Algebra.Ring     ((*), one, fromInteger, )+import Algebra.Additive ((+), (-), zero, negate, )+import Algebra.Module   ((*>), )++import System.Random (Random, randomR, random)++import Data.Tuple.HT (mapFst, )+import NumericPrelude.Base+import Prelude ()+++{- * Number type -}++newtype T u a = Cons a+   deriving (Eq, Ord)+++instance (Dim.C u, Show a) => Show (T u a) where+   showsPrec p x =+      let disect :: T u a -> (u,a)+          disect (Cons y) = (undefined, y)+          (u,z) = disect x+      in  showParen (p >= Dim.appPrec)+            (showString "DimensionNumber.fromNumberWithDimension " . showsPrec Dim.appPrec u .+             showString " " . showsPrec Dim.appPrec z)+++fromNumber :: a -> Scalar a+fromNumber = Cons++toNumber :: Scalar a -> a+toNumber (Cons x) = x++fromNumberWithDimension :: Dim.C u => u -> a -> T u a+fromNumberWithDimension _ = Cons++toNumberWithDimension :: Dim.C u => u -> T u a -> a+toNumberWithDimension _ (Cons x) = x+++instance (Dim.C u, Additive.C a) => Additive.C (T u a) where+   zero                = Cons zero+   (Cons a) + (Cons b) = Cons (a+b)+   (Cons a) - (Cons b) = Cons (a-b)+   negate (Cons a)     = Cons (negate a)++instance (Dim.C u, Module.C a b) => Module.C a (T u b) where+   a *> (Cons b) = Cons (a *> b)++instance (Dim.IsScalar u, Ring.C a) => Ring.C (T u a) where+   one                 = Cons one+   (Cons a) * (Cons b) = Cons (a*b)+   fromInteger a       = Cons (fromInteger a)++instance (Dim.IsScalar u, Field.C a) => Field.C (T u a) where+   (Cons a) / (Cons b) = Cons (a/b)+   recip (Cons a)      = Cons (Field.recip a)+   fromRational' a     = Cons (fromRational' a)++instance (Dim.IsScalar u, OccScalar.C a b) => OccScalar.C a (T u b) where+   toScalar =+      OccScalar.toScalar . toNumber . rewriteDimension Dim.toScalar+   toMaybeScalar =+      OccScalar.toMaybeScalar . toNumber . rewriteDimension Dim.toScalar+   fromScalar =+      rewriteDimension Dim.fromScalar . fromNumber . OccScalar.fromScalar++instance (Dim.C u, Random a) => Random (T u a) where+  randomR (Cons l, Cons u) = mapFst Cons . randomR (l,u)+  random = mapFst Cons . random+++infixl 7 &*&, *&+infixl 7 &/&++(&*&) :: (Dim.C u, Dim.C v, Ring.C a) =>+   T u a -> T v a -> T (Dim.Mul u v) a+(&*&) (Cons x) (Cons y) = Cons (x Ring.* y)++(&/&) :: (Dim.C u, Dim.C v, Field.C a) =>+   T u a -> T v a -> T (Dim.Mul u (Dim.Recip v)) a+(&/&) (Cons x) (Cons y) = Cons (x Field./ y)++mulToScalar :: (Dim.C u, Ring.C a) =>+   T u a -> T (Dim.Recip u) a -> a+mulToScalar x y = cancelToScalar (x &*& y)++divToScalar :: (Dim.C u, Field.C a) =>+   T u a -> T u a -> a+divToScalar x y = cancelToScalar (x &/& y)++cancelToScalar :: (Dim.C u) =>+   T (Dim.Mul u (Dim.Recip u)) a -> a+cancelToScalar =+   toNumber . rewriteDimension Dim.cancelRight+++recip :: (Dim.C u, Field.C a) =>+   T u a -> T (Dim.Recip u) a+recip (Cons x) = Cons (Field.recip x)++unrecip :: (Dim.C u, Field.C a) =>+   T (Dim.Recip u) a -> T u a+unrecip (Cons x) = Cons (Field.recip x)++sqr :: (Dim.C u, Ring.C a) =>+   T u a -> T (Dim.Sqr u) a+sqr x = x &*& x++sqrt :: (Dim.C u, Algebraic.C a) =>+   T (Dim.Sqr u) a -> T u a+sqrt (Cons x) = Cons (Algebraic.sqrt x)+++abs :: (Dim.C u, Absolute.C a) => T u a -> T u a+abs (Cons x) = Cons (Absolute.abs x)++absSignum :: (Dim.C u, Absolute.C a) => T u a -> (T u a, a)+absSignum x0@(Cons x) = (abs x0, Absolute.signum x)++scale, (*&) :: (Dim.C u, Ring.C a) =>+   a -> T u a -> T u a+scale x (Cons y) = Cons (x Ring.* y)++(*&) = scale+++rewriteDimension :: (Dim.C u, Dim.C v) => (u -> v) -> T u a -> T v a+rewriteDimension _ (Cons x) = Cons x+++{-+type class for converting Dim types to Dim value is straight-forward+   class SIDimensionType u where+      dynamic :: DimensionNumber u a -> SIValue a++   instance SIDimensionType Scalar where+      dynamic (DimensionNumber.Cons x) = SIValue.scalar x++   instance SIDimensionType Length where+      dynamic (DimensionNumber.Cons x) = SIValue.meter * dynamic x+-}+++{- * Example constructors -}++type Scalar      a = T Dim.Scalar a+type Length      a = T Dim.Length a+type Time        a = T Dim.Time a+type Mass        a = T Dim.Mass a+type Charge      a = T Dim.Charge a+type Angle       a = T Dim.Angle a+type Temperature a = T Dim.Temperature a+type Information a = T Dim.Information a++type Frequency   a = T Dim.Frequency a+type Voltage     a = T Dim.Voltage a+++scalar :: a -> Scalar a+scalar = fromNumber++length :: a -> Length a+length = Cons++time :: a -> Time a+time = Cons++mass :: a -> Mass a+mass = Cons++charge :: a -> Charge a+charge = Cons++frequency :: a -> Frequency a+frequency = Cons++angle :: a -> Angle a+angle = Cons++temperature :: a -> Temperature a+temperature = Cons++information :: a -> Information a+information = Cons+++voltage :: a -> Voltage a+voltage = Cons

+ src-ghc-6.12/Number/DimensionTerm/SI.hs view

@@ -0,0 +1,125 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Copyright   :  (c) Henning Thielemann 2003+License     :  GPL++Maintainer  :  numericprelude@henning-thielemann.de+Stability   :  provisional+Portability :  portable++Special physical units: SI unit system+-}++module Number.DimensionTerm.SI (+    second, minute, hour, day, year,+    hertz,+    meter,+    -- liter,+    gramm, tonne,+    -- newton,+    -- pascal,+    -- bar,+    -- joule,+    -- watt,+    coulomb,+    -- ampere,+    volt,+    -- ohm,+    -- farad,+    kelvin,+    bit, byte,+    -- baud,++    inch, foot, yard, astronomicUnit, parsec,++    SI.yocto, SI.zepto, SI.atto,  SI.femto, SI.pico, SI.nano,+    SI.micro, SI.milli, SI.centi, SI.deci,  SI.one,  SI.deca,+    SI.hecto, SI.kilo,  SI.mega,  SI.giga,  SI.tera, SI.peta,+    SI.exa,   SI.zetta, SI.yotta,+    ) where++-- import qualified Algebra.Transcendental      as Trans+import qualified Algebra.Field               as Field++-- import qualified Algebra.DimensionTerm as Dim+import qualified Number.DimensionTerm  as DN+import qualified Number.SI.Unit as SI++-- aimport NumericPrelude.Base hiding (length)+import NumericPrelude.Numeric hiding (one)+++second  :: Field.C a => DN.Time        a+second  = DN.time        1e+0+minute  :: Field.C a => DN.Time        a+minute  = DN.time        SI.secondsPerMinute+hour    :: Field.C a => DN.Time        a+hour    = DN.time        SI.secondsPerHour+day     :: Field.C a => DN.Time        a+day     = DN.time        SI.secondsPerDay+year    :: Field.C a => DN.Time        a+year    = DN.time        SI.secondsPerYear+hertz   :: Field.C a => DN.Frequency a+hertz   = DN.frequency   1e+0+meter   :: Field.C a => DN.Length      a+meter   = DN.length      1e+0+-- liter   :: Field.C a => DN.Volume      a+-- liter   = DN.volume      1e-3+gramm   :: Field.C a => DN.Mass        a+gramm   = DN.mass        1e-3+tonne   :: Field.C a => DN.Mass        a+tonne   = DN.mass        1e+3+-- newton  :: Field.C a => DN.Force       a+-- newton  = DN.force       1e+0+-- pascal  :: Field.C a => DN.Pressure    a+-- pascal  = DN.pressure    1e+0+-- bar     :: Field.C a => DN.Pressure    a+-- bar     = DN.pressure    1e+5+-- joule   :: Field.C a => DN.Energy      a+-- joule   = DN.energy      1e+0+-- watt    :: Field.C a => DN.Power       a+-- watt    = DN.power       1e+0+coulomb :: Field.C a => DN.Charge      a+coulomb = DN.charge      1e+0+-- ampere  :: Field.C a => DN.Current     a+-- ampere  = DN.current     1e+0+volt    :: Field.C a => DN.Voltage     a+volt    = DN.voltage     1e+0+-- ohm     :: Field.C a => DN.Resistance  a+-- ohm     = DN.resistance  1e+0+-- farad   :: Field.C a => DN.Capacitance a+-- farad   = DN.capacitance 1e+0+kelvin  :: Field.C a => DN.Temperature a+kelvin  = DN.temperature 1e+0+bit     :: Field.C a => DN.Information a+bit     = DN.information 1e+0+byte    :: Field.C a => DN.Information a+byte    = DN.information SI.bytesize+-- baud    :: Field.C a => DN.DataRate    a+-- baud    = DN.dataRate    1e+0++inch, foot, yard, astronomicUnit, parsec+   :: Field.C a => DN.Length a++inch           = DN.length SI.meterPerInch+foot           = DN.length SI.meterPerFoot+yard           = DN.length SI.meterPerYard+astronomicUnit = DN.length SI.meterPerAstronomicUnit+parsec         = DN.length SI.meterPerParsec++{-+accelerationOfEarthGravity :: Field.C a => DN.Acceleration    a+accelerationOfEarthGravity = DN.acceleration SI.accelerationOfEarthGravity++mach         :: Field.C a => DN.Speed a+speedOfLight :: Field.C a => DN.Speed a+electronVolt :: Field.C a => DN.Energy a+calorien     :: Field.C a => DN.Energy a+horsePower   :: Field.C a => DN.Power a++mach         = DN.speed        SI.mach+speedOfLight = DN.speed        SI.speedOfLight+electronVolt = DN.energy       SI.electronVolt+calorien     = DN.energy       SI.calorien+horsePower   = DN.power        SI.horsePower+-}

+ src-ghc-6.12/Number/FixedPoint.hs view

@@ -0,0 +1,235 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Copyright   :  (c) Henning Thielemann 2006++Maintainer  :  numericprelude@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++Fixed point numbers.+They are implemented as ratios with fixed denominator.+Many routines fail for some arguments.+When they work,+they can be useful for obtaining approximations of some constants.+We have not paid attention to rounding errors+and thus some of the trailing digits may be wrong.+-}+module Number.FixedPoint where++import qualified Algebra.RealRing    as RealRing+-- import qualified Algebra.Additive       as Additive+-- import qualified Algebra.ZeroTestable   as ZeroTestable+import qualified Algebra.Transcendental as Trans+import qualified MathObj.PowerSeries.Example as PSE++import NumericPrelude.List (mapLast, )+import Data.Function.HT (powerAssociative, )+import Data.List.HT (dropWhileRev, padLeft, )+import Data.Maybe.HT (toMaybe, )+import Data.List (transpose, unfoldr, )+import Data.Char (intToDigit, )++import NumericPrelude.Base+import NumericPrelude.Numeric hiding (recip, sqrt, exp, sin, cos, tan,+                              fromRational')++import qualified NumericPrelude.Numeric as NP+++{- ** Conversion -}++{- ** other number types -}++fromFloat :: RealRing.C a => Integer -> a -> Integer+fromFloat den x =+   round (x * NP.fromInteger den)++-- | denominator conversion+fromFixedPoint :: Integer -> Integer -> Integer -> Integer+fromFixedPoint denDst denSrc x = div (x*denDst) denSrc+++{- ** text -}++{- |+very efficient because it can make use of the decimal output of 'show'+-}+showPositionalDec :: Integer -> Integer -> String+showPositionalDec den = liftShowPosToInt $ \x ->+   let packetSize = 50  -- process digits in packets of this size+       basis = ringPower packetSize 10+       (int,frac) = toPositional basis den x+   in  show int ++ "." +++          concat (mapLast (dropWhileRev ('0'==))+             (map (padLeft '0' packetSize . show) frac))++showPositionalHex :: Integer -> Integer -> String+showPositionalHex = showPositionalBasis 16++showPositionalBin :: Integer -> Integer -> String+showPositionalBin = showPositionalBasis 2++showPositionalBasis :: Integer -> Integer -> Integer -> String+showPositionalBasis basis den = liftShowPosToInt $ \x ->+   let (int,frac) = toPositional basis den x+   in  show int ++ "." ++ map (intToDigit . fromInteger) frac++liftShowPosToInt :: (Integer -> String) -> (Integer -> String)+liftShowPosToInt f n =+   if n>=0+     then       f   n+     else '-' : f (-n)++toPositional :: Integer -> Integer -> Integer -> (Integer, [Integer])+toPositional basis den x =+   let (int, frac) = divMod x den+   in  (int, unfoldr (\rm -> toMaybe (rm/=0) (divMod (basis*rm) den)) frac)+++{- * Additive -}++add :: Integer -> Integer -> Integer -> Integer+add _ = (+)++sub :: Integer -> Integer -> Integer -> Integer+sub _ = (-)+++{- * Ring -}++mul :: Integer -> Integer -> Integer -> Integer+mul den x y = div (x*y) den+++{- * Field -}++divide :: Integer -> Integer -> Integer -> Integer+divide den x y = div (x*den) y++recip :: Integer -> Integer -> Integer+recip den x = div (den^2) x+++{- * Algebra -}++{-+Newton's method for computing roots.+-}++magnitudes :: [Integer]+magnitudes =+   concat (transpose [iterate (^2) 4, iterate (^2) 8])++{-+Maybe we can speed up the algorithm+by calling sqrt recursively on deflated arguments.+-}+sqrt :: Integer -> Integer -> Integer+sqrt den x =+   let xden     = x*den+       initial  = fst (head (dropWhile ((<= xden) . snd)+                                (zip magnitudes (tail (tail magnitudes)))))+       approxs  = iterate (\y -> div (y + div xden y) 2) initial+       isRoot y = y^2 <= xden && xden < (y+1)^2+   in  head (dropWhile (not . isRoot) approxs)++-- bug: needs too long:  root (12::Int) (fromIntegerBase 10 1000 2)+root :: Integer -> Integer -> Integer -> Integer+root n den x =+   let n1       = n-1+       xden     = x * den^n1+       initial  = fst (head (dropWhile ((\y -> y^n <= xden) . snd)+                                (zip magnitudes (tail magnitudes))))+       approxs  = iterate (\y -> div (n1*y + div xden (y^n1)) n) initial+       isRoot y = y^n <= xden && xden < (y+1)^n+   in  head (dropWhile (not . isRoot) approxs)++++{- * Transcendental -}++-- very simple evaluation by power series with lots of rounding errors+evalPowerSeries :: [Rational] -> Integer -> Integer -> Integer+evalPowerSeries series den x =+   let powers   = iterate (mul den x) den+       summands = zipWith (\c p -> round (c * fromInteger p)) series powers+   in  sum (map snd (takeWhile (\(c,s) -> s/=0 || c==0)+                               (zip series summands)))++cos, sin, tan :: Integer -> Integer -> Integer+cos = evalPowerSeries PSE.cos+sin = evalPowerSeries PSE.sin+-- tan will suffer from inaccuracies for small cosine+tan den x = divide den (sin den x) (cos den x)++-- it must abs x <= den+arctanSmall :: Integer -> Integer -> Integer+arctanSmall = evalPowerSeries PSE.atan++-- will fail for large inputs+arctan :: Integer -> Integer -> Integer+arctan den x =+   let estimate = fromFloat den+                     (Trans.atan (NP.fromRational' (x % den)) :: Double)+       tanEst   = tan den estimate+       residue  = divide den (x-tanEst) (den + mul den x tanEst)+   in  estimate + arctanSmall den residue++piConst :: Integer -> Integer+piConst den =+   let den4 = 4*den+       stArcTan k x = let d = k*den4 in arctanSmall d (div d x)+   in  {- formula 4 * (8 * arctan (1/10) - arctan (1/239) - 4 * arctan (1/515))+             from "Bartsch: Mathematische Formeln" -}+       -- (stArcTan 8 10 - stArcTan 1 239 - stArcTan 4 515)+       -- formula by Stoermer+       (stArcTan 44 57 + stArcTan 7 239 - stArcTan 12 682 + stArcTan 24 12943)+++expSmall :: Integer -> Integer -> Integer+expSmall = evalPowerSeries PSE.exp++eConst :: Integer -> Integer+eConst den = expSmall den den++recipEConst :: Integer -> Integer+recipEConst den = expSmall den (-den)++exp :: Integer -> Integer -> Integer+exp den x =+   let den2 = div den 2+       (int,frac) = divMod (x + den2) den+       expFrac = expSmall den (frac-den2)+   in  case compare int 0 of+          EQ -> expFrac+          GT -> powerAssociative (mul den) expFrac (eConst      den)   int+          LT -> powerAssociative (mul den) expFrac (recipEConst den) (-int)+          -- LT -> nest (-int) (divide den e) expFrac+++approxLogBase :: Integer -> Integer -> (Int, Integer)+approxLogBase base x =+   until ((<=base) . snd) (\(xE,xM) -> (succ xE, div xM base)) (0,x)++lnSmall :: Integer -> Integer -> Integer+lnSmall den x =+   evalPowerSeries PSE.log den (x-den)++-- uses Double's log for an estimate and dramatic speed up+ln :: Integer -> Integer -> Integer+ln den x =+   let fac = 10^50 {- A constant which is representable by Double+                      and which will quickly split our number it pieces+                      small enough for Double. -}+       (denE, denM) = approxLogBase fac den+       (xE,   xM)   = approxLogBase fac x+       approxDouble :: Double+       approxDouble =+          log (NP.fromInteger fac) * fromIntegral (xE-denE) ++          log (NP.fromInteger xM / NP.fromInteger denM)+       {- We convert first with respect to @fac@+          in order to keep in the range of Double values. -}+       approxFac = round (approxDouble * NP.fromInteger fac)+       approx    = fromFixedPoint den fac approxFac+       xSmall    = divide den x (exp den approx)+   in  add den approx (lnSmall den xSmall)

+ src-ghc-6.12/Number/FixedPoint/Check.hs view

@@ -0,0 +1,194 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Number.FixedPoint.Check where++import qualified Number.FixedPoint as FP++import qualified MathObj.PowerSeries.Example as PSE++import qualified Algebra.Transcendental as Trans+import qualified Algebra.Algebraic      as Algebraic+import qualified Algebra.RealRing      as RealRing+import qualified Algebra.Field          as Field+import qualified Algebra.Absolute           as Absolute+import qualified Algebra.Ring           as Ring+import qualified Algebra.Additive       as Additive+import qualified Algebra.ZeroTestable   as ZeroTestable++import NumericPrelude.Base+import NumericPrelude.Numeric   hiding (fromRational')++import qualified Prelude        as P98+import qualified NumericPrelude.Numeric as NP+++{- * Types -}++data T = Cons {denominator :: Integer, numerator :: Integer}+++{- * Conversion -}++cons :: Integer -> Integer -> T+cons = Cons++{- ** other number types -}++fromFloat :: RealRing.C a => Integer -> a -> T+fromFloat den x =+   cons den (FP.fromFloat den x)++fromInteger' :: Integer -> Integer -> T+fromInteger' den x =+   cons den (x * den)++fromRational' :: Integer -> Rational -> T+fromRational' den x =+   cons den (round (x * NP.fromInteger den))++fromFloatBasis :: RealRing.C a => Integer -> Int -> a -> T+fromFloatBasis basis numDigits =+   fromFloat (ringPower numDigits basis)++fromIntegerBasis :: Integer -> Int -> Integer -> T+fromIntegerBasis basis numDigits =+   fromInteger' (ringPower numDigits basis)++fromRationalBasis :: Integer -> Int -> Rational -> T+fromRationalBasis basis numDigits =+   fromRational' (ringPower numDigits basis)++-- | denominator conversion+fromFixedPoint :: Integer -> T -> T+fromFixedPoint denDst (Cons denSrc x) =+   cons denDst (FP.fromFixedPoint denDst denSrc x)+++{- * Lift core function -}++lift0 :: Integer -> (Integer -> Integer) -> T+lift0 den f = Cons den (f den)++lift1 :: (Integer -> Integer -> Integer) -> (T -> T)+lift1 f (Cons xd xn) = Cons xd (f xd xn)++lift2 :: (Integer -> Integer -> Integer -> Integer) -> (T -> T -> T)+lift2 f (Cons xd xn) (Cons yd yn) =+   commonDenominator xd yd $ Cons xd (f xd xn yn)++commonDenominator :: Integer -> Integer -> a -> a+commonDenominator xd yd z =+   if xd == yd+     then z+     else error "Number.FixedPoint: denominators differ"+++{- * Show -}++appPrec :: Int+appPrec  = 10++instance Show T where+  showsPrec p (Cons den num) =+    showParen (p >= appPrec)+       (showString "FixedPoint.cons " . shows den+          . showString " " . shows num)+++defltDenominator :: Integer+defltDenominator = 10^100++defltShow :: T -> String+defltShow (Cons den x) =+   FP.showPositionalDec den x++++instance Additive.C T where+   zero   = cons defltDenominator zero+   (+)    = lift2 FP.add+   (-)    = lift2 FP.sub+   negate (Cons xd xn) = Cons xd (negate xn)+++instance Ring.C T where+   one         = cons defltDenominator defltDenominator+   fromInteger = fromInteger' defltDenominator . NP.fromInteger+   (*)         = lift2 FP.mul+   -- the default instance of (^) cumulates rounding errors but is faster+   -- x^n           = lift1 (pow n) x+++instance Field.C T where+   (/)   = lift2 FP.divide+   recip = lift1 FP.recip+   fromRational' = fromRational' defltDenominator . NP.fromRational'+++instance Algebraic.C T where+   sqrt   = lift1 FP.sqrt+   root n = lift1 (FP.root n)+++-- these function are only implemented for the convergence radius of their Taylor expansions+instance Trans.C T where+   pi    = lift0 defltDenominator FP.piConst+   exp   = lift1 FP.exp+   log   = lift1 FP.ln+   {-+   logBase+   (**)+   -}+   sin   = lift1 (FP.evalPowerSeries PSE.sin)+   cos   = lift1 (FP.evalPowerSeries PSE.cos)+   -- tan   = lift1 (FP.evalPowerSeries PSE.tan)+   asin  = lift1 (FP.evalPowerSeries PSE.asin)+   atan  = lift1 FP.arctan+   {-+   acos  = lift1 (FP.evalPowerSeries PSE.acos)+   sinh  = lift1 (FP.evalPowerSeries PSE.sinh)+   tanh  = lift1 (FP.evalPowerSeries PSE.tanh)+   cosh  = lift1 (FP.evalPowerSeries PSE.cosh)+   asinh = lift1 (FP.evalPowerSeries PSE.asinh)+   atanh = lift1 (FP.evalPowerSeries PSE.atanh)+   acosh = lift1 (FP.evalPowerSeries PSE.acosh)+   -}+++instance ZeroTestable.C T where+   isZero (Cons _ xn)  =  isZero xn++instance Eq T where+   (Cons xd xn) == (Cons yd yn) =+      commonDenominator xd yd (xn==yn)++instance Ord T where+   compare (Cons xd xn) (Cons yd yn) =+      commonDenominator xd yd (compare xn yn)++instance Absolute.C T where+   abs = lift1 (const abs)+   signum = Absolute.signumOrd++instance RealRing.C T where+   splitFraction (Cons xd xn) =+      let (int, frac) = divMod xd xn+      in  (fromInteger int, Cons xd frac)++++-- legacy instances for work with GHCi+legacyInstance :: a+legacyInstance =+   error "legacy Ring.C instance for simple input of numeric literals"++instance P98.Num T where+   fromInteger = fromInteger' defltDenominator+   negate = negate --for unary minus+   (+)    = legacyInstance+   (*)    = legacyInstance+   abs    = legacyInstance+   signum = legacyInstance++instance P98.Fractional T where+   fromRational = fromRational' defltDenominator . fromRational+   (/) = legacyInstance

+ src-ghc-6.12/Number/GaloisField2p32m5.hs view

@@ -0,0 +1,92 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{- |+This number type is intended for tests of functions over fields,+where the field elements need constant space.+This way we can provide a Storable instance.+For 'Rational' this would not be possible.++However, be aware that sums of non-zero elements may yield zero.+Thus division is not always safe, where it is for rational numbers.+-}+module Number.GaloisField2p32m5 where++import qualified Number.ResidueClass as RC+import qualified Algebra.Module   as Module+import qualified Algebra.Field    as Field+import qualified Algebra.Ring     as Ring+import qualified Algebra.Additive as Additive++import Data.Int (Int64, )+import Data.Word (Word32, Word64, )++import qualified Foreign.Storable.Newtype as SN+import qualified Foreign.Storable as St++import Test.QuickCheck (Arbitrary(arbitrary), )++import NumericPrelude.Base+import NumericPrelude.Numeric+++newtype T = Cons {decons :: Word32}+   deriving Eq++{-# INLINE appPrec #-}+appPrec :: Int+appPrec  = 10++instance Show T where+   showsPrec p (Cons x) =+      showsPrec p x+{-+      showParen (p >= appPrec)+         (showString "GF2p32m5.Cons " . shows x)+-}++instance Arbitrary T where+   arbitrary = fmap (Cons . fromInteger . flip mod base) arbitrary++instance St.Storable T where+   sizeOf = SN.sizeOf decons+   alignment = SN.alignment decons+   peek = SN.peek Cons+   poke = SN.poke decons+++base :: Ring.C a => a+base = 2^32-5+++{-# INLINE lift2 #-}+lift2 :: (Word64 -> Word64 -> Word64) -> (T -> T -> T)+lift2 f (Cons x) (Cons y) =+   Cons (fromIntegral (mod (f (fromIntegral x) (fromIntegral y)) base))++{-# INLINE lift2Integer #-}+lift2Integer :: (Int64 -> Int64 -> Int64) -> (T -> T -> T)+lift2Integer f (Cons x) (Cons y) =+   Cons (fromIntegral (mod (f (fromIntegral x) (fromIntegral y)) base))+++instance Additive.C T where+   zero = Cons zero+   (+) = lift2 (+)+--   (-) = lift2 (-)+   x-y = x + negate y+   negate n@(Cons x) =+      if x==0+        then n+        else Cons (base-x)++instance Ring.C T where+   one = Cons one+   (*) = lift2 (*)+   fromInteger =+      Cons . fromInteger . flip mod base++instance Field.C T where+   (/) = lift2Integer (RC.divide base)++instance Module.C T T where+   (*>) = (*)

+ src-ghc-6.12/Number/NonNegative.hs view

@@ -0,0 +1,214 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++{-+Rationale for -fno-warn-orphans:+ * The orphan instances can't be put into Numeric.NonNegative.Wrapper+   since that's in another package.+ * We had to spread the instance declarations+   over the modules defining the typeclasses instantiated.+   Do we want that?+-}++{- |+Copyright   :  (c) Henning Thielemann 2007++Maintainer  :  haskell@henning-thielemann.de+Stability   :  stable+Portability :  Haskell 98++A type for non-negative numbers.+It performs a run-time check at construction time (i.e. at run-time)+and is a member of the non-negative number type class+'Numeric.NonNegative.Class.C'.+-}+module Number.NonNegative+   (T, fromNumber, fromNumberMsg, fromNumberClip, fromNumberUnsafe, toNumber,+    NonNegW.Int, NonNegW.Integer, NonNegW.Float, NonNegW.Double,+    Ratio, Rational) where++import Numeric.NonNegative.Wrapper+   (T, fromNumberUnsafe, toNumber, )+import qualified Numeric.NonNegative.Wrapper as NonNegW++import qualified Algebra.NonNegative        as NonNeg+import qualified Algebra.Transcendental     as Trans+import qualified Algebra.Algebraic          as Algebraic+import qualified Algebra.RealRing          as RealRing+import qualified Algebra.Field              as Field+import qualified Algebra.RealIntegral       as RealIntegral+import qualified Algebra.IntegralDomain     as Integral+import qualified Algebra.Absolute               as Absolute+import qualified Algebra.Ring               as Ring+import qualified Algebra.Additive           as Additive+import qualified Algebra.Monoid             as Monoid+import qualified Algebra.ZeroTestable       as ZeroTestable++import qualified Algebra.ToInteger          as ToInteger+import qualified Algebra.ToRational         as ToRational+-- import Test.QuickCheck (Arbitrary(arbitrary))++import qualified Number.Ratio as R++import NumericPrelude.Base+import Data.Tuple.HT (mapSnd, mapPair, )+import NumericPrelude.Numeric hiding (Int, Integer, Float, Double, Rational, )+++{- |+Convert a number to a non-negative number.+If a negative number is given, an error is raised.+-}+fromNumber :: (Ord a, Additive.C a) =>+      a+   -> T a+fromNumber = fromNumberMsg "fromNumber"++fromNumberMsg :: (Ord a, Additive.C a) =>+      String  {- ^ name of the calling function to be used in the error message -}+   -> a+   -> T a+fromNumberMsg funcName x =+   if x>=zero+     then fromNumberUnsafe x+     else error (funcName++": negative number")++fromNumberWrap :: (Ord a, Additive.C a) =>+      String+   -> a+   -> T a+fromNumberWrap funcName =+   fromNumberMsg ("Number.NonNegative."++funcName)++{- |+Convert a number to a non-negative number.+A negative number will be replaced by zero.+Use this function with care since it may hide bugs.+-}+fromNumberClip :: (Ord a, Additive.C a) =>+      a+   -> T a+fromNumberClip = fromNumberUnsafe . max zero++++{- |+Results are not checked for positivity.+-}+lift :: (a -> a) -> (T a -> T a)+lift f = fromNumberUnsafe . f . toNumber++liftWrap :: (Ord a, Additive.C a) => String -> (a -> a) -> (T a -> T a)+liftWrap msg f = fromNumberWrap msg . f . toNumber+++{- |+Results are not checked for positivity.+-}+lift2 :: (a -> a -> a) -> (T a -> T a -> T a)+lift2 f x y =+   fromNumberUnsafe $ f (toNumber x) (toNumber y)++++instance ZeroTestable.C a => ZeroTestable.C (T a) where+   isZero = isZero . toNumber++instance (Additive.C a) => Monoid.C (T a) where+   idt = fromNumberUnsafe Additive.zero+   x <*> y = fromNumberUnsafe (toNumber x + toNumber y)+--   mconcat = fromNumberUnsafe . sum . map toNumber++instance (Ord a, Additive.C a) => NonNeg.C (T a) where+   split = NonNeg.splitDefault toNumber fromNumberUnsafe++instance (Ord a, Additive.C a) => Additive.C (T a) where+   zero   = fromNumberUnsafe zero+   (+)    = lift2 (+)+   (-)    = liftWrap "-" . (-) . toNumber+   negate = liftWrap "negate" negate++instance (Ord a, Ring.C a) => Ring.C (T a) where+   (*)    = lift2 (*)+   fromInteger = fromNumberWrap "fromInteger" . fromInteger++instance (Ord a, ToRational.C a) => ToRational.C (T a) where+   toRational = ToRational.toRational . toNumber++instance ToInteger.C a => ToInteger.C (T a) where+   toInteger = toInteger . toNumber++{- already defined in the imported module+instance (Ord a, Additive.C a, Enum a) => Enum (T a) where+   toEnum   = fromNumberWrap "toEnum" . toEnum+   fromEnum = fromEnum . toNumber++instance (Ord a, Additive.C a, Bounded a) => Bounded (T a) where+   minBound = fromNumberClip minBound+   maxBound = fromNumberWrap "maxBound" maxBound++instance (Additive.C a, Arbitrary a) => Arbitrary (T a) where+   arbitrary = liftM (fromNumberUnsafe . abs) arbitrary+-}++instance RealIntegral.C a => RealIntegral.C (T a) where+   quot = lift2 quot+   rem  = lift2 rem+   quotRem x y =+      mapPair+         (fromNumberUnsafe, fromNumberUnsafe)+         (quotRem (toNumber x) (toNumber y))++instance (Ord a, Integral.C a) => Integral.C (T a) where+   div  = lift2 div+   mod  = lift2 mod+   divMod x y =+      mapPair+         (fromNumberUnsafe, fromNumberUnsafe)+         (divMod (toNumber x) (toNumber y))++instance (Ord a, Field.C a) => Field.C (T a) where+   fromRational' = fromNumberWrap "fromRational" . fromRational'+   (/) = lift2 (/)+++instance (ZeroTestable.C a, Ord a, Absolute.C a) => Absolute.C (T a) where+   abs    = lift abs+   signum = lift signum++instance (RealRing.C a) => RealRing.C (T a) where+   splitFraction = mapSnd fromNumberUnsafe . splitFraction . toNumber+   truncate = truncate . toNumber+   round    = round    . toNumber+   ceiling  = ceiling  . toNumber+   floor    = floor    . toNumber++instance (Ord a, Algebraic.C a) => Algebraic.C (T a) where+   sqrt = lift sqrt+   (^/) x r = lift (^/ r) x++instance (Ord a, Trans.C a) => Trans.C (T a) where+   pi = fromNumber pi+   exp  = lift exp+   log  = liftWrap "log" log+   (**) = lift2 (**)+   logBase = liftWrap "logBase" . logBase . toNumber+   sin = liftWrap "sin" sin+   tan = liftWrap "tan" tan+   cos = liftWrap "cos" cos+   asin = liftWrap "asin" asin+   atan = liftWrap "atan" atan+   acos = liftWrap "acos" acos+   sinh = liftWrap "sinh" sinh+   tanh = liftWrap "tanh" tanh+   cosh = liftWrap "cosh" cosh+   asinh = liftWrap "asinh" asinh+   atanh = liftWrap "atanh" atanh+   acosh = liftWrap "acosh" acosh+++type Ratio a  = T (R.T a)+type Rational = T R.Rational+++{- legacy instances already defined in non-negative package -}

+ src-ghc-6.12/Number/NonNegativeChunky.hs view

@@ -0,0 +1,311 @@+{- |+Copyright   :  (c) Henning Thielemann 2007-2010++Maintainer  :  haskell@henning-thielemann.de+Stability   :  stable+Portability :  Haskell 98++A lazy number type, which is a generalization of lazy Peano numbers.+Comparisons can be made lazy and+thus computations are possible which are impossible with strict number types,+e.g. you can compute @let y = min (1+y) 2 in y@.+You can even work with infinite values.+However, depending on the granularity,+the memory consumption is higher than that for strict number types.+This number type is of interest for the merge operation of event lists,+which allows for co-recursive merges.+-}+module Number.NonNegativeChunky+   (T, fromChunks, toChunks, fromNumber, toNumber, fromChunky98, toChunky98,+    minMaxDiff, normalize, isNull, isPositive,+    divModLazy, divModStrict, ) where++import qualified Numeric.NonNegative.Chunky as Chunky98+import qualified Numeric.NonNegative.Class as NonNeg98++import qualified Algebra.NonNegative  as NonNeg+import qualified Algebra.Field        as Field+import qualified Algebra.Absolute         as Absolute+import qualified Algebra.Ring         as Ring+import qualified Algebra.Additive     as Additive+import qualified Algebra.ToInteger    as ToInteger+import qualified Algebra.ToRational   as ToRational+import qualified Algebra.IntegralDomain as Integral+import qualified Algebra.RealIntegral as RealIntegral+import qualified Algebra.ZeroTestable as ZeroTestable+import Algebra.ZeroTestable (isZero, )++import qualified Algebra.Monoid as Monoid+import qualified Data.Monoid as Mn98++import Control.Monad (liftM, liftM2, )+import Data.Tuple.HT (mapFst, mapSnd, mapPair, )++import Test.QuickCheck (Arbitrary(arbitrary))++import NumericPrelude.Numeric+import NumericPrelude.Base+import qualified Prelude as P98 (Num(..), Fractional(..), )+++{- |+A chunky non-negative number is a list of non-negative numbers.+It represents the sum of the list elements.+It is possible to represent a finite number with infinitely many chunks+by using an infinite number of zeros.++Note the following problems:++Addition is commutative only for finite representations.+E.g. @let y = min (1+y) 2 in y@ is defined,+@let y = min (y+1) 2 in y@ is not.++The type is equivalent to 'Numeric.NonNegative.Chunky'.+-}+newtype T a = Cons {decons :: [a]}+++fromChunks :: NonNeg.C a => [a] -> T a+fromChunks = Cons++toChunks :: NonNeg.C a => T a -> [a]+toChunks = decons++fromChunky98 :: (NonNeg.C a, NonNeg98.C a) => Chunky98.T a -> T a+fromChunky98 = fromChunks . Chunky98.toChunks++toChunky98 :: (NonNeg.C a, NonNeg98.C a) => T a -> Chunky98.T a+toChunky98 = Chunky98.fromChunks . toChunks++fromNumber :: NonNeg.C a => a -> T a+fromNumber = fromChunks . (:[])++toNumber :: NonNeg.C a => T a -> a+toNumber =  Monoid.cumulate . toChunks++++lift2 :: NonNeg.C a => ([a] -> [a] -> [a]) -> (T a -> T a -> T a)+lift2 f x y =+   fromChunks $ f (toChunks x) (toChunks y)++{- |+Remove zero chunks.+-}+normalize :: NonNeg.C a => T a -> T a+normalize = fromChunks . filter (> NonNeg.zero) . toChunks++isNullList :: NonNeg.C a => [a] -> Bool+isNullList = null . filter (> NonNeg.zero)++isNull :: NonNeg.C a => T a -> Bool+isNull = isNullList . toChunks+  -- null . toChunks . normalize++isPositive :: NonNeg.C a => T a -> Bool+isPositive = not . isNull++++{-+normalizeZT :: ZeroTestable.C a => T a -> T a+normalizeZT = fromChunks . filter (not . isZero) . toChunks+-}++isNullListZT :: ZeroTestable.C a => [a] -> Bool+isNullListZT = null . filter (not . isZero)++isNullZT :: ZeroTestable.C a => T a -> Bool+isNullZT = isNullListZT . decons+  -- null . toChunks . normalize+{-+isPositiveZT :: ZeroTestable.C a => T a -> Bool+isPositiveZT = not . isNull+-}+++check :: String -> Bool -> a -> a+check funcName b x =+   if b+     then x+     else error ("Numeric.NonNegative.Chunky."++funcName++": negative number")+++glue :: (NonNeg.C a) => [a] -> [a] -> ([a], (Bool, [a]))+glue [] ys = ([], (True,  ys))+glue xs [] = ([], (False, xs))+glue (x:xs) (y:ys) =+   let (z,~(zs,brs)) =+          flip mapSnd (NonNeg.split x y) $+          \(b,d) ->+             if b+               then glue xs $+                    if NonNeg.zero == d+                      then ys else d:ys+               else glue (d:xs) ys+   in  (z:zs,brs)++minMaxDiff :: (NonNeg.C a) => T a -> T a -> (T a, (Bool, T a))+minMaxDiff (Cons xs) (Cons ys) =+   let (zs, (b, rs)) = glue xs ys+   in  (Cons zs, (b, Cons rs))++equalList :: (NonNeg.C a) => [a] -> [a] -> Bool+equalList x y =+   isNullList $ snd $ snd $ glue x y++compareList :: (NonNeg.C a) => [a] -> [a] -> Ordering+compareList x y =+   let (b,r) = snd $ glue x y+   in  if isNullList r+         then EQ+         else if b then LT else GT++minList :: (NonNeg.C a) => [a] -> [a] -> [a]+minList x y =+   fst $ glue x y++maxList :: (NonNeg.C a) => [a] -> [a] -> [a]+maxList x y =+   -- matching the inner pair lazily is important+   let (z,~(_,r)) = glue x y in z++r+++instance (NonNeg.C a) => Eq (T a) where+   (Cons x) == (Cons y) = equalList x y++instance (NonNeg.C a) => Ord (T a) where+   compare (Cons x) (Cons y) = compareList x y+   min = lift2 minList+   max = lift2 maxList+++instance (NonNeg.C a) => NonNeg.C (T a) where+   split (Cons xs) (Cons ys) =+      let (zs, ~(b, rs)) = glue xs ys+      in  (Cons zs, (b, Cons rs))++instance (ZeroTestable.C a) => ZeroTestable.C (T a) where+   isZero = isNullZT++instance (NonNeg.C a) => Additive.C (T a) where+   zero  = Monoid.idt+   (+)   = (Monoid.<*>)+   (Cons x) - (Cons y) =+      let (b,d) = snd $ glue x y+          d' = Cons d+      in check "-" (not b || isNull d') d'+   negate x = check "negate" (isNull x) x+{-+   x0 - y0 =+      let d' = lift2 (\x y -> let (_,d,b) = glue x y in  d) x0 y0+      in  check "-" (not b || isNull d') d'+-}++instance (Ring.C a, NonNeg.C a) => Ring.C (T a) where+   one   = fromNumber one+   (*)   = lift2 (liftM2 (*))+   fromInteger = fromNumber . fromInteger++instance (Ring.C a, ZeroTestable.C a, NonNeg.C a) => Absolute.C (T a) where+   abs    = id+   signum = fromNumber . (\b -> if b then one else zero) . isPositive++instance (ToInteger.C a, NonNeg.C a) => ToInteger.C (T a) where+   toInteger = sum . map toInteger . toChunks++instance (ToRational.C a, NonNeg.C a) => ToRational.C (T a) where+   toRational = sum . map toRational . toChunks+++instance (RealIntegral.C a, NonNeg.C a) => RealIntegral.C (T a) where+   quot = div+   rem  = mod+   quotRem = divMod++{- |+'divMod' is implemented in terms of 'divModStrict'.+If it is needed we could also provide a function+that accesses the divisor first in a lazy way+and then uses a strict divisor for subsequent rounds of the subtraction loop.+This way we can handle the cases \"dividend smaller than divisor\"+and \"dividend greater than divisor\" in a lazy and efficient way.+However changing the way of operation within one number is also not nice.+-}+instance (Ord a, Integral.C a, NonNeg.C a) => Integral.C (T a) where+   divMod x y =+      mapSnd fromNumber $+      divModStrict x (toNumber y)++{- |+divModLazy accesses the divisor in a lazy way.+However this is only relevant if the dividend is smaller than the divisor.+For large dividends the divisor will be accessed multiple times+but since it is already fully evaluated it could also be strict.+-}+divModLazy ::+   (Ring.C a, NonNeg.C a) =>+   T a -> T a -> (T a, T a)+divModLazy x0 y0 =+   let y = toChunks y0+       recourse x =+          let (r,~(b,d)) = glue y x+          in  if not b+                then ([], r)+                else mapFst (one:) (recourse d)+   in  mapPair+          (fromChunks, fromChunks)+          (recourse (toChunks x0))++{- |+This function has a strict divisor+and maintains the chunk structure of the dividend at a smaller scale.+-}+divModStrict ::+   (Integral.C a, NonNeg.C a) =>+   T a -> a -> (T a, a)+divModStrict x0 y =+   let recourse [] r = ([], r)+       recourse (x:xs) r0 =+          case divMod (x+r0) y of+             (q,r1) -> mapFst (q:) $ recourse xs r1+   in  mapFst fromChunks $ recourse (toChunks x0) zero++++instance (Show a) => Show (T a) where+   showsPrec p x =+      showParen (p>10)+         (showString "Chunky.fromChunks " . showsPrec 10 (decons x))+++instance (NonNeg.C a, Arbitrary a) => Arbitrary (T a) where+   arbitrary = liftM Cons arbitrary++++{- * legacy instances -}++legacyInstance :: a+legacyInstance =+   error "legacy Ring.C instance for simple input of numeric literals"++instance (Ring.C a, Eq a, Show a, NonNeg.C a) => P98.Num (T a) where+   fromInteger = fromNumber . fromInteger+   negate = Additive.negate -- for unary minus+   (+)    = legacyInstance+   (*)    = legacyInstance+   abs    = legacyInstance+   signum = legacyInstance++instance (Field.C a, Eq a, Show a, NonNeg.C a) => P98.Fractional (T a) where+   fromRational = fromNumber . fromRational+   (/) = legacyInstance++instance (NonNeg.C a) => Mn98.Monoid (T a) where+   mempty  = Monoid.idt+   mappend = (Monoid.<*>)++instance (NonNeg.C a) => Monoid.C (T a) where+   idt   = Cons []+   (<*>) = lift2 (++)

+ src-ghc-6.12/Number/OccasionallyScalarExpression.hs view

@@ -0,0 +1,196 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{- |+Copyright   :  (c) Henning Thielemann 2004+License     :  GPL++Maintainer  :  numericprelude@henning-thielemann.de+Stability   :  provisional+Portability :  multi-type parameter classes (vector space)++Physical expressions track the operations made on physical values+so we are able to give detailed information on how to resolve+unit violations.+-}++module Number.OccasionallyScalarExpression where++import qualified Algebra.Transcendental      as Trans+import qualified Algebra.Algebraic           as Algebraic+import qualified Algebra.Field               as Field+import qualified Algebra.Absolute                as Absolute+import qualified Algebra.Ring                as Ring+import qualified Algebra.Additive            as Additive+import qualified Algebra.ZeroTestable        as ZeroTestable++import Algebra.Algebraic (sqrt, (^/))+import qualified Algebra.OccasionallyScalar as OccScalar++import Data.Maybe(fromMaybe)+import Data.Array(listArray,(!))++import NumericPrelude.Base+import NumericPrelude.Numeric+++{- | A value of type 'T' stores information on how to resolve unit violations.+     The main application of the module are certainly+     Number.Physical type instances+     but in principle it can also be applied to other occasionally scalar types. -}+data T a v = Cons (Term a v) v++data Term a v =+     Const+   | Add (T a v) (T a v)+   | Mul (T a v) (T a v)+   | Div (T a v) (T a v)++fromValue :: v -> T a v+fromValue = Cons Const+++makeLine :: Int -> String -> String+makeLine indent str = replicate indent ' ' ++ str ++ "\n"++showUnitError :: (Show v) => Bool -> Int -> v -> T a v -> String+showUnitError divide indent x (Cons expr y) =+  let indent'   = indent+2+      showSub d = showUnitError d (indent'+2) x+      mulDivArr = listArray (False, True) ["multiply", "divide"]+  in  makeLine indent+         (mulDivArr ! divide +++          " " ++ show y ++ " by " ++ show x) +++      case expr of+        (Const) -> ""+        (Add y0 y1) ->+          makeLine indent' "e.g." +++          showSub divide y0 +++          makeLine indent' "and " +++          showSub divide y1+        (Mul y0 y1) ->+          makeLine indent' "e.g." +++          showSub divide y0 +++          makeLine indent' "or  " +++          showSub divide y1+        (Div y0 y1) ->+          makeLine indent' "e.g." +++          showSub divide y0 +++          makeLine indent' "or  " +++          showSub (not divide) y1+++lift :: (v -> v) -> (T a v -> T a v)+lift f (Cons xe x) = Cons xe (f x)++fromScalar :: (Show v, OccScalar.C a v) =>+   a -> T a v+fromScalar = OccScalar.fromScalar++scalarMap :: (Show v, OccScalar.C a v) =>+   (a -> a) -> (T a v -> T a v)+scalarMap f x = OccScalar.fromScalar (f (OccScalar.toScalar x))++scalarMap2 :: (Show v, OccScalar.C a v) =>+   (a -> a -> a) -> (T a v -> T a v -> T a v)+scalarMap2 f x y = OccScalar.fromScalar (f (OccScalar.toScalar x) (OccScalar.toScalar y))+++instance (Show v) => Show (T a v) where+  show (Cons _ x) = show x++instance (Eq v) => Eq (T a v) where+  (Cons _ x) == (Cons _ y) = x==y++instance (Ord v) => Ord (T a v) where+  compare (Cons _ x) (Cons _ y) = compare x y++instance (Additive.C v) => Additive.C (T a v) where+  zero = Cons Const zero+  xe@(Cons _ x) + ye@(Cons _ y) = Cons (Add xe ye) (x+y)+  xe@(Cons _ x) - ye@(Cons _ y) = Cons (Add xe ye) (x-y)+  negate = lift negate++instance (Ring.C v) => Ring.C (T a v) where+  xe@(Cons _ x) * ye@(Cons _ y) = Cons (Mul xe ye) (x*y)++  fromInteger = fromValue . fromInteger++instance (Field.C v) => Field.C (T a v) where+  xe@(Cons _ x) / ye@(Cons _ y) = Cons (Div xe ye) (x/y)+  fromRational' = fromValue . fromRational'++instance (ZeroTestable.C v) => ZeroTestable.C (T a v) where+  isZero (Cons _ x) = isZero x++instance (Absolute.C v) => Absolute.C (T a v) where+  {- are these definitions sensible? -}+  abs    = lift abs+  signum = lift signum+++{- This instance is not quite satisfying.+   The expression data structure should also keep track of powers+   in order to report according errors. -}+instance (Algebraic.C a, Field.C v, Show v, OccScalar.C a v) =>+    Algebraic.C (T a v) where+  sqrt    = scalarMap  sqrt+  x ^/ y  = scalarMap  (^/ y) x++instance (Trans.C a, Field.C v, Show v, OccScalar.C a v) =>+    Trans.C (T a v) where+  pi      = fromScalar pi+  log     = scalarMap  log+  exp     = scalarMap  exp+  logBase = scalarMap2 logBase+  (**)    = scalarMap2 (**)+  cos     = scalarMap  cos+  tan     = scalarMap  tan+  sin     = scalarMap  sin+  acos    = scalarMap  acos+  atan    = scalarMap  atan+  asin    = scalarMap  asin+  cosh    = scalarMap  cosh+  tanh    = scalarMap  tanh+  sinh    = scalarMap  sinh+  acosh   = scalarMap  acosh+  atanh   = scalarMap  atanh+  asinh   = scalarMap  asinh+++instance (OccScalar.C a v, Show v)+      => OccScalar.C a (T a v) where+   toScalar xe@(Cons _ x) =+      fromMaybe+         (error (show xe ++ " is not a scalar value.\n" +++                 showUnitError True 0 x xe))+         (OccScalar.toMaybeScalar x)+   toMaybeScalar (Cons _ x) = OccScalar.toMaybeScalar x+   fromScalar = fromValue . OccScalar.fromScalar+++{-+  I would like to use OccasionallyScalar.toScalar+  in fmap and (>>=) to allow more sophisticated error messages+  for types that support more descriptive error messages.+  But this requires constraints to the type arguments of+  Functor and Monad.+-}+++{- Operators for lifting scalar operations to+   operations on physical values -}+{-+instance Functor (T i) where+  fmap f (Cons xu x) =+    if Unit.isScalar xu+    then OccScalar.fromScalar (f x)+    else error "Physics.Quantity.Value.fmap: function for scalars, only"++instance Monad (T i) where+  (>>=) (Cons xu x) f =+    if Unit.isScalar xu+    then f x+    else error "Physics.Quantity.Value.(>>=): function for scalars, only"+  return = OccScalar.fromScalar+-}

+ src-ghc-6.12/Number/PartiallyTranscendental.hs view

@@ -0,0 +1,91 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Define Transcendental functions on arbitrary fields.+These functions are defined for only a few (in most cases only one) arguments,+that's why discourage making these types instances of 'Algebra.Transcendental.C'.+But instances of 'Algebra.Transcendental.C' can be useful when working with power series.+If you intent to work with power series with 'Rational' coefficients,+you might consider using @MathObj.PowerSeries.T (Number.PartiallyTranscendental.T Rational)@+instead of @MathObj.PowerSeries.T Rational@.+-}+module Number.PartiallyTranscendental (T, fromValue, toValue) where++import qualified Algebra.Transcendental as Transcendental+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 NumericPrelude.Numeric+import NumericPrelude.Base++import qualified Prelude as P+++newtype T a = Cons {toValue :: a}+   deriving (Eq, Ord, Show)++fromValue :: a -> T a+fromValue = lift0++lift0 :: a -> T a+lift0 = Cons++lift1 :: (a -> a) -> (T a -> T a)+lift1 f (Cons x0) = Cons (f x0)++lift2 :: (a -> a -> a) -> (T a -> T a -> T a)+lift2 f (Cons x0) (Cons x1) = Cons (f x0 x1)+++instance (Additive.C a) => Additive.C (T a) where+    negate = lift1 negate+    (+)    = lift2 (+)+    (-)    = lift2 (-)+    zero   = lift0 zero++instance (Ring.C a) => Ring.C (T a) where+    one           = lift0 one+    fromInteger n = lift0 (fromInteger n)+    (*)           = lift2 (*)++instance (Field.C a) => Field.C (T a) where+    (/) = lift2 (/)++instance (Algebraic.C a) => Algebraic.C (T a) where+    sqrt x = lift1 sqrt x+    root n = lift1 (Algebraic.root n)+    (^/) x y = lift1 (^/y) x++instance (Algebraic.C a, Eq a) => Transcendental.C (T a) where+    pi = undefined+    exp = \0 -> 1+    sin = \0 -> 0+    cos = \0 -> 1+    tan = \0 -> 0+    x ** y = if x==1 || y==0+               then 1+               else error "partially transcendental power undefined"+    log  = \1 -> 0+    asin = \0 -> 0+    acos = \1 -> 0+    atan = \0 -> 0++++legacyInstance :: a+legacyInstance = error "legacy Ring instance for simple input of numeric literals"+++instance (P.Num a) => P.Num (T a) where+   fromInteger n = lift0 $ P.fromInteger n+   negate = P.negate -- for unary minus+   (+)    = legacyInstance+   (*)    = legacyInstance+   abs    = legacyInstance+   signum = legacyInstance++instance (P.Num a) => P.Fractional (T a) where+   fromRational = P.fromRational+   (/) = legacyInstance

+ src-ghc-6.12/Number/Peano.hs view

@@ -0,0 +1,432 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Copyright    :   (c) Henning Thielemann 2007+Maintainer   :   numericprelude@henning-thielemann.de+Stability    :   provisional+Portability  :   portable++Lazy Peano numbers represent natural numbers inclusive infinity.+Since they are lazily evaluated,+they are optimally for use as number type of 'Data.List.genericLength' et.al.+-}+module Number.Peano where++import qualified Algebra.PrincipalIdealDomain as PID+import qualified Algebra.Units                as Units+import qualified Algebra.RealIntegral         as RealIntegral+import qualified Algebra.IntegralDomain       as Integral+import qualified Algebra.Absolute             as Absolute+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 qualified Algebra.Monoid               as Monoid++import qualified Algebra.ToInteger            as ToInteger+import qualified Algebra.ToRational           as ToRational+import qualified Algebra.NonNegative          as NonNeg++import qualified Algebra.EqualityDecision as EqDec+import qualified Algebra.OrderDecision    as OrdDec++import Data.Maybe (catMaybes, )+import Data.Array(Ix(..))++import qualified Prelude     as P98+import qualified NumericPrelude.Base as P+import qualified NumericPrelude.Numeric as NP+import Data.List.HT (mapAdjacent, shearTranspose, )+import Data.Tuple.HT (mapFst, )++import NumericPrelude.Base+import NumericPrelude.Numeric+++data T = Zero+       | Succ T+   deriving (Show, Read, Eq)++infinity :: T+infinity = Succ infinity++err :: String -> String -> a+err func msg = error ("Number.Peano."++func++": "++msg)+++instance ZeroTestable.C T where+   isZero Zero     = True+   isZero (Succ _) = False++add :: T -> T -> T+add Zero y = y+add (Succ x) y = Succ (add x y)++sub :: T -> T -> T+sub x y =+   let (sign,z) = subNeg y x+   in  if sign+         then err "sub" "negative difference"+         else z++subNeg :: T -> T -> (Bool, T)+subNeg Zero y = (False, y)+subNeg x Zero = (True,  x)+subNeg (Succ x) (Succ y) = subNeg x y+++mul :: T -> T -> T+mul Zero _ = Zero+mul _ Zero = Zero+mul (Succ x) y = add y (mul x y)++fromPosEnum :: (ZeroTestable.C a, Enum a) => a -> T+fromPosEnum n =+   if isZero n+      then Zero+      else Succ (fromPosEnum (pred n))++toPosEnum :: (Additive.C a, Enum a) => T -> a+toPosEnum Zero = zero+toPosEnum (Succ x) = succ (toPosEnum x)++instance Additive.C T where+   zero = Zero+   (+) = add+   (-) = sub+   negate Zero     = Zero+   negate (Succ _) = err "negate" "cannot negate positive number"++instance Ring.C T where+   one = Succ Zero+   (*) = mul+   fromInteger n =+      if n<0+        then err "fromInteger" "Peano numbers are always non-negative"+        else fromPosEnum n++instance Enum T where+   pred Zero = err "pred" "Zero has no predecessor"+   pred (Succ x) = x+   succ = Succ+   toEnum n =+      if n<0+        then err "toEnum" "Peano numbers are always non-negative"+        else fromPosEnum n+   fromEnum = toPosEnum+   enumFrom x = iterate Succ x+   enumFromThen x y =+      let (sign,d) = subNeg x y+      in  if sign+            then iterate (sub d) x+            else iterate (add d) x+   {-+   enumFromTo =+   enumFromThenTo =+   -}+++{- |+If all values are completely defined,+then it holds++> if b then x else y == ifLazy b x y++However if @b@ is undefined,+then it is at least known that the result is larger than @min x y@.+-}+ifLazy :: Bool -> T -> T -> T+ifLazy b (Succ x) (Succ y) = Succ (ifLazy b x y)+ifLazy b x y = if b then x else y++instance EqDec.C T where+   (==?) x y = ifLazy (x==y)++instance OrdDec.C T where+   (<=?) x y le gt = ifLazy (x<=y) le gt++{-+The default instance is good for compare,+but fails for min and max.+-}+instance Ord T where+   compare (Succ x) (Succ y) = compare x y+   compare Zero     (Succ _) = LT+   compare (Succ _) Zero     = GT+   compare Zero     Zero     = EQ++   min (Succ x) (Succ y) = Succ (min x y)+   min _        _        = Zero++   max (Succ x) (Succ y) = Succ (max x y)+   max Zero     y        = y+   max x        Zero     = x++   {-+   This special implementation works also for undefined < Zero.+   Thanks to Peter Divianszky for the hint.+   -}+   _      < Zero   = False+   Zero   < _      = True+   Succ n < Succ m = n < m++   x > y  = y < x++   x <= y = not (y < x)++   x >= y = not (x < y)+++{- | cf.+To how to find the shortest list in a list of lists efficiently,+this means, also in the presence of infinite lists.+<http://www.haskell.org/pipermail/haskell-cafe/2006-October/018753.html>+-}+argMinFull :: (T,a) -> (T,a) -> (T,a)+argMinFull (x0,xv) (y0,yv) =+   let recourse (Succ x) (Succ y) =+          let (z,zv) = recourse x y+          in  (Succ z, zv)+       recourse Zero _ = (Zero,xv)+       recourse _    _ = (Zero,yv)+   in  recourse x0 y0++{- |+On equality the first operand is returned.+-}+argMin :: (T,a) -> (T,a) -> a+argMin x y = snd $ argMinFull x y++argMinimum :: [(T,a)] -> a+argMinimum = snd . foldl1 argMinFull+++argMaxFull :: (T,a) -> (T,a) -> (T,a)+argMaxFull (x0,xv) (y0,yv) =+   let recourse (Succ x) (Succ y) =+          let (z,zv) = recourse x y+          in  (Succ z, zv)+       recourse x Zero = (x,xv)+       recourse _ y    = (y,yv)+   in  recourse x0 y0++{- |+On equality the first operand is returned.+-}+argMax :: (T,a) -> (T,a) -> a+argMax x y = snd $ argMaxFull x y++argMaximum :: [(T,a)] -> a+argMaximum = snd . foldl1 argMaxFull++++-- isAscending - naive implementations++{- |+@x0 <= x1 && x1 <= x2 ... @+for possibly infinite numbers in finite lists.+-}+isAscendingFiniteList :: [T] -> Bool+isAscendingFiniteList [] = True+isAscendingFiniteList (x:xs) =+   let decrement (Succ y) = Just y+       decrement _ = Nothing+   in  case x of+         Zero -> isAscendingFiniteList xs+         Succ xd ->+           case mapM decrement xs of+             Nothing -> False+             Just xsd -> isAscendingFiniteList (xd : xsd)++isAscendingFiniteNumbers :: [T] -> Bool+isAscendingFiniteNumbers = and . mapAdjacent (<=)+++-- isAscending - sophisticated implementations - explicit++toListMaybe :: a -> T -> [Maybe a]+toListMaybe a =+   let recourse Zero     = [Just a]+       recourse (Succ x) = Nothing : recourse x+   in  recourse++{- |+In @glue x y == (z,(b,r))@+@z@ represents @min x y@,+@r@ represents @max x y - min x y@,+and @x<=y  ==  b@.++Cf. Numeric.NonNegative.Chunky+-}+glue :: T -> T -> (T, (Bool, T))+glue Zero ys = (Zero, (True, ys))+glue xs Zero = (Zero, (False, xs))+glue (Succ xs) (Succ ys) =+   mapFst Succ $ glue xs ys++{-+Implementation notes:+We check all pairs of adjacent numbers for correct order.+We obtain a set of booleans, which must all be True.+The order of checking these booleans is crucial.+Pairs of numbers that are infinitely big or infinitely far in the list+must be checked \"last\".+Thus we order the booleans according to their computation costs+(list position + magnitude of number)+using 'shearTranspose'.+-}+isAscending :: [T] -> Bool+isAscending =+   and . catMaybes . concat .+   shearTranspose .+   mapAdjacent (\x y ->+      let (costs0,(le,_)) = glue x y+      in  toListMaybe le costs0)+++-- isAscending - use a cost measuring data type (could generalized to a monad, when considered as Writer monad, see htam and unique-logic packages++-- following an idea of vixy http://moonpatio.com:8080/fastcgi/hpaste.fcgi/view?id=562++data Valuable a = Valuable {costs :: T, value :: a}+   deriving (Show, Eq, Ord)+++increaseCosts :: T -> Valuable a -> Valuable a+increaseCosts inc ~(Valuable c x) = Valuable (inc+c) x++{- |+Compute '(&&)' with minimal costs.+-}+infixr 3 &&~+(&&~) :: Valuable Bool -> Valuable Bool -> Valuable Bool+(&&~) (Valuable xc xb) (Valuable yc yb) =+   let (minc,~(le,difc)) = glue xc yc+       (bCheap,bExpensive) =+          if le+            then (xb,yb)+            else (yb,xb)+   in  increaseCosts minc $+       uncurry Valuable $+       if bCheap+         then (difc, bExpensive)+         else (Zero, False)++andW :: [Valuable Bool] -> Valuable Bool+andW =+   foldr+      (\b acc -> b &&~ increaseCosts one acc)+      (Valuable Zero True)++leW :: T -> T -> Valuable Bool+leW x y =+   let (minc,~(le,_difc)) = glue x y+   in  Valuable minc le++isAscendingW :: [T] -> Valuable Bool+isAscendingW =+   andW . mapAdjacent leW++{-+test with++*Number.Peano> isAscendingW [0,infinity,infinity,5]+False+-}+++-- instances++instance Absolute.C T where+   signum Zero     = zero+   signum (Succ _) = one+   abs             = id++instance ToInteger.C T where+   toInteger = toPosEnum++instance ToRational.C T where+   toRational = toRational . toInteger++instance RealIntegral.C T where+   quot = div+   rem  = mod+   quotRem = divMod++instance Integral.C T where+   div x y = fst (divMod x y)+   mod x y = snd (divMod x y)+   divMod x y =+      let (isNeg,d) = subNeg y x+      in  if isNeg+            then (zero,x)+            else let (q,r) = divMod d y in (succ q,r)++instance Monoid.C T where+   idt = zero+   (<*>) = add+   cumulate = foldr add Zero++instance NonNeg.C T where+   split = glue++instance Ix T where+   range = uncurry enumFromTo+   index (lower,_) i =+      let (sign,offset) = subNeg lower i+      in  if sign+            then err "index" "index out of range"+            else toPosEnum offset+   inRange (lower,upper) i =+      isAscending [lower, i, upper]+   rangeSize (lower,upper) =+      toPosEnum (sub lower (succ upper))++instance Indexable.C T where+   compare = Indexable.ordCompare++instance Units.C T where+   isUnit x  =  x == one+   stdAssociate  =  id+   stdUnit    _ = one+   stdUnitInv _ = one++instance PID.C T where+   gcd = PID.euclid mod+   extendedGCD = PID.extendedEuclid divMod++instance Bounded T where+   minBound = Zero+   maxBound = infinity++++legacyInstance :: a+legacyInstance =+   error "legacy Ring.C instance for simple input of numeric literals"++instance P98.Num T where+   fromInteger = Ring.fromInteger+   negate = Additive.negate -- for unary minus+   (+) = add+   (-) = sub+   (*) = mul+   signum = legacyInstance+   abs = legacyInstance++-- for use with genericLength et.al.+instance P98.Real T where+   toRational = P98.toRational . toInteger++instance P98.Integral T where+   rem  = div+   quot = mod+   quotRem = divMod+   div x y = fst (divMod x y)+   mod x y = snd (divMod x y)+   divMod x y =+      let (sign,d) = subNeg y x+      in  if sign+            then (0,x)+            else let (q,r) = divMod d y in (succ q,r)+   toInteger = toPosEnum

+ src-ghc-6.12/Number/Physical.hs view

@@ -0,0 +1,236 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{- |+Copyright   :  (c) Henning Thielemann 2003-2006+License     :  GPL++Maintainer  :  numericprelude@henning-thielemann.de+Stability   :  provisional+Portability :  generic instances++Numeric values combined with abstract Physical Units+-}++module Number.Physical where++import qualified Number.Physical.Unit as Unit++import           Algebra.OccasionallyScalar  as OccScalar+import qualified Algebra.VectorSpace         as VectorSpace+import qualified Algebra.Module              as Module+import qualified Algebra.Vector              as Vector+import qualified Algebra.Transcendental      as Trans+import qualified Algebra.Algebraic           as Algebraic+import qualified Algebra.Field               as Field+import qualified Algebra.Absolute                as Absolute+import qualified Algebra.Ring                as Ring+import qualified Algebra.Additive            as Additive+import qualified Algebra.ZeroTestable        as ZeroTestable++import qualified Algebra.ToInteger      as ToInteger++import Algebra.Algebraic (sqrt, (^/))++import qualified Number.Ratio as Ratio++import Control.Monad(guard,liftM,liftM2)++import Data.Maybe.HT(toMaybe)+import Data.Maybe(fromMaybe)++import NumericPrelude.Numeric+import NumericPrelude.Base+++-- | A Physics.Quantity.Value.T combines a numeric value with a physical unit.+data T i a = Cons (Unit.T i) a++-- | Construct a physical value from a numeric value and+-- the full vector representation of a unit.+quantity :: (Ord i, Enum i, Ring.C a) => [Int] -> a -> T i a+quantity v = Cons (Unit.fromVector v)++fromScalarSingle :: a -> T i a+fromScalarSingle = Cons Unit.scalar++-- | Test for the neutral Unit.T. Also a zero has a unit!+isScalar :: T i a -> Bool+isScalar (Cons u _) = Unit.isScalar u+++{- Using (((join.).).liftM2) you can turn madd and msub+   into operations that map Maybes to Maybes -}++-- | apply a function to the numeric value while preserving the unit+lift :: (a -> b) -> T i a -> T i b+lift f (Cons xu x) = Cons xu (f x)++lift2 :: (Eq i) => String -> (a -> b -> c) -> T i a -> T i b -> T i c+lift2 opName op x y =+   fromMaybe (errorUnitMismatch opName) (lift2Maybe op x y)++lift2Maybe :: (Eq i) => (a -> b -> c) -> T i a -> T i b -> Maybe (T i c)+lift2Maybe op (Cons xu x) (Cons yu y) =+   toMaybe (xu==yu) (Cons xu (op x y))++lift2Gen :: (Eq i) => String -> (a -> b -> c) -> T i a -> T i b -> c+lift2Gen opName op (Cons xu x) (Cons yu y) =+   if (xu==yu)+     then op x y+     else errorUnitMismatch opName++errorUnitMismatch :: String -> a+errorUnitMismatch opName =+   error ("Physics.Quantity.Value."++opName++": units mismatch")++++-- | Add two values if the units match, otherwise return Nothing+addMaybe :: (Eq i, Additive.C a) =>+  T i a -> T i a -> Maybe (T i a)+addMaybe = lift2Maybe (+)++-- | Subtract two values if the units match, otherwise return Nothing+subMaybe :: (Eq i, Additive.C a) =>+  T i a -> T i a -> Maybe (T i a)+subMaybe = lift2Maybe (-)+++scale :: (Ord i, Ring.C a) => a -> T i a -> T i a+scale x = lift (x*)++ratPow :: Trans.C a => Ratio.T Int -> T i a -> T i a+ratPow expo (Cons xu x) =+  Cons (Unit.ratScale expo xu) (x ** fromRatio expo)++ratPowMaybe :: (Trans.C a) =>+    Ratio.T Int -> T i a -> Maybe (T i a)+ratPowMaybe expo (Cons xu x) =+  fmap (flip Cons (x ** fromRatio expo)) (Unit.ratScaleMaybe expo xu)++fromRatio :: (Field.C b, ToInteger.C a) => Ratio.T a -> b+fromRatio expo = fromIntegral (numerator expo) /+                 fromIntegral (denominator expo)++++instance (ZeroTestable.C v) => ZeroTestable.C (T a v) where+  isZero (Cons _ x) = isZero x++instance (Eq i, Eq a) => Eq (T i a) where+  (==) = lift2Gen "(==)" (==)++instance (Ord i, Enum i, Show a) => Show (T i a) where+  --show (Cons xu x) = show x ++ " !* " ++ show (Unit.toVector xu)+  show (Cons xu x) = "quantity " ++ show (Unit.toVector xu) ++ " " ++ show x++instance (Ord i, Additive.C a) => Additive.C (T i a) where+  zero   = fromScalarSingle zero+  -- Add two values if the units match, otherwise raise an error+  (+)    = lift2 "(+)" (+)+  -- Subtract two values if the units match, otherwise raise an error+  (-)    = lift2 "(-)" (-)+  negate = lift negate++instance (Ord i, Ring.C a) => Ring.C (T i a) where+  (Cons xu x) * (Cons yu y) = Cons (xu+yu) (x*y)+  fromInteger = fromScalarSingle . fromInteger++instance (Ord i, Ord a) => Ord (T i a) where+  max     = lift2    "max"     max+  min     = lift2    "min"     min+  compare = lift2Gen "compare" compare+  (<)     = lift2Gen "(<)"     (<)+  (>)     = lift2Gen "(>)"     (>)+  (<=)    = lift2Gen "(<=)"    (<=)+  (>=)    = lift2Gen "(>=)"    (>=)++{-+  Are absolute value and signum sensible for unit values?+  What is the sign, what is the absolute value?+  We could see it this way:+  The absolute value has no unit and+  the signum contains the unit and the scalar's sign.+  However the units contain also information of magnitude.+  E.g. if the base unit would be gramm instead kilogramm+  then the scalars would grow to a factor thousand.++  So is it better to give+  the absolute value unit and the absolute value of the scalar and+  the signum has no unit and the signum of the scalar?+  But the unit may also carry a kind of 'negativity' inside,+  e.g. the electric charge.++  It seems that there is no clear answer.+  However in my synthesizer application+  I need absolute values for sample rates and amplitudes.+  There the second interpretation is needed.+-}+instance (Ord i, Absolute.C a) => Absolute.C (T i a) where+  abs               = lift abs+  signum (Cons _ x) = fromScalarSingle (signum x)+++instance (Ord i, Field.C a) => Field.C (T i a) where+  (Cons xu x) / (Cons yu y) = Cons (xu-yu) (x/y)+  fromRational' = fromScalarSingle . fromRational'++instance (Ord i, Algebraic.C a) => Algebraic.C (T i a) where+  sqrt (Cons xu x) = Cons (Unit.ratScale 0.5 xu) (sqrt x)+  Cons xu x ^/ y =+     Cons (Unit.ratScale (fromRational' y) xu) (x ^/ y)++instance (Ord i, Trans.C a) => Trans.C (T i a) where+  pi      = fromScalarSingle pi+  log     = liftM  log+  exp     = liftM  exp+  logBase = liftM2 logBase+  (**)    = liftM2 (**)+  cos     = liftM  cos+  tan     = liftM  tan+  sin     = liftM  sin+  acos    = liftM  acos+  atan    = liftM  atan+  asin    = liftM  asin+  cosh    = liftM  cosh+  tanh    = liftM  tanh+  sinh    = liftM  sinh+  acosh   = liftM  acosh+  atanh   = liftM  atanh+  asinh   = liftM  asinh++instance Ord i => Vector.C (T i) where+  zero  = zero+  (<+>) = (+)+  (*>)  = scale++instance (Ord i, Module.C a v) => Module.C a (T i v) where+  x *> (Cons yu y) = Cons yu (x Module.*> y)++instance (Ord i, VectorSpace.C a v) => VectorSpace.C a (T i v)+++instance (OccScalar.C a v)+      => OccScalar.C a (T i v) where+   toScalar = toScalarDefault+   toMaybeScalar (Cons xu x)+            = guard (Unit.isScalar xu) >> toMaybeScalar x+   fromScalar = fromScalarSingle . fromScalar++++{- Operators for lifting scalar operations to+   operations on physical values -}+instance Functor (T i) where+  fmap f (Cons xu x) =+    if Unit.isScalar xu+    then fromScalarSingle (f x)+    else error "Physics.Quantity.Value.fmap: function for scalars, only"++instance Monad (T i) where+  (>>=) (Cons xu x) f =+    if Unit.isScalar xu+    then f x+    else error "Physics.Quantity.Value.(>>=): function for scalars, only"+  return = fromScalarSingle

+ src-ghc-6.12/Number/Physical/Read.hs view

@@ -0,0 +1,99 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Copyright   :  (c) Henning Thielemann 2004+License     :  GPL++Maintainer  :  numericprelude@henning-thielemann.de+Stability   :  provisional+Portability :  multi-parameter type classes (VectorSpace.hs)++Convert a human readable string to a physical value.+-}++module Number.Physical.Read where++import qualified Number.Physical        as Value+import qualified Number.Physical.UnitDatabase as Db+import qualified Algebra.VectorSpace as VectorSpace+-- import Algebra.Module((*>))+import qualified Algebra.Field       as Field+import qualified Data.Map as Map+import Data.Map (Map)+import Text.ParserCombinators.Parsec+import Control.Monad(liftM)++import NumericPrelude.Base+import NumericPrelude.Numeric++mulPrec :: Int+mulPrec = 7++-- How to handle the 'prec' argument?+readsNat :: (Enum i, Ord i, Read v, VectorSpace.C a v) =>+   Db.T i a -> Int -> ReadS (Value.T i v)+readsNat db prec =+   readParen (prec>=mulPrec)+      (map (\(x, rest) ->+             let (Value.Cons cu c, rest') = readUnitPart (createDict db) rest+             in  (Value.Cons cu (c *> x), rest'))+       .+       readsPrec mulPrec)++readUnitPart :: (Ord i, Field.C a) =>+   Map String (Value.T i a)+      -> String -> (Value.T i a, String)+readUnitPart dict str =+   let parseUnit =+          do p    <- parseProduct+             rest <- many anyChar+             return (product (map (\(unit,n) ->+                        Map.findWithDefault+                           (error ("unknown unit '" ++ unit ++ "'")) unit dict+                           ^ n) p),+                     rest)+   in  case parse parseUnit "unit" str of+          Left  msg -> error (show msg)+          Right val -> val+++{-| This function could also return the value,+    but a list of pairs (String, Integer) is easier for testing. -}+parseProduct :: Parser [(String, Integer)]+parseProduct =+   skipMany space >>+      ((do p <- ignoreSpace parsePower+           t <- parseProductTail+           return (p : t)) <|>+       parseProductTail)++parseProductTail :: Parser [(String, Integer)]+parseProductTail =+   let parseTail c f = +         do _ <- ignoreSpace (char c)+            p <- ignoreSpace parsePower+            t <- parseProductTail+            return (f p : t)+   in  parseTail '*' id <|>+       parseTail '/' (\(x,n) -> (x,-n)) <|>+       return []++parsePower :: Parser (String, Integer)+parsePower =+   do w <- ignoreSpace (many1 (letter <|> char '\181'))+      e <- liftM read (ignoreSpace (char '^') >> many1 digit) <|> return 1+      return (w,e)++{- Turns a parser into one that ignores subsequent whitespaces. -}+ignoreSpace :: Parser a -> Parser a+ignoreSpace p =+   do x <- p+      skipMany space+      return x+++createDict :: Db.T i a -> Map String (Value.T i a)+createDict db =+   Map.fromList (concatMap+      (\Db.UnitSet {Db.unit = xu, Db.scales = s}+           -> map (\Db.Scale {Db.symbol = sym, Db.magnitude = x}+                       -> (sym, Value.Cons xu x)) s) db)

+ src-ghc-6.12/Number/Physical/Show.hs view

@@ -0,0 +1,105 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Copyright   :  (c) Henning Thielemann 2004+License     :  GPL++Maintainer  :  numericprelude@henning-thielemann.de+Stability   :  provisional+Portability :  multi-parameter type classes (VectorSpace.hs, Normalization.hs)++Convert a physical value to a human readable string.+-}++module Number.Physical.Show where++import qualified Number.Physical              as Value+import qualified Number.Physical.UnitDatabase as Db+import Number.Physical.UnitDatabase+          (UnitSet, Scale, reciprocal, magnitude, symbol, scales)++import qualified Algebra.NormedSpace.Maximum as NormedMax+import qualified Algebra.Field               as Field+import qualified Algebra.Ring                as Ring++import Data.List(find)+import Data.Maybe(mapMaybe)++import NumericPrelude.Numeric+import NumericPrelude.Base+++mulPrec :: Int+mulPrec = 7++{-| Show the physical quantity in a human readable form+    with respect to a given unit data base. -}+showNat :: (Ord i, Show v, Field.C a, Ord a, NormedMax.C a v) =>+   Db.T i a -> Value.T i v -> String+showNat db x =+   let (y, unitStr) = showSplit db x+   in  if null unitStr+       then show y+       else showsPrec mulPrec y unitStr++{-| Returns the rescaled value as number+    and the unit as string.+    The value can be used re-scale connected values+    and display them under the label of the unit -}+showSplit :: (Ord i, Show v, Field.C a, Ord a, NormedMax.C a v) =>+   Db.T i a -> Value.T i v -> (v, String)+showSplit db (Value.Cons xu x) =+   showScaled x (Db.positiveToFront (Db.decompose xu db))+++showScaled :: (Ord i, Show v, Ord a, Field.C a, NormedMax.C a v) =>+   v -> [UnitSet i a] -> (v, String)+showScaled x [] = (x, "")+showScaled x (us:uss) =+  let (scaledX, sc) = chooseScale x us+  in  (scaledX, showUnitPart False (reciprocal us) sc +++                   concatMap (\us' ->+                      showUnitPart True (reciprocal us') (defScale us')) uss)++{-| Choose a scale where the number becomes handy+    and return the scaled number and the corresponding scale. -}+chooseScale :: (Ord i, Show v, Ord a, Field.C a, NormedMax.C a v) =>+   v -> UnitSet i a -> (v, Scale a)+chooseScale x us =+   let sc = findCloseScale (NormedMax.norm x) (+               {- you should not reverse earlier,+                  otherwise the index of the default unit is wrong -}+               if reciprocal us+               then scales us+               else reverse (scales us))+   in  ((1 / magnitude sc) *> x, sc)+++showUnitPart :: Bool -> Bool -> Scale a -> String+showUnitPart multSign rec sc =+   if rec+   then "/" ++ symbol sc+   else -- the multiplication sign can be omitted before the first unit component+        (if multSign then "*" else " ") ++ symbol sc++defScale :: UnitSet i v -> Scale v+defScale Db.UnitSet{Db.defScaleIx=def, Db.scales=scs} = scs!!def++findCloseScale :: (Ord a, Field.C a) => a -> [Scale a] -> Scale a+findCloseScale _ [sc]     = sc+findCloseScale x (sc:scs) =+   if 0.9 * magnitude sc < x+   then sc+   else findCloseScale x scs+findCloseScale _ _        =+   error "There must be at least one scale for a unit."++{-| unused -}+totalDefScale :: Ring.C a => Db.T i a -> a+totalDefScale =+   foldr (\us -> (magnitude (defScale us) *)) 1++{-| unused -}+getUnit :: Ring.C a => String -> Db.T i a -> Value.T i a+getUnit sym = Db.extractOne .+   (mapMaybe (\Db.UnitSet{Db.unit=u, scales=scs} ->+      fmap (Value.Cons u . magnitude) (find ((sym==) . symbol) scs)))

+ src-ghc-6.12/Number/Physical/Unit.hs view

@@ -0,0 +1,84 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Copyright   :  (c) Henning Thielemann 2003-2006+License     :  GPL++Maintainer  :  numericprelude@henning-thielemann.de+Stability   :  provisional+Portability :  portable++Abstract Physical Units+-}++module Number.Physical.Unit where++import MathObj.DiscreteMap (strip)+import qualified Data.Map as Map+import Data.Map (Map)+import Data.Maybe(fromJust,fromMaybe)++import qualified Number.Ratio as Ratio++import Data.Maybe.HT(toMaybe)++import NumericPrelude.Base+import NumericPrelude.Numeric++{- | A Unit.T is a sparse vector with integer entries+   Each map n->m means that the unit of the n-th dimension+   is given m times.++   Example: Let the quantity of length (meter, m) be the zeroth dimension+   and let the quantity of time (second, s) be the first dimension,+   then the composed unit "m_s²" corresponds to the Map+   [(0,1),(1,-2)]++   In future I want to have more abstraction here,+   e.g. a type class from the Edison project+   that abstracts from the underlying implementation.+   Then one can easily switch between+   Arrays, Binary trees (like Map) and what know I.+-}+type T i = Map i Int++-- | The neutral Unit.T+scalar :: T i+scalar = Map.empty++-- | Test for the neutral Unit.T+isScalar ::  T i -> Bool+isScalar = Map.null++-- | Convert a List to sparse Map representation+-- Example: [-1,0,-2] -> [(0,-1),(2,-2)]+fromVector :: (Enum i, Ord i) => [Int] -> T i+fromVector x = strip (Map.fromList (zip [toEnum 0 .. toEnum ((length x)-1)] x))++-- | Convert Map to a List+toVector :: (Enum i, Ord i) => T i -> [Int]+toVector x = map (flip (Map.findWithDefault 0) x)+                     [(toEnum 0)..(maximum (Map.keys x))]+++ratScale :: Ratio.T Int -> T i -> T i+ratScale expo =+   fmap (fromMaybe (error "Physics.Quantity.Unit.ratScale: fractional result")) .+   ratScaleMaybe2 expo++ratScaleMaybe :: Ratio.T Int -> T i -> Maybe (T i)+ratScaleMaybe expo u =+   let fmMaybe = ratScaleMaybe2 expo u+   in  toMaybe (not (Nothing `elem` Map.elems fmMaybe))+               (fmap fromJust fmMaybe)++-- helper function for ratScale and ratScaleMaybe+ratScaleMaybe2 :: Ratio.T Int -> T i -> Map i (Maybe Int)+ratScaleMaybe2 expo =+   fmap (\c -> let y = Ratio.scale c expo+               in  toMaybe (denominator y == 1) (numerator y))+++{- impossible because Unit.T is a type synonyme but not a data type+instance Show (Unit.T i) where+  show = show.toVector+-}

+ src-ghc-6.12/Number/Physical/UnitDatabase.hs view

@@ -0,0 +1,186 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Copyright   :  (c) Henning Thielemann 2003+License     :  GPL++Maintainer  :  numericprelude@henning-thielemann.de+Stability   :  provisional+Portability :  portable++Tools for creating a data base of physical units+and for extracting data from it+-}++module Number.Physical.UnitDatabase where++import qualified Number.Physical.Unit as Unit+import qualified Algebra.Field as Field++-- import Algebra.Module((*>))+import Algebra.NormedSpace.Sum(norm)++import Data.Maybe.HT (toMaybe)+import Data.List (findIndices, partition, unfoldr, find, minimumBy)++import NumericPrelude.Base+import NumericPrelude.Numeric++type T i a = [UnitSet i a]++-- since field names are reused for accessor functions+-- they are global identifiers and can't be reused+data InitUnitSet i a =+  InitUnitSet {+    initUnit        :: Unit.T i,+    initIndependent :: Bool,+    initScales      :: [InitScale a]+  }++data InitScale a =+  InitScale {+    initSymbol  :: String,+    initMag     :: a,+    initIsUnit  :: Bool,+    initDefault :: Bool+  }++-- | An entry for a unit and there scalings.+data UnitSet i a =+  UnitSet {+    unit        :: Unit.T i,+    independent :: Bool,+    defScaleIx  :: Int,+    reciprocal  :: Bool,  {-^ If True the symbols must be preceded with a '/'.+                              Though it sounds like an attribute of Scale+                              it must be the same for all scales and we need it+                              to sort positive powered unitsets to the front+                              of the list of unit components. -}+    scales      :: [Scale a]+  }+  deriving Show++-- | A common scaling for a unit.+data Scale a =+  Scale {+    symbol     :: String,+    magnitude  :: a+  }+  deriving Show+++-- extract the element from a list containing exact one element+-- fails if there are zero or more than one element+-- 'head' fails only if there are zero elements+extractOne :: [a] -> a+extractOne (x:[]) = x+extractOne _      = error "There must be exactly one default unit in the data base."++initScale   :: String -> a -> Bool -> Bool -> InitScale a+initScale   = InitScale+initUnitSet :: Unit.T i -> Bool -> [InitScale a] -> InitUnitSet i a+initUnitSet = InitUnitSet++createScale :: InitScale a -> Scale a+createScale (InitScale sym mg _ _) = (Scale sym mg)++createUnitSet :: InitUnitSet i a -> UnitSet i a+createUnitSet (InitUnitSet u ind scs) = (UnitSet u ind+    (extractOne (findIndices initDefault scs))+    False+    (map createScale scs)+  )++{- Filter out all scales intended for showing.+   If there is none return Nothing. -}+showableUnit :: InitUnitSet i a -> Maybe (InitUnitSet i a)+showableUnit (InitUnitSet u ind scs) =+   let sscs = filter initIsUnit scs+   in  toMaybe (not (null sscs)) (InitUnitSet u ind sscs)+++{- | Raise all scales of a unit and the unit itself to the n-th power -}+powerOfUnitSet :: (Ord i, Field.C a) => Int -> UnitSet i a -> UnitSet i a+powerOfUnitSet n us@UnitSet { unit = u, reciprocal = rec, scales = scs } =+   us { unit = n *> u,+        reciprocal = rec == (n>0),  -- flip sign+        scales = map (powerOfScale n) scs }+++powerOfScale :: Field.C a => Int -> Scale a -> Scale a+powerOfScale n Scale { symbol = sym, magnitude = mag } =+   if n>0+   then Scale { symbol = sym ++ showExp   n,  magnitude = ringPower  n mag }+   else Scale { symbol = sym ++ showExp (-n), magnitude = fieldPower n mag }++showExp :: Int -> String+showExp 1    = ""+--showExp 2    = "²"+--showExp 3    = "³"+showExp expo = "^" ++ show expo+++{- | Reorder the unit components in a way+     that the units with positive exponents lead the list. -}+positiveToFront :: [UnitSet i a] -> [UnitSet i a]+positiveToFront = uncurry (++) . partition (not . reciprocal)++-- | Decompose a complex unit into common ones+decompose :: (Ord i, Field.C a) => Unit.T i -> T i a -> [UnitSet i a]+decompose u db =+   case (findIndep u db) of+      Just us -> [us]+      Nothing ->+        unfoldr (\urem ->+          toMaybe (not (Unit.isScalar urem))+                  (let us = findClosest urem db+                   in  (us, subtract (unit us) urem))+        ) u++findIndep :: (Eq i) => Unit.T i -> T i a -> Maybe (UnitSet i a)+findIndep u = find (\UnitSet {unit=un} -> u==un) . filter independent++findClosest :: (Ord i, Field.C a) => Unit.T i -> T i a -> UnitSet i a+findClosest u =+   fst . minimumBy (\(_,dist0) (_,dist1) -> compare dist0 dist1) .+            evalDist u . filter (not.independent)++evalDist :: (Ord i, Field.C a)+   => Unit.T i+   -> T i a+   -> [(UnitSet i a, Int)] {-^ (UnitSet,distance)   the UnitSet may contain powered units -}+evalDist target = map (\us->+    let (expo,dist)=findBestExp target (unit us)+    in  (powerOfUnitSet expo us, dist)+  )++findBestExp :: (Ord i) => Unit.T i -> Unit.T i -> (Int, Int)+findBestExp target u =+  let bestl = findMinExp (distances target (listMultiples (subtract u) (-1)))+      bestr = findMinExp (distances target (listMultiples ((+)      u)   1 ))+  in  if distLE bestl bestr+      then bestl+      else bestr++{-|+  Find the exponent that lead to minimal distance+  Since the list is infinite 'maximum' will fail+  but the sequence is convex+  and thus we can abort when the distance stop falling+-}+findMinExp :: [(Int, Int)] -> (Int, Int)+findMinExp (x0:x1:rest) =+  if distLE x0 x1+  then x0+  else findMinExp (x1:rest)+findMinExp _ = error "List of unit approximations with respect to the unit exponent must be infinite."++distLE :: (Int, Int) -> (Int, Int) -> Bool+distLE (_,dist0) (_,dist1) = dist0<=dist1+--distLE (exp0,dist0) (exp1,dist1) = (dist0<dist1) || (dist0==dist1 && (abs exp0) <= (abs exp1))++-- [(exponent,unit)] -> [(exponent,distance)]+distances :: (Ord i) => Unit.T i -> [(Int, Unit.T i)] -> [(Int, Int)]+distances targetu = map (\(expo,u)->(expo, norm (subtract u targetu)))++listMultiples :: (Unit.T i -> Unit.T i) -> Int -> [(Int, Unit.T i)]+listMultiples f dir = iterate (\(expo,u)->(expo+dir,f u)) (0,Unit.scalar)

+ src-ghc-6.12/Number/Positional.hs view

@@ -0,0 +1,1465 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Copyright   :  (c) Henning Thielemann 2006+License     :  GPL++Maintainer  :  numericprelude@henning-thielemann.de+Stability   :  provisional+++Exact Real Arithmetic - Computable reals.+Inspired by ''The most unreliable technique for computing pi.''+See also <http://www.haskell.org/haskellwiki/Exact_real_arithmetic> .+-}+module Number.Positional where++import qualified MathObj.LaurentPolynomial as LPoly+import qualified MathObj.Polynomial.Core   as Poly++import qualified Algebra.IntegralDomain as Integral+import qualified Algebra.Ring           as Ring+-- import qualified Algebra.Additive       as Additive+import qualified Algebra.ToInteger      as ToInteger++import qualified Prelude as P98+import qualified NumericPrelude.Numeric as NP++import NumericPrelude.Base+import NumericPrelude.Numeric hiding (sqrt, tan, one, zero, )++import qualified Data.List as List+import Data.Char (intToDigit)++import qualified Data.List.Match as Match+import Data.Function.HT (powerAssociative, nest, )+import Data.Tuple.HT (swap, )+import Data.Maybe.HT (toMaybe, )+import Data.Bool.HT (select, if', )+import NumericPrelude.List (mapLast, )+import Data.List.HT+          (sliceVertical, mapAdjacent,+           padLeft, padRight, )+++{-+FIXME:++defltBase = 10+defltExp = 4++(sqrt 0.5) -- wrong result, probably due to undetected overflows+-}++{- * types -}++type T = (Exponent, Mantissa)+type FixedPoint = (Integer, Mantissa)+type Mantissa = [Digit]+type Digit    = Int+type Exponent = Int+type Basis    = Int+++{- * basic helpers -}++moveToZero :: Basis -> Digit -> (Digit,Digit)+moveToZero b n =+   let b2 = div b 2+       (q,r) = divMod (n+b2) b+   in  (q,r-b2)++checkPosDigit :: Basis -> Digit -> Digit+checkPosDigit b d =+   if d>=0 && d<b+     then d+     else error ("digit " ++ show d ++ " out of range [0," ++ show b ++ ")")++checkDigit :: Basis -> Digit -> Digit+checkDigit b d =+   if abs d < b+     then d+     else error ("digit " ++ show d ++ " out of range ("+                   ++ show (-b) ++ "," ++ show b ++ ")")++{- |+Converts all digits to non-negative digits,+that is the usual positional representation.+However the conversion will fail+when the remaining digits are all zero.+(This cannot be improved!)+-}+nonNegative :: Basis -> T -> T+nonNegative b x =+   let (xe,xm) = compress b x+   in  (xe, nonNegativeMant b xm)++{- |+Requires, that no digit is @(basis-1)@ or @(1-basis)@.+The leading digit might be negative and might be @-basis@ or @basis@.+-}+nonNegativeMant :: Basis -> Mantissa -> Mantissa+nonNegativeMant b =+   let recurse (x0:x1:xs) =+          select (replaceZeroChain x0 (x1:xs))+             [(x1 >=  1,  x0    : recurse (x1:xs)),+              (x1 <= -1, (x0-1) : recurse ((x1+b):xs))]+       recurse xs = xs++       replaceZeroChain x xs =+          let (xZeros,xRem) = span (0==) xs+          in  case xRem of+                [] -> (x:xs)  -- keep trailing zeros, because they show precision in 'show' functions+                (y:ys) ->+                  if y>=0  -- equivalent to y>0+                    then x     : Match.replicate xZeros 0     ++ recurse xRem+                    else (x-1) : Match.replicate xZeros (b-1) ++ recurse ((y+b) : ys)++   in  recurse+++{- |+May prepend a digit.+-}+compress :: Basis -> T -> T+compress _ x@(_, []) = x+compress b (xe, xm) =+   let (hi:his,los) = unzip (map (moveToZero b) xm)+   in  prependDigit hi (xe, Poly.add his los)++{- |+Compress first digit.+May prepend a digit.+-}+compressFirst :: Basis -> T -> T+compressFirst _ x@(_, []) = x+compressFirst b (xe, x:xs) =+   let (hi,lo) = moveToZero b x+   in  prependDigit hi (xe, lo:xs)++{- |+Does not prepend a digit.+-}+compressMant :: Basis -> Mantissa -> Mantissa+compressMant _ [] = []+compressMant b (x:xs) =+   let (his,los) = unzip (map (moveToZero b) xs)+   in  Poly.add his (x:los)++{- |+Compress second digit.+Sometimes this is enough to keep the digits in the admissible range.+Does not prepend a digit.+-}+compressSecondMant :: Basis -> Mantissa -> Mantissa+compressSecondMant b (x0:x1:xs) =+   let (hi,lo) = moveToZero b x1+   in  x0+hi : lo : xs+compressSecondMant _ xm = xm++prependDigit :: Basis -> T -> T+prependDigit 0 x = x+prependDigit x (xe, xs) = (xe+1, x:xs)++{- |+Eliminate leading zero digits.+This will fail for zero.+-}+trim :: T -> T+trim (xe,xm) =+   let (xZero, xNonZero) = span (0 ==) xm+   in  (xe - length xZero, xNonZero)++{- |+Trim until a minimum exponent is reached.+Safe for zeros.+-}+trimUntil :: Exponent -> T -> T+trimUntil e =+   until (\(xe,xm) -> xe<=e ||+              not (null xm || head xm == 0)) trimOnce++trimOnce :: T -> T+trimOnce (xe,[])   = (xe-1,[])+trimOnce (xe,0:xm) = (xe-1,xm)+trimOnce x = x++{- |+Accept a high leading digit for the sake of a reduced exponent.+This eliminates one leading digit.+Like 'pumpFirst' but with exponent management.+-}+decreaseExp :: Basis -> T -> T+decreaseExp b (xe,xm) =+   (xe-1, pumpFirst b xm)++{- |+Merge leading and second digit.+This is somehow an inverse of 'compressMant'.+-}+pumpFirst :: Basis -> Mantissa -> Mantissa+pumpFirst b xm =+   case xm of+     (x0:x1:xs) -> x0*b+x1:xs+     (x0:[])    -> x0*b:[]+     []         -> []++decreaseExpFP :: Basis -> (Exponent, FixedPoint) ->+                          (Exponent, FixedPoint)+decreaseExpFP b (xe,xm) =+   (xe-1, pumpFirstFP b xm)++pumpFirstFP :: Basis -> FixedPoint -> FixedPoint+pumpFirstFP b (x,xm) =+   let xb = x * fromIntegral b+   in  case xm of+         (x0:xs) -> (xb + fromIntegral x0, xs)+         []      -> (xb, [])++{- |+Make sure that a number with absolute value less than 1+has a (small) negative exponent.+Also works with zero because it chooses an heuristic exponent for stopping.+-}+negativeExp :: Basis -> T -> T+negativeExp b x =+   let tx  = trimUntil (-10) x+   in  if fst tx >=0 then decreaseExp b tx else tx+++{- * conversions -}++{- ** integer -}++fromBaseCardinal :: Basis -> Integer -> T+fromBaseCardinal b n =+   let mant = mantissaFromCard b n+   in  (length mant - 1, mant)++fromBaseInteger :: Basis -> Integer -> T+fromBaseInteger b n =+   if n<0+     then neg b (fromBaseCardinal b (negate n))+     else fromBaseCardinal b n++mantissaToNum :: Ring.C a => Basis -> Mantissa -> a+mantissaToNum bInt =+   let b = fromIntegral bInt+   in  foldl (\x d -> x*b + fromIntegral d) 0++mantissaFromCard :: (ToInteger.C a) => Basis -> a -> Mantissa+mantissaFromCard bInt n =+   let b = NP.fromIntegral bInt+   in  reverse (map NP.fromIntegral+          (Integral.decomposeVarPositional (repeat b) n))++mantissaFromInt :: (ToInteger.C a) => Basis -> a -> Mantissa+mantissaFromInt b n =+   if n<0+     then negate (mantissaFromCard b (negate n))+     else mantissaFromCard b n++mantissaFromFixedInt :: Basis -> Exponent -> Integer -> Mantissa+mantissaFromFixedInt bInt e n =+   let b = NP.fromIntegral bInt+   in  map NP.fromIntegral (uncurry (:) (List.mapAccumR+          (\x () -> divMod x b)+          n (replicate (pred e) ())))+++{- ** rational -}++fromBaseRational :: Basis -> Rational -> T+fromBaseRational bInt x =+   let b = NP.fromIntegral bInt+       xDen = denominator x+       (xInt,xNum) = divMod (numerator x) xDen+       (xe,xm) = fromBaseInteger bInt xInt+       xFrac = List.unfoldr+                 (\num -> toMaybe (num/=0) (divMod (num*b) xDen)) xNum+   in  (xe, xm ++ map NP.fromInteger xFrac)++{- ** fixed point -}++{- |+Split into integer and fractional part.+-}+toFixedPoint :: Basis -> T -> FixedPoint+toFixedPoint b (xe,xm) =+   if xe>=0+     then let (x0,x1) = splitAtPadZero (xe+1) xm+          in  (mantissaToNum b x0, x1)+     else (0, replicate (- succ xe) 0 ++ xm)++fromFixedPoint :: Basis -> FixedPoint -> T+fromFixedPoint b (xInt,xFrac) =+   let (xe,xm) = fromBaseInteger b xInt+   in  (xe, xm++xFrac)+++{- ** floating point -}++toDouble :: Basis -> T -> Double+toDouble b (xe,xm) =+   let txm = take (mantLengthDouble b) xm+       bf  = fromIntegral b+       br  = recip bf+   in  fieldPower xe bf * foldr (\xi y -> fromIntegral xi + y*br) 0 txm++{- |+cf. 'Numeric.floatToDigits'+-}+fromDouble :: Basis -> Double -> T+fromDouble b x =+   let (n,frac) = splitFraction x+       (mant,e) = P98.decodeFloat frac+       fracR    = alignMant b (-1)+                     (fromBaseRational b (mant % ringPower (-e) 2))+   in  fromFixedPoint b (n, fracR)++{- |+Only return as much digits as are contained in Double.+This will speedup further computations.+-}+fromDoubleApprox :: Basis -> Double -> T+fromDoubleApprox b x =+   let (xe,xm) = fromDouble b x+   in  (xe, take (mantLengthDouble b) xm)++fromDoubleRough :: Basis -> Double -> T+fromDoubleRough b x =+   let (xe,xm) = fromDouble b x+   in  (xe, take 2 xm)++mantLengthDouble :: Basis -> Exponent+mantLengthDouble b =+   let fi = fromIntegral :: Int -> Double+       x  = undefined :: Double+   in  ceiling+          (logBase (fi b) (fromInteger (P98.floatRadix x)) *+             fi (P98.floatDigits x))++liftDoubleApprox :: Basis -> (Double -> Double) -> T -> T+liftDoubleApprox b f = fromDoubleApprox b . f . toDouble b++liftDoubleRough :: Basis -> (Double -> Double) -> T -> T+liftDoubleRough b f = fromDoubleRough b . f . toDouble b+++{- ** text -}++{- |+Show a number with respect to basis @10^e@.+-}+showDec :: Exponent -> T -> String+showDec = showBasis 10++showHex :: Exponent -> T -> String+showHex = showBasis 16++showBin :: Exponent -> T -> String+showBin = showBasis 2++showBasis :: Basis -> Exponent -> T -> String+showBasis b e xBig =+   let x = rootBasis b e xBig+       (sign,absX) =+          case cmp b x (fst x,[]) of+             LT -> ("-", neg b x)+             _  -> ("", x)+       (int, frac) = toFixedPoint b (nonNegative b absX)+       checkedFrac = map (checkPosDigit b) frac+       intStr =+          if b==10+            then show int+            else map intToDigit (mantissaFromInt b int)+   in  sign ++ intStr ++ '.' : map intToDigit checkedFrac+++{- ** basis -}++{- |+Convert from a @b@ basis representation to a @b^e@ basis.++Works well with every exponent.+-}+powerBasis :: Basis -> Exponent -> T -> T+powerBasis b e (xe,xm) =+   let (ye,r)  = divMod xe e+       (y0,y1) = splitAtPadZero (r+1) xm+       y1pad   = mapLast (padRight 0 e) (sliceVertical e y1)+   in  (ye, map (mantissaToNum b) (y0 : y1pad))++{- |+Convert from a @b^e@ basis representation to a @b@ basis.++Works well with every exponent.+-}+rootBasis :: Basis -> Exponent -> T -> T+rootBasis b e (xe,xm) =+   let splitDigit d = padLeft 0 e (mantissaFromInt b d)+   in  nest (e-1) trimOnce+            ((xe+1)*e-1, concatMap splitDigit (map (checkDigit (ringPower e b)) xm))++{- |+Convert between arbitrary bases.+This conversion is expensive (quadratic time).+-}+fromBasis :: Basis -> Basis -> T -> T+fromBasis bDst bSrc x =+   let (int,frac) = toFixedPoint bSrc x+   in  fromFixedPoint bDst (int, fromBasisMant bDst bSrc frac)++fromBasisMant :: Basis -> Basis -> Mantissa -> Mantissa+fromBasisMant _    _    [] = []+fromBasisMant bDst bSrc xm =+   let {- We use a counter that alerts us,+          when the digits are grown too much by Poly.scale.+          Then it is time to do some carry/compression.+          'inc' is essentially the fractional number digits+          needed to represent the destination base in the source base.+          It is multiplied by 'unit' in order to allow integer computation. -}+       inc = ceiling+                (logBase (fromIntegral bSrc) (fromIntegral bDst)+                     * unit * 1.1 :: Double)+          -- Without the correction factor, invalid digits are emitted - why?+       unit :: Ring.C a => a+       unit = 10000+       {-+       This would create finite representations+       in some cases (input is finite, and the result is finite)+       but will cause infinite loop otherwise.+       dropWhileRev (0==) . compressMant bDst+       -}+       cmpr (mag,xs) = (mag - unit, compressMant bSrc xs)++       scl (_,[]) = Nothing+       scl (mag,xs) =+          let (newMag,y:ys) =+                 until ((<unit) . fst) cmpr+                       (mag + inc, Poly.scale bDst xs)+              (d,y0) = moveToZero bSrc y+          in  Just (d, (newMag, y0:ys))++   in  List.unfoldr scl (0::Int,xm)+++{- * comparison -}++{- |+The basis must be at least ***.+Note: Equality cannot be asserted in finite time on infinite precise numbers.+If you want to assert, that a number is below a certain threshold,+you should not call this routine directly,+because it will fail on equality.+Better round the numbers before comparison.+-}+cmp :: Basis -> T -> T -> Ordering+cmp b x y =+   let (_,dm) = sub b x y+       {- Only differences above 2 allow a safe decision,+          because 1(-9)(-9)(-9)(-9)... and (-1)9999...+          represent the same number, namely zero. -}+       recurse [] = EQ+       recurse (d:[]) = compare d 0+       recurse (d0:d1:ds) =+          select (recurse (d0*b+d1 : ds))+             [(d0 < -2, LT),+              (d0 >  2, GT)]+   in  recurse dm++{-+Compare two numbers approximately.+This circumvents the infinite loop if both numbers are equal.+If @lessApprox bnd b x y@+then @x@ is definitely smaller than @y@.+The converse is not true.+You should use this one instead of 'cmp' for checking for bounds.+-}+lessApprox :: Basis -> Exponent -> T -> T -> Bool+lessApprox b bnd x y =+   let tx = trunc bnd x+       ty = trunc bnd y+   in  LT == cmp b (liftLaurent2 LPoly.add (bnd,[2]) tx) ty++trunc :: Exponent -> T -> T+trunc bnd (xe, xm) =+   if bnd > xe+     then (bnd, [])+     else (xe, take (1+xe-bnd) xm)++equalApprox :: Basis -> Exponent -> T -> T -> Bool+equalApprox b bnd x y =+   fst (trimUntil bnd (sub b x y)) == bnd+++{- |+If all values are completely defined,+then it holds++> if b then x else y == ifLazy b x y++However if @b@ is undefined,+then it is at least known that the result is between @x@ and @y@.+-}+ifLazy :: Basis -> Bool -> T -> T -> T+ifLazy b c x@(xe, _) y@(ye, _) =+   let ze = max xe ye+       xm = alignMant b ze x+       ym = alignMant b ze y+       recurse :: Mantissa -> Mantissa -> Mantissa+       recurse xs0 ys0 =+          withTwoMantissas xs0 ys0 [] $ \(x0,xs1) (y0,ys1) ->+          if abs (y0-x0) > 2+            then if c then xs0 else ys0+            else+              {-+              @x0==y0 || c@ means that in case of @x0==y0@+              we do not have to check @c@.+              -}+              withTwoMantissas xs1 ys1 ((if x0==y0 || c then x0 else y0) : []) $+                  \(x1,xs2) (y1,ys2) ->+                {-+                We can choose @z0@ only when knowing also x1 and y1.+                Because of x0x1 = 09 and y0y1 = 19+                we may always choose the larger one of x0 and y0+                in order to get admissible digit z1.+                But this would be wrong for x0x1 = 0(-9) and y0y1 = 1(-9).+                -}+                let z0  = mean2 b (x0,x1) (y0,y1)+                    x1' = x1+(x0-z0)*b+                    y1' = y1+(y0-z0)*b+                in  if abs x1' < b  &&  abs y1' < b+                      then z0 : recurse (x1':xs2) (y1':ys2)+                      else if c then xs0 else ys0+   in  (ze, recurse xm ym)++{- |+> mean2 b (x0,x1) (y0,y1)++computes @ round ((x0.x1 + y0.y1)/2) @,+where @x0.x1@ and @y0.y1@ are positional rational numbers+with respect to basis @b@+-}+{-# INLINE mean2 #-}+mean2 :: Basis -> (Digit,Digit) -> (Digit,Digit) -> Digit+mean2 b (x0,x1) (y0,y1) =+   ((x0+y0+1)*b + (x1+y1)) `div` (2*b)++{-+In a first trial I used++> zipMantissas :: Mantissa -> Mantissa -> [(Digit, Digit)]++for implementation of ifLazy.+However, this required to extract digits from the pairs+after the decision for an argument.+With withTwoMantissas we can just return a pointer to the original list.+-}+withTwoMantissas ::+   Mantissa -> Mantissa ->+   a ->+   ((Digit,Mantissa) -> (Digit,Mantissa) -> a) ->+   a+withTwoMantissas [] [] r _ = r+withTwoMantissas [] (y:ys) _ f = f (0,[]) (y,ys)+withTwoMantissas (x:xs) [] _ f = f (x,xs) (0,[])+withTwoMantissas (x:xs) (y:ys) _ f = f (x,xs) (y,ys)+++align :: Basis -> Exponent -> T -> T+align b ye x = (ye, alignMant b ye x)++{- |+Get the mantissa in such a form+that it fits an expected exponent.++@x@ and @(e, alignMant b e x)@ represent the same number.+-}+alignMant :: Basis -> Exponent -> T -> Mantissa+alignMant b e (xe,xm) =+   if e>=xe+     then replicate (e-xe) 0 ++ xm+     else let (xm0,xm1) = splitAtPadZero (xe-e+1) xm+          in  mantissaToNum b xm0 : xm1++absolute :: T -> T+absolute (xe,xm) = (xe, absMant xm)++absMant :: Mantissa -> Mantissa+absMant xa@(x:xs) =+   case compare x 0 of+      EQ -> x : absMant xs+      LT -> Poly.negate xa+      GT -> xa+absMant [] = []+++{- * arithmetic -}++fromLaurent :: LPoly.T Int -> T+fromLaurent (LPoly.Cons nxe xm) = (NP.negate nxe, xm)++toLaurent :: T -> LPoly.T Int+toLaurent (xe, xm) = LPoly.Cons (NP.negate xe) xm++liftLaurent2 ::+   (LPoly.T Int -> LPoly.T Int -> LPoly.T Int) ->+      (T -> T -> T)+liftLaurent2 f x y =+   fromLaurent (f (toLaurent x) (toLaurent y))++liftLaurentMany ::+   ([LPoly.T Int] -> LPoly.T Int) ->+      ([T] -> T)+liftLaurentMany f =+   fromLaurent . f . map toLaurent++{- |+Add two numbers but do not eliminate leading zeros.+-}+add :: Basis -> T -> T -> T+add b x y = compress b (liftLaurent2 LPoly.add x y)++sub :: Basis -> T -> T -> T+sub b x y = compress b (liftLaurent2 LPoly.sub x y)++neg :: Basis -> T -> T+neg _ (xe, xm) = (xe, Poly.negate xm)+++{- |+Add at most @basis@ summands.+More summands will violate the allowed digit range.+-}+addSome :: Basis -> [T] -> T+addSome b = compress b . liftLaurentMany sum++{- |+Add many numbers efficiently by computing sums of sub lists+with only little carry propagation.+-}+addMany :: Basis -> [T] -> T+addMany _ [] = zero+addMany b ys =+   let recurse xs =+          case map (addSome b) (sliceVertical b xs) of+            [s]  -> s+            sums -> recurse sums+   in  recurse ys+++type Series = [(Exponent, T)]++{- |+Add an infinite number of numbers.+You must provide a list of estimate of the current remainders.+The estimates must be given as exponents of the remainder.+If such an exponent is too small, the summation will be aborted.+If exponents are too big, computation will become inefficient.+-}+series :: Basis -> Series -> T+series _ [] = error "empty series: don't know a good exponent"+-- series _ [] = (0,[]) -- unfortunate choice of exponent+series b summands =+   {- Some pre-processing that asserts decreasing exponents.+      Increasing coefficients can appear legally+      due to non-unique number representation. -}+   let (es,xs)    = unzip summands+       safeSeries = zip (scanl1 min es) xs+   in  seriesPlain b safeSeries++seriesPlain :: Basis -> Series -> T+seriesPlain _ [] = error "empty series: don't know a good exponent"+seriesPlain b summands =+   let (es,m:ms) = unzip (map (uncurry (align b)) summands)+       eDifs     = mapAdjacent (-) es+       eDifLists = sliceVertical (pred b) eDifs+       mLists    = sliceVertical (pred b) ms+       accum sumM (eDifList,mList) =+          let subM = LPoly.addShiftedMany eDifList (sumM:mList)+              -- lazy unary sum+              len = concatMap (flip replicate ()) eDifList+              (high,low)  = splitAtMatchPadZero len subM+          {-+          'compressMant' looks unsafe+          when the residue doesn't decrease for many summands.+          Then there is a leading digit of a chunk+          which is not compressed for long time.+          However, if the residue is estimated correctly+          there can be no overflow.+          -}+          in  (compressMant b low, high)+       (trailingDigits, chunks) =+          List.mapAccumL accum m (zip eDifLists mLists)+   in  compress b (head es, concat chunks ++ trailingDigits)++{-+An alternative series implementation+could reduce carries by do the following cycle+(split, add sub-lists).+This would reduce carries to the minimum+but we must work hard in order to find out lazily+how many digits can be emitted.+-}+++{- |+Like 'splitAt',+but it pads with zeros if the list is too short.+This way it preserves+ @ length (fst (splitAtPadZero n xs)) == n @+-}+splitAtPadZero :: Int -> Mantissa -> (Mantissa, Mantissa)+splitAtPadZero n [] = (replicate n 0, [])+splitAtPadZero 0 xs = ([], xs)+splitAtPadZero n (x:xs) =+   let (ys, zs) = splitAtPadZero (n-1) xs+   in  (x:ys, zs)+-- must get a case for negative index++splitAtMatchPadZero :: [()] -> Mantissa -> (Mantissa, Mantissa)+splitAtMatchPadZero n  [] = (Match.replicate n 0, [])+splitAtMatchPadZero [] xs = ([], xs)+splitAtMatchPadZero n (x:xs) =+   let (ys, zs) = splitAtMatchPadZero (tail n) xs+   in  (x:ys, zs)+++{- |+help showing series summands+-}+truncSeriesSummands :: Series -> Series+truncSeriesSummands = map (\(e,x) -> (e,trunc (-20) x))++++scale :: Basis -> Digit -> T -> T+scale b y x = compress b (scaleSimple y x)++{-+scaleSimple :: ToInteger.C a => a -> T -> T+scaleSimple y (xe, xm) = (xe, Poly.scale (fromIntegral y) xm)+-}++scaleSimple :: Basis -> T -> T+scaleSimple y (xe, xm) = (xe, Poly.scale y xm)++scaleMant :: Basis -> Digit -> Mantissa -> Mantissa+scaleMant b y xm = compressMant b (Poly.scale y xm)++++mulSeries :: Basis -> T -> T -> Series+mulSeries _ (xe,[]) (ye,_) = [(xe+ye, zero)]+mulSeries b (xe,xm) (ye,ym) =+   let zes = iterate pred (xe+ye+1)+       zs  = zipWith (\xd e -> scale b xd (e,ym)) xm (tail zes)+   in  zip zes zs++{- |+For obtaining n result digits it is mathematically sufficient+to know the first (n+1) digits of the operands.+However this implementation needs (n+2) digits,+because of calls to 'compress' in both 'scale' and 'series'.+We should fix that.+-}+mul :: Basis -> T -> T -> T+mul b x y = trimOnce (seriesPlain b (mulSeries b x y))++++{- |+Undefined if the divisor is zero - of course.+Because it is impossible to assert that a real is zero,+the routine will not throw an error in general.++ToDo: Rigorously derive the minimal required magnitude of the leading divisor digit.+-}+divide :: Basis -> T -> T -> T+divide b (xe,xm) (ye',ym') =+   let (ye,ym) = until ((>=b) . abs . head . snd)+                       (decreaseExp b)+                       (ye',ym')+   in  nest 3 trimOnce (compress b (xe-ye, divMant b ym xm))++divMant :: Basis -> Mantissa -> Mantissa -> Mantissa+divMant _ [] _   = error "Number.Positional: division by zero"+divMant b ym xm0 =+   snd $+   List.mapAccumL+      (\xm fullCompress ->+       let z = div (head xm) (head ym)+           {- 'scaleMant' contains compression,+              which is not much of a problem,+              because it is always applied to @ym@.+              That is, there is no nested call. -}+           dif = pumpFirst b (Poly.sub xm (scaleMant b z ym))+           cDif = if fullCompress+                    then compressMant       b dif+                    else compressSecondMant b dif+       in  (cDif, z))+   xm0 (cycle (replicate (b-1) False ++ [True]))++divMantSlow :: Basis -> Mantissa -> Mantissa -> Mantissa+divMantSlow _ [] = error "Number.Positional: division by zero"+divMantSlow b ym =+   List.unfoldr+      (\xm ->+       let z = div (head xm) (head ym)+           d = compressMant b (pumpFirst b+                  (Poly.sub xm (Poly.scale z ym)))+       in  Just (z, d))++reciprocal :: Basis -> T -> T+reciprocal b = divide b one+++{- |+Fast division for small integral divisors,+which occur for instance in summands of power series.+-}+divIntMant :: Basis -> Int -> Mantissa -> Mantissa+divIntMant b y xInit =+   List.unfoldr (\(r,rxs) ->+             let rb = r*b+                 (rbx, xs', run) =+                    case rxs of+                       []     -> (rb,   [], r/=0)+                       (x:xs) -> (rb+x, xs, True)+                 (d,m) = divMod rbx y+             in  toMaybe run (d, (m, xs')))+           (0,xInit)++-- this version is simple but ignores the possibility of a terminating result+divIntMantInf :: Basis -> Int -> Mantissa -> Mantissa+divIntMantInf b y =+   map fst . tail .+      scanl (\(_,r) x -> divMod (r*b+x) y) (undefined,0) .+         (++ repeat 0)++divInt :: Basis -> Digit -> T -> T+divInt b y (xe,xm) =+   -- (xe, divIntMant b y xm)+   let z  = (xe, divIntMant b y xm)+       {- Division by big integers may cause leading zeros.+          Eliminate as many as we can expect from the division.+          If the input number has leading zeros (it might be equal to zero),+          then the result may have, too. -}+       tz = until ((<=1) . fst) (\(yi,zi) -> (div yi b, trimOnce zi)) (y,z)+   in  snd tz+++{- * algebraic functions -}+++sqrt :: Basis -> T -> T+sqrt b = sqrtDriver b sqrtFP++sqrtDriver :: Basis -> (Basis -> FixedPoint -> Mantissa) -> T -> T+sqrtDriver _ _ (xe,[]) = (div xe 2, [])+sqrtDriver b sqrtFPworker x =+   let (exe,ex0:exm) = if odd (fst x) then decreaseExp b x else x+       (nxe,(nx0,nxm)) =+           until (\xi -> fst (snd xi) >= fromIntegral b ^ 2)+                 (nest 2 (decreaseExpFP b))+                 (exe, (fromIntegral ex0, exm))+   in  compress b (div nxe 2, sqrtFPworker b (nx0,nxm))+++sqrtMant :: Basis -> Mantissa -> Mantissa+sqrtMant _ [] = []+sqrtMant b (x:xs) =+   sqrtFP b (fromIntegral x, xs)++{- |+Square root.++We need a leading digit of type Integer,+because we have to collect up to 4 digits.+This presentation can also be considered as 'FixedPoint'.++ToDo:+Rigorously derive the minimal required magnitude+of the leading digit of the root.++Mathematically the @n@th digit of the square root+depends roughly only on the first @n@ digits of the input.+This is because @sqrt (1+eps) `equalApprox` 1 + eps\/2@.+However this implementation requires @2*n@ input digits+for emitting @n@ digits.+This is due to the repeated use of 'compressMant'.+It would suffice to fully compress only every @basis@th iteration (digit)+and compress only the second leading digit in each iteration.+++Can the involved operations be made lazy enough to solve+@y = (x+frac)^2@+by+@frac = (y-x^2-frac^2) \/ (2*x)@ ?+-}+sqrtFP :: Basis -> FixedPoint -> Mantissa+sqrtFP b (x0,xs) =+   let y0   = round (NP.sqrt (fromInteger x0 :: Double))+       dyx0 = fromInteger (x0 - fromIntegral y0 ^ 2)++       accum dif (e,ty) =+          -- (e,ty) == xm - (trunc j y)^2+          let yj = div (head dif + y0) (2*y0)+              newDif = pumpFirst b $+                 LPoly.addShifted e+                    (Poly.sub dif (scaleMant b (2*yj) ty))+                    [yj*yj]+              {- We could always compress the full difference number,+                 but it is not necessary,+                 and we save dependencies on less significant digits. -}+              cNewDif =+                 if mod e b == 0+                   then compressMant       b newDif+                   else compressSecondMant b newDif+          in  (cNewDif, yj)++       truncs = lazyInits y+       y = y0 : snd (List.mapAccumL+                        accum+                        (pumpFirst b (dyx0 : xs))+                        (zip [1..] (drop 2 truncs)))+   in  y+++sqrtNewton :: Basis -> T -> T+sqrtNewton b = sqrtDriver b sqrtFPNewton++{- |+Newton iteration doubles the number of correct digits in every step.+Thus we process the data in chunks of sizes of powers of two.+This way we get fastest computation possible with Newton+but also more dependencies on input than necessary.+The question arises whether this implementation still fits the needs+of computational reals.+The input is requested as larger and larger chunks,+and the input itself might be computed this way,+e.g. a repeated square root.+Requesting one digit too much,+requires the double amount of work for the input computation,+which in turn multiplies time consumption by a factor of four,+and so on.++Optimal fast implementation of one routine+does not preserve fast computation of composed computations.++The routine assumes, that the integer parts is at least @b^2.@+-}+sqrtFPNewton :: Basis -> FixedPoint -> Mantissa+sqrtFPNewton bInt (x0,xs) =+   let b = fromIntegral bInt+       chunkLengths = iterate (2*) 1+       xChunks = map (mantissaToNum bInt) $ snd $+            List.mapAccumL (\x cl -> swap (splitAtPadZero cl x))+                           xs chunkLengths+       basisPowers = iterate (^2) b+       truncXs = scanl (\acc (bp,frac) -> acc*bp+frac) x0+                       (zip basisPowers xChunks)+       accum y (bp, x) =+          let ybp  = y * bp+              newY = div (ybp + div (x * div bp b) y) 2+          in  (newY, newY-ybp)+       y0 = round (NP.sqrt (fromInteger x0 :: Double))+       yChunks = snd $ List.mapAccumL accum+                         y0 (zip basisPowers (tail truncXs))+       yFrac = concat $ zipWith (mantissaFromFixedInt bInt) chunkLengths yChunks+   in  fromInteger y0 : yFrac+++{- |+List.inits is defined by+@inits = foldr (\x ys -> [] : map (x:) ys) [[]]@++This is too strict for our application.++> Prelude> List.inits (0:1:2:undefined)+> [[],[0],[0,1]*** Exception: Prelude.undefined++The following routine is more lazy than 'List.inits'+and even lazier than 'Data.List.HT.inits' from @utility-ht@ package,+but it is restricted to infinite lists.+This degree of laziness is needed for @sqrtFP@.++> Prelude> lazyInits (0:1:2:undefined)+> [[],[0],[0,1],[0,1,2],[0,1,2,*** Exception: Prelude.undefined+-}+lazyInits :: [a] -> [[a]]+lazyInits ~(x:xs)  =  [] : map (x:) (lazyInits xs)+{-+The lazy match above is irrefutable,+so the pattern @[]@ would never be reached.+-}++++{- * transcendent functions -}++{- ** exponential functions -}++expSeries :: Basis -> T -> Series+expSeries b xOrig =+   let x   = negativeExp b xOrig+       xps = scanl (\p n -> divInt b n (mul b x p)) one [1..]+   in  map (\xp -> (fst xp, xp)) xps++{- |+Absolute value of argument should be below 1.+-}+expSmall :: Basis -> T -> T+expSmall b x = series b (expSeries b x)+++expSeriesLazy :: Basis -> T -> Series+expSeriesLazy b x@(xe,_) =+   let xps = scanl (\p n -> divInt b n (mul b x p)) one [1..]+       {- much effort for computing the residue exponents+          without touching the arguments mantissa -}+       es :: [Double]+       es = zipWith (-)+               (map fromIntegral (iterate ((1+xe)+) 0))+               (scanl (+) 0+                  (map (logBase (fromIntegral b)+                          . fromInteger) [1..]))+   in  zip (map ceiling es) xps++expSmallLazy :: Basis -> T -> T+expSmallLazy b x = series b (expSeriesLazy b x)+++exp :: Basis -> T -> T+exp b x =+   let (xInt,xFrac) = toFixedPoint b (compress b x)+       yFrac = expSmall b (-1,xFrac)+       {-+       (xFrac0,xFrac1) = splitAt 2 xFrac+       yFrac = mul b+                 -- slow convergence but simple argument+                 (expSmall b (-1, xFrac0))+                 -- fast convergence but big argument+                 (expSmall b (-3, xFrac1))+       -}+   in  intPower b xInt yFrac (recipEConst b) (eConst b)++intPower :: Basis -> Integer -> T -> T -> T -> T+intPower b expon neutral recipX x =+   if expon >= 0+     then cardPower b   expon  neutral x+     else cardPower b (-expon) neutral recipX++cardPower :: Basis -> Integer -> T -> T -> T+cardPower b expon neutral x =+   if expon >= 0+     then powerAssociative (mul b) neutral x expon+     else error "negative exponent - use intPower"+++{- |+Residue estimates will only hold for exponents+with absolute value below one.++The computation is based on 'Int',+thus the denominator should not be too big.+(Say, at most 1000 for 1000000 digits.)++It is not optimal to split the power into pure root and pure power+(that means, with integer exponents).+The root series can nicely handle all exponents,+but for exponents above 1 the series summands rises at the beginning+and thus make the residue estimate complicated.+For powers with integer exponents the root series turns+into the binomial formula,+which is just a complicated way to compute a power+which can also be determined by simple multiplication.+-}+powerSeries :: Basis -> Rational -> T -> Series+powerSeries b expon xOrig =+   let scaleRat ni yi =+          divInt b (fromInteger (denominator yi) * ni) .+          scaleSimple (fromInteger (numerator yi))+       x   = negativeExp b (sub b xOrig one)+       xps = scanl (\p fac -> uncurry scaleRat fac (mul b x p))+                   one (zip [1..] (iterate (subtract 1) expon))+   in  map (\xp -> (fst xp, xp)) xps++powerSmall :: Basis -> Rational -> T -> T+powerSmall b y x = series b (powerSeries b y x)++power :: Basis -> Rational -> T -> T+power b expon x =+   let num   = numerator   expon+       den   = denominator expon+       rootX = root b den x+   in  intPower b num one (reciprocal b rootX) rootX++root :: Basis -> Integer -> T -> T+root b expon x =+   let estimate = liftDoubleApprox b (** (1 / fromInteger expon)) x+       estPower = cardPower b expon one estimate+       residue  = divide b x estPower+   in  mul b estimate (powerSmall b (1 % fromIntegral expon) residue)++++{- |+Absolute value of argument should be below 1.+-}+cosSinhSmall :: Basis -> T -> (T, T)+cosSinhSmall b x =+   let (coshXps, sinhXps) = unzip (sliceVertPair (expSeries b x))+   in  (series b coshXps,+        series b sinhXps)++{- |+Absolute value of argument should be below 1.+-}+cosSinSmall :: Basis -> T -> (T, T)+cosSinSmall b x =+   let (coshXps, sinhXps) = unzip (sliceVertPair (expSeries b x))+       alternate s =+          zipWith3 if' (cycle [True,False])+             s (map (\(e,y) -> (e, neg b y)) s)+   in  (series b (alternate coshXps),+        series b (alternate sinhXps))+++{- |+Like 'cosSinSmall' but converges faster.+It calls @cosSinSmall@ with reduced arguments+using the trigonometric identities+@+cos (4*x) = 8 * cos x ^ 2 * (cos x ^ 2 - 1) + 1+sin (4*x) = 4 * sin x * cos x * (1 - 2 * sin x ^ 2)+@++Note that the faster convergence is hidden by the overhead.++The same could be achieved with a fourth power of a complex number.+-}+cosSinFourth :: Basis -> T -> (T, T)+cosSinFourth b x =+   let (cosx, sinx) = cosSinSmall b (divInt b 4 x)+       sinx2   = mul b sinx sinx+       cosx2   = mul b cosx cosx+       sincosx = mul b sinx cosx+   in  (add b one (scale b 8 (mul b cosx2 (sub b cosx2 one))),+        scale b 4 (mul b sincosx (sub b one (scale b 2 sinx2))))+++cosSin :: Basis -> T -> (T, T)+cosSin b x =+   let pi2 = divInt b 2 (piConst b)+       {- @compress@ ensures that the leading digit of the fractional part+          is close to zero -}+       (quadrant, frac) = toFixedPoint b (compress b (divide b x pi2))+       -- it's possibly faster if we subtract quadrant*pi/4+       wrapped = if quadrant==0 then x else mul b pi2 (-1, frac)+       (cosW,sinW) = cosSinSmall b wrapped+   in  case mod quadrant 4 of+          0 -> (      cosW,       sinW)+          1 -> (neg b sinW,       cosW)+          2 -> (neg b cosW, neg b sinW)+          3 -> (      sinW, neg b cosW)+          _ -> error "error in implementation of 'mod'"++tan :: Basis -> T -> T+tan b x = uncurry (flip (divide b)) (cosSin b x)++cot :: Basis -> T -> T+cot b x = uncurry (divide b) (cosSin b x)+++{- ** logarithmic functions -}++lnSeries :: Basis -> T -> Series+lnSeries b xOrig =+   let x   = negativeExp b (sub b xOrig one)+       mx  = neg b x+       xps = zipWith (divInt b) [1..] (iterate (mul b mx) x)+   in  map (\xp -> (fst xp, xp)) xps++lnSmall :: Basis -> T -> T+lnSmall b x = series b (lnSeries b x)++{- |+@+x' = x - (exp x - y) \/ exp x+   = x + (y * exp (-x) - 1)+@++First, the dependencies on low-significant places are currently+much more than mathematically necessary.+Check+@+*Number.Positional> expSmall 1000 (-1,100 : replicate 16 0 ++ [undefined])+(0,[1,105,171,-82,76*** Exception: Prelude.undefined+@+Every multiplication cut off two trailing digits.+@+*Number.Positional> nest 8 (mul 1000 (-1,repeat 1)) (-1,100 : replicate 16 0 ++ [undefined])+(-9,[101,*** Exception: Prelude.undefined+@++Possibly the dependencies of expSmall+could be resolved by not computing @mul@ immediately+but computing @mul@ series which are merged and subsequently added.+But this would lead to an explosion of series.++Second, even if the dependencies of all atomic operations+are reduced to a minimum,+the mathematical dependencies of the whole iteration function+are less than the sums of the parts.+Lets demonstrate this with the square root iteration.+It is+@+(1.4140 + 2/1.4140) / 2 == 1.414213578500707+(1.4149 + 2/1.4149) / 2 == 1.4142137288854335+@+That is, the digits @213@ do not depend mathematically on @x@ of @1.414x@,+but their computation depends.+Maybe there is a glorious trick to reduce the computational dependencies+to the mathematical ones.+-}+lnNewton :: Basis -> T -> T+lnNewton b y =+   let estimate = liftDoubleApprox b log y+       expRes   = mul b y (expSmall b (neg b estimate))+       -- try to reduce dependencies by feeding expSmall with a small argument+       residue =+          sub b (mul b expRes (expSmallLazy b (neg b resTrim))) one+       resTrim =+          -- (-3, replicate 4 0 ++ alignMant b (-7) residue)+          align b (- mantLengthDouble b) residue+       lazyAdd (xe,xm) (ye,ym) =+          (xe, LPoly.addShifted (xe-ye) xm ym)+       x = lazyAdd estimate resTrim+   in  x++lnNewton' :: Basis -> T -> T+lnNewton' b y =+   let estimate = liftDoubleApprox b log y+       residue  =+          sub b (mul b y (expSmall b (neg b x))) one+          -- sub b (mul b y (expSmall b (neg b estimate))) one+          -- sub b (mul b y (expSmall b (neg b+          --     (fst estimate, snd estimate ++ [undefined])))) one+       resTrim =+          -- align b (-6) residue+          align b (- mantLengthDouble b) residue+             -- align returns the new exponent immediately+          -- nest (mantLengthDouble b) trimOnce residue+          -- negativeExp b residue+       lazyAdd (xe,xm) (ye,ym) =+          (xe, LPoly.addShifted (xe-ye) xm ym)+       x = lazyAdd estimate resTrim+          -- add b estimate resTrim+                -- LPoly.add checks for empty lists and is thus too strict+   in  x+++ln :: Basis -> T -> T+ln b x@(xe,_) =+   let e  = round (log (fromIntegral b) * fromIntegral xe :: Double)+       ei = fromIntegral e+       y  = trim $+          if e<0+            then powerAssociative (mul b) x (eConst b)    (-ei)+            else powerAssociative (mul b) x (recipEConst b) ei+       estimate = liftDoubleApprox b log y+       residue  = mul b (expSmall b (neg b estimate)) y+   in  addSome b [(0,[e]), estimate, lnSmall b residue]+++{- |+This is an inverse of 'cosSin',+also known as @atan2@ with flipped arguments.+It's very slow because of the computation of sinus and cosinus.+However, because it uses the 'atan2' implementation as estimator,+the final application of arctan series should converge rapidly.++It could be certainly accelerated by not using cosSin+and its fiddling with pi.+Instead we could analyse quadrants before calling atan2,+then calling cosSinSmall immediately.+-}+angle :: Basis -> (T,T) -> T+angle b (cosx, sinx) =+   let wd      = atan2 (toDouble b sinx) (toDouble b cosx)+       wApprox = fromDoubleApprox b wd+       (cosApprox, sinApprox) = cosSin b wApprox+       (cosD,sinD) =+          (add b (mul b cosx cosApprox)+                 (mul b sinx sinApprox),+           sub b (mul b sinx cosApprox)+                 (mul b cosx sinApprox))+       sinDSmall = negativeExp b sinD+   in  add b wApprox (arctanSmall b (divide b sinDSmall cosD))+++{- |+Arcus tangens of arguments with absolute value less than @1 \/ sqrt 3@.+-}+arctanSeries :: Basis -> T -> Series+arctanSeries b xOrig =+   let x   = negativeExp b xOrig+       mx2 = neg b (mul b x x)+       xps = zipWith (divInt b) [1,3..] (iterate (mul b mx2) x)+   in  map (\xp -> (fst xp, xp)) xps++arctanSmall :: Basis -> T -> T+arctanSmall b x = series b (arctanSeries b x)++{- |+Efficient computation of Arcus tangens of an argument of the form @1\/n@.+-}+arctanStem :: Basis -> Int -> T+arctanStem b n =+   let x = (0, divIntMant b n [1])+       divN2 = divInt b n . divInt b (-n)+       {- this one can cause overflows in piConst too easily+       mn2 = - n*n+       divN2 = divInt b mn2+       -}+       xps = zipWith (divInt b) [1,3..] (iterate (trim . divN2) x)+   in  series b (map (\xp -> (fst xp, xp)) xps)+++{- |+This implementation gets the first decimal place for free+by calling the arcus tangens implementation for 'Double's.+-}+arctan :: Basis -> T -> T+arctan b x =+   let estimate = liftDoubleRough b atan x+       tanEst   = tan b estimate+       residue  = divide b (sub b x tanEst) (add b one (mul b x tanEst))+   in  addSome b [estimate, arctanSmall b residue]++{- |+A classic implementation without ''cheating''+with floating point implementations.++For @x < 1 \/ sqrt 3@+(@1 \/ sqrt 3 == tan (pi\/6)@)+use @arctan@ power series.+(@sqrt 3@ is approximately @19\/11@.)++For @x > sqrt 3@+use+@arctan x = pi\/2 - arctan (1\/x)@++For other @x@ use++@arctan x = pi\/4 - 0.5*arctan ((1-x^2)\/2*x)@+(which follows from+@arctan x + arctan y == arctan ((x+y) \/ (1-x*y))@+which in turn follows from complex multiplication+@(1:+x)*(1:+y) == ((1-x*y):+(x+y))@++If @x@ is close to @sqrt 3@ or @1 \/ sqrt 3@ the computation is quite inefficient.+-}+arctanClassic :: Basis -> T -> T+arctanClassic b x =+   let absX = absolute x+       pi2  = divInt b 2 (piConst b)+   in  select+          (divInt b 2 (sub b pi2+              (arctanSmall b+                  (divInt b 2 (sub b (reciprocal b x) x)))))+          [(lessApprox b (-5) absX (fromBaseRational b (11%19)),+               arctanSmall b x),+           (lessApprox b (-5) (fromBaseRational b (19%11)) absX,+               sub b pi2 (arctanSmall b (reciprocal b x)))]++++{- * constants -}++{- ** elementary -}++zero :: T+zero = (0,[])++one :: T+one = (0,[1])++minusOne :: T+minusOne = (0,[-1])+++{- ** transcendental -}++eConst :: Basis -> T+eConst b = expSmall b one++recipEConst :: Basis -> T+recipEConst b = expSmall b minusOne++piConst :: Basis -> T+piConst b =+   let numCompress = takeWhile (0/=)+          (iterate (flip div b) (4*(44+7+12+24)))+       stArcTan k den = scaleSimple k (arctanStem b den)+       sum' = addSome b+                 [stArcTan   44     57,+                  stArcTan    7    239,+                  stArcTan (-12)   682,+                  stArcTan   24  12943]+   in  foldl (const . compress b)+             (scaleSimple 4 sum') numCompress++++{- * auxilary functions -}++sliceVertPair :: [a] -> [(a,a)]+sliceVertPair (x0:x1:xs) = (x0,x1) : sliceVertPair xs+sliceVertPair [] = []+sliceVertPair _ = error "odd number of elements"++++{-+Pi as a zero of trigonometric functions. -+  Is a corresponding computation that bad?+Newton converges quadratically,+  but the involved trigonometric series converge only slightly more than linearly.++-- lift cos to higher frequencies, in order to shift the zero to smaller values, which let trigonometric series converge faster++take 10 $ Numerics.Newton.zero 0.7 (\x -> (cos (2*x), -2 * sin (2*x)))++(\x -> (2 * cos x ^ 2 - 1, -4 * cos x * sin x))+(\x -> (cos x ^ 2 - sin x ^ 2, -4 * cos x * sin x))+(\x -> (tan x ^ 2 - 1, 4 * tan x))+++-- compute arctan as inverse of tan by Newton++zero 0.7 (\x -> (tan x - 1, 1 + tan x ^ 2))+zero 0.7 (\x -> (tan x - 1, 1 / cos x ^ 2))+iterate (\x -> x + (cos x - sin x) * cos x) 0.7+iterate (\x -> x + (cos x - sin x) * sqrt 0.5) 0.7+iterate (\x -> x + cos x ^ 2 - sin x * cos x) 0.7+iterate (\x -> x + 0.5 - sin x * cos x) 0.7+iterate (\x -> x + cos x ^ 2 - 0.5) 0.7+++-- compute section of tan and cot++zero 0.7 (\x -> (tan x - 1 / tan x, (1 + tan x ^ 2) * (1 + 1 / tan x ^ 2))+zero 0.7 (\x -> ((tan x ^ 2 - 1) * tan x, (1 + tan x ^ 2) ^ 2)+iterate (\x -> x - (sin x ^ 2 - cos x ^ 2) * sin x * cos x) 0.7+iterate (\x -> x - (sin x ^ 2 - cos x ^ 2) * 0.5) 0.7+iterate (\x -> x + 1/2 - sin x ^ 2) 0.7++For using the last formula,+the n-th digit of (sin x) must depend only on the n-th digit of x.+The same holds for (^2).+This means that no interim carry compensation is possible.+This will certainly force usage of Integer for digits,+otherwise the multiplication will overflow sooner or later.+-}

+ src-ghc-6.12/Number/Positional/Check.hs view

@@ -0,0 +1,260 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Copyright   :  (c) Henning Thielemann 2006+License     :  GPL++Maintainer  :  numericprelude@henning-thielemann.de+Stability   :  provisional+++Interface to "Number.Positional" which dynamically checks for equal bases.+-}+module Number.Positional.Check where++import qualified Number.Positional as Pos++import qualified Number.Complex as Complex++-- import qualified Algebra.Module             as Module+import qualified Algebra.RealTranscendental as RealTrans+import qualified Algebra.Transcendental     as Trans+import qualified Algebra.Algebraic          as Algebraic+import qualified Algebra.RealField          as RealField+import qualified Algebra.Field              as Field+import qualified Algebra.RealRing           as RealRing+import qualified Algebra.Absolute           as Absolute+import qualified Algebra.Ring               as Ring+import qualified Algebra.Additive           as Additive+import qualified Algebra.ZeroTestable       as ZeroTestable++import qualified Algebra.EqualityDecision as EqDec+import qualified Algebra.OrderDecision    as OrdDec++import qualified NumericPrelude.Base as P+import qualified Prelude     as P98++import NumericPrelude.Base as P+import NumericPrelude.Numeric as NP+++{- |+The value @Cons b e m@+represents the number @b^e * (m!!0 \/ 1 + m!!1 \/ b + m!!2 \/ b^2 + ...)@.+The interpretation of exponent is chosen such that+@floor (logBase b (Cons b e m)) == e@.+That is, it is good for multiplication and logarithms.+(Because of the necessity to normalize the multiplication result,+the alternative interpretation wouldn't be more complicated.)+However for base conversions, roots, conversion to fixed point and+working with the fractional part+the interpretation+@b^e * (m!!0 \/ b + m!!1 \/ b^2 + m!!2 \/ b^3 + ...)@+would fit better.+The digits in the mantissa range from @1-base@ to @base-1@.+The representation is not unique+and cannot be made unique in finite time.+This way we avoid infinite carry ripples.+-}+data T = Cons {base :: Int, exponent :: Int, mantissa :: Pos.Mantissa}+   deriving (Show)+++{- * basic helpers -}++{- |+Shift digits towards zero by partial application of carries.+E.g. 1.8 is converted to 2.(-2)+If the digits are in the range @(1-base, base-1)@+the resulting digits are in the range @((1-base)/2-2, (base-1)/2+2)@.+The result is still not unique,+but may be useful for further processing.+-}+compress :: T -> T+compress = lift1 Pos.compress+++{- | perfect carry resolution, works only on finite numbers -}+carry :: T -> T+carry (Cons b ex xs) =+   let ys = scanr (\x (c,_) -> divMod (x+c) b) (0,undefined) xs+       digits = map snd (init ys)+   in  prependDigit (fst (head ys)) (Cons b ex digits)+++prependDigit :: Int -> T -> T+prependDigit 0 x = x+prependDigit x (Cons b ex xs) =+   Cons b (ex+1) (x:xs)++++{- * conversions -}++lift0 :: (Int -> Pos.T) -> T+lift0 op =+   uncurry (Cons defltBase) (op defltBase)++lift1 :: (Int -> Pos.T -> Pos.T) -> T -> T+lift1 op (Cons xb xe xm) =+   uncurry (Cons xb) (op xb (xe, xm))++lift2 :: (Int -> Pos.T -> Pos.T -> Pos.T) -> T -> T -> T+lift2 op (Cons xb xe xm) (Cons yb ye ym) =+   let b = commonBasis xb yb+   in  uncurry (Cons b) (op b (xe, xm) (ye, ym))++{-+lift4 :: (Int -> Pos.T -> Pos.T -> Pos.T -> Pos.T -> Pos.T) -> T -> T -> T -> T -> T+lift4 op (Cons xb xe xm) (Cons yb ye ym) (Cons zb ze zm) (Cons wb we wm) =+   let b = xb `commonBasis` yb `commonBasis` zb `commonBasis` wb+   in  uncurry (Cons b) (op b (xe, xm) (ye, ym) (ze, zm) (we, wm))+-}++commonBasis :: Pos.Basis -> Pos.Basis -> Pos.Basis+commonBasis xb yb =+   if xb == yb+     then xb+     else error "Number.Positional: bases differ"++fromBaseInteger :: Int -> Integer -> T+fromBaseInteger b n =+   uncurry (Cons b) (Pos.fromBaseInteger b n)++fromBaseRational :: Int -> Rational -> T+fromBaseRational b r =+   uncurry (Cons b) (Pos.fromBaseRational b r)++++++defltBaseRoot :: Pos.Basis+defltBaseRoot = 10++defltBaseExp :: Pos.Exponent+defltBaseExp = 3+-- exp 4   let  (sqrt 0.5) fail++defltBase :: Pos.Basis+defltBase = ringPower defltBaseExp defltBaseRoot++++defltShow :: T -> String+defltShow (Cons xb xe xm) =+   if xb == defltBase+     then Pos.showBasis defltBaseRoot defltBaseExp (xe,xm)+     else error "defltShow: wrong base"+++instance Additive.C T where+   zero   = fromBaseInteger defltBase 0+   (+)    = lift2 Pos.add+   (-)    = lift2 Pos.sub+   negate = lift1 Pos.neg++instance Ring.C T where+   one           = fromBaseInteger defltBase 1+   fromInteger n = fromBaseInteger defltBase n+   (*)           = lift2 Pos.mul++{-+instance Module.C T T where+   (*>) = (*)+-}++instance Field.C T where+   (/)   = lift2 Pos.divide+   recip = lift1 Pos.reciprocal++instance Algebraic.C T where+   sqrt   = lift1 Pos.sqrtNewton+   root n = lift1 (flip Pos.root n)+   x ^/ y = lift1 (flip Pos.power y) x++instance Trans.C T where+   pi     = lift0 Pos.piConst++   exp    = lift1 Pos.exp+   log    = lift1 Pos.ln++   sin    = lift1 (\b -> snd . Pos.cosSin b)+   cos    = lift1 (\b -> fst . Pos.cosSin b)+   tan    = lift1 Pos.tan++   atan   = lift1 Pos.arctan++   {-+   sinh   = lift1 (\b -> snd . Pos.cosSinh b)+   cosh   = lift1 (\b -> snd . Pos.cosSinh b)+   -}++{-+The way EqDec and OrdDec are instantiated+it is possible to have different bases+for the arguments for comparison+and the arguments between we decide.+However, I would not rely on this.+-}+instance EqDec.C T where+   x==?y  =  lift2 (\b -> Pos.ifLazy b (x==y))++instance OrdDec.C T where+   x<=?y  =  lift2 (\b -> Pos.ifLazy b (x<=y))++instance ZeroTestable.C T where+   isZero (Cons xb xe xm) =+      Pos.cmp xb (xe,xm) Pos.zero == EQ++instance Eq T where+   (Cons xb xe xm) == (Cons yb ye ym) =+      Pos.cmp (commonBasis xb yb) (xe,xm) (ye,ym) == EQ++instance Ord T where+   compare (Cons xb xe xm) (Cons yb ye ym) =+      Pos.cmp (commonBasis xb yb) (xe,xm) (ye,ym)++instance Absolute.C T where+   abs = lift1 (const Pos.absolute)+   signum = Absolute.signumOrd++instance RealRing.C T where+   splitFraction (Cons xb xe xm) =+      let (int, frac) = Pos.toFixedPoint xb (xe,xm)+      in  (fromInteger int, Cons xb (-1) frac)++instance RealField.C T where++instance RealTrans.C T where+   atan2  = lift2 (curry . Pos.angle)+++-- for complex numbers++instance Complex.Power T where+   power     = Complex.defltPow+++++-- legacy instances for work with GHCi+legacyInstance :: a+legacyInstance =+   error "legacy Ring.C instance for simple input of numeric literals"++instance P98.Num T where+   fromInteger = fromBaseInteger defltBase+   negate = negate --for unary minus+   (+)    = legacyInstance+   (*)    = legacyInstance+   abs    = legacyInstance+   signum = legacyInstance++instance P98.Fractional T where+   fromRational = fromBaseRational defltBase . fromRational+   (/) = legacyInstance+++{-+MathObj.PowerSeries.approx MathObj.PowerSeries.Example.exp (Number.Positional.fromBaseInteger 10 1) List.!! 30 :: Number.Positional.Check.T+-}

+ src-ghc-6.12/Number/Quaternion.hs view

@@ -0,0 +1,296 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{- |+Maintainer  :  numericprelude@henning-thielemann.de+Stability   :  provisional+Portability :  portable (?)++Quaternions+-}++module Number.Quaternion+        (+        -- * Cartesian form+        T(real,imag),+        fromReal,+        (+::),++        -- * Conversions+        toRotationMatrix,+        fromRotationMatrix,+        fromRotationMatrixDenorm,+        toComplexMatrix,+        fromComplexMatrix,++        -- * Operations+        scalarProduct,+        crossProduct,+        conjugate,+        scale,+        norm,+        normSqr,+        normalize,+        similarity,+        slerp,+        )  where++import qualified Algebra.NormedSpace.Euclidean as NormedEuc+import qualified Algebra.VectorSpace  as VectorSpace+import qualified Algebra.Module       as Module+import qualified Algebra.Vector       as Vector+import qualified Algebra.Transcendental as Trans+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 Algebra.ZeroTestable(isZero)+import Algebra.Module((*>), (<*>.*>), )++import qualified Number.Complex as Complex++import Number.Complex ((+:))++import qualified NumericPrelude.Elementwise as Elem+import Algebra.Additive ((<*>.+), (<*>.-), (<*>.-$), )++-- import qualified Data.Typeable as Ty+import Data.Array (Array, (!))+import qualified Data.Array as Array++import qualified Prelude as P+import NumericPrelude.Base+import NumericPrelude.Numeric hiding (signum)+import Text.Show.HT (showsInfixPrec, )+import Text.Read.HT (readsInfixPrec, )+++{- TODO:+conversion to and from complex matrix+-}+++infix  6  +::, `Cons`++{- |+Quaternions could be defined based on Complex numbers.+However quaternions are often considered as real part and three imaginary parts.+-}+data T a+  = Cons {real :: !a           -- ^ real part+         ,imag :: !(a, a, a)   -- ^ imaginary parts+         }+  deriving (Eq)++fromReal :: Additive.C a => a -> T a+fromReal x = Cons x zero+++plusPrec :: Int+plusPrec = 6++instance (Show a) => Show (T a) where+   showsPrec prec (x `Cons` y) = showsInfixPrec "+::" plusPrec prec x y++instance (Read a) => Read (T a) where+   readsPrec prec = readsInfixPrec "+::" plusPrec prec (+::)+++-- | Construct a quaternion from real and imaginary part.+(+::) :: a -> (a,a,a) -> T a+(+::) = Cons++-- | The conjugate of a quaternion.+{-# SPECIALISE conjugate :: T Double -> T Double #-}+conjugate	 :: (Additive.C a) => T a -> T a+conjugate (Cons r i) =  Cons r (negate i)++-- | Scale a quaternion by a real number.+{-# SPECIALISE scale :: Double -> T Double -> T Double #-}+scale		 :: (Ring.C a) => a -> T a -> T a+scale r (Cons xr xi) =  Cons (r * xr) (scaleImag r xi)++-- | like Module.*> but without additional class dependency+scaleImag	 :: (Ring.C a) => a -> (a,a,a) -> (a,a,a)+scaleImag r (xi,xj,xk) =  (r * xi, r * xj, r * xk)++-- | the same as NormedEuc.normSqr but with a simpler type class constraint+normSqr		 :: (Ring.C a) => T a -> a+normSqr (Cons xr xi) = xr*xr + scalarProduct xi xi++norm		 :: (Algebraic.C a) => T a -> a+norm x = sqrt (normSqr x)++-- | scale a quaternion into a unit quaternion+normalize	 :: (Algebraic.C a) => T a -> T a+normalize x = scale (recip (norm x)) x++scalarProduct	 :: (Ring.C a) => (a,a,a) -> (a,a,a) -> a+scalarProduct (xi,xj,xk) (yi,yj,yk) =+   xi*yi + xj*yj + xk*yk++crossProduct	 :: (Ring.C a) => (a,a,a) -> (a,a,a) -> (a,a,a)+crossProduct (xi,xj,xk) (yi,yj,yk) =+   (xj*yk - xk*yj, xk*yi - xi*yk, xi*yj - xj*yi)++{- | similarity mapping as needed for rotating 3D vectors++It holds+@similarity (cos(a\/2) +:: scaleImag (sin(a\/2)) v) (0 +:: x) == (0 +:: y)@+where @y@ results from rotating @x@ around the axis @v@ by the angle @a@.+-}+similarity	 :: (Field.C a) => T a -> T a -> T a+similarity c x = c*x/c++{-+rotate	 :: (Field.C a) =>+      (a,a,a)  {- ^ rotation axis, must be normalized -}+   -> T a+   -> T a+rotate c x = c*x/c+-}++{- |+Let @c@ be a unit quaternion, then it holds+@similarity c (0+::x) == toRotationMatrix c * x@+-}+toRotationMatrix :: (Ring.C a) => T a -> Array (Int,Int) a+toRotationMatrix (Cons r (i,j,k)) =+   let r2 = r^2+       i2 = i^2;   j2 = j^2;   k2 = k^2+       ri = 2*r*i; rj = 2*r*j; rk = 2*r*k+       jk = 2*j*k; ki = 2*k*i; ij = 2*i*j+   in  Array.listArray ((0,0),(2,2)) $ concat $+          [r2+i2-j2-k2, ij-rk,       ki+rj      ] :+          [ij+rk,       r2-i2+j2-k2, jk-ri      ] :+          [ki-rj,       jk+ri,       r2-i2-j2+k2] :+          []++fromRotationMatrix :: (Algebraic.C a) => Array (Int,Int) a -> T a+fromRotationMatrix =+   normalize . fromRotationMatrixDenorm+++checkBounds :: (Int,Int) -> Array (Int,Int) a -> Array (Int,Int) a+checkBounds (c,r) arr =+   let bnds@((c0,r0), (c1,r1)) = Array.bounds arr+   in  if c1-c0==c && r1-r0==r+         then Array.listArray ((0,0), (c1-c0, r1-r0))+                              (Array.elems arr)+         else error ("Quaternion.checkBounds: invalid matrix size "+                         ++ show bnds)+++{- |+The rotation matrix must be normalized.+(I.e. no rotation with scaling)+The computed quaternion is not normalized.+-}+fromRotationMatrixDenorm :: (Ring.C a) => Array (Int,Int) a -> T a+fromRotationMatrixDenorm mat' =+   let mat = checkBounds (2,2) mat'+       trace = sum (map (\i -> mat ! (i,i)) [0..2])+       dif (i,j) = mat!(i,j) - mat!(j,i)+   in  Cons (trace+1) (dif (2,1), dif (0,2), dif (1,0))++{- |+Map a quaternion to complex valued 2x2 matrix,+such that quaternion addition and multiplication+is mapped to matrix addition and multiplication.+The determinant of the matrix equals the squared quaternion norm ('normSqr').+Since complex numbers can be turned into real (orthogonal) matrices,+a quaternion could also be converted into a real matrix.+-}+toComplexMatrix :: (Additive.C a) =>+   T a -> Array (Int,Int) (Complex.T a)+toComplexMatrix (Cons r (i,j,k)) =+   Array.listArray ((0,0), (1,1))+      [r+:i, (-j)+:(-k), j+:(-k), r+:(-i)]+++{- |+Revert 'toComplexMatrix'.+-}+fromComplexMatrix :: (Field.C a) =>+   Array (Int,Int) (Complex.T a) -> T a+fromComplexMatrix mat =+   let xs = Array.elems (checkBounds (1,1) mat)+       [ar,br,cr,dr] = map Complex.real xs+       [ai,bi,ci,di] = map Complex.imag xs+   in  scale (1/2) (Cons (ar+dr) (ai-di, cr-br, -ci-bi))+++{- |+Spherical Linear Interpolation++Can be generalized to any transcendent Hilbert space.+In fact, we should also include the real part in the interpolation.+-}+slerp :: (Trans.C a) =>+      a   {- ^ For @0@ return vector @v@,+               for @1@ return vector @w@ -}+   -> (a,a,a)  {- ^ vector @v@, must be normalized -}+   -> (a,a,a)  {- ^ vector @w@, must be normalized -}+   -> (a,a,a)+slerp c v w =+   let scal  = scalarProduct v w /+                  sqrt (scalarProduct v v * scalarProduct w w)+       angle = Trans.acos scal+   in  scaleImag (recip (Algebraic.sqrt (1-scal^2)))+         (scaleImag (Trans.sin ((1-c)*angle)) v ++          scaleImag (Trans.sin (   c *angle)) w)++++instance (NormedEuc.Sqr a b) => NormedEuc.Sqr a (T b) where+   normSqr (Cons r i) = NormedEuc.normSqr r + NormedEuc.normSqr i++instance (Algebraic.C a, NormedEuc.Sqr a b) => NormedEuc.C a (T b) where+   norm = NormedEuc.defltNorm++++instance (ZeroTestable.C a) => ZeroTestable.C (T a)  where+   isZero (Cons r i)  = isZero r && isZero i++instance (Additive.C a) => Additive.C (T a)  where+   {-# SPECIALISE instance Additive.C (T Float) #-}+   {-# SPECIALISE instance Additive.C (T Double) #-}+   zero   = Cons zero zero+   (+)    = Elem.run2 $ Elem.with Cons <*>.+  real <*>.+  imag+   (-)    = Elem.run2 $ Elem.with Cons <*>.-  real <*>.-  imag+   negate = Elem.run  $ Elem.with Cons <*>.-$ real <*>.-$ imag++instance (Ring.C a) => Ring.C (T a)  where+   {-# SPECIALISE instance Ring.C (T Float) #-}+   {-# SPECIALISE instance Ring.C (T Double) #-}+   one				=  Cons one zero+   fromInteger			=  fromReal . fromInteger+   (Cons xr xi) * (Cons yr yi)	=+       Cons (xr*yr - scalarProduct xi yi)+            (scaleImag xr yi + scaleImag yr xi ++             crossProduct xi yi)++instance (Field.C a) => Field.C (T a)  where+   {-# SPECIALISE instance Field.C (T Float) #-}+   {-# SPECIALISE instance Field.C (T Double) #-}+   recip x = scale (recip (normSqr x)) (conjugate x)+   (Cons xr xi) / y@(Cons yr yi) =+       scale (recip (normSqr y))+          (Cons (xr*yr + scalarProduct xi yi)+                (scaleImag yr xi - scaleImag xr yi - crossProduct xi yi))++instance Vector.C T where+   zero  = zero+   (<+>) = (+)+   (*>)  = scale++-- | The '(*>)' method can't replace 'scale'+--   because it requires the Algebra.Module constraint+instance (Module.C a b) => Module.C a (T b) where+   (*>) = Elem.run2 $ Elem.with Cons <*>.*> real <*>.*> imag++instance (VectorSpace.C a b) => VectorSpace.C a (T b)+

+ src-ghc-6.12/Number/Ratio.hs view

@@ -0,0 +1,249 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Module      :  Number.Ratio+Copyright   :  (c) Henning Thielemann, Dylan Thurston 2006++Maintainer  :  numericprelude@henning-thielemann.de+Stability   :  provisional+Portability :  portable (?)++Ratios of mathematical objects.+-}++module Number.Ratio+	(+	  T((:%), numerator, denominator), (%),+          Rational,+          fromValue,++          scale,+          split,+          showsPrecAuto,++          toRational98,+        )  where++import qualified Algebra.PrincipalIdealDomain as PID+import qualified Algebra.Absolute             as Absolute+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 Algebra.PrincipalIdealDomain (gcd, )+import Algebra.Units (stdUnitInv, stdAssociate, )+import Algebra.IntegralDomain (div, divMod, )+import Algebra.Ring (one, (*), (^), fromInteger, )+import Algebra.Additive (zero, (+), (-), negate, )+import Algebra.ZeroTestable (isZero, )++import Control.Monad(liftM, liftM2, )++import Foreign.Storable (Storable (..), )+import qualified Foreign.Storable.Record as Store+import Control.Applicative (liftA2, )++import Test.QuickCheck (Arbitrary(arbitrary))+import System.Random (Random(..), RandomGen, )++import qualified Data.Ratio as Ratio98++import qualified Prelude as P+import NumericPrelude.Base+++infixl 7 %++data  {- (PID.C a)  => -} T a = (:%) {+        numerator   :: !a,+        denominator :: !a+     } deriving (Eq)+type  Rational = T P.Integer+++fromValue :: Ring.C a => a -> T a+fromValue x = x :% one++scale :: (PID.C a) => a -> T a -> T a+scale s (x:%y) =+   let {- x and y are cancelled,+          thus we can only have common divisors in s and y -}+       (n:%d) = s%y+   in  ((n*x):%d)++{- | similar to 'Algebra.RealRing.splitFraction' -}+split :: (PID.C a) => T a -> (a, T a)+split (x:%y) =+   let (q,r) = divMod x y+   in  (q, r:%y)++ratioPrec :: P.Int+ratioPrec = 7++(%) :: (PID.C a) => a -> a -> T a+x % y =+  if isZero y+    then error "NumericPrelude.% : zero denominator"+    else+      let d  = gcd x y+          y0 = div y d+          x0 = div x d+      in  (stdUnitInv y0 * x0) :% stdAssociate y0++instance (PID.C a) => Additive.C (T a) where+    zero                =  fromValue zero+--    (x:%y) + (x':%y')   =  (x*y' + x'*y) % (y*y')+    {-+    This version reduces the size of intermediate results.+    Is it also faster than the naive version?+    The final (%) includes another gcd computation,+    but it is still needed since e.g.+    5:%7 + (-5):%7 shall be simplified to 0:%1, not 0:%7 .+    -}+    (x:%y) + (x':%y')   =+       let d = gcd y y'+           y0  = div y  d+           y0' = div y' d+       in  (x*y0' + x'*y0) % (y0*y')+    negate (x:%y)       =  (-x) :% y++instance (PID.C a) => Ring.C (T a) where+    one                 =  fromValue one+    fromInteger x       =  fromValue $ fromInteger x+    (x:%y) * (x':%y')   =  (x * x') % (y * y')+    (x:%y) ^ n          =  (x ^ n) :% (y ^ n)++instance (Absolute.C a, PID.C a) => Absolute.C (T a) where+    abs (x:%y)          =  Absolute.abs x :% y+    signum (x:%_)       =  Absolute.signum x :% one+++liftOrd :: Ring.C a => (a -> a -> b) -> (T a -> T a -> b)+liftOrd f (x:%y) (x':%y') = f (x * y') (x' * y)++instance (Ord a, PID.C a) => Ord (T a) where+    (<=)     =  liftOrd (<=)+    (<)      =  liftOrd (<)+    (>=)     =  liftOrd (>=)+    (>)      =  liftOrd (>)+    compare  =  liftOrd compare++instance (Ord a, PID.C a) => Indexable.C (T a) where+    compare  =  compare++instance (ZeroTestable.C a, PID.C a) => ZeroTestable.C (T a) where+    isZero  =  isZero . numerator++instance  (Read a, PID.C a)  => Read (T a)  where+    readsPrec p  =+       readParen (p >= ratioPrec)+                 (\r -> [(x%y,u) | (x,s)   <- readsPrec ratioPrec r,+                                   ("%",t) <- lex s,+                                   (y,u)   <- readsPrec ratioPrec t ])++instance  (Show a, PID.C a)  => Show (T a)  where+    showsPrec p (x:%y)  =  showParen (p >= ratioPrec)+                               (shows x . showString " % " . shows y)++{- |+This is an alternative show method+that is more user-friendly but also potentially more ambigious.+-}++showsPrecAuto :: (Eq a, PID.C a, Show a) =>+   P.Int -> T a -> String -> String+showsPrecAuto p (x:%y) =+   if y == 1+     then showsPrec p x+     else showParen (p > ratioPrec)+             (showsPrec (ratioPrec+1) x . showString "/" .+              showsPrec (ratioPrec+1) y)+++instance (Arbitrary a, PID.C a, ZeroTestable.C a) => Arbitrary (T a) where+{-+   arbitrary = liftM2 (%) arbitrary (untilM (not . isZero) arbitrary)++This implementation leads to blocking:++*Main> Test.QuickCheck.test (\x -> x==(x::Rational))+Interrupted.+-}+   arbitrary =+      liftM2 (%) arbitrary+         (liftM (\x -> if isZero x then one else x) arbitrary)+++instance (Storable a, PID.C a) => Storable (T a) where+   sizeOf    = Store.sizeOf store+   alignment = Store.alignment store+   peek      = Store.peek store+   poke      = Store.poke store++store ::+   (Storable a, PID.C a) =>+   Store.Dictionary (T a)+store =+   Store.run $+   liftA2 (%)+      (Store.element numerator)+      (Store.element denominator)++{-+This instance may not be appropriate for mathematical objects other than numbers.+If we encounter such a type of object+we should define an intermediate class+which provides the necessary functions.+I should remark that methods of Random like 'randomR'+cannot sensibly be defined for ratios of polynomials.+-}+instance (Random a, PID.C a, ZeroTestable.C a) => Random (T a) where+   random g0 =+      let (numer, g1) = random g0+          (denom, g2) = random g1+      in  (numer % if isZero denom then one else denom, g2)+   randomR (lower,upper) g0 =+      let (k, g1) = randomR01 g0+      in  (lower + k*(upper-lower), g1)+++randomR01 ::+   (Random a, PID.C a, RandomGen g) =>+   g -> (T a, g)+randomR01 g0 =+   let (denom0, g1) = random g0+       denom = if isZero denom0 then one else denom0+       (numer, g2) = randomR (zero,denom) g1+   in  (numer % denom, g2)+++-- * Legacy Instances+++-- | Necessary when mixing NumericPrelude.Numeric Rationals with Prelude98 Rationals++toRational98 :: (P.Integral a, PID.C a) => T a -> Ratio98.Ratio a+toRational98 x = numerator x Ratio98.% denominator x+++legacyInstance :: String -> a+legacyInstance op =+   error ("Ratio." ++ op ++ ": legacy Ring instance for simple input of numeric literals")+++-- instance (P.Num a, PID.C a) => P.Num (T a) where+instance (P.Num a, PID.C a, Absolute.C a) => P.Num (T a) where+   fromInteger n = P.fromInteger n % 1+   negate = negate -- for unary minus+   (+)    = legacyInstance "(+)"+   (*)    = legacyInstance "(*)"+   abs    = Absolute.abs -- needed for Arbitrary instance of NonNegative.Ratio+   signum = legacyInstance "signum"++-- instance (P.Num a, PID.C a) => P.Fractional (T a) where+instance (P.Num a, PID.C a, Absolute.C a) => P.Fractional (T a) where+--   fromRational = Field.fromRational+   fromRational x =+      fromInteger (Ratio98.numerator x) :%+      fromInteger (Ratio98.denominator x)+   (/) = legacyInstance "(/)"

+ src-ghc-6.12/Number/ResidueClass.hs view

@@ -0,0 +1,47 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Number.ResidueClass where++import qualified Algebra.PrincipalIdealDomain as PID+import qualified Algebra.IntegralDomain as Integral+-- import qualified Algebra.Additive       as Additive+-- import qualified Algebra.ZeroTestable   as ZeroTestable++import NumericPrelude.Base+import NumericPrelude.Numeric hiding (recip)+import Data.Maybe.HT (toMaybe)+import Data.Maybe (fromMaybe)+++add, sub :: (Integral.C a) => a -> a -> a -> a+add m x y = mod (x+y) m+sub m x y = mod (x-y) m++neg :: (Integral.C a) => a -> a -> a+neg m x = mod (-x) m++mul :: (Integral.C a) => a -> a -> a -> a+mul m x y = mod (x*y) m+++{- |+The division may be ambiguous.+In this case an arbitrary quotient is returned.++@+0/:4 * 2/:4 == 0/:4+2/:4 * 2/:4 == 0/:4+@+-}+divideMaybe :: (PID.C a) => a -> a -> a -> Maybe a+divideMaybe m x y =+   let (d,(_,z)) = extendedGCD m y+       (q,r)     = divMod x d+   in  toMaybe (isZero r) (mod (q*z) m)++divide :: (PID.C a) => a -> a -> a -> a+divide m x y =+   fromMaybe (error "ResidueClass.divide: indivisible")+             (divideMaybe m x y)++recip :: (PID.C a) => a -> a -> a+recip m = divide m one

+ src-ghc-6.12/Number/ResidueClass/Check.hs view

@@ -0,0 +1,118 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Number.ResidueClass.Check where++import qualified Number.ResidueClass as Res++import qualified Algebra.PrincipalIdealDomain as PID+import qualified Algebra.IntegralDomain as Integral+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 Algebra.ZeroTestable(isZero)++import qualified Data.Function.HT as Func+import Data.Maybe.HT (toMaybe, )+import Text.Show.HT (showsInfixPrec, )+import Text.Read.HT (readsInfixPrec, )++import NumericPrelude.Base+import NumericPrelude.Numeric (Int, Integer, mod, (*), )+++infix 7 /:, `Cons`++{- |+The best solution seems to let 'modulus' be part of the type.+This could happen with a phantom type for modulus+and a @run@ function like 'Control.Monad.ST.runST'.+Then operations with non-matching moduli could be detected at compile time+and 'zero' and 'one' could be generated with the correct modulus.+An alternative trial can be found in module ResidueClassMaybe.+-}+data T a+  = Cons {modulus        :: !a+         ,representative :: !a+         }++factorPrec :: Int+factorPrec = read "7"++instance (Show a) => Show (T a) where+   showsPrec prec (Cons m r) = showsInfixPrec "/:" factorPrec prec r m++instance (Read a, Integral.C a) => Read (T a) where+   readsPrec prec = readsInfixPrec "/:" factorPrec prec (/:)+++-- | @r \/: m@ is the residue class containing @r@ with respect to the modulus @m@+(/:) :: (Integral.C a) => a -> a -> T a+(/:) r m = Cons m (mod r m)++-- | Check if two residue classes share the same modulus+isCompatible :: (Eq a) => T a -> T a -> Bool+isCompatible x y  =  modulus x == modulus y++maybeCompatible :: (Eq a) => T a -> T a -> Maybe a+maybeCompatible x y =+   let mx = modulus x+       my = modulus y+   in  toMaybe (mx==my) mx+++fromRepresentative :: (Integral.C a) => a -> a -> T a+fromRepresentative m x = Cons m (mod x m)++lift1 :: (Eq a) => (a -> a -> a) -> T a -> T a+lift1 f x =+   let m = modulus x+   in  Cons m (f m (representative x))++lift2 :: (Eq a) => (a -> a -> a -> a) -> T a -> T a -> T a+lift2 f x y =+   maybe+      (errIncompat)+      (\m -> Cons m (f (modulus x) (representative x) (representative y)))+      (maybeCompatible x y)++errIncompat :: a+errIncompat = error "Residue class: Incompatible operands"+++zero :: (Additive.C a) => a -> T a+zero m = Cons m Additive.zero++one :: (Ring.C a) => a -> T a+one  m = Cons m Ring.one++fromInteger :: (Integral.C a) => a -> Integer -> T a+fromInteger m x = fromRepresentative m (Ring.fromInteger x)++++instance  (Eq a) => Eq (T a)  where+    (==) x y  =+        maybe errIncompat+           (const (representative x == representative y))+           (maybeCompatible x y)++instance  (ZeroTestable.C a) => ZeroTestable.C (T a)  where+    isZero (Cons _ r)   =  isZero r++instance  (Eq a, Integral.C a) => Additive.C (T a)  where+    zero		=  error "no generic zero in a residue class, use ResidueClass.zero"+    (+)			=  lift2 Res.add+    (-)			=  lift2 Res.sub+    negate		=  lift1 Res.neg++instance  (Eq a, Integral.C a) => Ring.C (T a)  where+    one			=  error "no generic one in a residue class, use ResidueClass.one"+    (*)			=  lift2 Res.mul+    fromInteger		=  error "no generic integer in a residue class, use ResidueClass.fromInteger"+    x^n                 =  Func.powerAssociative (*) (one (modulus x)) x n++instance  (Eq a, PID.C a) => Field.C (T a)  where+    (/)			=  lift2 Res.divide+    recip               =  lift1 (flip Res.divide Ring.one)+    fromRational'	=  error "no conversion from rational to residue class"

+ src-ghc-6.12/Number/ResidueClass/Func.hs view

@@ -0,0 +1,102 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Number.ResidueClass.Func where++import qualified Number.ResidueClass as Res++import qualified Algebra.PrincipalIdealDomain as PID+import qualified Algebra.IntegralDomain   as Integral+import qualified Algebra.Field            as Field+import qualified Algebra.Ring             as Ring+import qualified Algebra.Additive         as Additive+import qualified Algebra.EqualityDecision as EqDec++import Algebra.EqualityDecision ((==?), )+import NumericPrelude.Base+import NumericPrelude.Numeric hiding (zero, one, )++import qualified Prelude        as P+import qualified NumericPrelude.Numeric as NP++{- |+Here a residue class is a representative+and the modulus is an argument.+You cannot show a value of type 'T',+you can only show it with respect to a concrete modulus.+Values cannot be compared,+because the comparison result depends on the modulus.+-}+newtype T a = Cons (a -> a)++concrete :: a -> T a -> a+concrete m (Cons r) = r m++fromRepresentative :: (Integral.C a) => a -> T a+fromRepresentative = Cons . mod++lift0 :: (a -> a) -> T a+lift0 = Cons++lift1 :: (a -> a -> a) -> T a -> T a+lift1 f (Cons x) = Cons $ \m -> f m (x m)++lift2 :: (a -> a -> a -> a) -> T a -> T a -> T a+lift2 f (Cons x) (Cons y) = Cons $ \m -> f m (x m) (y m)+++zero :: (Additive.C a) => T a+zero = Cons $ const Additive.zero++one :: (Ring.C a) => T a+one  = Cons $ const NP.one++fromInteger :: (Integral.C a) => Integer -> T a+fromInteger = fromRepresentative . NP.fromInteger++equal :: Eq a => a -> T a -> T a -> Bool+equal m (Cons x) (Cons y)  =  x m == y m+++instance  (EqDec.C a) => EqDec.C (T a)  where+    (==?) (Cons x) (Cons y) (Cons eq) (Cons noteq) =+       Cons (\m -> (x m ==? y m) (eq m) (noteq m))++instance  (Integral.C a) => Additive.C (T a)  where+    zero		=  zero+    (+)			=  lift2 Res.add+    (-)			=  lift2 Res.sub+    negate		=  lift1 Res.neg++instance  (Integral.C a) => Ring.C (T a)  where+    one			=  one+    (*)			=  lift2 Res.mul+    fromInteger		=  Number.ResidueClass.Func.fromInteger++instance  (PID.C a) => Field.C (T a)  where+    (/)			=  lift2 Res.divide+    recip               =  (NP.one /)+    fromRational'	=  error "no conversion from rational to residue class"+++{-+NumericPrelude.fromInteger seems to be not available at GHCi's prompt sometimes.+But Prelude.fromInteger requires Prelude.Num instance.+-}++-- legacy instances for work with GHCi+legacyInstance :: a+legacyInstance =+   error "legacy Ring.C instance for simple input of numeric literals"++instance (P.Num a, Integral.C a) => P.Num (T a) where+   fromInteger = Number.ResidueClass.Func.fromInteger+   negate = negate --for unary minus+   (+)    = legacyInstance+   (*)    = legacyInstance+   abs    = legacyInstance+   signum = legacyInstance++instance Eq (T a) where+   (==) = error "ResidueClass.Func: (==) not implemented"++instance Show (T a) where+   show = error "ResidueClass.Func: 'show' not implemented"

+ src-ghc-6.12/Number/ResidueClass/Maybe.hs view

@@ -0,0 +1,80 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Number.ResidueClass.Maybe where++import qualified Number.ResidueClass as Res++import qualified Algebra.IntegralDomain as Integral+import qualified Algebra.Ring           as Ring+import qualified Algebra.Additive       as Additive+import qualified Algebra.ZeroTestable   as ZeroTestable++import NumericPrelude.Base+import NumericPrelude.Numeric++infix 7 /:, `Cons`+++{- |+Here we try to provide implementations for 'zero' and 'one'+by making the modulus optional.+We have to provide non-modulus operations for the cases+where both operands have Nothing modulus.+This is problematic since operations like '(\/)'+depend essentially on the modulus.++A working version with disabled 'zero' and 'one' can be found ResidueClass.+-}+data T a+  = Cons {modulus        :: !(Maybe a)  -- ^ the modulus can be Nothing to denote a generic constant like 'zero' and 'one' which could not be bound to a specific modulus so far+         ,representative :: !a+         }+  deriving (Show, Read)+++-- | @r \/: m@ is the residue class containing @r@ with respect to the modulus @m@+(/:) :: (Integral.C a) => a -> a -> T a+(/:) r m = Cons (Just m) (mod r m)+++matchMaybe :: Maybe a -> Maybe a -> Maybe a+matchMaybe Nothing y = y+matchMaybe x       _ = x++isCompatibleMaybe :: (Eq a) => Maybe a -> Maybe a -> Bool+isCompatibleMaybe Nothing _ = True+isCompatibleMaybe _ Nothing = True+isCompatibleMaybe (Just x) (Just y) = x == y++-- | Check if two residue classes share the same modulus+isCompatible :: (Eq a) => T a -> T a -> Bool+isCompatible x y  =  isCompatibleMaybe (modulus x) (modulus y)+++lift2 :: (Eq a) => (a -> a -> a -> a) -> (a -> a -> a) -> (T a -> T a -> T a)+lift2 f g x y =+  if isCompatible x y+    then let m = matchMaybe (modulus x) (modulus y)+         in  Cons m+                  (maybe g f m (representative x) (representative y))+    else error "ResidueClass: Incompatible operands"+++instance  (Eq a, ZeroTestable.C a, Integral.C a) => Eq (T a)  where+    (==) x y =+      if isCompatible x y+        then maybe (==)+                   (\m x' y' -> isZero (mod (x'-y') m))+                   (matchMaybe (modulus x) (modulus y))+                   (representative x) (representative y)+        else error "ResidueClass.(==): Incompatible operands"++instance  (Eq a, Integral.C a) => Additive.C (T a)  where+    zero		=  Cons Nothing zero+    (+)			=  lift2 Res.add (+)+    (-)			=  lift2 Res.sub (-)+    negate (Cons m r)	=  Cons m (negate r)++instance  (Eq a, Integral.C a) => Ring.C (T a)  where+    one			=  Cons Nothing one+    (*)			=  lift2 Res.mul (*)+    fromInteger		=  Cons Nothing . fromInteger

+ src-ghc-6.12/Number/ResidueClass/Reader.hs view

@@ -0,0 +1,96 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Number.ResidueClass.Reader where++import qualified Number.ResidueClass as Res++import qualified Algebra.PrincipalIdealDomain as PID+import qualified Algebra.IntegralDomain as Integral+import qualified Algebra.Ring           as Ring+import qualified Algebra.Additive       as Additive++import NumericPrelude.Base+import NumericPrelude.Numeric++import Control.Monad (liftM2, liftM4)+-- import Control.Monad.Reader (MonadReader)++import qualified Prelude        as P+import qualified NumericPrelude.Numeric as NP+++{- |+T is a Reader monad but does not need functional dependencies+like that from the Monad Transformer Library.+-}+newtype T a b = Cons {toFunc :: a -> b}++concrete :: a -> T a b -> b+concrete m (Cons r) = r m++fromRepresentative :: (Integral.C a) => a -> T a a+fromRepresentative = Cons . mod+++getZero :: (Additive.C a) => T a a+getZero = Cons $ const Additive.zero++getOne :: (Ring.C a) => T a a+getOne  = Cons $ const NP.one++fromInteger :: (Integral.C a) => Integer -> T a a+fromInteger = fromRepresentative . NP.fromInteger+++instance Monad (T a) where+   (Cons x) >>= y  =  Cons (\r -> toFunc (y (x r)) r)+   return = Cons . const++++getAdd :: Integral.C a => T a (a -> a -> a)+getAdd = Cons Res.add++getSub :: Integral.C a => T a (a -> a -> a)+getSub = Cons Res.sub++getNeg :: Integral.C a => T a (a -> a)+getNeg = Cons Res.neg++getAdditiveVars :: Integral.C a => T a (a, a -> a -> a, a -> a -> a, a -> a)+getAdditiveVars = liftM4 (,,,) getZero getAdd getSub getNeg++++getMul :: Integral.C a => T a (a -> a -> a)+getMul = Cons Res.mul++getRingVars :: Integral.C a => T a (a, a -> a -> a)+getRingVars = liftM2 (,) getOne getMul++++getDivide :: PID.C a => T a (a -> a -> a)+getDivide = Cons Res.divide++getRecip :: PID.C a => T a (a -> a)+getRecip = Cons Res.recip++getFieldVars :: PID.C a => T a (a -> a -> a, a -> a)+getFieldVars = liftM2 (,) getDivide getRecip++monadExample :: PID.C a => T a [a]+monadExample =+   do (zero',(+~),(-~),negate') <- getAdditiveVars+      (one',(*~)) <- getRingVars+      ((/~),recip') <- getFieldVars+      let three = one'+one'+one'  -- is easier if only NP.fromInteger is visible+      let seven = three+three+one'+      return [zero'*~three, one'/~three, recip' three,+              three *~ seven, one' +~ three +~ seven,+              zero' -~ three, negate' three +~ seven]++runExample :: [Integer]+runExample =+   let three = one+one+one+       eleven = three+three+three + one+one+   in  concrete eleven monadExample

+ src-ghc-6.12/Number/Root.hs view

@@ -0,0 +1,97 @@+module Number.Root where++import qualified Algebra.Algebraic as Algebraic+import qualified Algebra.Field as Field+import qualified Algebra.Ring as Ring++import qualified MathObj.RootSet as RootSet+import qualified Number.Ratio as Ratio++import Algebra.IntegralDomain (divChecked, )++import qualified NumericPrelude.Numeric as NP+import NumericPrelude.Numeric hiding (recip, )+import NumericPrelude.Base+import Prelude ()++{- |+The root degree must be positive.+This way we can implement multiplication+using only multiplication from type @a@.+-}+data T a = Cons Integer a+   deriving (Show)++{- |+When you use @fmap@ you must assert that+@forall n. fmap f (Cons d x) == fmap f (Cons (n*d) (x^n))@+-}+instance Functor T where+   fmap f (Cons d x) = Cons d (f x)++fromNumber :: a -> T a+fromNumber = Cons 1++toNumber :: Algebraic.C a => T a -> a+toNumber (Cons n x) = Algebraic.root n x++toRootSet :: Ring.C a => T a -> RootSet.T a+toRootSet (Cons d x) =+   RootSet.lift0 ([negate x] ++ replicate (pred (fromInteger d)) zero ++ [one])+++commonDegree :: Ring.C a => T a -> T a -> T (a,a)+commonDegree (Cons xd x) (Cons yd y) =+   let zd = lcm xd yd+   in  Cons zd (x ^ divChecked zd xd, y ^ divChecked zd yd)++instance (Eq a, Ring.C a) => Eq (T a) where+   x == y  =+      case commonDegree x y of+         Cons _ (xn,yn) -> xn==yn++instance (Ord a, Ring.C a) => Ord (T a) where+   compare x y  =+      case commonDegree x y of+         Cons _ (xn,yn) -> compare xn yn+++mul :: Ring.C a => T a -> T a -> T a+mul x y = fmap (uncurry (*)) $ commonDegree x y++div :: Field.C a => T a -> T a -> T a+div x y = fmap (uncurry (/)) $ commonDegree x y++recip :: Field.C a => T a -> T a+recip = fmap NP.recip++{- |+exponent must be non-negative+-}+cardinalPower :: Ring.C a => Integer -> T a -> T a+cardinalPower n (Cons d x) =+   let m = gcd n d+   in  Cons (divChecked d m) (x ^ divChecked n m)++{- |+exponent can be negative+-}+integerPower :: Field.C a => Integer -> T a -> T a+integerPower n =+   if n<0+     then cardinalPower (-n) . recip+     else cardinalPower n++rationalPower :: Field.C a => Rational -> T a -> T a+rationalPower n =+   integerPower (Ratio.numerator n) .+   root (Ratio.denominator n)++{- |+exponent must be positive+-}+root :: Ring.C a => Integer -> T a -> T a+root n (Cons d x) = Cons (d*n) x++sqrt :: Ring.C a => T a -> T a+sqrt = root 2

+ src-ghc-6.12/Number/SI.hs view

@@ -0,0 +1,271 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{- |+Copyright   :  (c) Henning Thielemann 2003-2006+License     :  GPL++Maintainer  :  numericprelude@henning-thielemann.de+Stability   :  provisional+Portability :  portable++Numerical values equipped with SI units.+This is considered as the user front-end.+-}++module Number.SI where++import qualified Number.SI.Unit       as SIUnit+import           Number.SI.Unit (Dimension, bytesize)++import qualified Number.Physical      as Value+import qualified Number.Physical.Unit as Unit+import qualified Number.Physical.Show as PVShow+import qualified Number.Physical.Read as PVRead+import qualified Number.Physical.UnitDatabase as UnitDatabase++import           Algebra.OccasionallyScalar  as OccScalar+import qualified Algebra.NormedSpace.Maximum as NormedMax++import qualified Algebra.VectorSpace         as VectorSpace+import qualified Algebra.Module              as Module+import qualified Algebra.Vector              as Vector+import qualified Algebra.Transcendental      as Trans+import qualified Algebra.Algebraic           as Algebraic+import qualified Algebra.Field               as Field+import qualified Algebra.Absolute                as Absolute+import qualified Algebra.Ring                as Ring+import qualified Algebra.Additive            as Additive+import qualified Algebra.ZeroTestable        as ZeroTestable++import Algebra.Algebraic (sqrt, (^/), )++import Data.Tuple.HT (mapFst, )++import qualified Prelude as P++import NumericPrelude.Numeric+import NumericPrelude.Base+++newtype T a v = Cons (PValue v)+{- LANGUAGE GeneralizedNewtypeDeriving allows even this+   deriving (Monad, Functor)+-}++type PValue v = Value.T Dimension v++{-+import Control.Monad++instance Functor (SIValue.T a) where+  fmap f (SIValue.Cons x) = SIValue.Cons (f x)++instance Monad (SIValue.T a) where+  (>>=) (SIValue.Cons x) f = f x+  return = SIValue.Cons+-}++{- I hoped it would be possible to replace these functions+   by fmap and monadic liftM, liftM2, return -+   but SIValue.Cons lifts from the base type 'v' to 'SIValue.T a v'+   rather than the type 'PValue v' to 'SIValue.T a v'.++   I.e.+     fmap :: (v -> v) -> SIValue.T a v -> SIValue.T a v+-}+lift :: (PValue v0 -> PValue v1) ->+            (T a v0 -> T a v1)+lift f (Cons x) = (Cons (f x))++lift2 :: (PValue v0 -> PValue v1 -> PValue v2) ->+            (T a v0 -> T a v1 -> T a v2)+lift2 f (Cons x) (Cons y) = (Cons (f x y))++liftGen :: (PValue v -> x) -> (T a v -> x)+liftGen f (Cons x) = f x++lift2Gen :: (PValue v0 -> PValue v1 -> x) ->+               (T a v0 -> T a v1 -> x)+lift2Gen f (Cons x) (Cons y) = f x y+++{- There is almost nothing new to implement for SIValues.+   We have to lift existing functions to SIValues mainly. -}++scale :: Ring.C v => v -> T a v -> T a v+scale = lift . Value.scale++fromScalarSingle :: v -> T a v+fromScalarSingle = Cons . Value.fromScalarSingle+++instance (ZeroTestable.C v) => ZeroTestable.C (T a v) where+  isZero = liftGen isZero++instance Eq v => Eq (T a v) where+  (==)  =  lift2Gen (==)++showNat :: (Show v, Field.C a, Ord a, NormedMax.C a v) =>+   UnitDatabase.T Dimension a -> T a v -> String+showNat db =+   liftGen (PVShow.showNat db)++instance (Show v, Ord a, Trans.C a, NormedMax.C a v) =>+    Show (T a v) where+  showsPrec prec x =+    showParen (prec > PVShow.mulPrec)+       (showNat SIUnit.databaseShow x ++)++readsNat :: (Read v, VectorSpace.C a v) =>+   UnitDatabase.T Dimension a -> Int -> ReadS (T a v)+readsNat db prec =+   map (mapFst Cons) . PVRead.readsNat db prec++instance (Read v, Ord a, Trans.C a, VectorSpace.C a v) =>+    Read (T a v) where+  readsPrec = readsNat SIUnit.databaseRead++instance (Additive.C v) => Additive.C (T a v) where+  zero   = Cons zero+  (+)    = lift2 (+)+  (-)    = lift2 (-)+  negate = lift negate++instance (Ring.C v) => Ring.C (T a v) where+  (*) = lift2 (*)+  fromInteger = Cons . fromInteger++instance (Ord v) => Ord (T a v) where+  max     = lift2    max+  min     = lift2    min+  compare = lift2Gen compare+  (<)     = lift2Gen (<)+  (>)     = lift2Gen (>)+  (<=)    = lift2Gen (<=)+  (>=)    = lift2Gen (>=)++instance (Absolute.C v) => Absolute.C (T a v) where+  abs    = lift abs+  signum = lift signum++instance (Field.C v) => Field.C (T a v) where+  (/) = lift2 (/)+  fromRational' = Cons . fromRational'++instance (Algebraic.C v) => Algebraic.C (T a v) where+  sqrt    = lift  sqrt+  x ^/ y  = lift  (^/ y) x++instance (Trans.C v) => Trans.C (T a v) where+  pi      = Cons pi+  log     = lift  log+  exp     = lift  exp+  logBase = lift2 logBase+  (**)    = lift2 (**)+  cos     = lift  cos+  tan     = lift  tan+  sin     = lift  sin+  acos    = lift  acos+  atan    = lift  atan+  asin    = lift  asin+  cosh    = lift  cosh+  tanh    = lift  tanh+  sinh    = lift  sinh+  acosh   = lift  acosh+  atanh   = lift  atanh+  asinh   = lift  asinh+++instance Vector.C (T a) where+  zero  = zero+  (<+>) = (+)+  (*>)  = scale++instance (Module.C a v) => Module.C a (T b v) where+  (*>) x = lift (x Module.*>)++instance (VectorSpace.C a v) => VectorSpace.C a (T b v)++instance (Trans.C a, Ord a, OccScalar.C a v,+          Show v, NormedMax.C a v)+      => OccScalar.C a (T a v) where+   toScalar      = toScalarShow+   toMaybeScalar = liftGen toMaybeScalar+   fromScalar    = Cons . fromScalar++++quantity :: (Field.C a, Field.C v) => Unit.T Dimension -> v -> T a v+quantity xu = Cons . Value.Cons xu++hertz, second, minute, hour, day, year,+ meter, liter, gramm, tonne,+ newton, pascal, bar, joule, watt,+ kelvin,+ coulomb, ampere, volt, ohm, farad,+ bit, byte, baud,+ inch, foot, yard, astronomicUnit, parsec,+ mach, speedOfLight, electronVolt,+ calorien, horsePower, accelerationOfEarthGravity ::+    (Field.C a, Field.C v) => T a v++hertz   = quantity SIUnit.frequency   1e+0+second  = quantity SIUnit.time        1e+0+minute  = quantity SIUnit.time        SIUnit.secondsPerMinute+hour    = quantity SIUnit.time        SIUnit.secondsPerHour+day     = quantity SIUnit.time        SIUnit.secondsPerDay+year    = quantity SIUnit.time        SIUnit.secondsPerYear+meter   = quantity SIUnit.length      1e+0+liter   = quantity SIUnit.volume      1e-3+gramm   = quantity SIUnit.mass        1e-3+tonne   = quantity SIUnit.mass        1e+3+newton  = quantity SIUnit.force       1e+0+pascal  = quantity SIUnit.pressure    1e+0+bar     = quantity SIUnit.pressure    1e+5+joule   = quantity SIUnit.energy      1e+0+watt    = quantity SIUnit.power       1e+0+coulomb = quantity SIUnit.charge      1e+0+ampere  = quantity SIUnit.current     1e+0+volt    = quantity SIUnit.voltage     1e+0+ohm     = quantity SIUnit.resistance  1e+0+farad   = quantity SIUnit.capacitance 1e+0+kelvin  = quantity SIUnit.temperature 1e+0+bit     = quantity SIUnit.information 1e+0+byte    = quantity SIUnit.information bytesize+baud    = quantity SIUnit.dataRate    1e+0++inch           = quantity SIUnit.length SIUnit.meterPerInch+foot           = quantity SIUnit.length SIUnit.meterPerFoot+yard           = quantity SIUnit.length SIUnit.meterPerYard+astronomicUnit = quantity SIUnit.length SIUnit.meterPerAstronomicUnit+parsec         = quantity SIUnit.length SIUnit.meterPerParsec++accelerationOfEarthGravity+             = quantity SIUnit.acceleration SIUnit.accelerationOfEarthGravity+mach         = quantity SIUnit.speed        SIUnit.mach+speedOfLight = quantity SIUnit.speed        SIUnit.speedOfLight+electronVolt = quantity SIUnit.energy       SIUnit.electronVolt+calorien     = quantity SIUnit.energy       SIUnit.calorien+horsePower   = quantity SIUnit.power        SIUnit.horsePower++++-- legacy instances for work with GHCi+legacyInstance :: a+legacyInstance =+   error "legacy Ring.C instance for simple input of numeric literals"++instance (Ord a, Trans.C a, NormedMax.C a v, P.Num v, Ring.C v) =>+      P.Num (T a v) where+   fromInteger = fromInteger+   negate = negate -- for unary minus+   (+)    = legacyInstance+   (*)    = legacyInstance+   abs    = legacyInstance+   signum = legacyInstance++instance (Ord a, Trans.C a, NormedMax.C a v, P.Num v, Field.C v) =>+      P.Fractional (T a v) where+   fromRational = fromRational+   (/) = legacyInstance

+ src-ghc-6.12/Number/SI/Unit.hs view

@@ -0,0 +1,293 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Copyright   :  (c) Henning Thielemann 2003+License     :  GPL++Maintainer  :  numericprelude@henning-thielemann.de+Stability   :  provisional+Portability :  portable++Special physical units: SI unit system+-}++module Number.SI.Unit where++import qualified Algebra.Transcendental      as Trans+import qualified Algebra.Field               as Field++import qualified Number.Physical.Unit         as Unit+import qualified Number.Physical.UnitDatabase as UnitDatabase+import Number.Physical.UnitDatabase(initScale, initUnitSet)+import Data.Maybe(catMaybes)++import NumericPrelude.Base hiding (length)+import NumericPrelude.Numeric hiding (one)++data Dimension =+   Length | Time | Mass | Charge |+   Angle | Temperature | Information+      deriving (Eq, Ord, Enum, Show)+++-- | Some common quantity classes.+angle, angularSpeed, -- needs explicit signature because it does not occur in the database+ length, distance, area, volume, time,+ frequency, speed, acceleration, mass,+ force, pressure, energy, power,+ charge, current, voltage, resistance,+ capacitance, temperature,+ information, dataRate+  :: Unit.T Dimension++length       = Unit.fromVector [ 1, 0, 0, 0, 0, 0, 0]+-- synonym for 'length' which is distinct from List.length+distance     = Unit.fromVector [ 1, 0, 0, 0, 0, 0, 0]+area         = Unit.fromVector [ 2, 0, 0, 0, 0, 0, 0]+volume       = Unit.fromVector [ 3, 0, 0, 0, 0, 0, 0]+time         = Unit.fromVector [ 0, 1, 0, 0, 0, 0, 0]+frequency    = Unit.fromVector [ 0,-1, 0, 0, 0, 0, 0]+speed        = Unit.fromVector [ 1,-1, 0, 0, 0, 0, 0]+acceleration = Unit.fromVector [ 1,-2, 0, 0, 0, 0, 0]+mass         = Unit.fromVector [ 0, 0, 1, 0, 0, 0, 0]+force        = Unit.fromVector [ 1,-2, 1, 0, 0, 0, 0]+pressure     = Unit.fromVector [-1,-2, 1, 0, 0, 0, 0]+energy       = Unit.fromVector [ 2,-2, 1, 0, 0, 0, 0]+power        = Unit.fromVector [ 2,-3, 1, 0, 0, 0, 0]+charge       = Unit.fromVector [ 0, 0, 0, 1, 0, 0, 0]+current      = Unit.fromVector [ 0,-1, 0, 1, 0, 0, 0]+voltage      = Unit.fromVector [ 2,-2, 1,-1, 0, 0, 0]+resistance   = Unit.fromVector [ 2,-1, 1,-2, 0, 0, 0]+capacitance  = Unit.fromVector [-2, 2,-1, 2, 0, 0, 0]+angle        = Unit.fromVector [ 0, 0, 0, 0, 1, 0, 0]+angularSpeed = Unit.fromVector [ 0,-1, 0, 0, 1, 0, 0]+temperature  = Unit.fromVector [ 0, 0, 0, 0, 0, 1, 0]+information  = Unit.fromVector [ 0, 0, 0, 0, 0, 0, 1]+dataRate     = Unit.fromVector [ 0,-1, 0, 0, 0, 0, 1]+++percent, fourth, half, threeFourth   :: Field.C a => a++secondsPerMinute, secondsPerHour, secondsPerDay, secondsPerYear, + meterPerInch, meterPerFoot, meterPerYard,+ meterPerAstronomicUnit, meterPerParsec, + accelerationOfEarthGravity,+ k2, deg180, grad200, bytesize       :: Field.C a => a++radPerDeg, radPerGrad                :: Trans.C a => a++mach, speedOfLight, electronVolt,+ calorien, horsePower                :: Field.C a => a++yocto, zepto, atto, femto, pico,+ nano, micro, milli, centi, deci,+ one, deca, hecto, kilo, mega,+ giga, tera, peta, exa, zetta, yotta :: Field.C a => a++-- | Common constants+percent      = 0.01+fourth       = 0.25+half         = 0.50+threeFourth  = 0.75++-- | Conversion factors+secondsPerMinute = 60+secondsPerHour   = 60*secondsPerMinute+secondsPerDay    = 24*secondsPerHour  -- 86400.0+secondsPerYear   = 365.2422*secondsPerDay++meterPerInch           = 0.0254+meterPerFoot           = 0.3048+meterPerYard           = 0.9144+meterPerAstronomicUnit = 149.6e6+meterPerParsec         = 30.857e12++k2           = 1024+deg180       = 180+grad200      = 200+radPerDeg    = pi/deg180;+radPerGrad   = pi/grad200;+bytesize     = 8++++-- | Physical constants+accelerationOfEarthGravity = 9.80665+mach                       = 332.0+speedOfLight               = 299792458.0+electronVolt               = 1.602e-19+calorien                   = 4.19+horsePower                 = 736.0++-- | Prefixes used for SI units+yocto = 1.0e-24+zepto = 1.0e-21+atto  = 1.0e-18+femto = 1.0e-15+pico  = 1.0e-12+nano  = 1.0e-9+micro = 1.0e-6+milli = 1.0e-3+centi = 1.0e-2+deci  = 1.0e-1+one   = 1.0e0+deca  = 1.0e1+hecto = 1.0e2+kilo  = 1.0e3+mega  = 1.0e6+giga  = 1.0e9+tera  = 1.0e12+peta  = 1.0e15+exa   = 1.0e18+zetta = 1.0e21+yotta = 1.0e24++++{- | UnitDatabase.T of units and their common scalings -}+databaseRead, databaseShow :: Trans.C a => UnitDatabase.T Dimension a+databaseRead = map UnitDatabase.createUnitSet database+databaseShow =+   map UnitDatabase.createUnitSet $+      catMaybes $ map UnitDatabase.showableUnit database++database :: Trans.C a => [UnitDatabase.InitUnitSet Dimension a]+database = [+    (initUnitSet Unit.scalar False [+      (initScale "pi"    pi                        False False),+      (initScale "e"     (exp 1)                   False False),+      (initScale "i"     (sqrt (-1))               False False),+      (initScale "%"     percent                   False False),+      (initScale "\188"  fourth                    False False),+      (initScale "\189"  half                      False False),+      (initScale "\190"  threeFourth               False False)+    ]),+    (initUnitSet angle False [+      (initScale "''"    (radPerDeg/secondsPerHour)   True  False),+      (initScale "'"     (radPerDeg/secondsPerMinute) True  False),+      (initScale "grad"  radPerGrad                False False),+      (initScale "\176"  radPerDeg                 True  True ),+      (initScale "rad"   one                       False False)+    ]),+    (initUnitSet frequency True [+      (initScale "bpm"   (one/secondsPerMinute)    False False),+      (initScale "Hz"    one                       True  True ),+      (initScale "kHz"   kilo                      True  False),+      (initScale "MHz"   mega                      True  False),+      (initScale "GHz"   giga                      True  False)+    ]),+    (initUnitSet time False [+      (initScale "ns"    nano                      True  False),+      (initScale "\181s" micro                     True  False),+      (initScale "ms"    milli                     True  False),+      (initScale "s"     one                       True  True ),+      (initScale "min"   secondsPerMinute          True  False),+      (initScale "h"     secondsPerHour            True  False),+      (initScale "d"     secondsPerDay             True  False),+      (initScale "a"     secondsPerYear            True  False)+    ]),+--    (initUnitSet distance False [+    (initUnitSet length False [+      (initScale "nm"    nano                      True  False),+      (initScale "\181m" micro                     True  False),+      (initScale "mm"    milli                     True  False),+      (initScale "cm"    centi                     True  False),+      (initScale "dm"    deci                      True  False),+      (initScale "m"     one                       True  True ),+      (initScale "km"    kilo                      True  False)+    ]),+    (initUnitSet area False [+      (initScale "ha"    (hecto*hecto)             False False)+    ]),+    (initUnitSet volume False [+      (initScale "ml"    (milli*milli)             False False),+      (initScale "cl"    (milli*centi)             False False),+      (initScale "l"     milli                     False False)+    ]),+    (initUnitSet speed False [+      (initScale "mach"  mach                      False False),+      (initScale "c"     speedOfLight              False False)+    ]),+    (initUnitSet acceleration False [+      (initScale "G"     accelerationOfEarthGravity False False)+    ]),+    (initUnitSet mass False [+      (initScale "\181g" nano                      True  False),+      (initScale "mg"    micro                     True  False),+      (initScale "g"     milli                     True  False),+      (initScale "kg"    one                       True  True ),+      (initScale "dt"    hecto                     True  False),+      (initScale "t"     kilo                      True  False),+      (initScale "kt"    mega                      True  False)+    ]),+    (initUnitSet force False [+      (initScale "N"     one                       True  True ),+      (initScale "kp"    accelerationOfEarthGravity False False),+      (initScale "kN"    kilo                      True  False)+    ]),+    (initUnitSet pressure False [+      (initScale "Pa"    one                       True  True ),+      (initScale "mbar"  hecto                     False False),+      (initScale "kPa"   kilo                      True  False),+      (initScale "bar"   (hecto*kilo)              False False)+    ]),+    (initUnitSet energy False [+      (initScale "eV"    electronVolt              False False),+      (initScale "J"     one                       True  True ),+      (initScale "cal"   calorien                  False False),+      (initScale "kJ"    kilo                      True  False),+      (initScale "kcal"  (kilo*calorien)           False False),+      (initScale "MJ"    mega                      True  False)+    ]),+    (initUnitSet power False [+      (initScale "mW"    milli                     True  False),+      (initScale "W"     one                       True  True ),+      (initScale "HP"    horsePower                False False),+      (initScale "kW"    kilo                      True  False),+      (initScale "MW"    mega                      True  False)+    ]),+    (initUnitSet charge False [+      (initScale "C"     one                       True  True )+    ]),+    (initUnitSet current False [+      (initScale "\181A" micro                     True  False),+      (initScale "mA"    milli                     True  False),+      (initScale "A"     one                       True  True )+    ]),+    (initUnitSet voltage False [+      (initScale "mV"    milli                     True  False),+      (initScale "V"     one                       True  True ),+      (initScale "kV"    kilo                      True  False),+      (initScale "MV"    mega                      True  False),+      (initScale "GV"    giga                      True  False)+    ]),+    (initUnitSet resistance False [+      (initScale "Ohm"   one                       True  True ),+      (initScale "kOhm"  kilo                      True  False),+      (initScale "MOhm"  mega                      True  False)+    ]),+    (initUnitSet capacitance False [+      (initScale "pF"    pico                      True  False),+      (initScale "nF"    nano                      True  False),+      (initScale "\181F" micro                     True  False),+      (initScale "mF"    milli                     True  False),+      (initScale "F"     one                       True  True )+    ]),+    (initUnitSet temperature False [+      (initScale "K"     one                       True  True )+    ]),+    (initUnitSet information False [+      (initScale "bit"   one                       True  True ),+      (initScale "B"     bytesize                  True  False),+      (initScale "kB"    (kilo*bytesize)           False False),+      (initScale "KB"    (k2*bytesize)             True  False),+      (initScale "MB"    (k2*k2*bytesize)          True  False),+      (initScale "GB"    (k2*k2*k2*bytesize)       True  False)+    ]),+    (initUnitSet dataRate True [+      (initScale "baud"  one                       True  True ),+      (initScale "kbaud" kilo                      False False),+      (initScale "Kbaud" k2                        True  False),+      (initScale "Mbaud" (k2*k2)                   True  False),+      (initScale "Gbaud" (k2*k2*k2)                True  False)+    ])+  ]

+ src-ghc-6.12/NumericPrelude.hs view

@@ -0,0 +1,9 @@+module NumericPrelude+   (module NumericPrelude.Numeric,+    module NumericPrelude.Base,+    max, min, abs, ) where++import NumericPrelude.Numeric hiding (abs, )+import NumericPrelude.Base    hiding (max, min, )+import Prelude ()+import Algebra.Lattice (max, min, abs, )

+ src-ghc-6.12/NumericPrelude/Base.hs view

@@ -0,0 +1,12 @@+{- |+The only point of this module is+to reexport items that we want from the standard Prelude.+-}++module NumericPrelude.Base (module Prelude) where+import Prelude hiding (+       Int, Integer, Float, Double, Rational, Num(..), Real(..),+       Integral(..), Fractional(..), Floating(..), RealFrac(..),+       RealFloat(..), subtract, even, odd,+       gcd, lcm, (^), (^^), sum, product,+       fromIntegral, fromRational, )

+ src-ghc-6.12/NumericPrelude/Elementwise.hs view

@@ -0,0 +1,54 @@+module NumericPrelude.Elementwise where++import Control.Applicative (Applicative(pure, (<*>)), )++{- |+A reader monad for the special purpose+of defining instances of certain operations on tuples and records.+It does not add any new functionality to the common Reader monad,+but it restricts the functions to the required ones+and exports them from one module.+That is you do not have to import+both Control.Monad.Trans.Reader and Control.Applicative.+The type also tells the user, for what the Reader monad is used.+We can more easily replace or extend the implementation when needed.+-}+newtype T v a = Cons {run :: v -> a}++{-# INLINE with #-}+with :: a -> T v a+with e = Cons $ \ _v -> e++{-# INLINE element #-}+element :: (v -> a) -> T v a+element = Cons+++{-# INLINE run2 #-}+run2 :: T (x,y) a -> x -> y -> a+run2 = curry . run++{-# INLINE run3 #-}+run3 :: T (x,y,z) a -> x -> y -> z -> a+run3 e x y z = run e (x,y,z)++{-# INLINE run4 #-}+run4 :: T (x,y,z,w) a -> x -> y -> z -> w -> a+run4 e x y z w = run e (x,y,z,w)++{-# INLINE run5 #-}+run5 :: T (x,y,z,u,w) a -> x -> y -> z -> u -> w -> a+run5 e x y z u w = run e (x,y,z,u,w)+++instance Functor (T v) where+   {-# INLINE fmap #-}+   fmap f (Cons e) =+      Cons $ \v -> f $ e v++instance Applicative (T v) where+   {-# INLINE pure #-}+   {-# INLINE (<*>) #-}+   pure = with+   Cons f <*> Cons e =+      Cons $ \v -> f v $ e v

+ src-ghc-6.12/NumericPrelude/List.hs view

@@ -0,0 +1,71 @@+module NumericPrelude.List where++import Data.List.HT (switchL, switchR, )+++{- * Zip lists -}++{- | zip two lists using an arbitrary function, the shorter list is padded -}+{-# INLINE zipWithPad #-}+zipWithPad :: a               {-^ padding value -}+           -> (a -> a -> b)   {-^ function applied to corresponding elements of the lists -}+           -> [a]+           -> [a]+           -> [b]+zipWithPad z f =+   let aux l []          = map (\x -> f x z) l+       aux [] l          = map (\y -> f z y) l+       aux (x:xs) (y:ys) = f x y : aux xs ys+   in  aux++{-# INLINE zipWithOverlap #-}+zipWithOverlap :: (a -> c) -> (b -> c) -> (a -> b -> c) -> [a] -> [b] -> [c]+zipWithOverlap fa fb fab =+   let aux (x:xs) (y:ys) = fab x y : aux xs ys+       aux xs [] = map fa xs+       aux [] ys = map fb ys+   in  aux++{-+This is exported Checked.zipWith.+We need to define it here in order to prevent an import cycle.+-}+zipWithChecked+   :: (a -> b -> c)   {-^ function applied to corresponding elements of the lists -}+   -> [a]+   -> [b]+   -> [c]+zipWithChecked f =+   let aux (x:xs) (y:ys) = f x y : aux xs ys+       aux []     []     = []+       aux _      _      = error "Checked.zipWith: lists must have the same length"+   in  aux+++{- |+Apply a function to the last element of a list.+If the list is empty, nothing changes.+-}+{-# INLINE mapLast #-}+mapLast :: (a -> a) -> [a] -> [a]+mapLast f =+   switchL []+      (\x xs ->+         uncurry (:) $+         foldr (\x1 k x0 -> (x0, uncurry (:) (k x1)))+            (\x0 -> (f x0, [])) xs x)++mapLast' :: (a -> a) -> [a] -> [a]+mapLast' f =+   let recourse [] = [] -- behaviour as needed in powerBasis+          -- otherwise: error "mapLast: empty list"+       recourse (x:xs) =+          uncurry (:) $+          if null xs+            then (f x, [])+            else (x, recourse xs)+   in  recourse++mapLast'' :: (a -> a) -> [a] -> [a]+mapLast'' f =+   switchR [] (\xs x -> xs ++ [f x])

+ src-ghc-6.12/NumericPrelude/List/Checked.hs view

@@ -0,0 +1,94 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Some functions that are counterparts of functions from "Data.List"+using NumericPrelude.Numeric type classes.+They are distinct in that they check for valid arguments,+e.g. the length argument of 'take' must be at most the length of the input list.+However, since many Haskell programs rely on the absence of such checks,+we did not make these the default implementations+as in "NumericPrelude.List.Generic".+-}+module NumericPrelude.List.Checked+   (take, drop, splitAt, (!!), zipWith,+   ) where++import qualified Algebra.ToInteger  as ToInteger+-- import qualified Algebra.Ring       as Ring+import Algebra.Ring (one, )+import Algebra.Additive (zero, (-), )++import Data.Tuple.HT (mapFst, )++import qualified NumericPrelude.List as NPList++import NumericPrelude.Base hiding (take, drop, splitAt, length, replicate, (!!), zipWith, )+++moduleError :: String -> String -> a+moduleError name msg =+   error $ "NumericPrelude.List.Left." ++ name ++ ": " ++ msg++{- |+Taken number of elements must be at most the length of the list,+otherwise the end of the list is undefined.+-}+take :: (ToInteger.C n) => n -> [a] -> [a]+take n =+   if n<=zero+     then const []+     else \xt ->+       case xt of+          [] -> moduleError "take" "index out of range"+          (x:xs) -> x : take (n-one) xs++{- |+Dropped number of elements must be at most the length of the list,+otherwise the end of the list is undefined.+-}+drop :: (ToInteger.C n) => n -> [a] -> [a]+drop n =+   if n<=zero+     then id+     else \xt ->+       case xt of+          [] -> moduleError "drop" "index out of range"+          (_:xs) -> drop (n-one) xs++{- |+Split position must be at most the length of the list,+otherwise the end of the first list and the second list are undefined.+-}+splitAt :: (ToInteger.C n) => n -> [a] -> ([a], [a])+splitAt n xt =+   if n<=zero+     then ([], xt)+     else+       case xt of+          [] -> moduleError "splitAt" "index out of range"+          (x:xs) -> mapFst (x:) $ splitAt (n-one) xs++{- |+The index must be smaller than the length of the list,+otherwise the result is undefined.+-}+(!!) :: (ToInteger.C n) => [a] -> n -> a+(!!) [] _ = moduleError "(!!)" "index out of range"+(!!) (x:xs) n =+   if n<=zero+     then x+     else (!!) xs (n-one)+++{- |+Zip two lists which must be of the same length.+This is checked only lazily, that is unequal lengths are detected only+if the list is evaluated completely.+But it is more strict than @zipWithPad undefined f@+since the latter one may succeed on unequal length list if @f@ is lazy.+-}+zipWith+   :: (a -> b -> c)   {-^ function applied to corresponding elements of the lists -}+   -> [a]+   -> [b]+   -> [c]+zipWith = NPList.zipWithChecked

+ src-ghc-6.12/NumericPrelude/List/Generic.hs view

@@ -0,0 +1,84 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Functions that are counterparts of the @generic@ functions in "Data.List"+using NumericPrelude.Numeric type classes.+For input arguments we use the restrictive @ToInteger@ constraint,+although in principle @RealRing@ would be enough.+However we think that @take 0.5 xs@ is rather a bug than a feature,+thus we forbid fractional types.+On the other hand fractional types as result can be quite handy,+e.g. in @average xs = sum xs / length xs@.+-}+module NumericPrelude.List.Generic+   ((!!), lengthLeft, lengthRight, replicate,+    take, drop, splitAt,+    findIndex, elemIndex, findIndices, elemIndices,+   ) where++import NumericPrelude.List.Checked ((!!), )++import qualified Algebra.ToInteger  as ToInteger+import qualified Algebra.Ring       as Ring+import Algebra.Ring (one, )+import Algebra.Additive (zero, (+), (-), )++import qualified Data.Maybe         as Maybe+import Data.Tuple.HT (mapFst, )++import NumericPrelude.Base as List+   hiding (take, drop, splitAt, length, replicate, (!!), )+++replicate :: (ToInteger.C n) => n -> a -> [a]+replicate n x = take n (List.repeat x)++take :: (ToInteger.C n) => n -> [a] -> [a]+take _ [] = []+take n (x:xs) =+   if n<=zero+     then []+     else x : take (n-one) xs++drop :: (ToInteger.C n) => n -> [a] -> [a]+drop _ [] = []+drop n xt@(_:xs) =+   if n<=zero+     then xt+     else drop (n-one) xs++splitAt :: (ToInteger.C n) => n -> [a] -> ([a], [a])+splitAt _ [] = ([], [])+splitAt n xt@(x:xs) =+   if n<=zero+     then ([], xt)+     else mapFst (x:) $ splitAt (n-one) xs+++{- |+Left associative length computation+that is appropriate for types like @Integer@.+-}+lengthLeft :: (Ring.C n) => [a] -> n+lengthLeft = List.foldl (\n _ -> n+one) zero++{- |+Right associative length computation+that is appropriate for types like @Peano@ number.+-}+lengthRight :: (Ring.C n) => [a] -> n+lengthRight = List.foldr (\_ n -> one+n) zero++elemIndex :: (Ring.C n, Eq a) => a -> [a] -> Maybe n+elemIndex e = findIndex (e==)++elemIndices :: (Ring.C n, Eq a) => a -> [a] -> [n]+elemIndices e = findIndices (e==)++findIndex :: Ring.C n => (a -> Bool) -> [a] -> Maybe n+findIndex p = Maybe.listToMaybe . findIndices p++findIndices :: Ring.C n => (a -> Bool) -> [a] -> [n]+findIndices p =+   map fst .+   filter (p . snd) .+   zip (iterate (one+) zero)

+ src-ghc-6.12/NumericPrelude/Numeric.hs view

@@ -0,0 +1,44 @@+{-# LANGUAGE NoImplicitPrelude #-}+module NumericPrelude.Numeric (+    {- Additive -} (+), (-), negate, zero, subtract, sum, sum1,+    {- ZeroTestable -} isZero,+    {- Ring -} (*), one, fromInteger, (^), ringPower, sqr, product, product1,+    {- IntegralDomain -} div, mod, divMod, divides, even, odd,+    {- Field -} (/), recip, fromRational', (^-), fieldPower, fromRational,+    {- Algebraic -} (^/), sqrt,+    {- Transcendental -}+        pi, exp, log, logBase, (**), (^?), sin, cos, tan,+        asin, acos, atan, sinh, cosh, tanh, asinh, acosh, atanh,+    {- Absolute -} abs, signum,+    {- RealIntegral -} quot, rem, quotRem,+    {- RealFrac -} splitFraction, fraction, truncate, round, ceiling, floor, approxRational,+    {- RealTrans -} atan2,+    {- ToRational -} toRational,+    {- ToInteger -} toInteger, fromIntegral,+    {- Units -} isUnit, stdAssociate, stdUnit, stdUnitInv,+    {- PID -} extendedGCD, gcd, lcm, euclid, extendedEuclid,+    {- Ratio -} Rational, (%), numerator, denominator,+    Integer, Int, Float, Double,+    {- Module -} (*>)+) where++import Number.Ratio (Rational, (%), numerator, denominator)++import Algebra.Module((*>))+import Algebra.RealTranscendental(atan2)+import Algebra.Transcendental+import Algebra.Algebraic((^/), sqrt)+import Algebra.RealRing(splitFraction, fraction, truncate, round, ceiling, floor, approxRational, )+import Algebra.Field((/), (^-), recip, fromRational', fromRational, )+import Algebra.PrincipalIdealDomain (extendedGCD, gcd, lcm, euclid, extendedEuclid)+import Algebra.Units (isUnit, stdAssociate, stdUnit, stdUnitInv)+import Algebra.RealIntegral (quot, rem, quotRem, )+import Algebra.IntegralDomain (div, mod, divMod, divides, even, odd)+import Algebra.Absolute (abs, signum, )+import Algebra.Ring (one, fromInteger, (*), (^), sqr, product, product1)+import Algebra.Additive (zero, (+), (-), negate, subtract, sum, sum1)+import Algebra.ZeroTestable (isZero)+import Algebra.ToInteger (ringPower, fieldPower, toInteger, fromIntegral, )+import Algebra.ToRational (toRational, )++import Prelude (Int, Integer, Float, Double)

src/Algebra/Absolute.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Algebra.Absolute (    C(abs, signum),    absOrd, signumOrd,@@ -16,7 +16,7 @@  import NumericPrelude.Base import qualified Prelude as P-import Prelude(Int,Integer,Float,Double)+import Prelude (Integer, Float, Double, )   {- |

src/Algebra/Additive.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Algebra.Additive (     -- * Class     C,@@ -31,7 +31,7 @@  import qualified Data.Ratio as Ratio98 import qualified Prelude as P-import Prelude(Int, Integer, Float, Double, fromInteger, )+import Prelude (Integer, Float, Double, fromInteger, ) import NumericPrelude.Base

src/Algebra/Algebraic.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Algebra.Algebraic where  import qualified Algebra.Field as Field

src/Algebra/Differential.hs view

@@ -1,10 +1,10 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Algebra.Differential where  import qualified Algebra.Ring as Ring  -- import NumericPrelude.Numeric-import qualified Prelude+-- import qualified Prelude  {- | 'differentiate' is a general differentation operation

src/Algebra/DivisibleSpace.hs view

@@ -1,8 +1,8 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} module Algebra.DivisibleSpace where-import qualified Prelude+ import qualified Algebra.VectorSpace as VectorSpace  -- Is this right?

src/Algebra/Field.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Algebra.Field (     {- * Class -}     C,@@ -18,9 +18,10 @@ import qualified Number.Ratio as Ratio import qualified Data.Ratio as Ratio98 import qualified Algebra.PrincipalIdealDomain as PID+import qualified Algebra.Units as Unit  import qualified Algebra.Ring         as Ring-import qualified Algebra.Additive     as Additive+-- import qualified Algebra.Additive     as Additive import qualified Algebra.ZeroTestable as ZeroTestable  import Algebra.Ring ((*), (^), one, fromInteger)@@ -98,8 +99,6 @@ {- * Instances for atomic types -}  {--ToDo:- fromRational must be implemented explicitly for Float and Double! It may be that numerator or denominator cannot be represented as Float due to size constraints, but the fraction can.@@ -110,20 +109,37 @@     {-# INLINE recip #-}     (/)    = (P./)     recip  = (P.recip)+    -- using Ratio98.:% would be more efficient but it is not exported.+    fromRational' x =+       P.fromRational (numerator x Ratio98.% denominator x)  instance C Double where     {-# INLINE (/) #-}     {-# INLINE recip #-}     (/)    = (P./)     recip  = (P.recip)+    fromRational' x =+       P.fromRational (numerator x Ratio98.% denominator x)  instance (PID.C a) => C (Ratio.T a) where     {-# INLINE (/) #-}     {-# INLINE recip #-}     {-# INLINE fromRational' #-} --    (/)                  =  Ratio.liftOrd (%)-    (x:%y) / (x':%y')    =  (x*y') % (y*x')+    x / y                =  x * recip y+{-+This is efficient and almost correct in the sense,+that all admissible cases yield a correct result.+However it will hide division by zero and thus may hide bugs.+Unfortunately 'x' might not be a standard associate,+thus (y:%x) may deviate from the canonical representation.+     recip (x:%y)         =  (y:%x)+-}+    recip (x:%y)         =+       if isZero y+         then error "Ratio./: division by zero"+         else (y * Unit.stdUnitInv x) :% Unit.stdAssociate x     fromRational' (x:%y) =  fromInteger x % fromInteger y

src/Algebra/IntegralDomain.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Algebra.IntegralDomain (     {- * Class -}     C,@@ -8,10 +8,14 @@     divModZero,     divides,     sameResidueClass,-    safeDiv,+    divChecked, safeDiv,     even,     odd, +    divUp,+    roundDown,+    roundUp,+     {- * Algorithms -}     decomposeVarPositional,     decomposeVarPositionalInf,@@ -28,12 +32,12 @@   ) where  import qualified Algebra.Ring         as Ring-import qualified Algebra.Additive     as Additive+-- import qualified Algebra.Additive     as Additive import qualified Algebra.ZeroTestable as ZeroTestable -import Algebra.Ring     ((*), fromInteger)-import Algebra.Additive (zero, (+), (-))-import Algebra.ZeroTestable (isZero)+import Algebra.Ring     ((*), fromInteger, )+import Algebra.Additive (zero, (+), (-), negate, )+import Algebra.ZeroTestable (isZero, )  import Data.Bool.HT (implies, ) import Data.List (mapAccumL, )@@ -44,7 +48,7 @@ import Data.Word (Word, Word8, Word16, Word32, Word64, )  import NumericPrelude.Base-import Prelude (Integer, Int)+import Prelude (Integer, ) import qualified Prelude as P  @@ -142,17 +146,20 @@ Returns the result of the division, if divisible. Otherwise undefined. -}-{-# INLINE safeDiv #-}-safeDiv :: (ZeroTestable.C a, C a) => a -> a -> a-safeDiv a b =+{-# INLINE divChecked #-}+divChecked, safeDiv :: (ZeroTestable.C a, C a) => a -> a -> a+divChecked a b =    let (q,r) = divMod a b    in  if isZero r          then q          else error "safeDiv: indivisible term" +{-# DEPRECATED safeDiv "use divChecked instead" #-}+safeDiv = divChecked+ {- | Allows division by zero.-If the divisor is zero, then the divident is returned as remainder.+If the divisor is zero, then the dividend is returned as remainder. -} {-# INLINE divModZero #-} divModZero :: (C a, ZeroTestable.C a) => a -> a -> (a,a)@@ -170,6 +177,40 @@ odd       =  not . even  +{- |+@roundDown n m@ rounds @n@ down to the next multiple of @m@.+That is, @roundDown n m@ is the greatest multiple of @m@+that is at most @n@.+The parameter order is consistent with @div@ and friends,+but maybe not useful for partial application.+-}+roundDown :: C a => a -> a -> a+roundDown n m = n - mod n m++{- |+@roundUp n m@ rounds @n@ up to the next multiple of @m@.+That is, @roundUp n m@ is the greatest multiple of @m@+that is at most @n@.+-}+roundUp :: C a => a -> a -> a+roundUp n m = n + mod (-n) m++{- |+@divUp n m@ is similar to @div@+but it rounds up the quotient,+such that @divUp n m * m = roundUp n m@.+-}+divUp :: C a => a -> a -> a+divUp n m = - div (-n) m++{-+What sign of the remainder is most appropriate?++divModUp :: C a => a -> a -> (a,a)+divModUp n m = mapFst negate $ divMod (-n) m+-}++ {- * Instances for atomic types -}  instance C Integer where@@ -280,7 +321,7 @@ propMultipleDiv m a =    not (isZero m) ==>                 (a*m) `div` m  ==  a propMultipleMod m a =-   not (isZero m) ==>                 (a*m) `mod` m  ==  0+   not (isZero m) ==>                 (a*m) `mod` m  ==  zero propProjectAddition m a b =    not (isZero m) ==>       (a+b) `mod` m  ==  ((a`mod`m)+(b`mod`m)) `mod` m

src/Algebra/Lattice.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Algebra.Lattice (       C(up, dn)     , max, min, abs

src/Algebra/Module.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {- |@@ -124,7 +124,7 @@ Compute the linear combination of a list of vectors.  ToDo:-Should it use 'NumericPrelude.List.zipWithMatch' ?+Should it use 'NumericPrelude.List.Checked.zipWith' ? -} linearComb :: C a v => [a] -> [v] -> v linearComb c = sum . zipWith (*>) c

src/Algebra/ModuleBasis.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {- |@@ -15,7 +15,7 @@  import qualified Algebra.PrincipalIdealDomain as PID import qualified Algebra.Module   as Module-import qualified Algebra.Additive as Additive+-- import qualified Algebra.Additive as Additive import Algebra.Ring     (one, fromInteger) import Algebra.Additive ((+), zero)

src/Algebra/NormedSpace/Euclidean.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-}

src/Algebra/NormedSpace/Maximum.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} @@ -23,7 +23,6 @@ import qualified Algebra.PrincipalIdealDomain as PID import qualified Algebra.ToInteger as ToInteger import qualified Algebra.RealRing as RealRing-import qualified Algebra.Absolute as Absolute import qualified Algebra.Module   as Module  import qualified Data.Foldable as Fold

src/Algebra/NormedSpace/Sum.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-}

src/Algebra/OccasionallyScalar.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-}

src/Algebra/PrincipalIdealDomain.hs view

@@ -1,10 +1,11 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Algebra.PrincipalIdealDomain (     {- * Class -}     C,     extendedGCD,     gcd,     lcm,+    coprime,      {- * Standard implementations for instances -}     euclid,@@ -38,19 +39,19 @@  import qualified Algebra.Units          as Units import qualified Algebra.IntegralDomain as Integral-import qualified Algebra.Ring           as Ring-import qualified Algebra.Additive       as Additive+-- import qualified Algebra.Ring           as Ring+-- import qualified Algebra.Additive       as Additive import qualified Algebra.ZeroTestable   as ZeroTestable  import qualified Algebra.Laws as Laws  import Algebra.Units          (stdAssociate, stdUnitInv)-import Algebra.IntegralDomain (mod, safeDiv, divMod, divides, divModZero)+import Algebra.IntegralDomain (mod, divChecked, divMod, divides, divModZero) import Algebra.Ring           (one, (*), scalarProduct) import Algebra.Additive       (zero, (+), (-)) import Algebra.ZeroTestable   (isZero) -import Data.Maybe.HT (toMaybe)+import Data.Maybe.HT (toMaybe, )  import Control.Monad (foldM, liftM) import Data.List (mapAccumL, mapAccumR, unfoldr)@@ -58,8 +59,7 @@ import Data.Int  (Int,  Int8,  Int16,  Int32,  Int64,  )  import NumericPrelude.Base-import Prelude (Integer, Int)-import qualified Prelude as P+import Prelude (Integer, ) import Test.QuickCheck ((==>), Property)  @@ -119,11 +119,29 @@     Least common multiple     -}     lcm         :: a -> a -> a-    lcm x y     = safeDiv x (gcd x y) * y  -- avoid big temporary results-    -- lcm x y     = safeDiv (x * y) (gcd x y)+    lcm x y     =+       if isZero x+         then x -- avoid computing undefined (gcd 0 0)+         else divChecked x (gcd x y) * y  -- avoid big temporary results+    -- lcm x y     = divChecked (x * y) (gcd x y)  +{-+These do only work if zero and one are really identity elements. +gcdMulti :: (C a) => [a] -> a+gcdMulti = foldl gcd zero++lcmMulti :: (C a) => [a] -> a+lcmMulti = foldl lcm one+-}++coprime :: (C a) => a -> a -> Bool+coprime x y =+   Units.isUnit (gcd x y)+++ {- We could implement a helper function, which exposes the temporary results.@@ -195,8 +213,8 @@    if isZero g      then (zero,zero)      else-       let xl = safeDiv x g-           yl = safeDiv y g+       let xl = divChecked x g+           yl = divChecked y g            (d,aRed) = divModZero a yl        in  (aRed, b + d*xl) @@ -246,10 +264,6 @@                   (d',cLast') = minimizeFirstOperand (gcd d cLast) d cLast               in  as' ++ [d',cLast']            _ -> as---- cf. MathObj.Permutation.Table-swap :: (a,b) -> (b,a)-swap (x,y) = (y,x) -}  {- |@@ -282,8 +296,9 @@   {--There exists a GCD variant,-that is specialised for integers and does not need a division.+There is the binary GCD algorithm,+that is specialised for integers in binary representation.+It does not need a division. However, since we have an optimized division, the standard implementation is probably faster.

src/Algebra/RealField.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Algebra.RealField (    C,    ) where@@ -11,7 +11,7 @@ import qualified Number.Ratio as Ratio  -- import NumericPrelude.Base-import qualified Prelude as P+-- import qualified Prelude as P import Prelude (Float, Double, )  {- |

src/Algebra/RealIntegral.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Generally before using 'quot' and 'rem', think twice. In most cases 'divMod' and friends are the right choice,@@ -17,9 +17,9 @@    ) where  import qualified Algebra.IntegralDomain as Integral-import qualified Algebra.Absolute           as Absolute-import qualified Algebra.Ring           as Ring-import qualified Algebra.Additive       as Additive+import qualified Algebra.Absolute       as Absolute+-- import qualified Algebra.Ring           as Ring+-- import qualified Algebra.Additive       as Additive  import Algebra.Absolute (signum, ) import Algebra.IntegralDomain (divMod, )@@ -31,7 +31,7 @@  import NumericPrelude.Base import qualified Prelude as P-import Prelude (Int, Integer, )+import Prelude (Integer, )   infixl 7 `quot`, `rem`

src/Algebra/RealRing.hs view

@@ -1,6 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# OPTIONS_GHC -fglasgow-exts #-}--- -fglasgow-exts for RULES+{-# LANGUAGE RebindableSyntax #-} module Algebra.RealRing where  import qualified Algebra.Field              as Field@@ -30,7 +28,7 @@ import qualified GHC.Float as GHC import Data.List as List import Data.Tuple.HT (mapFst, mapPair, )-import Prelude(Int, Integer, Float, Double)+import Prelude (Integer, Float, Double, ) import qualified Prelude as P import NumericPrelude.Base

src/Algebra/RealTranscendental.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Algebra.RealTranscendental where  import qualified Algebra.Transcendental      as Trans

src/Algebra/RightModule.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} module Algebra.RightModule where@@ -7,7 +7,7 @@ import qualified Algebra.Additive as Additive  -- import NumericPrelude.Numeric-import qualified Prelude+-- import qualified Prelude   -- Is this right?

src/Algebra/Ring.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Algebra.Ring (     {- * Class -}     C,@@ -29,7 +29,7 @@ import Algebra.Additive(zero, (+), negate, sum)  import Data.Function.HT (powerAssociative, )-import NumericPrelude.List (zipWithMatch, )+import NumericPrelude.List (zipWithChecked, )  import Test.QuickCheck ((==>), Property) @@ -37,7 +37,7 @@ import Data.Word (Word, Word8, Word16, Word32, Word64, )  import NumericPrelude.Base-import Prelude(Integer,Int,Float,Double)+import Prelude (Integer, Float, Double, ) import qualified Data.Ratio as Ratio98 import qualified Prelude as P -- import Test.QuickCheck@@ -105,7 +105,7 @@   scalarProduct :: C a => [a] -> [a] -> a-scalarProduct as bs = sum (zipWithMatch (*) as bs)+scalarProduct as bs = sum (zipWithChecked (*) as bs)   {- * Instances for atomic types -}

src/Algebra/ToInteger.hs view

@@ -1,7 +1,5 @@-{-# OPTIONS_GHC -fglasgow-exts -fno-warn-orphans #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} {---fglasgow-exts for RULES- The orphan instance could be fixed by making this module mutually recursive with ToRational.hs, but that's not worth the complication.@@ -27,7 +25,7 @@  import qualified Prelude as P import NumericPrelude.Base-import Prelude (Int, Integer, Float, Double, )+import Prelude (Integer, Float, Double, )   {- |

src/Algebra/ToRational.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Algebra.ToRational where  import qualified Algebra.Field    as Field@@ -13,7 +13,7 @@  import qualified Prelude as P import NumericPrelude.Base-import Prelude(Int,Integer,Float,Double)+import Prelude (Integer, Float, Double, )  {- | This class allows lossless conversion

src/Algebra/Transcendental.hs view

@@ -1,9 +1,9 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Algebra.Transcendental where  import qualified Algebra.Algebraic as Algebraic-import qualified Algebra.Ring      as Ring-import qualified Algebra.Additive  as Additive+-- import qualified Algebra.Ring      as Ring+-- import qualified Algebra.Additive  as Additive  import qualified Algebra.Laws as Laws

src/Algebra/Units.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Algebra.Units (     {- * Class -}     C,@@ -22,7 +22,7 @@  import qualified Algebra.IntegralDomain as Integral import qualified Algebra.Ring           as Ring-import qualified Algebra.Additive       as Additive+-- import qualified Algebra.Additive       as Additive import qualified Algebra.ZeroTestable   as ZeroTestable  import qualified Algebra.Laws           as Laws@@ -35,7 +35,7 @@ import Data.Int  (Int,  Int8,  Int16,  Int32,  Int64,  )  import NumericPrelude.Base-import Prelude (Integer, Int)+import Prelude (Integer, ) import qualified Prelude as P import Test.QuickCheck ((==>), Property) @@ -74,7 +74,7 @@   stdAssociate, stdUnit, stdUnitInv :: a -> a    stdAssociate x = x * stdUnitInv x-  stdUnit      x = div one (stdUnitInv x)  -- should be safeDiv+  stdUnit      x = div one (stdUnitInv x)  -- should be divChecked   stdUnitInv   x = div one (stdUnit x)

src/Algebra/Vector.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Copyright   :  (c) Henning Thielemann 2004-2005

src/Algebra/VectorSpace.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} module Algebra.VectorSpace where

src/Algebra/ZeroTestable.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Algebra.ZeroTestable where  import qualified Algebra.Additive as Additive@@ -7,7 +7,7 @@ import Data.Word (Word, Word8, Word16, Word32, Word64, )  -- import qualified Prelude as P-import Prelude(Int,Integer,Float,Double)+import Prelude (Integer, Float, Double, ) import NumericPrelude.Base  {- |

src/MathObj/Algebra.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Copyright    :   (c) Mikael Johansson 2006 Maintainer   :   mik@math.uni-jena.de

src/MathObj/DiscreteMap.hs view

@@ -1,5 +1,5 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} @@ -41,7 +41,7 @@ import qualified Data.Map as Map import Data.Map (Map) -import qualified Prelude as P+-- import qualified Prelude as P import NumericPrelude.Base  -- FIXME: Should this be implemented by isZero?

src/MathObj/Gaussian/Bell.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- Complex translated Gaussian bell curve with amplitude abstracted away.@@ -10,14 +10,11 @@  import qualified Algebra.Transcendental as Trans import qualified Algebra.Field          as Field-import qualified Algebra.Absolute           as Absolute+import qualified Algebra.Absolute       as Absolute import qualified Algebra.Ring           as Ring import qualified Algebra.Additive       as Additive  import Number.Complex ((+:), )-import Algebra.Transcendental (pi, )-import Algebra.Ring ((*), (^), )-import Algebra.Additive ((+), )  import Test.QuickCheck (Arbitrary, arbitrary, ) import Control.Monad (liftM4, )@@ -33,7 +30,7 @@ instance (Absolute.C a, Arbitrary a) => Arbitrary (T a) where    arbitrary =       liftM4-         (\k a b c -> Cons k a b (1 + abs c))+         (\k a b c -> Cons (abs k) a b (1 + abs c))          arbitrary arbitrary arbitrary arbitrary  @@ -82,10 +79,38 @@       (amp f * amp g)       (c0 f + c0 g) (c1 f + c1 g) (c2 f + c2 g) +powerRing :: (Trans.C a) =>+   Integer -> T a -> T a+powerRing p f =+   let pa = fromInteger p+   in  Cons+          (amp f ^ p)+          (pa * c0 f) (pa * c1 f) (fromInteger p * c2 f)  {--let x=Cons (1+:3) (4+:5) (7::Rational); y=Cons (1+:4) (3+:2) (5::Rational)+powerField does not makes sense,+since the reciprocal of a Gaussian diverges. -}++powerAlgebraic :: (Trans.C a) =>+   Rational -> T a -> T a+powerAlgebraic p f =+   let pa = fromRational' p+   in  Cons+          (amp f ^/ p)+          (pa * c0 f) (pa * c1 f) (fromRational' p * c2 f)++powerTranscendental :: (Trans.C a) =>+   a -> T a -> T a+powerTranscendental p f =+   Cons+      (amp f ^? p)+      (Complex.scale p $ c0 f) (Complex.scale p $ c1 f) (p * c2 f)+++{-+let x=Cons 2 (1+:3) (4+:5) (7::Rational); y=Cons 7 (1+:4) (3+:2) (5::Rational)+-} convolve :: (Field.C a) =>    T a -> T a -> T a convolve f g =@@ -105,7 +130,7 @@          = -(f1 - g1)^2/(4*(f2 + g2))        -}    in  Cons-          ((amp f * amp g) / (c2 f + c2 g))+          (amp f * amp g / s)           (c0 f + c0 g               - Complex.scale (recip (4*s)) ((c1 f - c1 g)^2))           (Complex.scale (c2 g / s) (c1 f) +@@ -125,11 +150,12 @@        gd = Complex.scale (recip (2 * c2 g0)) $ c1 g0        f1 = translateComplex fd f0        g1 = translateComplex gd g0+       s = c2 f1 + c2 g1    in  translateComplex (negate $ fd + gd) $        Cons-          ((amp f0 * amp g0) / (c2 f0 + c2 g0))+          (amp f1 * amp g1 / s)           (c0 f1 + c0 g1) zero-          (recip $ recip (c2 f1) + recip (c2 g1))+          (c2 f1 * c2 g1 / s)  convolveByFourier :: (Field.C a) =>    T a -> T a -> T a@@ -141,10 +167,9 @@ fourier f =    let a = c0 f        b = c1 f-       c = c2 f-       rc = recip c+       rc = recip $ c2 f    in  Cons-          (amp f / c2 f)+          (amp f * rc)           (Complex.scale (rc/4) (-b^2) + a)           (Complex.scale rc $ Complex.quarterRight b)           rc@@ -271,7 +296,7 @@       (amp f)       (c0 f)       (Complex.scale k $ c1 f)-      (k^2 * c2 f)+      (c2 f * k^2)  amplify :: (Ring.C a) => a -> T a -> T a amplify k f =

src/MathObj/Gaussian/Example.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- Reciprocal of variance of a Gaussian bell curve. We describe the curve only in terms of its variance

src/MathObj/Gaussian/Polynomial.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- Complex Gaussian bell multiplied with a polynomial. @@ -35,10 +35,6 @@ import qualified Algebra.Ring           as Ring import qualified Algebra.Additive       as Additive -import Algebra.Transcendental (pi, )-import Algebra.Ring ((*), )--- import Algebra.Additive ((+))- import qualified Data.Record.HT as Rec import qualified Data.List as List import Data.Function.HT (nest, )@@ -57,24 +53,47 @@ data T a = Cons {bell :: Bell.T a, polynomial :: Poly.T (Complex.T a)}    deriving (Show) -instance (Ring.C a, Ord a) => Eq (T a) where+instance (Absolute.C a, Eq a) => Eq (T a) where    (==) = equal + {-+Helper data type for 'equal',+that allows to call the (not quite trivial) polynomial equality check.+@RootProduct r a@ represents @sqrt r * a@.+The test using 'signum' works for real numbers,+and I do not know, whether it is correct for other mathematical objects.+However I cannot imagine other mathematical objects,+that make sense at all, here.+Maybe elements of a finite field.+-}+data RootProduct a = RootProduct a a++instance (Absolute.C a, Eq a) => Eq (RootProduct a) where+   (RootProduct xr xa) == (RootProduct yr ya)  =+      let xp = xr*xa^2+          yp = yr*ya^2+      in  xp==yp &&+          (isZero xp || signum xa == signum ya)++instance (ZeroTestable.C a) => ZeroTestable.C (RootProduct a) where+   isZero (RootProduct r a) = isZero r || isZero a+++{- The derived Eq is not correct. We have to combine the amplitude of the bell with the polynomial, respecting signs and the square root of the bell amplitude. -}-equal :: (Ring.C a, Ord a) => T a -> T a -> Bool+equal :: (Absolute.C a, Eq a) => T a -> T a -> Bool equal x y =    let bx = bell x        by = bell y-       csign c =-          Complex.real c > 0 ||-          (Complex.real c == 0 && Complex.imag c > 0)        scaleSqr b =-          map (\c -> (Complex.scale (Bell.amp b) (c^2), csign c)) .-          Poly.coeffs . polynomial+          (\p ->+              (fmap (RootProduct (Bell.amp b) . Complex.real) p,+               fmap (RootProduct (Bell.amp b) . Complex.imag) p))+           . polynomial    in  Rec.equal           (equating Bell.c0 :            equating Bell.c1 :@@ -82,7 +101,7 @@            [])           bx by        &&-       scaleSqr by x == scaleSqr bx y+       scaleSqr bx x == scaleSqr by y   instance (Absolute.C a, Arbitrary a) => Arbitrary (T a) where@@ -146,7 +165,7 @@    nest n (scale (-1/4) . differentiate) $    Cons (Bell.Cons one zero zero 2) one -eigenfunctionIterative :: (Field.C a, Ord a) => Int -> T a+eigenfunctionIterative :: (Field.C a, Absolute.C a, Eq a) => Int -> T a eigenfunctionIterative n =    fst . head . dropWhile (uncurry (/=)) . mapAdjacent (,) $    eigenfunctionIteration $@@ -171,9 +190,29 @@       (Bell.multiply (bell f) (bell g))       (polynomial f * polynomial g) -convolve :: (Field.C a) =>+convolve, {- convolveByDifferentiation, -} convolveByFourier :: (Field.C a) =>    T a -> T a -> T a-convolve f g =+convolve = convolveByFourier++{-+f <*> g =+   let (foff,fint) = integrate f+   in  fint <*> differentiate g + makeGaussPoly foff * g++In principle this would work,+but (makeGaussPoly foff * g) contains a lot of+convolutions of Gaussian with Gaussian-polynomial-product,+where the Gaussians have different parameters.++convolveByDifferentiation f g =+   case polynomial f of+      fpoly ->+         if null $ Poly.coeffs fpoly+           then ...+           else ...+-}++convolveByFourier f g =    reverse $ fourier $ multiply (fourier f) (fourier g)  {-@@ -184,7 +223,7 @@  fourier (Cons bell (Poly.const a + Poly.shift f))   = fourier (Cons bell (Poly.const a)) + fourier (Cons bell (Poly.shift f))-  = fourier (Cons bell (Poly.const a)) + C * differentiate (fourier (Cons bell f))+  = fourier (Cons bell (Poly.const a)) + differentiate (fourier (Cons bell f)) -} fourier :: (Field.C a) =>    T a -> T a@@ -198,7 +237,7 @@       (Cons (Bell.fourier $ bell f) zero) $    Poly.coeffs $ polynomial f -{-+{- | Differentiate and divide by @sqrt pi@ in order to stay in a ring. This way, we do not need to fiddle with pi factors. -}@@ -211,6 +250,17 @@  {- snd $ integrate $ differentiate (Cons Bell.unit (Poly.fromCoeffs [7,7,7,7]) :: T Double)++g = (bell f * poly f)'+  = bell f * ((poly f)' - (exppoly (bell f))' * poly f)+poly g = (poly f)' - (exppoly (bell f))' * poly f++Integration means we have g and ask for f.++poly f = ((poly f)' - poly g) / (exppoly (bell f))'++However must start with the highest term of 'poly f',+and thus we need to perform the division on reversed polynomials. -} integrate ::    (Field.C a, ZeroTestable.C a) =>

src/MathObj/Gaussian/Variance.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- We represent a Gaussian bell curve in terms of the reciprocal of its variance and its value at the origin.@@ -10,11 +10,12 @@ module MathObj.Gaussian.Variance where  import qualified MathObj.Polynomial as Poly+import qualified Number.Root as Root  import qualified Algebra.Transcendental as Trans import qualified Algebra.Algebraic      as Algebraic import qualified Algebra.Field          as Field-import qualified Algebra.Absolute           as Absolute+import qualified Algebra.Absolute       as Absolute import qualified Algebra.Ring           as Ring import qualified Algebra.Additive       as Additive @@ -31,13 +32,16 @@ import NumericPrelude.Base  +{- |+Since @amp@ is the square of the actual amplitude it must be non-negative.+-} data T a = Cons {amp, c :: a}    deriving (Eq, Show)  instance (Absolute.C a, Arbitrary a) => Arbitrary (T a) where    arbitrary =       liftM2 Cons-         arbitrary+         (fmap abs arbitrary)          (fmap ((1+) . abs) arbitrary)  @@ -56,17 +60,43 @@    Poly.fromCoeffs [zero, zero, c f]  -norm1 :: (Algebraic.C a, Absolute.C a) => T a -> a+norm1Root :: (Field.C a) => T a -> Root.T a+norm1Root f =+   Root.sqrt $ Root.fromNumber $ amp f / c f++norm2Root :: (Field.C a) => T a -> Root.T a+norm2Root f =+   Root.sqrt $+      Root.fromNumber (amp f)+      `Root.div`+      Root.sqrt (Root.fromNumber $ 2 * c f)++normInfRoot :: (Field.C a) => T a -> Root.T a+normInfRoot f =+   Root.sqrt $ Root.fromNumber $ amp f++normPRoot :: (Field.C a) => Rational -> T a -> Root.T a+normPRoot p f =+   Root.sqrt (Root.fromNumber (amp f))+   `Root.div`+   Root.rationalPower (recip (2*p)) (Root.fromNumber (fromRational' p * c f))+++norm1 :: (Algebraic.C a) => T a -> a norm1 f =-   sqrt $ abs (amp f) / c f+   sqrt $ amp f / c f -norm2 :: (Algebraic.C a, Absolute.C a) => T a -> a+norm2 :: (Algebraic.C a) => T a -> a norm2 f =-   sqrt $ abs (amp f) / (sqrt $ 2 * c f)+   sqrt $ amp f / (sqrt $ 2 * c f) -normP :: (Trans.C a, Absolute.C a) => a -> T a -> a+normInf :: (Algebraic.C a) => T a -> a+normInf f =+   sqrt (amp f)++normP :: (Trans.C a) => a -> T a -> a normP p f =-   sqrt (abs (amp f)) * (p * c f) ^? (- recip (2*p))+   sqrt (amp f) * (p * c f) ^? (- recip (2*p))   variance :: (Trans.C a) =>@@ -79,20 +109,45 @@ multiply f g =    Cons (amp f * amp g) (c f + c g) +powerRing :: (Trans.C a) =>+   Integer -> T a -> T a+powerRing p f =+   Cons (amp f ^ p) (fromInteger p * c f)++{-+powerField does not makes sense,+since the reciprocal of a Gaussian diverges.+-}++powerAlgebraic :: (Trans.C a) =>+   Rational -> T a -> T a+powerAlgebraic p f =+   Cons (amp f ^/ p) (fromRational' p * c f)++powerTranscendental :: (Trans.C a) =>+   a -> T a -> T a+powerTranscendental p f =+   Cons (amp f ^? p) (p * c f)+ {- | > convolve x y t = >    integrate $ \s -> x s * y(t-s)++Convergence only for @c f + c g > 0@. -} convolve :: (Field.C a) =>    T a -> T a -> T a convolve f g =-   Cons-      (amp f * amp g / (c f + c g))-      (recip $ recip (c f) + recip (c g))+   let s = c f + c g+   in  Cons+          (amp f * amp g / s)+          (c f * c g / s)  {- | > fourier x f = >    integrate $ \t -> x t * cis (-2*pi*t*f)++Convergence only for @c f > 0@. -} fourier :: (Field.C a) =>    T a -> T a@@ -110,6 +165,9 @@ shrink k f =    Cons (amp f) $ c f * k^2 +{- |+@amplify k@ scales by @abs k@!+-} amplify :: (Ring.C a) => a -> T a -> T a amplify k f =    Cons (k^2 * amp f) $ c f

src/MathObj/LaurentPolynomial.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {- |@@ -26,7 +26,6 @@  import qualified Number.Complex as Complex -import Algebra.ZeroTestable(isZero) import Algebra.Module((*>))  import qualified NumericPrelude.Base as P

src/MathObj/Matrix.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {- |@@ -27,6 +27,7 @@    transpose,    rows,    columns,+   index,    fromRows,    fromColumns,    fromList,@@ -58,8 +59,10 @@ import Control.Monad (liftM2, ) import Control.Exception (assert, ) +import Data.Function.HT (powerAssociative, ) import Data.Tuple.HT (swap, mapFst, ) import Data.List.HT (outerProduct, )+import Text.Show.HT (concatS, )  import NumericPrelude.Numeric (Int, ) import NumericPrelude.Base hiding (zipWith, )@@ -83,15 +86,18 @@    in  Cons (ixmap (swap lower, swap upper) swap m)  rows :: T a -> [[a]]-rows (Cons m) =+rows mM@(Cons m) =    let ((lr,lc), (ur,uc)) = bounds m-   in  outerProduct (curry(m!)) (range (lr,ur)) (range (lc,uc))+   in  outerProduct (index mM) (range (lr,ur)) (range (lc,uc))  columns :: T a -> [[a]]-columns (Cons m) =+columns mM@(Cons m) =    let ((lr,lc), (ur,uc)) = bounds m-   in  outerProduct (flip(curry(m!))) (range (lc,uc)) (range (lr,ur))+   in  outerProduct (flip (index mM)) (range (lc,uc)) (range (lr,ur)) +index :: T a -> Dimension -> Dimension -> a+index (Cons m) i j = m ! (i,j)+ fromRows :: Dimension -> Dimension -> [[a]] -> T a fromRows m n =    Cons .@@ -129,9 +135,6 @@    map (List.intersperse (' ':) . map (showsPrec 11)) .    rows -concatS :: [ShowS] -> ShowS-concatS = flip (foldr ($))- dimension :: T a -> (Dimension,Dimension) dimension (Cons m) = uncurry subtract (bounds m) + (1,1) @@ -183,9 +186,13 @@ instance (Ring.C a) => Ring.C (T a) where    mM * nM =       assert (numColumns mM == numRows nM) $-      fromList (numRows mM) (numColumns nM)-         (liftM2 scalarProduct (rows mM) (columns nM))+      fromList (numRows mM) (numColumns nM) $+      liftM2 scalarProduct (rows mM) (columns nM)    fromInteger n = fromList 1 1 [fromInteger n]+   mM ^ n =+      assert (numColumns mM == numRows mM) $+      assert (n >= Additive.zero) $+      powerAssociative (*) (one (numColumns mM)) mM n  instance Functor T where    fmap f (Cons m) = Cons (fmap f m)

src/MathObj/Monoid.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module MathObj.Monoid where  import qualified Algebra.PrincipalIdealDomain as PID

src/MathObj/PartialFraction.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Copyright    :   (c) Henning Thielemann 2007 Maintainer   :   numericprelude@henning-thielemann.de@@ -16,7 +16,6 @@ import qualified Algebra.PrincipalIdealDomain as PID import qualified Algebra.IntegralDomain       as Integral import qualified Number.Ratio                 as Ratio-import qualified Algebra.Field                as Field import qualified Algebra.Ring                 as Ring import qualified Algebra.Additive             as Additive import qualified Algebra.ZeroTestable         as ZeroTestable@@ -271,8 +270,8 @@    in  if (isZero r)          then ((q*a, q*b), zero)          else-           let fx = safeDiv dx g-               fy = safeDiv dy g+           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:

src/MathObj/Permutation.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Copyright    :   (c) Henning Thielemann 2006 Maintainer   :   numericprelude@henning-thielemann.de@@ -17,7 +17,7 @@ import Data.Array(Ix)  -- import NumericPrelude.Numeric (Integer)-import NumericPrelude.Base+-- import NumericPrelude.Base   {- |

src/MathObj/Permutation/CycleList.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Copyright    :   (c) Mikael Johansson 2006 Maintainer   :   mik@math.uni-jena.de

src/MathObj/Permutation/CycleList/Check.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Copyright    :   (c) Henning Thielemann 2006 Maintainer   :   numericprelude@henning-thielemann.de

src/MathObj/Permutation/Table.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Copyright    :   (c) Henning Thielemann 2006 Maintainer   :   numericprelude@henning-thielemann.de

src/MathObj/Polynomial.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-}

src/MathObj/Polynomial/Core.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | This module implements polynomial functions on plain lists. We use such functions in order to implement methods of other datatypes.@@ -31,16 +31,12 @@ import qualified Algebra.Additive             as Additive import qualified Algebra.ZeroTestable         as ZeroTestable -import Algebra.Module((*>))-import Algebra.ZeroTestable(isZero)- import qualified Data.List as List import NumericPrelude.List (zipWithOverlap, ) import Data.Tuple.HT (mapPair, mapFst, forcePair, ) import Data.List.HT           (dropWhileRev, switchL, shear, shearTranspose, outerProduct, ) -import qualified Prelude     as P98 import qualified NumericPrelude.Base as P import qualified NumericPrelude.Numeric as NP @@ -199,7 +195,7 @@ {-# INLINE integrateInt #-} integrateInt :: (ZeroTestable.C a, Integral.C a) => a -> [a] -> [a] integrateInt c x =-   c : zipWith Integral.safeDiv x progression+   c : zipWith Integral.divChecked x progression   {-# INLINE mulLinearFactor #-}@@ -221,8 +217,8 @@ discriminant :: Ring.C a => [a] -> a discriminant xs =    let degree = genericLength xs-   in  parityFlip (safeDiv (degree*(degree-1)) 2)+   in  parityFlip (divChecked (degree*(degree-1)) 2)                   (resultant xs (differentiate xs))-          `safeDiv` last xs+          `divChecked` last xs -}

src/MathObj/PowerSeries.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} @@ -24,7 +24,6 @@ import qualified Algebra.ZeroTestable   as ZeroTestable  import Algebra.Module((*>))-import Algebra.ZeroTestable(isZero)  import NumericPrelude.Base    hiding (const) import NumericPrelude.Numeric

src/MathObj/PowerSeries/Core.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module MathObj.PowerSeries.Core where  import qualified MathObj.Polynomial.Core as Poly@@ -9,9 +9,6 @@ import qualified Algebra.Ring           as Ring import qualified Algebra.Additive       as Additive import qualified Algebra.ZeroTestable   as ZeroTestable--import Algebra.Module((*>))-import Algebra.ZeroTestable(isZero)  import qualified Data.List.Match as Match import qualified NumericPrelude.Numeric as NP

src/MathObj/PowerSeries/DifferentialEquation.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Lazy evaluation allows for the solution  of differential equations in terms of power series.

src/MathObj/PowerSeries/Example.hs view

@@ -1,18 +1,18 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module MathObj.PowerSeries.Example where  import qualified MathObj.PowerSeries.Core as PS  import qualified Algebra.Field          as Field import qualified Algebra.Ring           as Ring-import qualified Algebra.Additive       as Additive+-- import qualified Algebra.Additive       as Additive import qualified Algebra.ZeroTestable   as ZeroTestable import qualified Algebra.Transcendental as Transcendental  import Algebra.Additive (zero, subtract, negate) -import Data.List (map, tail, cycle, zipWith, scanl, intersperse)-import Data.List.HT (sieve)+import Data.List (intersperse, )+import Data.List.HT (sieve, )  import NumericPrelude.Numeric (one, (*), (/),                        fromInteger, {-fromRational,-} pi)

src/MathObj/PowerSeries/Mean.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | This module computes power series for representing some means as generalized $f$-means.

src/MathObj/PowerSeries2.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-}

src/MathObj/PowerSeries2/Core.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module MathObj.PowerSeries2.Core where  import qualified MathObj.PowerSeries as PS

src/MathObj/PowerSum.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {- |

src/MathObj/RefinementMask2.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module MathObj.RefinementMask2 (    T, coeffs, fromCoeffs,    fromPolynomial,

src/MathObj/RootSet.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Copyright   :  (c) Henning Thielemann 2004-2005

src/Number/Complex.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {- Rules should be processed -}@@ -64,8 +64,8 @@ import qualified Algebra.Units              as Units import qualified Algebra.PrincipalIdealDomain as PID import qualified Algebra.IntegralDomain     as Integral-import qualified Algebra.RealRing          as RealRing-import qualified Algebra.Absolute               as Absolute+import qualified Algebra.RealRing           as RealRing+import qualified Algebra.Absolute           as Absolute import qualified Algebra.Ring               as Ring import qualified Algebra.Additive           as Additive import qualified Algebra.ZeroTestable       as ZeroTestable@@ -124,6 +124,10 @@ instance (Read a) => Read (T a) where    readsPrec prec = readsInfixPrec "+:" plusPrec prec (+:) +instance Functor T where+   {-# INLINE fmap #-}+   fmap f (Cons x y) = Cons (f x) (f y)+ instance (Arbitrary a) => Arbitrary (T a) where    {-# INLINE arbitrary #-}    arbitrary = liftM2 Cons arbitrary arbitrary@@ -167,7 +171,7 @@ {- SPECIALISE scale :: Double -> T Double -> T Double -} {-# INLINE scale #-} scale :: (Ring.C a) => a -> T a -> T a-scale r (Cons x y) =  Cons (r * x) (r * y)+scale r =  fmap (r*)  -- | Exponential of a complex number with minimal type class constraints. {-# INLINE exp #-}@@ -362,7 +366,7 @@   In this implementation the complex plane is structured   as an orthogonal grid induced by the divisor z'.   The coordinate of a cell within this grid is returned as quotient-  and the position with a cell is returned as remainder.+  and the position of the cell in the grid is returned as remainder.   The magnitude of the remainder might be larger than that of the divisor   thus the Euclidean algorithm can fail. -}@@ -371,9 +375,7 @@     divMod z z' =        let denom = magnitudeSqr z'            zBig  = z * conjugate z'-           re    = divMod (real zBig) denom-           im    = divMod (imag zBig) denom-           q     = Cons (fst re) (fst im)+           q     = fmap (flip div denom) zBig        in  (q, z-q*z')  @@ -495,12 +497,13 @@  instance  (RealRing.C a, Algebraic.C a, Power a) =>           Algebraic.C (T a)  where+    -- | the real part of the result is always non-negative     {-# INLINE sqrt #-}     sqrt z@(Cons x y)  =  if z == zero                             then zero                             else-                              let v'    = abs y / (u'*2)-                                  u'    = sqrt ((magnitude z + abs x) / 2)+                              let u'    = sqrt ((magnitude z + abs x) / 2)+                                  v'    = abs y / (u'*2)                                   (u,v) = if x < 0 then (v',u') else (u',v')                               in  Cons u (if y < 0 then -v else v)     {-# INLINE (^/) #-}

+ src/Number/ComplexSquareRoot.hs view

@@ -0,0 +1,119 @@+module Number.ComplexSquareRoot where++-- import qualified Algebra.Algebraic as Algebraic+import qualified Algebra.RealField as RealField+import qualified Algebra.RealRing as RealRing+-- 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 Number.Complex as Complex++import Algebra.ZeroTestable(isZero, )++import Test.QuickCheck (Arbitrary, arbitrary, )++import Control.Monad (liftM2, )++import qualified NumericPrelude.Numeric as NP+import NumericPrelude.Numeric hiding (recip, )+import NumericPrelude.Base+import Prelude ()++{- |+Represent the square root of a complex number+without actually having to compute a square root.+If the Bool is False,+then the square root is represented with positive real part+or zero real part and positive imaginary part.+If the Bool is True the square root is negated.+-}+data T a = Cons Bool (Complex.T a)+   deriving (Show)++{- |+You must use @fmap@ only for number type conversion.+-}+instance Functor T where+   fmap f (Cons n x) = Cons n (fmap f x)++instance (ZeroTestable.C a) => ZeroTestable.C (T a) where+   isZero (Cons _b s) = isZero s++instance (ZeroTestable.C a, Eq a) => Eq (T a) where+   (Cons xb xs) == (Cons yb ys) =+      isZero xs && isZero ys  ||+      xb==yb && xs==ys++instance (Arbitrary a) => Arbitrary (T a) where+   arbitrary = liftM2 Cons arbitrary arbitrary+++fromNumber :: (RealRing.C a) => Complex.T a -> T a+fromNumber x =+   Cons+      (case compare zero (Complex.real x) of+         LT -> False+         GT -> True+         EQ -> Complex.imag x < zero)+      (x^2)++-- htam:Wavelet.DyadicResultant.parityFlip+toNumber :: (RealRing.C a, Complex.Power a) => T a -> Complex.T a+toNumber (Cons n x) =+   case sqrt x of y -> if n then NP.negate y else y+++one :: (Ring.C a) => T a+one = Cons False NP.one++inUpperHalfplane :: (Additive.C a, Ord a) => Complex.T a -> Bool+inUpperHalfplane x =+   case compare (Complex.imag x) zero of+      GT -> True+      LT -> False+      EQ -> Complex.real x < zero++mul, mulAlt, mulAlt2 :: (RealRing.C a) => T a -> T a -> T a+mul (Cons xb xs) (Cons yb ys) =+   let zs = xs*ys+   in  Cons+          ((xb /= yb) /=+             case (inUpperHalfplane xs,+                   inUpperHalfplane ys,+                   inUpperHalfplane zs) of+                (True,True,False) -> True+                (False,False,True) -> True+                _ -> False)+          zs++mulAlt (Cons xb xs) (Cons yb ys) =+   let zs = xs*ys+   in  Cons+          ((xb /= yb) /=+             let xi = Complex.imag xs+                 yi = Complex.imag ys+                 zi = Complex.imag zs+             in  (xi>=zero) /= (yi>=zero) &&+                 (xi>=zero) /= (zi>=zero))+          zs++mulAlt2 (Cons xb xs) (Cons yb ys) =+   let zs = xs*ys+   in  Cons+          ((xb /= yb) /=+             let xi = Complex.imag xs+                 yi = Complex.imag ys+                 zi = Complex.imag zs+             in  xi*yi<zero && xi*zi<zero)+          zs++div :: (RealField.C a) => T a -> T a -> T a+div x y = mul x (recip y)++recip :: (RealField.C a) => T a -> T a+recip (Cons b s) =+   Cons+      (b /= (Complex.imag s == zero && Complex.real s < zero))+      (NP.recip s)

src/Number/DimensionTerm/SI.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Copyright   :  (c) Henning Thielemann 2003 License     :  GPL

src/Number/FixedPoint.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Copyright   :  (c) Henning Thielemann 2006 @@ -17,7 +17,7 @@ module Number.FixedPoint where  import qualified Algebra.RealRing    as RealRing-import qualified Algebra.Additive       as Additive+-- import qualified Algebra.Additive       as Additive -- import qualified Algebra.ZeroTestable   as ZeroTestable import qualified Algebra.Transcendental as Trans import qualified MathObj.PowerSeries.Example as PSE

src/Number/FixedPoint/Check.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Number.FixedPoint.Check where  import qualified Number.FixedPoint as FP

src/Number/GaloisField2p32m5.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {- | This number type is intended for tests of functions over fields,

src/Number/NonNegative.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  {-@@ -49,8 +49,6 @@ -- import Test.QuickCheck (Arbitrary(arbitrary))  import qualified Number.Ratio as R--import qualified Prelude as P  import NumericPrelude.Base import Data.Tuple.HT (mapSnd, mapPair, )

src/Number/OccasionallyScalarExpression.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {- |

src/Number/PartiallyTranscendental.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Define Transcendental functions on arbitrary fields. These functions are defined for only a few (in most cases only one) arguments,

src/Number/Peano.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Copyright    :   (c) Henning Thielemann 2007 Maintainer   :   numericprelude@henning-thielemann.de

src/Number/Physical.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {- |

src/Number/Physical/Read.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Copyright   :  (c) Henning Thielemann 2004 License     :  GPL@@ -69,7 +69,7 @@ parseProductTail :: Parser [(String, Integer)] parseProductTail =    let parseTail c f = -         do ignoreSpace (char c)+         do _ <- ignoreSpace (char c)             p <- ignoreSpace parsePower             t <- parseProductTail             return (f p : t)

src/Number/Physical/Show.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Copyright   :  (c) Henning Thielemann 2004 License     :  GPL

src/Number/Physical/Unit.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Copyright   :  (c) Henning Thielemann 2003-2006 License     :  GPL

src/Number/Physical/UnitDatabase.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Copyright   :  (c) Henning Thielemann 2003 License     :  GPL

src/Number/Positional.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Copyright   :  (c) Henning Thielemann 2006 License     :  GPL@@ -18,11 +18,10 @@  import qualified Algebra.IntegralDomain as Integral import qualified Algebra.Ring           as Ring-import qualified Algebra.Additive       as Additive+-- import qualified Algebra.Additive       as Additive import qualified Algebra.ToInteger      as ToInteger  import qualified Prelude as P98-import qualified NumericPrelude.Base as P import qualified NumericPrelude.Numeric as NP  import NumericPrelude.Base

src/Number/Positional/Check.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Copyright   :  (c) Henning Thielemann 2006 License     :  GPL

src/Number/Quaternion.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {- |

src/Number/Ratio.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Module      :  Number.Ratio Copyright   :  (c) Henning Thielemann, Dylan Thurston 2006@@ -24,19 +24,18 @@         )  where  import qualified Algebra.PrincipalIdealDomain as PID-import qualified Algebra.Units                as Units-import qualified Algebra.Absolute                 as Absolute+import qualified Algebra.Absolute             as Absolute 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 Algebra.PrincipalIdealDomain (gcd)-import Algebra.Units (stdUnitInv, stdAssociate)-import Algebra.IntegralDomain (div, divMod)-import Algebra.Ring (one, (*), fromInteger)-import Algebra.Additive (zero, (+), (-), negate)-import Algebra.ZeroTestable (isZero)+import Algebra.PrincipalIdealDomain (gcd, )+import Algebra.Units (stdUnitInv, stdAssociate, )+import Algebra.IntegralDomain (div, divMod, )+import Algebra.Ring (one, (*), (^), fromInteger, )+import Algebra.Additive (zero, (+), (-), negate, )+import Algebra.ZeroTestable (isZero, )  import Control.Monad(liftM, liftM2, ) @@ -93,13 +92,26 @@  instance (PID.C a) => Additive.C (T a) where     zero                =  fromValue zero-    (x:%y) + (x':%y')   =  (x*y' + x'*y) % (y*y')+--    (x:%y) + (x':%y')   =  (x*y' + x'*y) % (y*y')+    {-+    This version reduces the size of intermediate results.+    Is it also faster than the naive version?+    The final (%) includes another gcd computation,+    but it is still needed since e.g.+    5:%7 + (-5):%7 shall be simplified to 0:%1, not 0:%7 .+    -}+    (x:%y) + (x':%y')   =+       let d = gcd y y'+           y0  = div y  d+           y0' = div y' d+       in  (x*y0' + x'*y0) % (y0*y')     negate (x:%y)       =  (-x) :% y  instance (PID.C a) => Ring.C (T a) where     one                 =  fromValue one     fromInteger x       =  fromValue $ fromInteger x     (x:%y) * (x':%y')   =  (x * x') % (y * y')+    (x:%y) ^ n          =  (x ^ n) :% (y ^ n)  instance (Absolute.C a, PID.C a) => Absolute.C (T a) where     abs (x:%y)          =  Absolute.abs x :% y

src/Number/ResidueClass.hs view

@@ -1,12 +1,10 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Number.ResidueClass where  import qualified Algebra.PrincipalIdealDomain as PID import qualified Algebra.IntegralDomain as Integral-import qualified Algebra.Additive       as Additive-import qualified Algebra.ZeroTestable   as ZeroTestable--import Algebra.ZeroTestable(isZero)+-- import qualified Algebra.Additive       as Additive+-- import qualified Algebra.ZeroTestable   as ZeroTestable  import NumericPrelude.Base import NumericPrelude.Numeric hiding (recip)

src/Number/ResidueClass/Check.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Number.ResidueClass.Check where  import qualified Number.ResidueClass as Res@@ -12,13 +12,15 @@  import Algebra.ZeroTestable(isZero) -import NumericPrelude.Base-import NumericPrelude.Numeric (Int, Integer, mod, )+import qualified Data.Function.HT as Func import Data.Maybe.HT (toMaybe, ) import Text.Show.HT (showsInfixPrec, ) import Text.Read.HT (readsInfixPrec, ) +import NumericPrelude.Base+import NumericPrelude.Numeric (Int, Integer, mod, (*), ) + infix 7 /:, `Cons`  {- |@@ -108,6 +110,7 @@     one			=  error "no generic one in a residue class, use ResidueClass.one"     (*)			=  lift2 Res.mul     fromInteger		=  error "no generic integer in a residue class, use ResidueClass.fromInteger"+    x^n                 =  Func.powerAssociative (*) (one (modulus x)) x n  instance  (Eq a, PID.C a) => Field.C (T a)  where     (/)			=  lift2 Res.divide

src/Number/ResidueClass/Func.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Number.ResidueClass.Func where  import qualified Number.ResidueClass as Res

src/Number/ResidueClass/Maybe.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Number.ResidueClass.Maybe where  import qualified Number.ResidueClass as Res@@ -7,8 +7,6 @@ import qualified Algebra.Ring           as Ring import qualified Algebra.Additive       as Additive import qualified Algebra.ZeroTestable   as ZeroTestable--import Algebra.ZeroTestable(isZero)  import NumericPrelude.Base import NumericPrelude.Numeric

src/Number/ResidueClass/Reader.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Number.ResidueClass.Reader where  import qualified Number.ResidueClass as Res

+ src/Number/Root.hs view

@@ -0,0 +1,97 @@+module Number.Root where++import qualified Algebra.Algebraic as Algebraic+import qualified Algebra.Field as Field+import qualified Algebra.Ring as Ring++import qualified MathObj.RootSet as RootSet+import qualified Number.Ratio as Ratio++import Algebra.IntegralDomain (divChecked, )++import qualified NumericPrelude.Numeric as NP+import NumericPrelude.Numeric hiding (recip, )+import NumericPrelude.Base+import Prelude ()++{- |+The root degree must be positive.+This way we can implement multiplication+using only multiplication from type @a@.+-}+data T a = Cons Integer a+   deriving (Show)++{- |+When you use @fmap@ you must assert that+@forall n. fmap f (Cons d x) == fmap f (Cons (n*d) (x^n))@+-}+instance Functor T where+   fmap f (Cons d x) = Cons d (f x)++fromNumber :: a -> T a+fromNumber = Cons 1++toNumber :: Algebraic.C a => T a -> a+toNumber (Cons n x) = Algebraic.root n x++toRootSet :: Ring.C a => T a -> RootSet.T a+toRootSet (Cons d x) =+   RootSet.lift0 ([negate x] ++ replicate (pred (fromInteger d)) zero ++ [one])+++commonDegree :: Ring.C a => T a -> T a -> T (a,a)+commonDegree (Cons xd x) (Cons yd y) =+   let zd = lcm xd yd+   in  Cons zd (x ^ divChecked zd xd, y ^ divChecked zd yd)++instance (Eq a, Ring.C a) => Eq (T a) where+   x == y  =+      case commonDegree x y of+         Cons _ (xn,yn) -> xn==yn++instance (Ord a, Ring.C a) => Ord (T a) where+   compare x y  =+      case commonDegree x y of+         Cons _ (xn,yn) -> compare xn yn+++mul :: Ring.C a => T a -> T a -> T a+mul x y = fmap (uncurry (*)) $ commonDegree x y++div :: Field.C a => T a -> T a -> T a+div x y = fmap (uncurry (/)) $ commonDegree x y++recip :: Field.C a => T a -> T a+recip = fmap NP.recip++{- |+exponent must be non-negative+-}+cardinalPower :: Ring.C a => Integer -> T a -> T a+cardinalPower n (Cons d x) =+   let m = gcd n d+   in  Cons (divChecked d m) (x ^ divChecked n m)++{- |+exponent can be negative+-}+integerPower :: Field.C a => Integer -> T a -> T a+integerPower n =+   if n<0+     then cardinalPower (-n) . recip+     else cardinalPower n++rationalPower :: Field.C a => Rational -> T a -> T a+rationalPower n =+   integerPower (Ratio.numerator n) .+   root (Ratio.denominator n)++{- |+exponent must be positive+-}+root :: Ring.C a => Integer -> T a -> T a+root n (Cons d x) = Cons (d*n) x++sqrt :: Ring.C a => T a -> T a+sqrt = root 2

src/Number/SI.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {- |

src/Number/SI/Unit.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Copyright   :  (c) Henning Thielemann 2003 License     :  GPL

src/NumericPrelude/Base.hs view

@@ -3,10 +3,11 @@ to reexport items that we want from the standard Prelude. -} -module NumericPrelude.Base (module Prelude) where+module NumericPrelude.Base (module Prelude, ifThenElse, ) where import Prelude hiding (        Int, Integer, Float, Double, Rational, Num(..), Real(..),        Integral(..), Fractional(..), Floating(..), RealFrac(..),        RealFloat(..), subtract, even, odd,        gcd, lcm, (^), (^^), sum, product,        fromIntegral, fromRational, )+import Data.Bool.HT (ifThenElse, )

src/NumericPrelude/List.hs view

@@ -26,20 +26,19 @@        aux [] ys = map fb ys    in  aux -{- | Zip two lists which must be of the same length.-    This is checked only lazily, that is unequal lengths are detected only-    if the list is evaluated completely.-    But it is more strict than @zipWithPad undefined f@-    since the latter one may succeed on unequal length list if @f@ is lazy. -}-zipWithMatch+{-+This is exported Checked.zipWith.+We need to define it here in order to prevent an import cycle.+-}+zipWithChecked    :: (a -> b -> c)   {-^ function applied to corresponding elements of the lists -}    -> [a]    -> [b]    -> [c]-zipWithMatch f =+zipWithChecked f =    let aux (x:xs) (y:ys) = f x y : aux xs ys        aux []     []     = []-       aux _      _      = error "zipWith: lists must have the same length"+       aux _      _      = error "Checked.zipWith: lists must have the same length"    in  aux

src/NumericPrelude/List/Checked.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Some functions that are counterparts of functions from "Data.List" using NumericPrelude.Numeric type classes.@@ -13,7 +13,7 @@    ) where  import qualified Algebra.ToInteger  as ToInteger-import qualified Algebra.Ring       as Ring+-- import qualified Algebra.Ring       as Ring import Algebra.Ring (one, ) import Algebra.Additive (zero, (-), ) @@ -91,4 +91,4 @@    -> [a]    -> [b]    -> [c]-zipWith = NPList.zipWithMatch+zipWith = NPList.zipWithChecked

src/NumericPrelude/List/Generic.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {- | Functions that are counterparts of the @generic@ functions in "Data.List" using NumericPrelude.Numeric type classes.

src/NumericPrelude/Numeric.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module NumericPrelude.Numeric (     {- Additive -} (+), (-), negate, zero, subtract, sum, sum1,     {- ZeroTestable -} isZero,

+ test-ghc-6.12/Gaussian.hs view

@@ -0,0 +1,6 @@+module Main where++import qualified MathObj.Gaussian.Example as Example++main :: IO ()+main = Example.polyApprox

+ test-ghc-6.12/Test.hs view

@@ -0,0 +1,173 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Main where++import Number.Complex((+:), (-:), )+import qualified Number.Complex as Complex+import Number.Physical      as Value+import Number.SI            as SIValue -- units+import Number.SI.Unit       as SIUnit  -- unit prefixes+          (pico, nano, micro, milli, centi, deci,+           deca, hecto, kilo, mega, giga, tera, peta)+import Number.OccasionallyScalarExpression as Expr++import qualified Number.Positional.Check  as Absolute+import qualified Number.FixedPoint.Check  as FixedPoint+import qualified Number.ResidueClass.Func as ResidueClass+import qualified Number.Peano             as Peano++import qualified MathObj.Polynomial          as Polynomial+import qualified MathObj.LaurentPolynomial   as LaurentPolynomial+import qualified MathObj.PowerSeries         as PowerSeries+import qualified MathObj.PowerSeries.Example as PowerSeriesExample+import qualified MathObj.PartialFraction     as PartialFraction++import qualified Algebra.PrincipalIdealDomain as PID+import qualified Algebra.Field                as Field+import qualified Algebra.ZeroTestable         as ZeroTestable+import qualified Algebra.Indexable            as Indexable++import Data.List (genericTake, genericLength)++import NumericPrelude.Base+import NumericPrelude.Numeric+++{- * Physical units -}++-- some shorthands for common usage+type SIDouble  = SIValue.T Double Double+type SIComplex = SIValue.T Double (Complex.T Double)++{- this advice seems not to be targeted to ghc's interactive mode+default (SIDouble)+-}+++++test :: [SIDouble]+test =+   let lengthScales = map (\n->10^-n*meter) [-10..6]+       areaScales = map (\n->10^-n*meter^2) [-10..6]+   in  lengthScales ++ map recip lengthScales +++       areaScales   ++ map recip areaScales +++       map ((meter*gramm/second)^-) [-5..5] +++       take 16 (iterate (10*) (10e-10*meter/gramm)) +++       [1/meter^2, 1/meter, meter, meter^2,+        second, hertz,+        meter*second, second/meter, meter/second, 1/meter/second,+        volt/meter,newton/meter,+        gramm]++testComplex :: SIComplex+testComplex = (2 :: Double) *> (SIValue.fromScalarSingle (3+:4)*milli*second)++testMagnitude :: SIDouble+testMagnitude = SIValue.lift (Value.lift Complex.magnitude) testComplex++testExpr :: Expr.T Double SIDouble+testExpr = sin (5 / (3+1) * fromValue meter)++testPrefixes :: [SIDouble]+testPrefixes =+   [pico, nano, micro, milli, centi, deci,+    deca, hecto, kilo, mega, giga, tera, peta]+++{- * Reals -}++testReal :: String+testReal = Absolute.defltShow (sqrt 2 + log 2 * pi)++testComplexReal :: Complex.T Absolute.T+testComplexReal = exp (0 +: pi) + exp (0 -: pi)++showReal :: Absolute.T -> String+showReal = Absolute.defltShow+++{- * Fixed point numbers -}++testFixedPoint :: String+testFixedPoint = FixedPoint.defltShow (sqrt 2 + log 2 * pi)++showFixedPoint :: FixedPoint.T -> String+showFixedPoint = FixedPoint.defltShow+++{- * Residue classes -}++testResidueClass :: Integer+testResidueClass = ResidueClass.concrete 7 (5*3/2)++polyResidueClass :: (ZeroTestable.C a, Field.C a) =>+   [a] -> ResidueClass.T (Polynomial.T a)+polyResidueClass = ResidueClass.fromRepresentative . polynomial++{- That's strange:+The residue class implementation should constantly compute mod+and thus should be much faster.+I assume that this is an effect of missing sharing.+The functions which represent a residue class are shared,+but not their values.++*Main> mod (3^3000000) 2 :: Integer+1+(2.47 secs, 24541080 bytes)+*Main> ResidueClass.concrete 2 (3^3000000) :: Integer+1+(7.33 secs, 515047072 bytes)+-}+++{- * Polynomials and power series -}++polynomial :: [a] -> Polynomial.T a+polynomial = Polynomial.fromCoeffs++powerSeries :: [a] -> PowerSeries.T a+powerSeries = PowerSeries.fromCoeffs++laurentPolynomial :: Int -> [a] -> LaurentPolynomial.T a+laurentPolynomial = LaurentPolynomial.fromShiftCoeffs++tanSeries :: PowerSeries.T Rational+tanSeries = powerSeries PowerSeriesExample.tan+++{- * Partial fractions -}++partialFraction :: (PID.C a, Indexable.C a) =>+   [a] -> a -> PartialFraction.T a+partialFraction = PartialFraction.fromFactoredFraction++{- |+An example from wavelet theory: lifting coefficients of the CDF wavelet family.+-}+cdfFraction :: PartialFraction.T (Polynomial.T Rational)+cdfFraction =+   partialFraction+      (map polynomial [[-4,1],[0,1],[4,1]])+      (product (map polynomial [[-2,1],[2,1]]))++{- |+The same example with different notation,+that relies on numerical literals being used for polynomials.+-}+cdfFractionNum :: PartialFraction.T (Polynomial.T Rational)+cdfFractionNum =+   let x = polynomial [0,1]+   in  partialFraction [x-4,x,x+4] ((x-2)*(x+2))+++{- * Peano numbers -}+testPeano :: Peano.T+testPeano = minimum [Peano.infinity, 2, Peano.infinity, 4]++testPeanoList :: [Char]+testPeanoList =+   genericTake (genericLength (repeat 'a') :: Peano.T) ['a'..'z']+++main :: IO ()+main = print test

+ test-ghc-6.12/Test/Algebra/IntegralDomain.hs view

@@ -0,0 +1,41 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Test.Algebra.IntegralDomain where++import Algebra.IntegralDomain (roundDown, roundUp, divUp, )++import Test.NumericPrelude.Utility (testUnit, )+import Test.QuickCheck (Testable, quickCheck, (==>), )+import qualified Test.HUnit as HUnit++import NumericPrelude.Base as P+import NumericPrelude.Numeric as NP+++test ::+   (Testable t) =>+   (Integer -> t) -> IO ()+test = quickCheck+++tests :: HUnit.Test+tests =+   HUnit.TestLabel "integral domain functions" $+   HUnit.TestList $+   map testUnit $+   testList++testList :: [(String, IO ())]+testList =+   ("divMod", test $ \n m ->+      m/=0 ==> let (q,r) = divMod n m in n == q*m+r) :+   ("divRound", test $ \n m ->+      m/=0 ==> div n m * m == roundDown n m) :+   ("divUpRound", test $ \n m ->+      m/=0 ==> divUp n m * m == roundUp n m) :+   ("floorLimit", test $ \n m0 ->+      let m = 1 + abs m0+          x = roundDown n m+      in  n-m < x && x <=n) :+   ("floorCeiling", test $ \n m ->+      m/=0 ==> - roundDown n m == roundUp (-n) m) :+   []

+ test-ghc-6.12/Test/Algebra/RealRing.hs view

@@ -0,0 +1,40 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Test.Algebra.RealRing where++import qualified Algebra.RealRing as RealRing++import Test.NumericPrelude.Utility (testUnit, )+import Test.QuickCheck (quickCheck, )+import qualified Test.HUnit as HUnit++import Data.Tuple.HT (mapFst, )++import NumericPrelude.Base as P+import NumericPrelude.Numeric as NP+++test :: (Eq a) => (Double -> a) -> (Double -> a) -> IO ()+test f g =+   quickCheck (\x -> f x == g x)+++tests :: HUnit.Test+tests =+   HUnit.TestLabel "rounding functions" $+   HUnit.TestList $+   map testUnit $+      ("round",         test RealRing.genericRound    (NP.round :: Double -> Integer)) :+      ("truncate",      test RealRing.genericTruncate (NP.truncate :: Double -> Integer)) :+      ("ceiling",       test RealRing.genericCeiling  (NP.ceiling :: Double -> Integer)) :+      ("floor",         test RealRing.genericFloor    (NP.floor :: Double -> Integer)) :+      ("fraction",      test RealRing.genericFraction (NP.fraction :: Double -> Double)) :+      ("splitFraction", test RealRing.genericSplitFraction (NP.splitFraction :: Double -> (Integer, Double))) :++{-+      ("splitFractionId", quickCheck (\x -> (x::Double) == (uncurry (+) $ mapFst fromInteger $ splitFraction x))) :+-}+      ("splitFractionId", quickCheck (\x ->  uncurry (==) $ mapFst (((x::Double)-) . fromInteger) $ splitFraction x)) :+      ("splitFractionFloorFraction", quickCheck (\x -> (floor (x::Double) :: Integer, fraction x) == splitFraction x)) :+      ("fractionBound", quickCheck (\x -> let y = fraction (x::Double) in 0<=y && y<1)) :+      ("floorCeiling", quickCheck (\x -> negate (floor (x::Double) :: Integer) == ceiling (-x))) :+      []

+ test-ghc-6.12/Test/MathObj/Gaussian/Bell.hs view

@@ -0,0 +1,96 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+module Test.MathObj.Gaussian.Bell where++import qualified MathObj.Gaussian.Bell as G++-- import qualified Algebra.Ring           as Ring++import qualified Algebra.Laws as Laws++import qualified Number.Complex as Complex++import Test.NumericPrelude.Utility (testUnit)+import Test.QuickCheck (Testable, quickCheck, (==>))+import qualified Test.HUnit as HUnit++import Data.Function.HT (nest, )++import NumericPrelude.Base as P+import NumericPrelude.Numeric as NP+++simple ::+   (Testable t) =>+   (G.T Rational -> t) -> IO ()+simple f =+   quickCheck (\x -> f (x :: G.T Rational))++tests :: HUnit.Test+tests =+   HUnit.TestLabel "polynomial" $+   HUnit.TestList $+   map testUnit $+{-+      ("convolution, dirac",+          simple $ Laws.identity (+) zero) :+-}+      ("convolution, commutative",+          simple $ Laws.commutative G.convolve) :+      ("convolution, associative",+          simple $ Laws.associative G.convolve) :+      ("multiplication, one",+          simple $ Laws.identity G.multiply G.constant) :+      ("multiplication, commutative",+          simple $ Laws.commutative G.multiply) :+      ("multiplication, associative",+          simple $ Laws.associative G.multiply) :+      ("convolution, multplication, fourier",+          simple $ \x y ->+             G.fourier (G.convolve x y)+              == G.multiply (G.fourier x) (G.fourier y)) :+      ("convolution via translation",+          simple $ \x y ->+             G.convolve x y+              == G.convolveByTranslation x y) :+      ("convolution via fourier",+          simple $ \x y ->+             G.convolve x y+              == G.convolveByFourier x y) :+      ("fourier reverse",+          simple $ \x -> nest 2 G.fourier x == G.reverse x) :+      ("reverse identity",+          simple $ \x -> nest 2 G.reverse x == x) :+      ("fourier unit",+          quickCheck $ G.fourier G.unit == (G.unit :: G.T Rational)) :+      ("translate additive",+          simple $ \x a b ->+             G.translate a (G.translate b x) == G.translate (a+b) x) :+      ("translateComplex additive",+          simple $ \x a b ->+             G.translateComplex a (G.translateComplex b x) == G.translateComplex (a+b) x) :+      ("translateComplex real",+          simple $ \x a ->+             G.translateComplex (Complex.fromReal a) x == G.translate a x) :+      ("modulate additive",+          simple $ \x a b ->+             G.modulate a (G.modulate b x) == G.modulate (a+b) x) :+      ("commute translate modulate",+          simple $ \x a b ->+             G.modulate b (G.translate a x)+              == G.turn (a*b) (G.translate a (G.modulate b x))) :+      ("fourier translate",+          simple $ \x a ->+             G.fourier (G.translate a x)+              == G.modulate a (G.fourier x)) :+      ("dilate multiplicative",+          simple $ \x a b -> a>0 && b>0 ==>+             G.dilate a (G.dilate b x) == G.dilate (a*b) x) :+      ("dilate by shrink",+          simple $ \x a -> a>0 ==>+             G.shrink a x == G.dilate (recip a) x) :+      ("fourier dilate",+          simple $ \x a -> a>0 ==>+             G.fourier (G.dilate a x) == G.amplify a (G.shrink a (G.fourier x))) :+      []

+ test-ghc-6.12/Test/MathObj/Gaussian/Polynomial.hs view

@@ -0,0 +1,158 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+module Test.MathObj.Gaussian.Polynomial where++import qualified MathObj.Gaussian.Polynomial as G+import qualified MathObj.Gaussian.Bell as B++import qualified MathObj.Polynomial as Poly++-- import qualified Algebra.Ring           as Ring++import qualified Algebra.Laws as Laws++import qualified Number.Complex as Complex++import Test.NumericPrelude.Utility (testUnit)+import Test.QuickCheck (Testable, quickCheck, (==>))+import qualified Test.HUnit as HUnit++import qualified Number.NonNegative as NonNeg+import Data.Function.HT (nest, )+import Data.Tuple.HT (mapSnd, )++-- import Debug.Trace (trace, )++import NumericPrelude.Base as P+import NumericPrelude.Numeric as NP+++simple ::+   (Testable t) =>+   (G.T Rational -> t) -> IO ()+simple f =+   quickCheck (\x -> f (x :: G.T Rational))++tests :: HUnit.Test+tests =+   HUnit.TestLabel "polynomial" $+   HUnit.TestList $+   map testUnit $+   testList++testList :: [(String, IO ())]+testList =+{-+      ("convolution, dirac",+          simple $ Laws.identity (+) zero) :+-}+      ("convolution, commutative",+          simple $ Laws.commutative G.convolve) :+--          simple $ \x -> Laws.commutative G.convolve (trace (show x) x)) :+      ("convolution, associative",+          simple $ Laws.associative G.convolve) :+{-+      ("convolution by differentiation vs. fourier",+          simple $ \x y ->+             G.convolveByDifferentiation x y+              == G.convolveByFourier x y) :+-}+      ("multiplication, one",+          simple $ Laws.identity G.multiply G.constant) :+      ("multiplication, commutative",+          simple $ Laws.commutative G.multiply) :+      ("multiplication, associative",+          simple $ Laws.associative G.multiply) :+      ("convolution, multplication, fourier",+          simple $ \x y ->+             G.fourier (G.convolve x y)+              == G.multiply (G.fourier x) (G.fourier y)) :+      ("fourier reverse",+          simple $ \x -> nest 2 G.fourier x == G.reverse x) :+      ("reverse identity",+          simple $ \x -> nest 2 G.reverse x == x) :+      ("fourier eigenfunction differential",+          quickCheck $ \m ->+             m <= 15 ==>+                let n = NonNeg.toNumber m+                    x = G.eigenfunctionDifferential n :: G.T Rational+                    k = Complex.conjugate Complex.imaginaryUnit ^ fromIntegral n+                in  G.fourier x  ==  G.scaleComplex k x) :+      ("fourier eigenfunction iterative",+          quickCheck $ \m ->+             m <= 15 ==>+                let n = NonNeg.toNumber m+                    x = G.eigenfunctionIterative n :: G.T Rational+                    k = Complex.conjugate Complex.imaginaryUnit ^ fromIntegral n+                in  G.fourier x  ==  G.scaleComplex k x) :+{- this does not hold, both functions compute different eigenbases+      ("fourier eigenfunction diff vs. iterative",+          quickCheck $ \n ->+             n <= 15 ==>+                G.eigenfunctionDifferential n ==+                (G.eigenfunctionIterative n :: G.T Rational)) :+-}+      ("translate additive",+          simple $ \x a b ->+             G.translate a (G.translate b x) == G.translate (a+b) x) :+      ("translateComplex additive",+          simple $ \x a b ->+             G.translateComplex a (G.translateComplex b x) == G.translateComplex (a+b) x) :+      ("translateComplex real",+          simple $ \x a ->+             G.translateComplex (Complex.fromReal a) x == G.translate a x) :+      ("modulate additive",+          simple $ \x a b ->+             G.modulate a (G.modulate b x) == G.modulate (a+b) x) :+      ("commute translate modulate",+          simple $ \x a b ->+             G.modulate b (G.translate a x)+              == G.turn (a*b) (G.translate a (G.modulate b x))) :+      ("fourier translate",+          simple $ \x a ->+             G.fourier (G.translate a x)+              == G.modulate a (G.fourier x)) :+      ("dilate multiplicative",+          simple $ \x a b -> a>0 && b>0 ==>+             G.dilate a (G.dilate b x) == G.dilate (a*b) x) :+      ("dilate by shrink",+          simple $ \x a -> a>0 ==>+             G.shrink a x == G.dilate (recip a) x) :+      ("fourier dilate",+          simple $ \x a -> a>0 ==>+             G.fourier (G.dilate a x) == G.amplify a (G.shrink a (G.fourier x))) :+      ("integrate differentiate",+          simple $ \x ->+             G.integrate (G.differentiate x) == (zero, x)) :+      ("differentiate integrate",+          simple $ \x@(G.Cons b p) ->+             let (xoff,xint) = G.integrate x+             in  G.differentiate xint == G.Cons b (p + Poly.const xoff)) :+      ("fourier differentiate",+          simple $ \x ->+             G.fourier (G.differentiate x) ==+              let y = G.fourier x+              in  y{G.polynomial =+                      Poly.fromCoeffs [0, 0 Complex.+: 2] * G.polynomial y}) :+      ("differentiate convolve",+          simple $ \x y ->+             G.convolve (G.differentiate x) y ==+             G.convolve x (G.differentiate y)) :+      ("approximate by bells, translate",+          simple $ \x unit d -> unit/=0 ==>+             G.approximateByBells unit (G.translateComplex d x) ==+             map (mapSnd (B.translateComplex d)) (G.approximateByBells unit x)) :+      ("approximate by bells, dilate",+          simple $ \x unit d -> unit/=0 && d/=0 ==>+             G.approximateByBells unit (G.dilate d x) ==+             map (mapSnd (B.dilate d)) (G.approximateByBells (unit/d) x)) :+      ("approximate by bells, shrink",+          simple $ \x unit d -> unit/=0 && d/=0 ==>+             G.approximateByBells unit (G.shrink d x) ==+             map (mapSnd (B.shrink d)) (G.approximateByBells (unit*d) x)) :+      ("approximate by bells, different implementations",+          quickCheck $ \unit d s p -> unit/=0 ==>+             G.approximateByBellsAtOnce unit d s (p::Poly.T (Complex.T Rational)) ==+             G.approximateByBellsByTranslation unit d s p) :+      []

+ test-ghc-6.12/Test/MathObj/Gaussian/Variance.hs view

@@ -0,0 +1,198 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+module Test.MathObj.Gaussian.Variance where++import qualified MathObj.Gaussian.Variance as G+import qualified Number.Root as Root++-- import qualified Algebra.Ring           as Ring++import qualified Algebra.Laws as Laws++import Test.NumericPrelude.Utility (testUnit)+import Test.QuickCheck (Testable, quickCheck, (==>), Arbitrary, arbitrary, )+import qualified Test.HUnit as HUnit++import Control.Monad (liftM2, liftM3, )++import Data.Function.HT (nest, compose2, )++import NumericPrelude.Base as P+import NumericPrelude.Numeric as NP+++newtype PositiveInteger = PositiveInteger Integer+   deriving Show++instance Arbitrary PositiveInteger where+   arbitrary =+      fmap (\p -> PositiveInteger $ 1 + abs p) arbitrary+++{- |+For @(HoelderConjugates p q)@ it holds++> 1/p + 1/q = 1+-}+data HoelderConjugates = HoelderConjugates Rational Rational+   deriving Show++instance Arbitrary HoelderConjugates where+   arbitrary = liftM2+      (\(PositiveInteger p) (PositiveInteger q) ->+         let s  = 1%p + 1%q+         in  HoelderConjugates (fromInteger p * s) (fromInteger q * s))+      arbitrary arbitrary++{- |+For @(YoungConjugates p q r)@ it holds++> 1/p + 1/q = 1/r + 1+-}+data YoungConjugates = YoungConjugates Rational Rational Rational+   deriving Show++{-+Find positive natural numbers @a, b, c, d@ with++> a + b = c + d++and++> d >= a, d >= b, d >= c++then set++> p=d/a, q=d/b, r=d/c+++a+b<=c+b+c<=a+->  2b <= 0+-}+instance Arbitrary YoungConjugates where+   arbitrary = liftM3+      (\(PositiveInteger a0) (PositiveInteger b0) (PositiveInteger c0) ->+         let guardSwap cond (x,y) =+                if cond x y then (x,y) else (y,x)+             {-+             If a+b<=c, then from b>0 it follows a<c and thus c+b>a.+             Swapping a and c is enough and we have not to consider more cases.+             -}+             (a1,c1) = guardSwap (\a c -> a+b0>c) (a0,c0)+             b1 = b0+             d1 = a1+b1-c1+             ((a2,b2),(c2,d2)) =+                guardSwap (compose2 (<=) snd)+                   (guardSwap (<=) (a1,b1),+                    guardSwap (<=) (c1,d1))+         in  YoungConjugates (d2%a2) (d2%b2) (d2%c2))+      arbitrary arbitrary arbitrary+++simple ::+   (Testable t) =>+   (G.T Rational -> t) -> IO ()+simple f =+   quickCheck (\x -> f (x :: G.T Rational))++tests :: HUnit.Test+tests =+   HUnit.TestLabel "variance" $+   HUnit.TestList $+   map testUnit $+   testList++testList :: [(String, IO ())]+testList =+{-+      ("convolution, dirac",+          simple $ Laws.identity (+) zero) :+-}+      ("convolution, commutative",+          simple $ Laws.commutative G.convolve) :+      ("convolution, associative",+          simple $ Laws.associative G.convolve) :+      ("multiplication, one",+          simple $ Laws.identity G.multiply G.constant) :+      ("multiplication, commutative",+          simple $ Laws.commutative G.multiply) :+      ("multiplication, associative",+          simple $ Laws.associative G.multiply) :+      ("convolution via fourier",+          simple $ \x y ->+             G.fourier (G.convolve x y)+              == G.multiply (G.fourier x) (G.fourier y)) :+      ("fourier identity",+          simple $ \x -> nest 4 G.fourier x == x) :+      ("dilate multiplicative",+          simple $ \x a b -> a>0 && b>0 ==>+             G.dilate a (G.dilate b x) == G.dilate (a*b) x) :+      ("dilate by shrink",+          simple $ \x a -> a>0 ==>+             G.shrink a x == G.dilate (recip a) x) :+      ("fourier dilate",+          simple $ \x a -> a>0 ==>+             G.fourier (G.dilate a x) == G.amplify a (G.shrink a (G.fourier x))) :+      ("norm1 vs. normP 1",+          simple $ \x -> G.norm1Root x == G.normPRoot 1 x) :+      ("norm2 vs. normP 2",+          simple $ \x -> G.norm2Root x == G.normPRoot 2 x) :+{-+I would have liked to test for a monotony of norms.+Unfortunately, it does not hold.++Means contain a division by the size of the domain.+Norms do not have this division.+Means are monotonic with respect to the degree.+Norms are not.+We cannot turn the norms into means since the size of the domain+(the complete real axis) is infinitely large.+      ("norm monotony",+          simple $ \x p0 q0 ->+             let p = 1 + abs p0+                 q = 1 + abs q0+             in  case compare p q of+                    EQ -> G.normPRoot p x == G.normPRoot q x+                    LT -> G.normPRoot p x <= G.normPRoot q x+                    GT -> G.normPRoot p x >= G.normPRoot q x) :++This should also fail,+but QuickCheck does not seem to try counterexamples.+      ("infinity norm upper bound",+          simple $ \x p0 ->+             let p = 1 + abs p0+             in  G.normPRoot p x <= G.normInfRoot x) :+-}+      ("Cauchy-Schwarz inequality",+          simple $ \x y ->+             G.norm1Root (G.multiply x y)+                <= G.norm2Root x `Root.mul` G.norm2Root y) :+      ("Hoelder conjugates",+          quickCheck $ \(HoelderConjugates p q) ->+             p>=1 && q>=1 && 1/p + 1/q == 1) :+      ("Hoelder inequality with infinity norm",+          simple $ \x y ->+             G.norm1Root (G.multiply x y)+                <= G.norm1Root x `Root.mul` G.normInfRoot y) :+      ("Hoelder inequality",+          simple $ \x y (HoelderConjugates p q) ->+             G.norm1Root (G.multiply x y)+                <= G.normPRoot p x `Root.mul` G.normPRoot q y) :+      ("Young inequality with two infinity norms",+          simple $ \x y ->+             G.normInfRoot (G.convolve x y)+                <= G.norm1Root x `Root.mul` G.normInfRoot y) :+      ("Young inequality with infinity norm",+          simple $ \x y (HoelderConjugates p q) ->+             G.normInfRoot (G.convolve x y)+                <= G.normPRoot p x `Root.mul` G.normPRoot q y) :+      ("Young conjugates",+          quickCheck $ \(YoungConjugates p q r) ->+             p>=1 && q>=1 && r>=1 && 1/p + 1/q == 1/r + 1) :+      ("Young inequality",+          simple $ \x y (YoungConjugates p q r) ->+             G.normPRoot r (G.convolve x y)+                <= G.normPRoot p x `Root.mul` G.normPRoot q y) :+      []

+ test-ghc-6.12/Test/MathObj/Matrix.hs view

@@ -0,0 +1,103 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+module Test.MathObj.Matrix where++import qualified MathObj.Matrix as Matrix++import qualified Algebra.Ring           as Ring++import qualified Algebra.Laws as Laws++import qualified Number.NonNegative as NonNeg++import qualified System.Random as Random++import Data.Function.HT (nest, )++import Test.NumericPrelude.Utility (testUnit, )+import Test.QuickCheck (quickCheck, )+import qualified Test.HUnit as HUnit+++import NumericPrelude.Base as P+import NumericPrelude.Numeric as NP+++type Seed = Int+type Dimension = NonNeg.Int++random :: Dimension -> Dimension -> Seed -> Matrix.T Integer+random mn nn seed =+   fst $+   Matrix.random (NonNeg.toNumber mn) (NonNeg.toNumber nn) $+   Random.mkStdGen seed+++tests :: HUnit.Test+tests =+   HUnit.TestLabel "matrix" $+   HUnit.TestList $+   map testUnit $+      ("dimension",+          quickCheck (\m n a ->+             (NonNeg.toNumber m, NonNeg.toNumber n) == Matrix.dimension (random m n a))) :+      ("to and from rows",+          quickCheck (\m n a' ->+             let a = random m n a'+             in  a == Matrix.fromRows (NonNeg.toNumber m) (NonNeg.toNumber n) (Matrix.rows a))) :+      ("to and from columns",+          quickCheck (\m n a' ->+             let a = random m n a'+             in  a == Matrix.fromColumns (NonNeg.toNumber m) (NonNeg.toNumber n) (Matrix.columns a))) :+      ("transpose, rows, columns",+          quickCheck (\m n a' ->+             let a = random m n a'+             in  Matrix.rows a == Matrix.columns (Matrix.transpose a))) :+      ("transpose, columns, rows",+          quickCheck (\m n a' ->+             let a = random m n a'+             in  Matrix.columns a == Matrix.rows (Matrix.transpose a))) :+      ("addition, zero",+          quickCheck (\m n a ->+             Laws.identity (+) (Matrix.zero (NonNeg.toNumber m) (NonNeg.toNumber n)) (random m n a))) :+      ("addition, commutative",+          quickCheck (\m n a b ->+             Laws.commutative (+) (random m n a) (random m n b))) :+      ("addition, associative",+          quickCheck (\m n a b c ->+             Laws.associative (+) (random m n a) (random m n b) (random m n c))) :+      ("addition, transpose",+          quickCheck (\m n a b ->+             Laws.homomorphism Matrix.transpose (+) (+) (random m n a) (random m n b))) :+      ("one, diagonal",+          quickCheck (\n' ->+             let n = NonNeg.toNumber n'+             in Matrix.one n == (Matrix.diagonal $ replicate n Ring.one :: Matrix.T Integer))) :+      ("multiplication, one left",+          quickCheck (\m n a ->+             Laws.leftIdentity  (*) (Matrix.one (NonNeg.toNumber m)) (random m n a))) :+      ("multiplication, one right",+          quickCheck (\m n a ->+             Laws.rightIdentity (*) (Matrix.one (NonNeg.toNumber n)) (random m n a))) :+      ("multiplication, associative",+          quickCheck (\k l m n a b c ->+             Laws.associative (*) (random k l a) (random l m b) (random m n c))) :+      ("multiplication and addition, distributive left",+          quickCheck (\l m n a b c ->+             Laws.leftDistributive (*) (+) (random n l a) (random m n b) (random m n c))) :+      ("multiplication and addition, distributive right",+          quickCheck (\l m n a b c ->+             Laws.rightDistributive (*) (+) (random l m a) (random m n b) (random m n c))) :+      ("multiplication, transpose",+          quickCheck (\l m n a b ->+             Laws.homomorphism Matrix.transpose (*) (flip (*)) (random l m a) (random m n b))) :+      ("multiplication vs. power",+          quickCheck (\m a n0 ->+             let x = random m m a+                 n = mod n0 10+             in  x^n == nest (fromInteger n) (x*) (Matrix.one (NonNeg.toNumber m)))) :+{-+      ("division",       quickCheck (\x -> Integral.propInverse (x :: Poly.T Rational))) :+-}+      []

+ test-ghc-6.12/Test/MathObj/PartialFraction.hs view

@@ -0,0 +1,205 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+module Test.MathObj.PartialFraction where++import qualified MathObj.PartialFraction      as PartialFraction+import qualified MathObj.Polynomial           as Poly+import qualified Number.Ratio                 as Ratio++import qualified Algebra.PrincipalIdealDomain as PID+-- import qualified Algebra.Ring                 as Ring+import qualified Algebra.Indexable            as Indexable+import qualified Algebra.Vector               as Vector+-- import Algebra.Vector((*>))++import qualified Algebra.Laws as Laws+import qualified Test.QuickCheck as QC++import Control.Monad.HT as M+import Test.NumericPrelude.Utility (testUnit)+import Test.QuickCheck (quickCheck)+import qualified Test.HUnit as HUnit+++import NumericPrelude.Base as P+import NumericPrelude.Numeric as NP+++{- * Properties for generic types -}++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 :: (PID.C a, Indexable.C a) => PartialFraction.T a -> PartialFraction.T a -> Bool+add = Laws.homomorphism PartialFraction.toFraction (+) (+)++sub :: (PID.C a, Indexable.C a) => PartialFraction.T a -> PartialFraction.T a -> Bool+sub = Laws.homomorphism PartialFraction.toFraction (-) (-)++mul :: (PID.C a, Indexable.C a) => PartialFraction.T a -> PartialFraction.T a -> Bool+mul = Laws.homomorphism PartialFraction.toFraction (*) (*)++++{- * Properties for Integers -}++{- |+Arbitrary instance of that type generates 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.+-}+newtype SmallPrime = SmallPrime {intFromSmallPrime :: Integer}++type IntFraction = ([SmallPrime],Integer)++instance QC.Arbitrary SmallPrime where+   arbitrary =+      let primes = [2,3,5,7,11,13]+      in  fmap SmallPrime $ QC.elements (primes ++ map negate primes)++instance Show SmallPrime where+   show = show . intFromSmallPrime+++fractionConvInt :: [SmallPrime] -> Integer -> Bool+fractionConvInt =+   fractionConv . map intFromSmallPrime++fractionConvAltInt :: [SmallPrime] -> Integer -> Bool+fractionConvAltInt =+   fractionConvAlt . map intFromSmallPrime++fromSmallPrimes :: IntFraction -> PartialFraction.T Integer+fromSmallPrimes (xs,y) =+   PartialFraction.fromFactoredFraction (map intFromSmallPrime xs) y+++scaleIntInt :: Integer -> IntFraction -> Bool+scaleIntInt k a =+   scaleInt k (fromSmallPrimes a)++addInt :: IntFraction -> IntFraction -> Bool+addInt q0 q1 =+   add+      (fromSmallPrimes q0)+      (fromSmallPrimes q1)++subInt :: IntFraction -> IntFraction -> Bool+subInt q0 q1 =+   sub+      (fromSmallPrimes q0)+      (fromSmallPrimes q1)++mulInt :: IntFraction -> IntFraction -> Bool+mulInt q0 q1 =+   mul+      (fromSmallPrimes q0)+      (fromSmallPrimes q1)+++intTests :: HUnit.Test+intTests =+   HUnit.TestLabel "integer" $+   HUnit.TestList $+   map testUnit $+      ("conversion between partial and ordinary fraction", quickCheck fractionConvInt) :+      ("two conversion routines from factored fractions", quickCheck fractionConvAltInt) :+      ("integer scaling", quickCheck scaleIntInt) :+      ("addition", quickCheck addInt) :+      ("subtraction", quickCheck subInt) :+      ("multiplication", quickCheck mulInt) :+      []+++{- * Properties for Polynomials -}++newtype IrredPoly = IrredPoly {polyFromIrredPoly :: Poly.T Rational}++type RatPolynomial = Poly.T Rational+type PolyFraction = ([IrredPoly],RatPolynomial)++instance QC.Arbitrary IrredPoly where+   arbitrary =+      do poly <- QC.elements (map Poly.fromCoeffs [[2,3],[2,0,1],[3,0,1],[1,-3,0,1]])+         unit <- M.until (not. isZero) QC.arbitrary+         return (IrredPoly (unit Vector.*> poly))++instance Show IrredPoly where+   show = show . polyFromIrredPoly+++fractionConvPoly :: [IrredPoly] -> RatPolynomial -> Bool+fractionConvPoly =+   fractionConv . map polyFromIrredPoly++fractionConvAltPoly :: [IrredPoly] -> RatPolynomial -> Bool+fractionConvAltPoly =+   fractionConvAlt . map polyFromIrredPoly++fromIrredPolys :: PolyFraction -> PartialFraction.T RatPolynomial+fromIrredPolys (xs,y) =+   PartialFraction.fromFactoredFraction (map polyFromIrredPoly xs) y+++scaleIntPoly :: RatPolynomial -> PolyFraction -> Bool+scaleIntPoly k a =+   scaleInt k (fromIrredPolys a)++addPoly :: PolyFraction -> PolyFraction -> Bool+addPoly q0 q1 =+   add+      (fromIrredPolys q0)+      (fromIrredPolys q1)++subPoly :: PolyFraction -> PolyFraction -> Bool+subPoly q0 q1 =+   sub+      (fromIrredPolys q0)+      (fromIrredPolys q1)++mulPoly :: PolyFraction -> PolyFraction -> Bool+mulPoly q0 q1 =+   mul+      (fromIrredPolys q0)+      (fromIrredPolys q1)++++polyTests :: HUnit.Test+polyTests =+   HUnit.TestLabel "polynomial" $+   HUnit.TestList $+   map testUnit $+{- this test fails, because addition may result in leading zero coefficients,+      that is, polynomial addition does not contain a normalization+      if it would contain one, we would exclude computable reals -}+-- wrong     ("conversion between partial and ordinary fraction", quickCheck fractionConvPoly) :+-- wrong     ("two conversion routines from factored fractions", quickCheck fractionConvAltPoly) :+-- too slow      ("integer scaling", quickCheck scaleIntPoly) :+-- too slow      ("addition", quickCheck addPoly) :+-- too slow      ("subtraction", quickCheck subPoly) :+-- too slow      ("multiplication", quickCheck mulPoly) :+      []+++tests :: HUnit.Test+tests =+   HUnit.TestLabel "partial fraction" $+   HUnit.TestList $+      intTests :+--      polyTests :+      []

+ test-ghc-6.12/Test/MathObj/Polynomial.hs view

@@ -0,0 +1,56 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Test.MathObj.Polynomial where++import qualified MathObj.Polynomial      as Poly+import qualified MathObj.Polynomial.Core as PolyCore++import qualified Algebra.IntegralDomain as Integral+import qualified Algebra.Ring           as Ring++import qualified Algebra.ZeroTestable   as ZeroTestable+import qualified Algebra.Laws as Laws++import qualified Data.List as List++import Test.NumericPrelude.Utility (testUnit)+import Test.QuickCheck (Property, quickCheck, (==>), Testable, )+import qualified Test.HUnit as HUnit+++import NumericPrelude.Base as P+import NumericPrelude.Numeric as NP+++tensorProductTranspose :: (Ring.C a, Eq a) => [a] -> [a] -> Property+tensorProductTranspose xs ys =+   not (null xs) && not (null ys) ==>+      PolyCore.tensorProduct xs ys == List.transpose (PolyCore.tensorProduct ys xs)+++mul :: (Ring.C a, Eq a, ZeroTestable.C a) => [a] -> [a] -> Bool+mul xs ys  =  PolyCore.equal (PolyCore.mul xs ys) (PolyCore.mulShear xs ys)+++test :: Testable a => (Poly.T Integer -> a) -> IO ()+test = quickCheck++testRat :: Testable a => (Poly.T Rational -> a) -> IO ()+testRat = quickCheck+++tests :: HUnit.Test+tests =+   HUnit.TestLabel "polynomial" $+   HUnit.TestList $+   map testUnit $+      ("tensor product", quickCheck (tensorProductTranspose :: [Integer] -> [Integer] -> Property)) :+      ("mul speed",      quickCheck (mul                    :: [Integer] -> [Integer] -> Bool)) :+      ("addition, zero",         test (Laws.identity (+) zero)) :+      ("addition, commutative",  test (Laws.commutative (+))) :+      ("addition, associative",  test (Laws.associative (+))) :+      ("multiplication, one",          test (Laws.identity (*) one)) :+      ("multiplication, commutative",  test (Laws.commutative (*))) :+      ("multiplication, associative",  test (Laws.associative (*))) :+      ("multiplication and addition, distributive",   test (Laws.leftDistributive (*) (+))) :+      ("division",       testRat (Integral.propInverse)) :+      []

+ test-ghc-6.12/Test/MathObj/PowerSeries.hs view

@@ -0,0 +1,103 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+module Test.MathObj.PowerSeries where++import qualified MathObj.PowerSeries.Core    as PS+import qualified MathObj.PowerSeries.Example as PSE++import Test.NumericPrelude.Utility (equalInfLists {- , testUnit -} )+-- import Test.QuickCheck (Property, quickCheck, (==>))+import qualified Test.HUnit as HUnit+++import NumericPrelude.Base as P+import NumericPrelude.Numeric as NP+++identitiesExplODE, identitiesSeriesFunction, identitiesInverses ::+   [(String, Int, [Rational],[Rational])]++identitiesExplODE =+   ("exp",   500, PSE.expExpl,   PSE.expODE) :+   ("sin",   500, PSE.sinExpl,   PSE.sinODE) :+   ("cos",   500, PSE.cosExpl,   PSE.cosODE) :+   ("tan",    50, PSE.tanExpl,   PSE.tanODE) :+   ("tan",    50, PSE.tanExpl,   PSE.tanExplSieve) :+   ("tan",    50, PSE.tanODE,    PSE.tanODESieve) :+   ("log",   500, PSE.logExpl,   PSE.logODE) :+   ("asin",   50, PSE.asinODE,   snd (PS.inv PSE.sinODE)) :+   ("atan",  500, PSE.atanExpl,  PSE.atanODE) :+   ("sinh",  500, PSE.sinhExpl,  PSE.sinhODE) :+   ("cosh",  500, PSE.coshExpl,  PSE.coshODE) :+   ("atanh", 500, PSE.atanhExpl, PSE.atanhODE) :+   ("sqrt",  100, PSE.sqrtExpl,  PSE.sqrtODE) :+   []++identitiesSeriesFunction =+   ("exp",   500, PSE.expExpl,  PS.exp (\0 -> 1) [0,1]) :+   ("sin",   500, PSE.sinExpl,  PS.sin (\0 -> (0,1)) [0,1]) :+   ("cos",   500, PSE.cosExpl,  PS.cos (\0 -> (0,1)) [0,1]) :+   ("tan",    50, PSE.tanExpl,  PS.tan (\0 -> (0,1)) [0,1]) :+   ("sqrt",   50, PSE.sqrtExpl, PS.sqrt (\1 -> 1) [1,1]) :+   ("power", 500, PSE.powExpl (-1/3), PS.pow (\1 -> 1) (-1/3) [1,1]) :+   ("power",  50, PSE.powExpl (-1/3), PS.exp (\0 -> 1) (PS.scale (-1/3) PSE.log)) :+   ("log",   500, PSE.logExpl, PS.log (\1 -> 0) [1,1]) :+   ("asin",   50, PSE.asin, PS.asin (\1 -> 1) (\0 -> 0) [0,1]) :+ --  ("acos",  50, PSE.acos, PS.acos (\1 -> 1) (\0 -> pi/2) [0,1]) :+   ("atan",  500, PSE.atan, PS.atan (\0 -> 0) [0,1]) :+   []++identitiesInverses =+   ("exp",   100, 1:1:repeat 0, PS.exp  (\0 -> 1) PSE.log) :+   ("log",   100, 0:1:repeat 0, PS.log  (\1 -> 0) PSE.exp) :+   ("tan",    50, 0:1:repeat 0, PS.tan  (\0 -> (0,1)) PSE.atan) :+   ("atan",   50, 0:1:repeat 0, PS.atan (\0 -> 0) PSE.tan) :+   ("sin",    50, 0:1:repeat 0, PS.sin  (\0 -> (0,1)) PSE.asin) :+   ("asin",  100, 0:1:repeat 0, PS.asin (\1 -> 1) (\0 -> 0) PSE.sin) :+   ("sqrt",  500, 1:1:repeat 0, PS.sqrt (\1 -> 1) (PS.mul [1,1] [1,1])) :+   []++testSeriesIdentity :: (String, Int, [Rational], [Rational]) -> HUnit.Test+testSeriesIdentity (label, len, x, y) =+   HUnit.test (HUnit.assertBool label (equalInfLists len [x,y]))++testSeriesIdentities ::+   String -> [(String, Int, [Rational], [Rational])] -> HUnit.Test+testSeriesIdentities label ids =+   HUnit.TestLabel label $+     HUnit.TestList $ map testSeriesIdentity ids++checkSeriesIdentities ::+   [(String, Int, [Rational], [Rational])] -> [(String,Bool)]+checkSeriesIdentities =+   map (\(label, len, x, y) -> (label, equalInfLists len [x,y]))+++++powerMult :: Rational -> Rational -> Bool+powerMult exp0 exp1 =+   PS.mul (PSE.pow exp0) (PSE.pow exp1)  ==  PSE.pow (exp0+exp1)++powerExplODE :: Rational -> Bool+powerExplODE expon =+   PSE.powODE expon == PSE.powExpl expon+++tests :: HUnit.Test+tests =+   HUnit.TestLabel "power series" $+   HUnit.TestList [+      testSeriesIdentities "explicit vs. ODE solution" identitiesExplODE,+      testSeriesIdentities "transcendent functions of series" identitiesSeriesFunction,+      testSeriesIdentities "inverses of some series" identitiesInverses+{-+      HUnit.TestLabel "laws" $+      HUnit.TestList $+         map testUnit $+            ("products of powers",     quickCheck (powerMult)) :+            ("power explicit vs. ODE", quickCheck (powerExplODE)) :+            []+-}+    ]

+ test-ghc-6.12/Test/MathObj/RefinementMask2.hs view

@@ -0,0 +1,78 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Test.MathObj.RefinementMask2 where++import qualified MathObj.RefinementMask2 as Mask+import qualified Algebra.Differential    as D++import qualified MathObj.Polynomial      as Poly+import qualified MathObj.Polynomial.Core as PolyCore++import qualified Algebra.RealField      as RealField+import qualified Algebra.Ring           as Ring++import qualified Algebra.ZeroTestable   as ZeroTestable++import Data.Maybe (fromMaybe, )++import Test.NumericPrelude.Utility (testUnit)+import Test.QuickCheck (Property, quickCheck, (==>), Testable, )+import qualified Test.HUnit as HUnit+++import NumericPrelude.Base as P+import NumericPrelude.Numeric as NP++++hasMultipleZero :: (Ring.C a, Eq a) => Int -> a -> Poly.T a -> Bool+hasMultipleZero n x poly =+   all (zero==) $ take n $+   map (flip Poly.evaluate x) $+   iterate D.differentiate poly++inverse0 :: (RealField.C a) => Mask.T a -> Property+inverse0 mask0 =+   let (b,poly) =+          case Mask.toPolynomial mask0 of+             Just p -> (True, p)+             Nothing -> (False, error "RefinementMask2.inverse0: no admissible mask")+       mask1 = Mask.fromPolynomial poly+       maskD =+          Poly.fromCoeffs (Mask.coeffs mask1) -+          Poly.fromCoeffs (Mask.coeffs mask0)+   in  b ==>+          hasMultipleZero (fromMaybe 0 $ Poly.degree poly)+             1 maskD++truncatePolynomial :: (ZeroTestable.C a) => Int -> Poly.T a -> Poly.T a+truncatePolynomial n =+   Poly.fromCoeffs . PolyCore.normalize . take n . Poly.coeffs++inverse1 :: (RealField.C a) => Poly.T a -> Bool+inverse1 poly0 =+   case Mask.toPolynomial (Mask.fromPolynomial poly0) of+      Just poly1 -> Poly.collinear poly0 poly1+      Nothing -> False++refining :: (RealField.C a) => Poly.T a -> Bool+refining poly =+   poly == Mask.refinePolynomial (Mask.fromPolynomial poly) poly++++test :: Testable a => (Poly.T Integer -> a) -> IO ()+test = quickCheck++testRat :: Testable a => (Poly.T Rational -> a) -> IO ()+testRat = quickCheck+++tests :: HUnit.Test+tests =+   HUnit.TestLabel "refinement mask" $+   HUnit.TestList $+   map testUnit $+      ("inverse0", quickCheck (inverse0 :: Mask.T Rational -> Property)) :+      ("inverse1", quickCheck (inverse1 . truncatePolynomial 5 :: Poly.T Rational -> Bool)) :+      ("refining", quickCheck (refining . truncatePolynomial 5 :: Poly.T Rational -> Bool)) :+      []

+ test-ghc-6.12/Test/Number/ComplexSquareRoot.hs view

@@ -0,0 +1,50 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+module Test.Number.ComplexSquareRoot where++import qualified Number.ComplexSquareRoot as S+import qualified Number.Complex as Complex++-- import qualified Algebra.Ring           as Ring++import qualified Algebra.Laws as Laws++import Test.NumericPrelude.Utility (testUnit)+import Test.QuickCheck (Testable, quickCheck, (==>), )+import qualified Test.HUnit as HUnit++import NumericPrelude.Base as P+import NumericPrelude.Numeric as NP+++simple ::+   (Testable t) =>+   (S.T Rational -> t) -> IO ()+simple = quickCheck++tests :: HUnit.Test+tests =+   HUnit.TestLabel "complex square root" $+   HUnit.TestList $+   map testUnit $+   testList++testList :: [(String, IO ())]+testList =+   ("multiplication, one",+      simple $ Laws.identity S.mul S.one) :+   ("multiplication, commutative",+      simple $ Laws.commutative S.mul) :+   ("multiplication, associative",+      simple $ Laws.associative S.mul) :+   ("multiplication, homomorphism",+      quickCheck $ Laws.homomorphism S.fromNumber+         (\x y -> (x :: Complex.T Rational) * y) S.mul) :+   ("division, one",+      simple $ Laws.rightIdentity S.div S.one) :+   ("recip recip",+      simple $ \x -> not (isZero x) ==> S.recip (S.recip x) == x) :+   ("recip inverts multiplication",+      simple $ \x -> not (isZero x) ==> Laws.inverse S.mul S.recip S.one x) :+   []

+ test-ghc-6.12/Test/Number/GaloisField2p32m5.hs view

@@ -0,0 +1,37 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Test.Number.GaloisField2p32m5 where++import qualified Number.GaloisField2p32m5 as GF++import qualified Algebra.Laws as Laws++import Test.NumericPrelude.Utility (testUnit)+import Test.QuickCheck (Testable, quickCheck, (==>))+import qualified Test.HUnit as HUnit+++import NumericPrelude.Base as P+import NumericPrelude.Numeric as NP+++test :: Testable a => (GF.T -> a) -> IO ()+test = quickCheck+++tests :: HUnit.Test+tests =+   HUnit.TestLabel "galois field 2^32-5" $+   HUnit.TestList $+   map testUnit $+      ("addition, zero",         test (Laws.identity (+) zero)) :+      ("addition, commutative",  test (Laws.commutative (+))) :+      ("addition, associative",  test (Laws.associative (+))) :+      ("addition, negate",       test (Laws.inverse (+) negate zero)) :+      ("addition, subtract",     test (\x -> Laws.inverse (+) (x-) x)) :+      ("multiplication, one",          test (Laws.identity (*) one)) :+      ("multiplication, commutative",  test (Laws.commutative (*))) :+      ("multiplication, associative",  test (Laws.associative (*))) :+      ("multiplication, recip",        test (\y -> y /= 0 ==> Laws.inverse (*) recip one y)) :+      ("multiplication, division",     test (\y x -> y /= 0 ==> Laws.inverse (*) (x/) x y)) :+      ("multiplication and addition, distributive",   test (Laws.leftDistributive (*) (+))) :+      []

+ test-ghc-6.12/Test/NumericPrelude/Utility.hs view

@@ -0,0 +1,21 @@+-- cf. utility-ht Test.Utility+module Test.NumericPrelude.Utility where++import Data.List.HT (mapAdjacent, )+import qualified Data.List as List+import qualified Test.HUnit as HUnit+++testUnit :: (String, IO ()) -> HUnit.Test+testUnit (label, check) =+   HUnit.TestLabel label (HUnit.TestCase check)++-- compare the lists simultaneously+equalLists :: Eq a => [[a]] -> Bool+equalLists xs =+   let equalElems ys =+          and (mapAdjacent (==) ys)  &&  length xs == length ys+   in  all equalElems (List.transpose xs)++equalInfLists :: Eq a => Int -> [[a]] -> Bool+equalInfLists n xs = equalLists (map (take n) xs)

+ test-ghc-6.12/Test/Run.hs view

@@ -0,0 +1,34 @@+module Main where++import qualified Test.MathObj.RefinementMask2 as RefinementMask2+import qualified Test.Algebra.RealRing as RealRing+import qualified Test.Algebra.IntegralDomain as Integral+import qualified Test.MathObj.Gaussian.Polynomial as GaussPoly+import qualified Test.MathObj.Gaussian.Variance as GaussVariance+import qualified Test.MathObj.Gaussian.Bell as GaussBell+import qualified Test.MathObj.PartialFraction as PartialFraction+import qualified Test.MathObj.Matrix  as Matrix+import qualified Test.MathObj.Polynomial  as Polynomial+import qualified Test.MathObj.PowerSeries as PowerSeries+import qualified Test.Number.ComplexSquareRoot as CSqRt+import qualified Test.Number.GaloisField2p32m5 as GF+import qualified Test.HUnit.Text as HUnitText+import qualified Test.HUnit as HUnit++main :: IO ()+main =+   print =<<+      HUnitText.runTestTT (HUnit.TestList $+         RefinementMask2.tests :+         RealRing.tests :+         Integral.tests :+         GaussVariance.tests :+         GaussBell.tests :+         GaussPoly.tests :+         PartialFraction.tests :+         Matrix.tests :+         Polynomial.tests :+         PowerSeries.tests :+         CSqRt.tests :+         GF.tests :+         [])

test/Test.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Main where  import Number.Complex((+:), (-:), )

+ test/Test/Algebra/IntegralDomain.hs view

@@ -0,0 +1,41 @@+{-# LANGUAGE RebindableSyntax #-}+module Test.Algebra.IntegralDomain where++import Algebra.IntegralDomain (roundDown, roundUp, divUp, )++import Test.NumericPrelude.Utility (testUnit, )+import Test.QuickCheck (Testable, quickCheck, (==>), )+import qualified Test.HUnit as HUnit++import NumericPrelude.Base as P+import NumericPrelude.Numeric as NP+++test ::+   (Testable t) =>+   (Integer -> t) -> IO ()+test = quickCheck+++tests :: HUnit.Test+tests =+   HUnit.TestLabel "integral domain functions" $+   HUnit.TestList $+   map testUnit $+   testList++testList :: [(String, IO ())]+testList =+   ("divMod", test $ \n m ->+      m/=0 ==> let (q,r) = divMod n m in n == q*m+r) :+   ("divRound", test $ \n m ->+      m/=0 ==> div n m * m == roundDown n m) :+   ("divUpRound", test $ \n m ->+      m/=0 ==> divUp n m * m == roundUp n m) :+   ("floorLimit", test $ \n m0 ->+      let m = 1 + abs m0+          x = roundDown n m+      in  n-m < x && x <=n) :+   ("floorCeiling", test $ \n m ->+      m/=0 ==> - roundDown n m == roundUp (-n) m) :+   []

+ test/Test/Algebra/RealRing.hs view

@@ -0,0 +1,40 @@+{-# LANGUAGE RebindableSyntax #-}+module Test.Algebra.RealRing where++import qualified Algebra.RealRing as RealRing++import Test.NumericPrelude.Utility (testUnit, )+import Test.QuickCheck (quickCheck, )+import qualified Test.HUnit as HUnit++import Data.Tuple.HT (mapFst, )++import NumericPrelude.Base as P+import NumericPrelude.Numeric as NP+++test :: (Eq a) => (Double -> a) -> (Double -> a) -> IO ()+test f g =+   quickCheck (\x -> f x == g x)+++tests :: HUnit.Test+tests =+   HUnit.TestLabel "rounding functions" $+   HUnit.TestList $+   map testUnit $+      ("round",         test RealRing.genericRound    (NP.round :: Double -> Integer)) :+      ("truncate",      test RealRing.genericTruncate (NP.truncate :: Double -> Integer)) :+      ("ceiling",       test RealRing.genericCeiling  (NP.ceiling :: Double -> Integer)) :+      ("floor",         test RealRing.genericFloor    (NP.floor :: Double -> Integer)) :+      ("fraction",      test RealRing.genericFraction (NP.fraction :: Double -> Double)) :+      ("splitFraction", test RealRing.genericSplitFraction (NP.splitFraction :: Double -> (Integer, Double))) :++{-+      ("splitFractionId", quickCheck (\x -> (x::Double) == (uncurry (+) $ mapFst fromInteger $ splitFraction x))) :+-}+      ("splitFractionId", quickCheck (\x ->  uncurry (==) $ mapFst (((x::Double)-) . fromInteger) $ splitFraction x)) :+      ("splitFractionFloorFraction", quickCheck (\x -> (floor (x::Double) :: Integer, fraction x) == splitFraction x)) :+      ("fractionBound", quickCheck (\x -> let y = fraction (x::Double) in 0<=y && y<1)) :+      ("floorCeiling", quickCheck (\x -> negate (floor (x::Double) :: Integer) == ceiling (-x))) :+      []

test/Test/MathObj/Gaussian/Bell.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} module Test.MathObj.Gaussian.Bell where

test/Test/MathObj/Gaussian/Polynomial.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} module Test.MathObj.Gaussian.Polynomial where@@ -52,6 +52,12 @@ --          simple $ \x -> Laws.commutative G.convolve (trace (show x) x)) :       ("convolution, associative",           simple $ Laws.associative G.convolve) :+{-+      ("convolution by differentiation vs. fourier",+          simple $ \x y ->+             G.convolveByDifferentiation x y+              == G.convolveByFourier x y) :+-}       ("multiplication, one",           simple $ Laws.identity G.multiply G.constant) :       ("multiplication, commutative",@@ -119,12 +125,20 @@       ("integrate differentiate",           simple $ \x ->              G.integrate (G.differentiate x) == (zero, x)) :+      ("differentiate integrate",+          simple $ \x@(G.Cons b p) ->+             let (xoff,xint) = G.integrate x+             in  G.differentiate xint == G.Cons b (p + Poly.const xoff)) :       ("fourier differentiate",           simple $ \x ->              G.fourier (G.differentiate x) ==               let y = G.fourier x               in  y{G.polynomial =                       Poly.fromCoeffs [0, 0 Complex.+: 2] * G.polynomial y}) :+      ("differentiate convolve",+          simple $ \x y ->+             G.convolve (G.differentiate x) y ==+             G.convolve x (G.differentiate y)) :       ("approximate by bells, translate",           simple $ \x unit d -> unit/=0 ==>              G.approximateByBells unit (G.translateComplex d x) ==

test/Test/MathObj/Gaussian/Variance.hs view

@@ -1,24 +1,96 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} module Test.MathObj.Gaussian.Variance where  import qualified MathObj.Gaussian.Variance as G+import qualified Number.Root as Root  -- import qualified Algebra.Ring           as Ring  import qualified Algebra.Laws as Laws  import Test.NumericPrelude.Utility (testUnit)-import Test.QuickCheck (Testable, quickCheck, (==>))+import Test.QuickCheck (Testable, quickCheck, (==>), Arbitrary, arbitrary, ) import qualified Test.HUnit as HUnit -import Data.Function.HT (nest, )+import Control.Monad (liftM2, liftM3, ) +import Data.Function.HT (nest, compose2, )+ import NumericPrelude.Base as P import NumericPrelude.Numeric as NP  +newtype PositiveInteger = PositiveInteger Integer+   deriving Show++instance Arbitrary PositiveInteger where+   arbitrary =+      fmap (\p -> PositiveInteger $ 1 + abs p) arbitrary+++{- |+For @(HoelderConjugates p q)@ it holds++> 1/p + 1/q = 1+-}+data HoelderConjugates = HoelderConjugates Rational Rational+   deriving Show++instance Arbitrary HoelderConjugates where+   arbitrary = liftM2+      (\(PositiveInteger p) (PositiveInteger q) ->+         let s  = 1%p + 1%q+         in  HoelderConjugates (fromInteger p * s) (fromInteger q * s))+      arbitrary arbitrary++{- |+For @(YoungConjugates p q r)@ it holds++> 1/p + 1/q = 1/r + 1+-}+data YoungConjugates = YoungConjugates Rational Rational Rational+   deriving Show++{-+Find positive natural numbers @a, b, c, d@ with++> a + b = c + d++and++> d >= a, d >= b, d >= c++then set++> p=d/a, q=d/b, r=d/c+++a+b<=c+b+c<=a+->  2b <= 0+-}+instance Arbitrary YoungConjugates where+   arbitrary = liftM3+      (\(PositiveInteger a0) (PositiveInteger b0) (PositiveInteger c0) ->+         let guardSwap cond (x,y) =+                if cond x y then (x,y) else (y,x)+             {-+             If a+b<=c, then from b>0 it follows a<c and thus c+b>a.+             Swapping a and c is enough and we have not to consider more cases.+             -}+             (a1,c1) = guardSwap (\a c -> a+b0>c) (a0,c0)+             b1 = b0+             d1 = a1+b1-c1+             ((a2,b2),(c2,d2)) =+                guardSwap (compose2 (<=) snd)+                   (guardSwap (<=) (a1,b1),+                    guardSwap (<=) (c1,d1))+         in  YoungConjugates (d2%a2) (d2%b2) (d2%c2))+      arbitrary arbitrary arbitrary++ simple ::    (Testable t) =>    (G.T Rational -> t) -> IO ()@@ -27,9 +99,13 @@  tests :: HUnit.Test tests =-   HUnit.TestLabel "polynomial" $+   HUnit.TestLabel "variance" $    HUnit.TestList $    map testUnit $+   testList++testList :: [(String, IO ())]+testList = {-       ("convolution, dirac",           simple $ Laws.identity (+) zero) :@@ -59,4 +135,64 @@       ("fourier dilate",           simple $ \x a -> a>0 ==>              G.fourier (G.dilate a x) == G.amplify a (G.shrink a (G.fourier x))) :+      ("norm1 vs. normP 1",+          simple $ \x -> G.norm1Root x == G.normPRoot 1 x) :+      ("norm2 vs. normP 2",+          simple $ \x -> G.norm2Root x == G.normPRoot 2 x) :+{-+I would have liked to test for a monotony of norms.+Unfortunately, it does not hold.++Means contain a division by the size of the domain.+Norms do not have this division.+Means are monotonic with respect to the degree.+Norms are not.+We cannot turn the norms into means since the size of the domain+(the complete real axis) is infinitely large.+      ("norm monotony",+          simple $ \x p0 q0 ->+             let p = 1 + abs p0+                 q = 1 + abs q0+             in  case compare p q of+                    EQ -> G.normPRoot p x == G.normPRoot q x+                    LT -> G.normPRoot p x <= G.normPRoot q x+                    GT -> G.normPRoot p x >= G.normPRoot q x) :++This should also fail,+but QuickCheck does not seem to try counterexamples.+      ("infinity norm upper bound",+          simple $ \x p0 ->+             let p = 1 + abs p0+             in  G.normPRoot p x <= G.normInfRoot x) :+-}+      ("Cauchy-Schwarz inequality",+          simple $ \x y ->+             G.norm1Root (G.multiply x y)+                <= G.norm2Root x `Root.mul` G.norm2Root y) :+      ("Hoelder conjugates",+          quickCheck $ \(HoelderConjugates p q) ->+             p>=1 && q>=1 && 1/p + 1/q == 1) :+      ("Hoelder inequality with infinity norm",+          simple $ \x y ->+             G.norm1Root (G.multiply x y)+                <= G.norm1Root x `Root.mul` G.normInfRoot y) :+      ("Hoelder inequality",+          simple $ \x y (HoelderConjugates p q) ->+             G.norm1Root (G.multiply x y)+                <= G.normPRoot p x `Root.mul` G.normPRoot q y) :+      ("Young inequality with two infinity norms",+          simple $ \x y ->+             G.normInfRoot (G.convolve x y)+                <= G.norm1Root x `Root.mul` G.normInfRoot y) :+      ("Young inequality with infinity norm",+          simple $ \x y (HoelderConjugates p q) ->+             G.normInfRoot (G.convolve x y)+                <= G.normPRoot p x `Root.mul` G.normPRoot q y) :+      ("Young conjugates",+          quickCheck $ \(YoungConjugates p q r) ->+             p>=1 && q>=1 && r>=1 && 1/p + 1/q == 1/r + 1) :+      ("Young inequality",+          simple $ \x y (YoungConjugates p q r) ->+             G.normPRoot r (G.convolve x y)+                <= G.normPRoot p x `Root.mul` G.normPRoot q y) :       []

test/Test/MathObj/Matrix.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} module Test.MathObj.Matrix where@@ -13,6 +13,8 @@  import qualified System.Random as Random +import Data.Function.HT (nest, )+ import Test.NumericPrelude.Utility (testUnit, ) import Test.QuickCheck (quickCheck, ) import qualified Test.HUnit as HUnit@@ -90,6 +92,11 @@       ("multiplication, transpose",           quickCheck (\l m n a b ->              Laws.homomorphism Matrix.transpose (*) (flip (*)) (random l m a) (random m n b))) :+      ("multiplication vs. power",+          quickCheck (\m a n0 ->+             let x = random m m a+                 n = mod n0 10+             in  x^n == nest (fromInteger n) (x*) (Matrix.one (NonNeg.toNumber m)))) : {-       ("division",       quickCheck (\x -> Integral.propInverse (x :: Poly.T Rational))) : -}

test/Test/MathObj/PartialFraction.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} module Test.MathObj.PartialFraction where@@ -8,7 +8,7 @@ import qualified Number.Ratio                 as Ratio  import qualified Algebra.PrincipalIdealDomain as PID-import qualified Algebra.Ring                 as Ring+-- import qualified Algebra.Ring                 as Ring import qualified Algebra.Indexable            as Indexable import qualified Algebra.Vector               as Vector -- import Algebra.Vector((*>))

test/Test/MathObj/Polynomial.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Test.MathObj.Polynomial where  import qualified MathObj.Polynomial      as Poly

test/Test/MathObj/PowerSeries.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} module Test.MathObj.PowerSeries where

test/Test/MathObj/RefinementMask2.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Test.MathObj.RefinementMask2 where  import qualified MathObj.RefinementMask2 as Mask

+ test/Test/Number/ComplexSquareRoot.hs view

@@ -0,0 +1,50 @@+{-# LANGUAGE RebindableSyntax #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+module Test.Number.ComplexSquareRoot where++import qualified Number.ComplexSquareRoot as S+import qualified Number.Complex as Complex++-- import qualified Algebra.Ring           as Ring++import qualified Algebra.Laws as Laws++import Test.NumericPrelude.Utility (testUnit)+import Test.QuickCheck (Testable, quickCheck, (==>), )+import qualified Test.HUnit as HUnit++import NumericPrelude.Base as P+import NumericPrelude.Numeric as NP+++simple ::+   (Testable t) =>+   (S.T Rational -> t) -> IO ()+simple = quickCheck++tests :: HUnit.Test+tests =+   HUnit.TestLabel "complex square root" $+   HUnit.TestList $+   map testUnit $+   testList++testList :: [(String, IO ())]+testList =+   ("multiplication, one",+      simple $ Laws.identity S.mul S.one) :+   ("multiplication, commutative",+      simple $ Laws.commutative S.mul) :+   ("multiplication, associative",+      simple $ Laws.associative S.mul) :+   ("multiplication, homomorphism",+      quickCheck $ Laws.homomorphism S.fromNumber+         (\x y -> (x :: Complex.T Rational) * y) S.mul) :+   ("division, one",+      simple $ Laws.rightIdentity S.div S.one) :+   ("recip recip",+      simple $ \x -> not (isZero x) ==> S.recip (S.recip x) == x) :+   ("recip inverts multiplication",+      simple $ \x -> not (isZero x) ==> Laws.inverse S.mul S.recip S.one x) :+   []

test/Test/Number/GaloisField2p32m5.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-} module Test.Number.GaloisField2p32m5 where  import qualified Number.GaloisField2p32m5 as GF

test/Test/Run.hs view

@@ -2,6 +2,7 @@  import qualified Test.MathObj.RefinementMask2 as RefinementMask2 import qualified Test.Algebra.RealRing as RealRing+import qualified Test.Algebra.IntegralDomain as Integral import qualified Test.MathObj.Gaussian.Polynomial as GaussPoly import qualified Test.MathObj.Gaussian.Variance as GaussVariance import qualified Test.MathObj.Gaussian.Bell as GaussBell@@ -9,15 +10,18 @@ import qualified Test.MathObj.Matrix  as Matrix import qualified Test.MathObj.Polynomial  as Polynomial import qualified Test.MathObj.PowerSeries as PowerSeries+import qualified Test.Number.ComplexSquareRoot as CSqRt import qualified Test.Number.GaloisField2p32m5 as GF import qualified Test.HUnit.Text as HUnitText import qualified Test.HUnit as HUnit  main :: IO () main =-   do HUnitText.runTestTT (HUnit.TestList $+   print =<<+      HUnitText.runTestTT (HUnit.TestList $          RefinementMask2.tests :          RealRing.tests :+         Integral.tests :          GaussVariance.tests :          GaussBell.tests :          GaussPoly.tests :@@ -25,6 +29,6 @@          Matrix.tests :          Polynomial.tests :          PowerSeries.tests :+         CSqRt.tests :          GF.tests :          [])-      return ()