Browse files

repository initialized

  • Loading branch information...
0 parents commit 3a70b11281dc3bd721a1b3fe67f30d252386e83c @ekmett committed Jul 7, 2011
2 .gitignore
@@ -0,0 +1,2 @@
+_darcs
+dist
30 LICENSE
@@ -0,0 +1,30 @@
+Copyright 2011 Edward Kmett
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+2. 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.
+
+3. Neither the name of the author nor the names of his contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.
9 Numeric/Additive.hs
@@ -0,0 +1,9 @@
+module Numeric.Additive
+ ( module Numeric.Additive.Semigroup
+ , module Numeric.Additive.Monoid
+ , module Numeric.Additive.Group
+ ) where
+
+import Numeric.Additive.Semigroup
+import Numeric.Additive.Monoid
+import Numeric.Additive.Group
118 Numeric/Additive/Group.hs
@@ -0,0 +1,118 @@
+module Numeric.Additive.Group
+ (
+ -- * Additive Groups
+ AdditiveGroup(..)
+ , replicateGroup
+ -- * Additive Abelian Groups
+ , AdditiveAbelianGroup
+ ) where
+
+import Data.Int
+import Data.Word
+import Prelude hiding ((+), (-), negate, subtract)
+import qualified Prelude
+import Numeric.Additive.Semigroup
+import Numeric.Additive.Monoid
+
+class AdditiveMonoid r => AdditiveGroup r where
+ (-) :: r -> r -> r
+ negate :: r -> r
+ subtract :: r -> r -> r
+
+ negate a = zero - a
+ a - b = a + negate b
+ subtract a b = negate a + b
+
+class AdditiveGroup r => AdditiveAbelianGroup r
+
+replicateGroup :: (Integral n, AdditiveGroup r) => n -> r -> r
+replicateGroup y0 x0 = case compare y0 0 of
+ LT -> f (negate x0) (Prelude.negate y0)
+ EQ -> zero
+ GT -> f x0 y0
+ where
+ f x y
+ | even y = f (x + x) (y `quot` 2)
+ | y == 1 = x
+ | otherwise = g (x + x) ((y Prelude.- 1) `quot` 2) x
+ g x y z
+ | even y = g (x + x) (y `quot` 2) z
+ | y == 1 = x + z
+ | otherwise = g (x + x) ((y Prelude.- 1) `quot` 2) (x + z)
+
+
+instance AdditiveGroup r => AdditiveGroup (e -> r) where
+ f - g = \x -> f x - g x
+ negate f x = negate (f x)
+ subtract f g x = subtract (f x) (g x)
+
+instance AdditiveGroup Integer where
+ (-) = (Prelude.-)
+ negate = Prelude.negate
+ subtract = Prelude.subtract
+
+instance AdditiveGroup Int where
+ (-) = (Prelude.-)
+ negate = Prelude.negate
+ subtract = Prelude.subtract
+
+instance AdditiveGroup Int8 where
+ (-) = (Prelude.-)
+ negate = Prelude.negate
+ subtract = Prelude.subtract
+
+instance AdditiveGroup Int16 where
+ (-) = (Prelude.-)
+ negate = Prelude.negate
+ subtract = Prelude.subtract
+
+instance AdditiveGroup Int32 where
+ (-) = (Prelude.-)
+ negate = Prelude.negate
+ subtract = Prelude.subtract
+
+instance AdditiveGroup Int64 where
+ (-) = (Prelude.-)
+ negate = Prelude.negate
+ subtract = Prelude.subtract
+
+instance AdditiveGroup Word where
+ (-) = (Prelude.-)
+ negate = Prelude.negate
+ subtract = Prelude.subtract
+
+instance AdditiveGroup Word8 where
+ (-) = (Prelude.-)
+ negate = Prelude.negate
+ subtract = Prelude.subtract
+
+instance AdditiveGroup Word16 where
+ (-) = (Prelude.-)
+ negate = Prelude.negate
+ subtract = Prelude.subtract
+
+instance AdditiveGroup Word32 where
+ (-) = (Prelude.-)
+ negate = Prelude.negate
+ subtract = Prelude.subtract
+
+instance AdditiveGroup Word64 where
+ (-) = (Prelude.-)
+ negate = Prelude.negate
+ subtract = Prelude.subtract
+
+-- *** Additive Abelian Group Instances
+
+instance AdditiveAbelianGroup r => AdditiveAbelianGroup (e -> r)
+instance AdditiveAbelianGroup Integer
+instance AdditiveAbelianGroup Int
+instance AdditiveAbelianGroup Int8
+instance AdditiveAbelianGroup Int16
+instance AdditiveAbelianGroup Int32
+instance AdditiveAbelianGroup Int64
+instance AdditiveAbelianGroup Word
+instance AdditiveAbelianGroup Word8
+instance AdditiveAbelianGroup Word16
+instance AdditiveAbelianGroup Word32
+instance AdditiveAbelianGroup Word64
+
56 Numeric/Additive/Monoid.hs
@@ -0,0 +1,56 @@
+module Numeric.Additive.Monoid
+ (
+ -- * Additive Monoids
+ AdditiveMonoid(..)
+ , replicateMonoid
+ , sum
+ ) where
+
+import Data.Foldable hiding (sum)
+import Numeric.Additive.Semigroup
+import Data.Int
+import Data.Word
+
+import Prelude hiding ((+), sum)
+
+-- |
+class AdditiveSemigroup r => AdditiveMonoid r where
+ zero :: r
+
+ sumWith :: Foldable f => (a -> r) -> f a -> r
+ sumWith f = foldl' (\b a -> b + f a) zero
+
+sum :: (Foldable f, AdditiveMonoid r) => f r -> r
+sum = sumWith id
+
+replicateMonoid :: (Integral n, AdditiveMonoid r) => n -> r -> r
+replicateMonoid y0 x0 = case compare y0 0 of
+ LT -> error "replicateSemigroup: negative multiplier"
+ EQ -> zero
+ GT -> f x0 y0
+ where
+ f x y
+ | even y = f (x + x) (y `quot` 2)
+ | y == 1 = x
+ | otherwise = g (x + x) ((y Prelude.- 1) `quot` 2) x
+ g x y z
+ | even y = g (x + x) (y `quot` 2) z
+ | y == 1 = x + z
+ | otherwise = g (x + x) ((y Prelude.- 1) `quot` 2) (x + z)
+
+instance AdditiveMonoid r => AdditiveMonoid (e -> r) where
+ zero = const zero
+ sumWith f xs e = sumWith (`f` e) xs
+
+instance AdditiveMonoid Integer where zero = 0
+instance AdditiveMonoid Int where zero = 0
+instance AdditiveMonoid Int8 where zero = 0
+instance AdditiveMonoid Int16 where zero = 0
+instance AdditiveMonoid Int32 where zero = 0
+instance AdditiveMonoid Int64 where zero = 0
+instance AdditiveMonoid Word where zero = 0
+instance AdditiveMonoid Word8 where zero = 0
+instance AdditiveMonoid Word16 where zero = 0
+instance AdditiveMonoid Word32 where zero = 0
+instance AdditiveMonoid Word64 where zero = 0
+
99 Numeric/Additive/Semigroup.hs
@@ -0,0 +1,99 @@
+module Numeric.Additive.Semigroup
+ (
+ -- * Additive Semigroups
+ AdditiveSemigroup(..)
+ , replicateSemigroup
+ , sum1
+ ) where
+
+import qualified Prelude
+import Prelude hiding ((+), replicate)
+import Data.Int
+import Data.Word
+import Data.Semigroup.Foldable
+import Data.Foldable
+
+-- |
+-- > (a + b) + c = a + (b + c)
+-- > replicate 1 a = a
+-- > replicate (2 * n) a = replicate n a + replicate n a
+-- > replicate (2 * n + 1) a = replicate n a + replicate n a + a
+class AdditiveSemigroup r where
+ (+) :: r -> r -> r
+
+ replicate :: Integral n => n -> r -> r
+
+ sumWith1 :: Foldable1 f => (a -> r) -> f a -> r
+ sumWith1 f = maybe (error "Numeric.Additive.Semigroup.sumWith1: empty structure") id . foldl' mf Nothing
+ where mf Nothing y = Just $! f y
+ mf (Just x) y = Just $! x + f y
+
+-- | A suitable default definition for replicate, given only a semigroup.
+-- Not used as a default definition, because you can usually do better if you have more than a semigroup!
+replicateSemigroup :: (Integral n, AdditiveSemigroup r) => n -> r -> r
+replicateSemigroup y0 x0 = case compare y0 0 of
+ LT -> error "replicateSemigroup: negative multiplier"
+ EQ -> error "replicateSemigroup: zero multiplier"
+ GT -> f x0 y0
+ where
+ f x y
+ | even y = f (x + x) (y `quot` 2)
+ | y == 1 = x
+ | otherwise = g (x + x) ((y Prelude.- 1) `quot` 2) x
+ g x y z
+ | even y = g (x + x) (y `quot` 2) z
+ | y == 1 = x + z
+ | otherwise = g (x + x) ((y Prelude.- 1) `quot` 2) (x + z)
+
+sum1 :: (Foldable1 f, AdditiveSemigroup r) => f r -> r
+sum1 = sumWith1 id
+
+instance AdditiveSemigroup r => AdditiveSemigroup (b -> r) where
+ f + g = \e -> f e + g e
+ replicate n f e = replicate n (f e)
+ sumWith1 f xs e = sumWith1 (`f` e) xs
+
+instance AdditiveSemigroup Integer where
+ (+) = (Prelude.+)
+ replicate n r = fromIntegral n * r
+
+instance AdditiveSemigroup Int where
+ (+) = (Prelude.+)
+ replicate n r = fromIntegral n * r
+
+instance AdditiveSemigroup Int8 where
+ (+) = (Prelude.+)
+ replicate n r = fromIntegral n * r
+
+instance AdditiveSemigroup Int16 where
+ (+) = (Prelude.+)
+ replicate n r = fromIntegral n * r
+
+instance AdditiveSemigroup Int32 where
+ (+) = (Prelude.+)
+ replicate n r = fromIntegral n * r
+
+instance AdditiveSemigroup Int64 where
+ (+) = (Prelude.+)
+ replicate n r = fromIntegral n * r
+
+instance AdditiveSemigroup Word where
+ (+) = (Prelude.+)
+ replicate n r = fromIntegral n * r
+
+instance AdditiveSemigroup Word8 where
+ (+) = (Prelude.+)
+ replicate n r = fromIntegral n * r
+
+instance AdditiveSemigroup Word16 where
+ (+) = (Prelude.+)
+ replicate n r = fromIntegral n * r
+
+instance AdditiveSemigroup Word32 where
+ (+) = (Prelude.+)
+ replicate n r = fromIntegral n * r
+
+instance AdditiveSemigroup Word64 where
+ (+) = (Prelude.+)
+ replicate n r = fromIntegral n * r
+
23 Numeric/Decidable/Zero.hs
@@ -0,0 +1,23 @@
+module Numeric.Decidable.Zero
+ ( DecidableZero(..)
+ ) where
+
+import Numeric.Additive.Monoid
+import Data.Int
+import Data.Word
+
+class AdditiveMonoid r => DecidableZero r where
+ isZero :: r -> Bool
+
+instance DecidableZero Integer where isZero = (0==)
+instance DecidableZero Int where isZero = (0==)
+instance DecidableZero Int8 where isZero = (0==)
+instance DecidableZero Int16 where isZero = (0==)
+instance DecidableZero Int32 where isZero = (0==)
+instance DecidableZero Int64 where isZero = (0==)
+
+instance DecidableZero Word where isZero = (0==)
+instance DecidableZero Word8 where isZero = (0==)
+instance DecidableZero Word16 where isZero = (0==)
+instance DecidableZero Word32 where isZero = (0==)
+instance DecidableZero Word64 where isZero = (0==)
71 Numeric/Functional/Antilinear.hs
@@ -0,0 +1,71 @@
+module Numeric.Functional.Antilinear
+ ( Antilinear(..)
+ ) where
+
+import Numeric.Additive
+import Control.Applicative
+import Control.Monad
+import Data.Functor.Plus hiding (zero)
+import qualified Data.Functor.Plus as Plus
+import Data.Functor.Bind
+import qualified Prelude
+import Prelude hiding ((+),(-),negate,subtract,replicate)
+
+-- | Antilinear functionals from elements of a free module to a scalar
+
+-- appAntilinear f (x + y) = appAntilinear f x + appAntilinear f y
+-- appAntilinear f (a .* x) = conjugate a * appAntilinear f x
+
+newtype Antilinear s a = Antilinear { appAntilinear :: (a -> s) -> s }
+
+instance Functor (Antilinear s) where
+ fmap f (Antilinear m) = Antilinear (\k -> m (k . f))
+
+instance Apply (Antilinear s) where
+ Antilinear mf <.> Antilinear ma = Antilinear (\k -> mf (\f -> ma (k . f)))
+
+instance Applicative (Antilinear s) where
+ pure a = Antilinear (\k -> k a)
+ Antilinear mf <*> Antilinear ma = Antilinear (\k -> mf (\f -> ma (k . f)))
+
+instance Bind (Antilinear s) where
+ Antilinear m >>- f = Antilinear (\k -> m (\a -> appAntilinear (f a) k))
+
+instance Monad (Antilinear s) where
+ return a = Antilinear (\k -> k a)
+ Antilinear m >>= f = Antilinear (\k -> m (\a -> appAntilinear (f a) k))
+
+instance AdditiveSemigroup s => Alt (Antilinear s) where
+ Antilinear m <!> Antilinear n = Antilinear (m + n)
+
+instance AdditiveMonoid s => Plus (Antilinear s) where
+ zero = Antilinear zero
+
+instance AdditiveMonoid s => Alternative (Antilinear s) where
+ Antilinear m <|> Antilinear n = Antilinear (m + n)
+ empty = Antilinear zero
+
+instance AdditiveMonoid s => MonadPlus (Antilinear s) where
+ Antilinear m `mplus` Antilinear n = Antilinear (m + n)
+ mzero = Antilinear zero
+
+instance AdditiveSemigroup s => AdditiveSemigroup (Antilinear s a) where
+ Antilinear m + Antilinear n = Antilinear (m + n)
+ replicate n (Antilinear m) = Antilinear (replicate n m)
+
+instance AdditiveMonoid s => AdditiveMonoid (Antilinear s a) where
+ zero = Antilinear zero
+
+instance AdditiveGroup s => AdditiveGroup (Antilinear s a) where
+ Antilinear m - Antilinear n = Antilinear (m - n)
+ negate (Antilinear m) = Antilinear (negate m)
+ subtract (Antilinear m) (Antilinear n) = Antilinear (subtract m n)
+
+instance AdditiveAbelianGroup s => AdditiveAbelianGroup (Antilinear s a)
+
+-- instance MultiplicativeSemigroup s => LeftModule s (Antilinear s a) where
+-- s .* Antilinear m = Antilinear (s .* m)
+
+-- instance MultiplicativeSemigroup s => RightModule s (Antilinear s a) where
+-- Antilinear m *. s = Antilinear (m *. s)
+
71 Numeric/Functional/Linear.hs
@@ -0,0 +1,71 @@
+module Numeric.Functional.Linear
+ ( Linear(..)
+ ) where
+
+import Numeric.Additive
+import Control.Applicative
+import Control.Monad
+import Data.Functor.Plus hiding (zero)
+import qualified Data.Functor.Plus as Plus
+import Data.Functor.Bind
+import qualified Prelude
+import Prelude hiding ((+),(-),negate,subtract,replicate)
+
+-- | Linear functionals from elements of a free module to a scalar
+
+-- appLinear f (x + y) = appLinear f x + appLinear f y
+-- appLinear f (a .* x) = a * appLinear f x
+
+newtype Linear s a = Linear { appLinear :: (a -> s) -> s }
+
+instance Functor (Linear s) where
+ fmap f (Linear m) = Linear (\k -> m (k . f))
+
+instance Apply (Linear s) where
+ Linear mf <.> Linear ma = Linear (\k -> mf (\f -> ma (k . f)))
+
+instance Applicative (Linear s) where
+ pure a = Linear (\k -> k a)
+ Linear mf <*> Linear ma = Linear (\k -> mf (\f -> ma (k . f)))
+
+instance Bind (Linear s) where
+ Linear m >>- f = Linear (\k -> m (\a -> appLinear (f a) k))
+
+instance Monad (Linear s) where
+ return a = Linear (\k -> k a)
+ Linear m >>= f = Linear (\k -> m (\a -> appLinear (f a) k))
+
+instance AdditiveSemigroup s => Alt (Linear s) where
+ Linear m <!> Linear n = Linear (m + n)
+
+instance AdditiveMonoid s => Plus (Linear s) where
+ zero = Linear zero
+
+instance AdditiveMonoid s => Alternative (Linear s) where
+ Linear m <|> Linear n = Linear (m + n)
+ empty = Linear zero
+
+instance AdditiveMonoid s => MonadPlus (Linear s) where
+ Linear m `mplus` Linear n = Linear (m + n)
+ mzero = Linear zero
+
+instance AdditiveSemigroup s => AdditiveSemigroup (Linear s a) where
+ Linear m + Linear n = Linear (m + n)
+ replicate n (Linear m) = Linear (replicate n m)
+
+instance AdditiveMonoid s => AdditiveMonoid (Linear s a) where
+ zero = Linear zero
+
+instance AdditiveGroup s => AdditiveGroup (Linear s a) where
+ Linear m - Linear n = Linear (m - n)
+ negate (Linear m) = Linear (negate m)
+ subtract (Linear m) (Linear n) = Linear (subtract m n)
+
+instance AdditiveAbelianGroup s => AdditiveAbelianGroup (Linear s a)
+
+-- instance MultiplicativeSemigroup s => LeftModule s (Linear s a) where
+-- s .* Linear m = Linear (s .* m)
+
+-- instance MultiplicativeSemigroup s => RightModule s (Linear s a) where
+-- Linear m *. s = Linear (m *. s)
+
54 Numeric/Multiplicative/Monoid.hs
@@ -0,0 +1,54 @@
+module Numeric.Multiplicative.Monoid
+ ( MultiplicativeMonoid(..)
+ , powMonoid
+ , product
+ ) where
+
+import Numeric.Multiplicative.Semigroup
+import Data.Foldable hiding (product)
+import Data.Int
+import Data.Word
+import Prelude hiding ((*), foldr, product)
+
+class MultiplicativeSemigroup r => MultiplicativeMonoid r where
+ one :: r
+ productWith :: Foldable f => (a -> r) -> f a -> r
+ productWith f = foldl' (\b a -> b * f a) one
+
+product :: (Foldable f, MultiplicativeMonoid r) => f r -> r
+product = productWith id
+
+powMonoid :: (MultiplicativeMonoid r, Integral n) => r -> n -> r
+powMonoid x0 y0 = case compare y0 0 of
+ LT -> error "powSemigroup: negative length"
+ EQ -> one
+ GT -> f x0 y0
+ where
+ f x y
+ | even y = f (x * x) (y `quot` 2)
+ | y == 1 = x
+ | otherwise = g (x * x) ((y - 1) `quot` 2) x
+ g x y z
+ | even y = g (x * x) (y `quot` 2) z
+ | y == 1 = x * z
+ | otherwise = g (x * x) ((y - 1) `quot` 2) (x * z)
+
+
+-- Conversion from the endomorphism ring of an abelian group r
+-- fromEnd :: Ring r => (r -> r) -> r
+-- fromEnd f = f one
+-- instance MultiplicativeMonoid (r -> r) where one = id
+
+instance MultiplicativeMonoid Integer where one = 1
+instance MultiplicativeMonoid Int where one = 1
+instance MultiplicativeMonoid Int8 where one = 1
+instance MultiplicativeMonoid Int16 where one = 1
+instance MultiplicativeMonoid Int32 where one = 1
+instance MultiplicativeMonoid Int64 where one = 1
+
+instance MultiplicativeMonoid Word where one = 1
+instance MultiplicativeMonoid Word8 where one = 1
+instance MultiplicativeMonoid Word16 where one = 1
+instance MultiplicativeMonoid Word32 where one = 1
+instance MultiplicativeMonoid Word64 where one = 1
+
113 Numeric/Multiplicative/Semigroup.hs
@@ -0,0 +1,113 @@
+module Numeric.Multiplicative.Semigroup
+ ( MultiplicativeSemigroup(..)
+ , powSemigroup
+ , powIntegral
+ , product1
+ ) where
+
+import Data.Foldable
+import Data.Int
+import Data.Word
+import Data.Semigroup.Foldable
+import qualified Prelude
+import Prelude hiding ((*), (+), negate, (-), recip, (/), foldr, sum, product)
+
+class MultiplicativeSemigroup r where
+ (*) :: r -> r -> r
+ (^) :: Integral n => r -> n -> r
+ productWith1 :: Foldable1 f => (a -> r) -> f a -> r
+ productWith1 f = maybe (error "Numeric.Multiplicative.Semigroup.productWith1: empty structure") id . foldl' mf Nothing
+ where mf Nothing y = Just $! f y
+ mf (Just x) y = Just $! x * f y
+
+product1 :: (Foldable1 f, MultiplicativeSemigroup r) => f r -> r
+product1 = productWith1 id
+
+powSemigroup :: (MultiplicativeSemigroup r, Integral n) => r -> n -> r
+powSemigroup x0 y0 = case compare y0 0 of
+ LT -> error "powSemigroup: negative length"
+ EQ -> error "powSemigroup: zero length"
+ GT -> f x0 y0
+ where
+ f x y
+ | even y = f (x * x) (y `quot` 2)
+ | y == 1 = x
+ | otherwise = g (x * x) ((y Prelude.- 1) `quot` 2) x
+ g x y z
+ | even y = g (x * x) (y `quot` 2) z
+ | y == 1 = x * z
+ | otherwise = g (x * x) ((y Prelude.- 1) `quot` 2) (x * z)
+
+-- a suitable default definition for (^) for instances of the Prelude Integral class,
+-- addressing possible negative exponentiation of units 1 and -1.
+powIntegral :: (Integral r, Integral n) => r -> n -> r
+powIntegral (-1) y0
+ | even y0 = 1
+ | otherwise = -1
+powIntegral 1 _ = 1
+powIntegral x0 y0 = case compare y0 0 of
+ LT -> error "negative non-unit recipriocal"
+ EQ -> 1
+ GT -> f x0 y0
+ where
+ f x y
+ | even y = f (x Prelude.* x) (y `quot` 2)
+ | y == 1 = x
+ | otherwise = g (x Prelude.* x) ((y Prelude.- 1) `quot` 2) x
+ g x y z
+ | even y = g (x Prelude.* x) (y `quot` 2) z
+ | y == 1 = x Prelude.* z
+ | otherwise = g (x Prelude.* x) ((y Prelude.- 1) `quot` 2) (x Prelude.* z)
+
+{-
+-- requires flexible instances
+instance MultiplicativeSemigroup (r -> r) where
+ (*) = (.)
+ x0 ^ y0 = case compare y0 0 of
+ LT -> error "(a -> a).(^) : negative length"
+ EQ -> id
+ GT -> f x0 y0
+ where
+ f x y
+ | even y = f (x * x) (y `quot` 2)
+ | y == 1 = x
+ | otherwise = g (x * x) ((y Prelude.- 1) `quot` 2) x
+ g x y z
+ | even y = g (x * x) (y `quot` 2) z
+ | y == 1 = x * z
+ | otherwise = g (x * x) ((y Prelude.- 1) `quot` 2) (x * z)
+-}
+
+instance MultiplicativeSemigroup Integer where
+ (*) = (Prelude.*)
+ (^) = powIntegral
+instance MultiplicativeSemigroup Int where
+ (*) = (Prelude.*)
+ (^) = powIntegral
+instance MultiplicativeSemigroup Int8 where
+ (*) = (Prelude.*)
+ (^) = powIntegral
+instance MultiplicativeSemigroup Int16 where
+ (*) = (Prelude.*)
+ (^) = powIntegral
+instance MultiplicativeSemigroup Int32 where
+ (*) = (Prelude.*)
+ (^) = powIntegral
+instance MultiplicativeSemigroup Int64 where
+ (*) = (Prelude.*)
+ (^) = powIntegral
+instance MultiplicativeSemigroup Word where
+ (*) = (Prelude.*)
+ (^) = powIntegral
+instance MultiplicativeSemigroup Word8 where
+ (*) = (Prelude.*)
+ (^) = powIntegral
+instance MultiplicativeSemigroup Word16 where
+ (*) = (Prelude.*)
+ (^) = powIntegral
+instance MultiplicativeSemigroup Word32 where
+ (*) = (Prelude.*)
+ (^) = powIntegral
+instance MultiplicativeSemigroup Word64 where
+ (*) = (Prelude.*)
+ (^) = powIntegral
38 algebra.cabal
@@ -0,0 +1,38 @@
+name: algebra
+category: Control, Comonads
+version: 0.1.0
+license: BSD3
+cabal-version: >= 1.6
+license-file: LICENSE
+author: Edward A. Kmett
+maintainer: Edward A. Kmett <ekmett@gmail.com>
+stability: provisional
+homepage: http://github.com/ekmett/algebra/
+copyright: Copyright (C) 2011 Edward A. Kmett
+synopsis: Haskell 98 abstract algebra
+description: Haskell 98 abstract algebra
+build-type: Simple
+
+source-repository head
+ type: git
+ location: git://github.com/ekmett/algebra.git
+
+library
+ build-depends:
+ base >= 4 && < 4.4,
+ transformers >= 0.2.0 && < 0.3,
+ containers >= 0.3.0.0 && < 0.5,
+ semigroups >= 0.5 && < 0.6,
+ semigroupoids >= 1.2.2 && < 1.3
+
+ exposed-modules:
+ Numeric.Additive
+ Numeric.Additive.Semigroup
+ Numeric.Additive.Monoid
+ Numeric.Additive.Group
+ Numeric.Multiplicative.Semigroup
+ Numeric.Multiplicative.Monoid
+ Numeric.Functional.Linear
+ Numeric.Decidable.Zero
+
+ ghc-options: -Wall

0 comments on commit 3a70b11

Please sign in to comment.