packages feed

plankton (empty) → 0.0.0.1

raw patch · 14 files changed

+1371/−0 lines, 14 filesdep +adjunctionsdep +basedep +protoludesetup-changed

Dependencies added: adjunctions, base, protolude

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Tony Day (c) 2016++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Tony Day nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ plankton.cabal view
@@ -0,0 +1,42 @@+name:               plankton+version:            0.0.0.1+synopsis:           The core of a numeric prelude, taken from numhask+description:        The core of a numeric prelude, taken from numhask, because I thought it would be useful to have this as a separate library.+category:           Mathematics+homepage:           https://github.com/chessai/plankton+bug-reports:        https://github.com/chessai/issues+license:            BSD3+license-file:       LICENSE+author:             Daniel Cartwright+maintainer:         dcartwright@layer3com.com+build-type:         Simple+cabal-version:      >= 1.10+extra-source-files: readme.md++library+  default-language: Haskell2010+  ghc-options:      -Wall+  hs-source-dirs:   src+  exposed-modules:+    Plankton.Additive,+    Plankton.Basis,+    Plankton.Distribution,+    Plankton.Ring,+    Plankton.Field,+    Plankton.Integral,+    Plankton.Magma,+    Plankton.Metric,+    Plankton.Module,+    Plankton.Multiplicative+  build-depends:+    base >= 4.7 && < 4.11,+    protolude >= 0.1 && < 0.3,+    adjunctions >= 4.3 && < 5.0+  default-extensions:+    NoImplicitPrelude,+    OverloadedStrings,+    UnicodeSyntax++source-repository head+  type: git+  location: https://github.com/chessai/plankton
+ readme.md view
+ src/Plankton/Additive.hs view
@@ -0,0 +1,214 @@+{-# OPTIONS_GHC -Wall #-}++-- | A magma heirarchy for addition. The basic magma structure is repeated and prefixed with 'Additive-'.+module Plankton.Additive+  ( AdditiveMagma(..)+  , AdditiveUnital(..)+  , AdditiveAssociative+  , AdditiveCommutative+  , AdditiveInvertible(..)+  , AdditiveIdempotent+  , sum+  , Additive(..)+  , AdditiveRightCancellative(..)+  , AdditiveLeftCancellative(..)+  , AdditiveGroup(..)+  ) where++import Data.Complex (Complex(..))+import qualified Protolude as P+import Protolude (Bool(..), Double, Float, Int, Integer)++-- | 'plus' is used as the operator for the additive magma to distinguish from '+' which, by convention, implies commutativity+--+-- > ∀ a,b ∈ A: a `plus` b ∈ A+--+-- law is true by construction in Haskell+class AdditiveMagma a where+  plus :: a -> a -> a++instance AdditiveMagma Double where+  plus = (P.+)++instance AdditiveMagma Float where+  plus = (P.+)++instance AdditiveMagma Int where+  plus = (P.+)++instance AdditiveMagma Integer where+  plus = (P.+)++instance AdditiveMagma Bool where+  plus = (P.||)++instance (AdditiveMagma a) => AdditiveMagma (Complex a) where+  (rx :+ ix) `plus` (ry :+ iy) = (rx `plus` ry) :+ (ix `plus` iy)++-- | Unital magma for addition.+--+-- > zero `plus` a == a+-- > a `plus` zero == a+class AdditiveMagma a =>+      AdditiveUnital a where+  zero :: a++instance AdditiveUnital Double where+  zero = 0++instance AdditiveUnital Float where+  zero = 0++instance AdditiveUnital Int where+  zero = 0++instance AdditiveUnital Integer where+  zero = 0++instance AdditiveUnital Bool where+  zero = False++instance (AdditiveUnital a) => AdditiveUnital (Complex a) where+  zero = zero :+ zero++-- | Associative magma for addition.+--+-- > (a `plus` b) `plus` c == a `plus` (b `plus` c)+class AdditiveMagma a =>+      AdditiveAssociative a++instance AdditiveAssociative Double++instance AdditiveAssociative Float++instance AdditiveAssociative Int++instance AdditiveAssociative Integer++instance AdditiveAssociative Bool++instance (AdditiveAssociative a) => AdditiveAssociative (Complex a)++-- | Commutative magma for addition.+--+-- > a `plus` b == b `plus` a+class AdditiveMagma a =>+      AdditiveCommutative a++instance AdditiveCommutative Double++instance AdditiveCommutative Float++instance AdditiveCommutative Int++instance AdditiveCommutative Integer++instance AdditiveCommutative Bool++instance (AdditiveCommutative a) => AdditiveCommutative (Complex a)++-- | Invertible magma for addition.+--+-- > ∀ a ∈ A: negate a ∈ A+--+-- law is true by construction in Haskell+class AdditiveMagma a =>+      AdditiveInvertible a where+  negate :: a -> a++instance AdditiveInvertible Double where+  negate = P.negate++instance AdditiveInvertible Float where+  negate = P.negate++instance AdditiveInvertible Int where+  negate = P.negate++instance AdditiveInvertible Integer where+  negate = P.negate++instance AdditiveInvertible Bool where+  negate = P.not++instance (AdditiveInvertible a) => AdditiveInvertible (Complex a) where+  negate (rx :+ ix) = negate rx :+ negate ix++-- | Idempotent magma for addition.+--+-- > a `plus` a == a+class AdditiveMagma a =>+      AdditiveIdempotent a++instance AdditiveIdempotent Bool++-- | sum definition avoiding a clash with the Sum monoid in base+--+sum :: (Additive a, P.Foldable f) => f a -> a+sum = P.foldr (+) zero++-- | Additive is commutative, unital and associative under addition+--+-- > zero + a == a+-- > a + zero == a+-- > (a + b) + c == a + (b + c)+-- > a + b == b + a+class (AdditiveCommutative a, AdditiveUnital a, AdditiveAssociative a) =>+      Additive a where+  infixl 6 ++  (+) :: a -> a -> a+  a + b = plus a b++instance Additive Double++instance Additive Float++instance Additive Int++instance Additive Integer++instance Additive Bool++instance (Additive a) => Additive (Complex a)++-- | Non-commutative left minus+--+-- > negate a `plus` a = zero+class (AdditiveUnital a, AdditiveAssociative a, AdditiveInvertible a) =>+      AdditiveLeftCancellative a where+  infixl 6 ~-+  (~-) :: a -> a -> a+  (~-) a b = negate b `plus` a++-- | Non-commutative right minus+--+-- > a `plus` negate a = zero+class (AdditiveUnital a, AdditiveAssociative a, AdditiveInvertible a) =>+      AdditiveRightCancellative a where+  infixl 6 -~+  (-~) :: a -> a -> a+  (-~) a b = a `plus` negate b++-- | Minus ('-') is reserved for where both the left and right cancellative laws hold.  This then implies that the AdditiveGroup is also Abelian.+--+-- Syntactic unary negation - substituting "negate a" for "-a" in code - is hard-coded in the language to assume a Num instance.  So, for example, using ''-a = zero - a' for the second rule below doesn't work.+--+-- > a - a = zero+-- > negate a = zero - a+-- > negate a + a = zero+-- > a + negate a = zero+class (Additive a, AdditiveInvertible a) =>+      AdditiveGroup a where+  infixl 6 -+  (-) :: a -> a -> a+  (-) a b = a `plus` negate b++instance AdditiveGroup Double++instance AdditiveGroup Float++instance AdditiveGroup Int++instance AdditiveGroup Integer++instance (AdditiveGroup a) => AdditiveGroup (Complex a)
+ src/Plankton/Basis.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -Wall #-}++-- | Element-by-element operation for 'Representable's+module Plankton.Basis+  ( AdditiveBasis(..)+  , AdditiveGroupBasis(..)+  , MultiplicativeBasis(..)+  , MultiplicativeGroupBasis(..)+  ) where++import Data.Functor.Rep+import Plankton.Additive+import Plankton.Multiplicative++-- | element by element addition+--+-- > (a .+. b) .+. c == a .+. (b .+. c)+-- > zero .+. a = a+-- > a .+. zero = a+-- > a .+. b == b .+. a+class (Representable m, Additive a) =>+      AdditiveBasis m a where+  infixl 7 .+.+  (.+.) :: m a -> m a -> m a+  (.+.) = liftR2 (+)++instance (Representable r, Additive a) => AdditiveBasis r a++-- | element by element subtraction+--+-- > a .-. a = singleton zero+class (Representable m, AdditiveGroup a) =>+      AdditiveGroupBasis m a where+  infixl 6 .-.+  (.-.) :: m a -> m a -> m a+  (.-.) = liftR2 (-)++instance (Representable r, AdditiveGroup a) => AdditiveGroupBasis r a++-- | element by element multiplication+--+-- > (a .*. b) .*. c == a .*. (b .*. c)+-- > singleton one .*. a = a+-- > a .*. singelton one = a+-- > a .*. b == b .*. a+class (Representable m, Multiplicative a) =>+      MultiplicativeBasis m a where+  infixl 7 .*.+  (.*.) :: m a -> m a -> m a+  (.*.) = liftR2 (*)++instance (Representable r, Multiplicative a) => MultiplicativeBasis r a++-- | element by element division+--+-- > a ./. a == singleton one+class (Representable m, MultiplicativeGroup a) =>+      MultiplicativeGroupBasis m a where+  infixl 7 ./.+  (./.) :: m a -> m a -> m a+  (./.) = liftR2 (/)++instance (Representable r, MultiplicativeGroup a) =>+         MultiplicativeGroupBasis r a
+ src/Plankton/Distribution.hs view
@@ -0,0 +1,32 @@+{-# OPTIONS_GHC -Wall #-}++-- | 'Distribution' avoids a name clash with 'Data.Distributive'+module Plankton.Distribution+  ( Distribution+  ) where++import Data.Complex (Complex(..))+import Plankton.Additive+import Plankton.Multiplicative+import Protolude (Bool(..), Double, Float, Int, Integer)++-- | Distribution (and annihilation) laws+--+-- > a * (b + c) == a * b + a * c+-- > (a + b) * c == a * c + b * c+-- > a * zero == zero+-- > zero * a == zero+class (Additive a, MultiplicativeMagma a) =>+      Distribution a++instance Distribution Double++instance Distribution Float++instance Distribution Int++instance Distribution Integer++instance Distribution Bool++instance (AdditiveGroup a, Distribution a) => Distribution (Complex a)
+ src/Plankton/Field.hs view
@@ -0,0 +1,213 @@+{-# OPTIONS_GHC -Wall #-}++-- | Field classes+module Plankton.Field+  ( Semifield+  , Field+  , ExpField(..)+  , QuotientField(..)+  , BoundedField(..)+  , infinity+  , neginfinity+  , TrigField(..)+  ) where++import Data.Complex (Complex(..))+import Plankton.Additive+import Plankton.Multiplicative+import Plankton.Ring+import Protolude (Bool, Double, Float, Integer, (||))+import qualified Protolude as P++-- | A Semifield is a Field without Commutative Multiplication.+class (MultiplicativeInvertible a, Ring a) =>+      Semifield a++instance Semifield Double++instance Semifield Float++instance (Semifield a) => Semifield (Complex a)++-- | A Field is a Ring plus additive invertible and multiplicative invertible operations.+--+-- A summary of the rules inherited from super-classes of Field+--+-- > zero + a == a+-- > a + zero == a+-- > (a + b) + c == a + (b + c)+-- > a + b == b + a+-- > a - a = zero+-- > negate a = zero - a+-- > negate a + a = zero+-- > a + negate a = zero+-- > one * a == a+-- > a * one == a+-- > (a * b) * c == a * (b * c)+-- > a * (b + c) == a * b + a * c+-- > (a + b) * c == a * c + b * c+-- > a * zero == zero+-- > zero * a == zero+-- > a * b == b * a+-- > a / a = one+-- > recip a = one / a+-- > recip a * a = one+-- > a * recip a = one+class (AdditiveGroup a, MultiplicativeGroup a, Ring a) =>+      Field a++instance Field Double++instance Field Float++instance (Field a) => Field (Complex a)++-- | A hyperbolic field class+--+-- > sqrt . (**2) == identity+-- > log . exp == identity+-- > for +ive b, a != 0,1: a ** logBase a b ≈ b+class (Field a) =>+      ExpField a where+  exp :: a -> a+  log :: a -> a+  logBase :: a -> a -> a+  logBase a b = log b / log a+  (**) :: a -> a -> a+  (**) a b = exp (log a * b)+  sqrt :: a -> a+  sqrt a = a ** (one / (one + one))++instance ExpField Double where+  exp = P.exp+  log = P.log+  (**) = (P.**)++instance ExpField Float where+  exp = P.exp+  log = P.log+  (**) = (P.**)++-- | todo: bottom is here somewhere???+instance (TrigField a, ExpField a) => ExpField (Complex a) where+  exp (rx :+ ix) = exp rx * cos ix :+ exp rx * sin ix+  log (rx :+ ix) = log (sqrt (rx * rx + ix * ix)) :+ atan2 ix rx++-- | quotient fields explode constraints if they allow for polymorphic integral types+--+-- > a - one < floor a <= a <= ceiling a < a + one+-- > round a == floor (a + one/(one+one))+class (Field a) =>+      QuotientField a where+  round :: a -> Integer+  ceiling :: a -> Integer+  floor :: a -> Integer+  (^^) :: a -> Integer -> a++instance QuotientField Float where+  round = P.round+  ceiling = P.ceiling+  floor = P.floor+  (^^) = (P.^^)++instance QuotientField Double where+  round = P.round+  ceiling = P.ceiling+  floor = P.floor+  (^^) = (P.^^)++-- | A bounded field includes the concepts of infinity and NaN, thus moving away from error throwing.+--+-- > one / zero + infinity == infinity+-- > infinity + a == infinity+-- > isNaN (infinity - infinity)+-- > isNaN (infinity / infinity)+-- > isNaN (nan + a)+-- > zero / zero != nan+--+-- Note the tricky law that, although nan is assigned to zero/zero, they are never-the-less not equal. A committee decided this.+class (Field a) =>+      BoundedField a where+  maxBound :: a+  maxBound = one / zero+  minBound :: a+  minBound = negate (one / zero)+  nan :: a+  nan = zero / zero+  isNaN :: a -> Bool++-- | prints as `Infinity`+infinity :: BoundedField a => a+infinity = maxBound++-- | prints as `-Infinity`+neginfinity :: BoundedField a => a+neginfinity = minBound++instance BoundedField Float where+  isNaN = P.isNaN++instance BoundedField Double where+  isNaN = P.isNaN++-- | todo: work out boundings for complex+-- as it stands now, complex is different eg+--+-- > one / (zero :: Complex Float) == nan+instance (BoundedField a) => BoundedField (Complex a) where+  isNaN (rx :+ ix) = isNaN rx || isNaN ix++-- | Trigonometric Field+class (P.Ord a, Field a) =>+      TrigField a where+  pi :: a+  sin :: a -> a+  cos :: a -> a+  tan :: a -> a+  tan x = sin x / cos x+  asin :: a -> a+  acos :: a -> a+  atan :: a -> a+  sinh :: a -> a+  cosh :: a -> a+  tanh :: a -> a+  tanh x = sinh x / cosh x+  asinh :: a -> a+  acosh :: a -> a+  atanh :: a -> a+  atan2 :: a -> a -> a+  atan2 y x+    | x P.> zero = atan (y / x)+    | x P.== zero P.&& y P.> zero = pi / (one + one)+    | x P.< one P.&& y P.> one = pi + atan (y / x)+    | (x P.<= zero P.&& y P.< zero) || (x P.< zero) =+      negate (atan2 (negate y) x)+    | y P.== zero = pi -- must be after the previous test on zero y+    | x P.== zero P.&& y P.== zero = y -- must be after the other double zero tests+    | P.otherwise = x + y -- x or y is a NaN, return a NaN (via +)++instance TrigField Double where+  pi = P.pi+  sin = P.sin+  cos = P.cos+  asin = P.asin+  acos = P.acos+  atan = P.atan+  sinh = P.sinh+  cosh = P.cosh+  asinh = P.sinh+  acosh = P.acosh+  atanh = P.atanh++instance TrigField Float where+  pi = P.pi+  sin = P.sin+  cos = P.cos+  asin = P.asin+  acos = P.acos+  atan = P.atan+  sinh = P.sinh+  cosh = P.cosh+  asinh = P.sinh+  acosh = P.acosh+  atanh = P.atanh
+ src/Plankton/Integral.hs view
@@ -0,0 +1,63 @@+{-# OPTIONS_GHC -Wall #-}++-- | Integral classes+module Plankton.Integral+  ( Integral(..)+  , ToInteger(..)+  , FromInteger(..)+  , fromIntegral+  ) where++import Plankton.Ring+import qualified Protolude as P+import Protolude (Double, Float, Int, Integer, (.), fst, snd)++-- | Integral laws+--+-- > b == zero || b * (a `div` b) + (a `mod` b) == a+class (Ring a) =>+      Integral a where+  infixl 7 `div`, `mod`+  div :: a -> a -> a+  div a1 a2 = fst (divMod a1 a2)+  mod :: a -> a -> a+  mod a1 a2 = snd (divMod a1 a2)+  divMod :: a -> a -> (a, a)++instance Integral Int where+  divMod = P.divMod++instance Integral Integer where+  divMod = P.divMod++-- | toInteger is kept separate from Integral to help with compatability issues.+class ToInteger a where+  toInteger :: a -> Integer++-- | fromInteger is the most problematic of the 'Num' class operators.  Particularly heinous, it is assumed that any number type can be constructed from an Integer, so that the broad classes of objects that are composed of multiple elements is avoided in haskell.+class FromInteger a where+  fromInteger :: Integer -> a++-- | coercion of 'Integral's+--+-- > fromIntegral a == a+fromIntegral :: (ToInteger a, FromInteger b) => a -> b+fromIntegral = fromInteger . toInteger++instance FromInteger Double where+  fromInteger = P.fromInteger++instance FromInteger Float where+  fromInteger = P.fromInteger++instance FromInteger Int where+  fromInteger = P.fromInteger++instance FromInteger Integer where+  fromInteger = P.fromInteger++instance ToInteger Int where+  toInteger = P.toInteger++instance ToInteger Integer where+  toInteger = P.toInteger
+ src/Plankton/Magma.hs view
@@ -0,0 +1,107 @@+{-# OPTIONS_GHC -Wall #-}++-- | Bootstrapping the number system.+--+-- This heirarchy is repeated for the Additive and Multiplicative structures, in order to achieve class separation, so these classes are not used in the main numerical classes.+module Plankton.Magma+  ( Magma(..)+  , Unital(..)+  , Associative+  , Commutative+  , Invertible(..)+  , Idempotent+  , Monoidal+  , CMonoidal+  , Loop+  , Group+  , groupSwap+  , Abelian+  ) where++-- * Magma structure+-- | A <https://en.wikipedia.org/wiki/Magma_(algebra) Magma> is a tuple (T,⊕) consisting of+--+-- - a type a, and+--+-- - a function (⊕) :: T -> T -> T+--+-- The mathematical laws for a magma are:+--+-- - ⊕ is defined for all possible pairs of type T, and+--+-- - ⊕ is closed in the set of all possible values of type T+--+-- or, more tersly,+--+-- > ∀ a, b ∈ T: a ⊕ b ∈ T+--+-- These laws are true by construction in haskell: the type signature of 'magma' and the above mathematical laws are synonyms.+--+--+class Magma a where+  (⊕) :: a -> a -> a++-- | A Unital Magma+--+-- > unit ⊕ a = a+-- > a ⊕ unit = a+--+class Magma a =>+      Unital a where+  unit :: a++-- | An Associative Magma+--+-- > (a ⊕ b) ⊕ c = a ⊕ (b ⊕ c)+class Magma a =>+      Associative a++-- | A Commutative Magma+--+-- > a ⊕ b = b ⊕ a+class Magma a =>+      Commutative a++-- | An Invertible Magma+--+-- > ∀ a ∈ T: inv a ∈ T+--+-- law is true by construction in Haskell+--+class Magma a =>+      Invertible a where+  inv :: a -> a++-- | An Idempotent Magma+--+-- > a ⊕ a = a+class Magma a =>+      Idempotent a++-- | A Monoidal Magma is associative and unital.+class (Associative a, Unital a) =>+      Monoidal a++-- | A CMonoidal Magma is commutative, associative and unital.+class (Commutative a, Associative a, Unital a) =>+      CMonoidal a++-- | A Loop is unital and invertible+class (Unital a, Invertible a) =>+      Loop a++-- | A Group is associative, unital and invertible+class (Associative a, Unital a, Invertible a) =>+      Group a++-- | see http://chris-taylor.github.io/blog/2013/02/25/xor-trick/+groupSwap :: (Group a) => (a, a) -> (a, a)+groupSwap (a, b) =+  let a' = a ⊕ b+      b' = a ⊕ inv b+      a'' = inv b' ⊕ a'+  in (a'', b')++-- | An Abelian Group is associative, unital, invertible and commutative+class (Associative a, Unital a, Invertible a, Commutative a) =>+      Abelian a
+ src/Plankton/Metric.hs view
@@ -0,0 +1,142 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -Wall #-}++-- | Metric classes+module Plankton.Metric+  ( Signed(..)+  , Normed(..)+  , Metric(..)+  , Epsilon(..)+  , (≈)+  ) where++import Data.Complex (Complex(..))+import Plankton.Additive+import Plankton.Field+import Plankton.Multiplicative+import qualified Protolude as P+import Protolude+       (Bool(..), Double, Eq(..), Float, Int, Integer, Ord(..), ($), (&&))++-- | 'signum' from base is not an operator replicated in numhask, being such a very silly name, and preferred is the much more obvious 'sign'.  Compare with 'Norm' and 'Banach' where there is a change in codomain+--+-- > abs a * sign a == a+--+-- Generalising this class tends towards size and direction (abs is the size on the one-dim number line of a vector with its tail at zero, and sign is the direction, right?).+class (MultiplicativeUnital a) =>+      Signed a where+  sign :: a -> a+  abs :: a -> a++instance Signed Double where+  sign a =+    if a >= zero+      then one+      else negate one+  abs = P.abs++instance Signed Float where+  sign a =+    if a >= zero+      then one+      else negate one+  abs = P.abs++instance Signed Int where+  sign a =+    if a >= zero+      then one+      else negate one+  abs = P.abs++instance Signed Integer where+  sign a =+    if a >= zero+      then one+      else negate one+  abs = P.abs++-- | Like Signed, except the codomain can be different to the domain.+class Normed a b where+  size :: a -> b++instance Normed Double Double where+  size = P.abs++instance Normed Float Float where+  size = P.abs++instance Normed Int Int where+  size = P.abs++instance Normed Integer Integer where+  size = P.abs++instance (Multiplicative a, ExpField a, Normed a a) =>+         Normed (Complex a) a where+  size (rx :+ ix) = sqrt (rx * rx + ix * ix)++-- | distance between numbers+--+-- > distance a b >= zero+-- > distance a a == zero+-- > \a b c -> distance a c + distance b c - distance a b >= zero &&+-- >           distance a b + distance b c - distance a c >= zero &&+-- >           distance a b + distance a c - distance b c >= zero &&+class Metric a b where+  distance :: a -> a -> b++instance Metric Double Double where+  distance a b = abs (a - b)++instance Metric Float Float where+  distance a b = abs (a - b)++instance Metric Int Int where+  distance a b = abs (a - b)++instance Metric Integer Integer where+  distance a b = abs (a - b)++instance (Multiplicative a, ExpField a, Normed a a) =>+         Metric (Complex a) a where+  distance a b = size (a - b)++-- | todo: This should probably be split off into some sort of alternative Equality logic, but to what end?+class (AdditiveGroup a) =>+      Epsilon a where+  nearZero :: a -> Bool+  aboutEqual :: a -> a -> Bool+  positive :: (Eq a, Signed a) => a -> Bool+  positive a = a == abs a+  veryPositive :: (Eq a, Signed a) => a -> Bool+  veryPositive a = P.not (nearZero a) && positive a+  veryNegative :: (Eq a, Signed a) => a -> Bool+  veryNegative a = P.not (nearZero a P.|| positive a)++infixl 4 ≈++-- | todo: is utf perfectly acceptable these days?+(≈) :: (Epsilon a) => a -> a -> Bool+(≈) = aboutEqual++instance Epsilon Double where+  nearZero a = abs a <= (1e-12 :: Double)+  aboutEqual a b = nearZero $ a - b++instance Epsilon Float where+  nearZero a = abs a <= (1e-6 :: Float)+  aboutEqual a b = nearZero $ a - b++instance Epsilon Int where+  nearZero a = a == zero+  aboutEqual a b = nearZero $ a - b++instance Epsilon Integer where+  nearZero a = a == zero+  aboutEqual a b = nearZero $ a - b++instance (Epsilon a) => Epsilon (Complex a) where+  nearZero (rx :+ ix) = nearZero rx && nearZero ix+  aboutEqual a b = nearZero $ a - b
+ src/Plankton/Module.hs view
@@ -0,0 +1,164 @@+{-# LANGUAGE ExplicitNamespaces #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wall #-}++-- | Algebra for Representable numbers+module Plankton.Module+  ( AdditiveModule(..)+  , AdditiveGroupModule(..)+  , MultiplicativeModule(..)+  , MultiplicativeGroupModule(..)+  , Banach(..)+  , Hilbert(..)+  , inner+  , type (><)+  , TensorProduct(..)+  ) where++import Data.Functor.Rep+import Plankton.Additive+import Plankton.Field+import Plankton.Metric+import Plankton.Multiplicative+import Plankton.Ring+import Protolude+       (Double, Float, Foldable(..), Functor(..), Int, Integer, ($))++-- | Additive Module Laws+--+-- > (a + b) .+ c == a + (b .+ c)+-- > (a + b) .+ c == (a .+ c) + b+-- > a .+ zero == a+-- > a .+ b == b +. a+class (Representable r, Additive a) =>+      AdditiveModule r a where+  infixl 6 .++  (.+) :: r a -> a -> r a+  r .+ a = fmap (a +) r+  infixl 6 +.+  (+.) :: a -> r a -> r a+  a +. r = fmap (a +) r++instance (Representable r, Additive a) => AdditiveModule r a++-- | Subtraction Module Laws+--+-- > (a + b) .- c == a + (b .- c)+-- > (a + b) .- c == (a .- c) + b+-- > a .- zero == a+-- > a .- b == negate b +. a+class (Representable r, AdditiveGroup a) =>+      AdditiveGroupModule r a where+  infixl 6 .-+  (.-) :: r a -> a -> r a+  r .- a = fmap (\x -> x - a) r+  infixl 6 -.+  (-.) :: a -> r a -> r a+  a -. r = fmap (\x -> a - x) r++instance (Representable r, AdditiveGroup a) => AdditiveGroupModule r a++-- | Multiplicative Module Laws+--+-- > a .* one == a+-- > (a + b) .* c == (a .* c) + (b .* c)+-- > c *. (a + b) == (c *. a) + (c *. b)+-- > a .* zero == zero+-- > a .* b == b *. a+class (Representable r, Multiplicative a) =>+      MultiplicativeModule r a where+  infixl 7 .*+  (.*) :: r a -> a -> r a+  r .* a = fmap (a *) r+  infixl 7 *.+  (*.) :: a -> r a -> r a+  a *. r = fmap (a *) r++instance (Representable r, Multiplicative a) => MultiplicativeModule r a++-- | Division Module Laws+--+-- > nearZero a || a ./ one == a+-- > b == zero || a ./ b == recip b *. a+class (Representable r, MultiplicativeGroup a) =>+      MultiplicativeGroupModule r a where+  infixl 7 ./+  (./) :: r a -> a -> r a+  r ./ a = fmap (/ a) r+  infixl 7 /.+  (/.) :: a -> r a -> r a+  a /. r = fmap (\x -> a / x) r++instance (Representable r, MultiplicativeGroup a) =>+         MultiplicativeGroupModule r a++-- | Banach (with Norm) laws form rules around size and direction of a number, with a potential crossing into another codomain.+--+-- > a == singleton zero || normalize a *. size a == a+class (Representable r, ExpField a, Normed (r a) a) =>+      Banach r a where+  normalize :: r a -> r a+  normalize a = a ./ size a++instance (Normed (r a) a, ExpField a, Representable r) => Banach r a++-- | the inner product of a representable over a semiring+--+-- > a <.> b == b <.> a+-- > a <.> (b +c) == a <.> b + a <.> c+-- > a <.> (s *. b + c) == s * (a <.> b) + a <.> c+-- (s0 *. a) <.> (s1 *. b) == s0 * s1 * (a <.> b)+class (Semiring a, Foldable r, Representable r) =>+      Hilbert r a where+  infix 8 <.>+  (<.>) :: r a -> r a -> a+  (<.>) a b = sum $ liftR2 times a b++-- | synonym for (<.>)+inner :: (Hilbert r a) => r a -> r a -> a+inner = (<.>)++-- | tensorial type+type family (><) (a :: k1) (b :: k2) :: *++type instance Int >< Int = Int++type instance Integer >< Integer = Integer++type instance Double >< Double = Double++type instance Float >< Float = Float++-- | representation synthesis+type family TensorRep k1 k2 where+  TensorRep (r a) (r a) = r (r a)+  TensorRep (r a) (s a) = r (s a)+  TensorRep (r a) a = r a++type instance r a >< b = TensorRep (r a) b++-- | generalised outer product+--+-- > a><b + c><b == (a+c) >< b+-- > a><b + a><c == a >< (b+c)+--+-- todo: work out why these laws down't apply+-- > a *. (b><c) == (a><b) .* c+-- > (a><b) .* c == a *. (b><c)+class TensorProduct a where+  infix 8 ><+  (><) :: a -> a -> (a >< a)+  outer :: a -> a -> (a >< a)+  outer = (><)+  timesleft :: a -> (a >< a) -> a+  timesright :: (a >< a) -> a -> a++instance (Hilbert r a, Multiplicative a) => TensorProduct (r a) where+  (><) m n = tabulate (\i -> index m i *. n)+  timesleft v m = tabulate (\i -> v <.> index m i)+  timesright m v = tabulate (\i -> v <.> index m i)
+ src/Plankton/Multiplicative.hs view
@@ -0,0 +1,217 @@+{-# OPTIONS_GHC -Wall #-}++-- | A magma heirarchy for multiplication. The basic magma structure is repeated and prefixed with 'Multiplicative-'.+module Plankton.Multiplicative+  ( MultiplicativeMagma(..)+  , MultiplicativeUnital(..)+  , MultiplicativeAssociative+  , MultiplicativeCommutative+  , MultiplicativeInvertible(..)+  , product+  , Multiplicative(..)+  , MultiplicativeRightCancellative(..)+  , MultiplicativeLeftCancellative(..)+  , MultiplicativeGroup(..)+  ) where++import Data.Complex (Complex(..))+import Plankton.Additive+import qualified Protolude as P+import Protolude (Bool(..), Double, Float, Int, Integer)++-- | 'times' is used as the operator for the multiplicative magam to distinguish from '*' which, by convention, implies commutativity+--+-- > ∀ a,b ∈ A: a `times` b ∈ A+--+-- law is true by construction in Haskell+class MultiplicativeMagma a where+  times :: a -> a -> a++instance MultiplicativeMagma Double where+  times = (P.*)++instance MultiplicativeMagma Float where+  times = (P.*)++instance MultiplicativeMagma Int where+  times = (P.*)++instance MultiplicativeMagma Integer where+  times = (P.*)++instance MultiplicativeMagma Bool where+  times = (P.&&)++instance (MultiplicativeMagma a, AdditiveGroup a) =>+         MultiplicativeMagma (Complex a) where+  (rx :+ ix) `times` (ry :+ iy) =+    (rx `times` ry - ix `times` iy) :+ (ix `times` ry + iy `times` rx)++-- | Unital magma for multiplication.+--+-- > one `times` a == a+-- > a `times` one == a+class MultiplicativeMagma a =>+      MultiplicativeUnital a where+  one :: a++instance MultiplicativeUnital Double where+  one = 1++instance MultiplicativeUnital Float where+  one = 1++instance MultiplicativeUnital Int where+  one = 1++instance MultiplicativeUnital Integer where+  one = 1++instance MultiplicativeUnital Bool where+  one = True++instance (AdditiveUnital a, AdditiveGroup a, MultiplicativeUnital a) =>+         MultiplicativeUnital (Complex a) where+  one = one :+ zero++-- | Associative magma for multiplication.+--+-- > (a `times` b) `times` c == a `times` (b `times` c)+class MultiplicativeMagma a =>+      MultiplicativeAssociative a++instance MultiplicativeAssociative Double++instance MultiplicativeAssociative Float++instance MultiplicativeAssociative Int++instance MultiplicativeAssociative Integer++instance MultiplicativeAssociative Bool++instance (AdditiveGroup a, MultiplicativeAssociative a) =>+         MultiplicativeAssociative (Complex a)++-- | Commutative magma for multiplication.+--+-- > a `times` b == b `times` a+class MultiplicativeMagma a =>+      MultiplicativeCommutative a++instance MultiplicativeCommutative Double++instance MultiplicativeCommutative Float++instance MultiplicativeCommutative Int++instance MultiplicativeCommutative Integer++instance MultiplicativeCommutative Bool++instance (AdditiveGroup a, MultiplicativeCommutative a) =>+         MultiplicativeCommutative (Complex a)++-- | Invertible magma for multiplication.+--+-- > ∀ a ∈ A: recip a ∈ A+--+-- law is true by construction in Haskell+class MultiplicativeMagma a =>+      MultiplicativeInvertible a where+  recip :: a -> a++instance MultiplicativeInvertible Double where+  recip = P.recip++instance MultiplicativeInvertible Float where+  recip = P.recip++instance (AdditiveGroup a, MultiplicativeInvertible a) =>+         MultiplicativeInvertible (Complex a) where+  recip (rx :+ ix) = (rx `times` d) :+ (negate ix `times` d)+    where+      d = recip ((rx `times` rx) `plus` (ix `times` ix))++-- | Idempotent magma for multiplication.+--+-- > a `times` a == a+class MultiplicativeMagma a =>+      MultiplicativeIdempotent a++instance MultiplicativeIdempotent Bool++-- | product definition avoiding a clash with the Product monoid in base+--+product :: (Multiplicative a, P.Foldable f) => f a -> a+product = P.foldr (*) one++-- | Multiplicative is commutative, associative and unital under multiplication+--+-- > one * a == a+-- > a * one == a+-- > (a * b) * c == a * (b * c)+-- > a * b == b * a+class ( MultiplicativeCommutative a+      , MultiplicativeUnital a+      , MultiplicativeAssociative a+      ) =>+      Multiplicative a where+  infixl 7 *+  (*) :: a -> a -> a+  a * b = times a b++instance Multiplicative Double++instance Multiplicative Float++instance Multiplicative Int++instance Multiplicative Integer++instance Multiplicative Bool++instance (AdditiveGroup a, Multiplicative a) => Multiplicative (Complex a)++-- | Non-commutative left divide+--+-- > recip a `times` a = one+class ( MultiplicativeUnital a+      , MultiplicativeAssociative a+      , MultiplicativeInvertible a+      ) =>+      MultiplicativeLeftCancellative a where+  infixl 7 ~/+  (~/) :: a -> a -> a+  a ~/ b = recip b `times` a++-- | Non-commutative right divide+--+-- > a `times` recip a = one+class ( MultiplicativeUnital a+      , MultiplicativeAssociative a+      , MultiplicativeInvertible a+      ) =>+      MultiplicativeRightCancellative a where+  infixl 7 /~+  (/~) :: a -> a -> a+  a /~ b = a `times` recip b++-- | Divide ('/') is reserved for where both the left and right cancellative laws hold.  This then implies that the MultiplicativeGroup is also Abelian.+--+-- > a / a = one+-- > recip a = one / a+-- > recip a * a = one+-- > a * recip a = one+class (Multiplicative a, MultiplicativeInvertible a) =>+      MultiplicativeGroup a where+  infixl 7 /+  (/) :: a -> a -> a+  (/) a b = a `times` recip b++instance MultiplicativeGroup Double++instance MultiplicativeGroup Float++instance (AdditiveGroup a, MultiplicativeGroup a) =>+         MultiplicativeGroup (Complex a)
+ src/Plankton/Ring.hs view
@@ -0,0 +1,79 @@+{-# OPTIONS_GHC -Wall #-}++-- | Ring classes. A distinguishment is made between Rings and Commutative Rings.+module Plankton.Ring+  ( Semiring+  , Ring+  , CRing+  ) where++import Data.Complex (Complex(..))+import Plankton.Additive+import Plankton.Distribution+import Plankton.Multiplicative+import Protolude (Bool(..), Double, Float, Int, Integer)++-- | Semiring+class (MultiplicativeAssociative a, MultiplicativeUnital a, Distribution a) =>+      Semiring a++instance Semiring Double++instance Semiring Float++instance Semiring Int++instance Semiring Integer++instance Semiring Bool++instance (AdditiveGroup a, Semiring a) => Semiring (Complex a)++-- | Ring+-- a summary of the laws inherited from the ring super-classes+--+-- > zero + a == a+-- > a + zero == a+-- > (a + b) + c == a + (b + c)+-- > a + b == b + a+-- > a - a = zero+-- > negate a = zero - a+-- > negate a + a = zero+-- > a + negate a = zero+-- > one `times` a == a+-- > a `times` one == a+-- > (a `times` b) `times` c == a `times` (b `times` c)+-- > a `times` (b + c) == a `times` b + a `times` c+-- > (a + b) `times` c == a `times` c + b `times` c+-- > a `times` zero == zero+-- > zero `times` a == zero+class ( AdditiveGroup a+      , MultiplicativeAssociative a+      , MultiplicativeUnital a+      , Distribution a+      ) =>+      Ring a++instance Ring Double++instance Ring Float++instance Ring Int++instance Ring Integer++instance (Ring a) => Ring (Complex a)++-- | CRing is a Ring with Multiplicative Commutation.  It arises often due to '*' being defined as a multiplicative commutative operation.+class (Multiplicative a, Ring a) =>+      CRing a++instance CRing Double++instance CRing Float++instance CRing Int++instance CRing Integer++instance (CRing a) => CRing (Complex a)