Initial commit of Haskell nimber library

Signed-off-by: Anders Kaseorg <[email protected]>

Data/Nimber.hs

@@ -0,0 +1,164 @@
+{-# LANGUAGE
+  DeriveDataTypeable #-}
+
+{- |
+Module      :  Data.Nimber
+Description :  Finite nimber arithmetic
+Copyright   :  © Anders Kaseorg, 2013
+License     :  BSD-style
+
+Maintainer  :  Anders Kaseorg <[email protected]>
+Stability   :  experimental
+Portability :  Non-portable (GHC extensions)
+
+The finite nimbers, 'Nimber', are a quadratically closed field of
+characteristic 2 introduced in combinatorial game theory.
+
+>>> 257 + 258 :: Nimber
+*3
+>>> sqrt 123456789 :: Nimber
+*98433322
+>>> 123456789/sqrt 123456789 :: Nimber
+*98433322
+
+This implementation was inspired by Patrick Hurst’s slow Haskell
+implementation that this replaced (with his permission), and by Michel
+Van den Bergh’s Python implementation at
+<https://web.archive.org/web/20101124110959/http://alpha.uhasselt.be/Research/Algebra/Members/nimbers/nimbers.py>.
+-}
+
+module Data.Nimber (
+  Nimber,
+  fromNimber,
+  NimberException (..),
+  ) where
+
+import Control.Exception (Exception, ArithException (..), throw)
+import Data.Bits
+import Data.Ratio
+import Data.Typeable
+import Math.NumberTheory.Logarithms
+
+-- |The type of exceptions thrown by impossible 'Nimber' operations.
+data NimberException =
+  -- |A negative integer was converted to a nimber.
+  NegativeNimber |
+  -- |A transcendental function was called on nimbers.
+  Innimerable String
+  deriving (Eq, Ord, Typeable)
+
+instance Show NimberException where
+  showsPrec _ (NegativeNimber) =
+    showString "nimbers cannot be negative"
+  showsPrec _ (Innimerable s) =
+    showString "nimbers do not support " . showString s
+
+instance Exception NimberException
+
+-- |The type of finite nimbers.
+newtype Nimber = Nimber {fromNimber :: Integer} deriving (Eq, Ord)
+
+nimSize :: Nimber -> Int
+nimSize (Nimber a) = bit (intLog2 (integerLog2 a))
+
+nimSplit :: Int -> Nimber -> (Nimber, Nimber)
+nimSplit k = \(Nimber a) -> (Nimber (a `shiftR` k), Nimber (a .&. mask)) where
+  mask = complement (-1 `shiftL` k)
+
+nimJoin :: Int -> (Nimber, Nimber) -> Nimber
+nimJoin k (Nimber a1, Nimber a0) = Nimber ((a1 `shiftL` k) .|. a0)
+
+nimBit :: Int -> Nimber
+nimBit i = Nimber (bit i)
+
+nimSqr :: Nimber -> Nimber
+nimSqr 0 = 0
+nimSqr 1 = 1
+nimSqr a = nimJoin k (p1, p0 + p1 * nimBit (k - 1)) where
+  k = nimSize a
+  (a1, a0) = nimSplit k a
+  p0 = nimSqr a0
+  p1 = nimSqr a1
+
+instance Show Nimber where
+  showsPrec d (Nimber a) = showParen (d > 7) $ showChar '*' . showsPrec 8 a
+
+instance Read Nimber where
+  readsPrec d = readParen (d > 7) $ \s -> case s of
+    '*' : s1 -> [(fromInteger a, s2) | (a, s2) <- readsPrec 8 s1]
+    _ -> []
+
+instance Enum Nimber where
+  pred (Nimber a) = fromInteger (pred a)
+  succ (Nimber a) = fromInteger (succ a)
+  toEnum a = fromInteger (toEnum a)
+  fromEnum (Nimber a) = fromEnum a
+
+instance Num Nimber where
+  Nimber a + Nimber b = Nimber (a `xor` b)
+
+  0 * _ = 0
+  _ * 0 = 0
+  1 * a = a
+  a * 1 = a
+  a * b | a == b = nimSqr a
+  a * b = nimJoin k (p0 + (a0 + a1) * (b0 + b1), p0 + p1 * nimBit (k - 1)) where
+    k = max (nimSize a) (nimSize b)
+    split = nimSplit k
+    (a1, a0) = split a
+    (b1, b0) = split b
+    p0 = a0 * b0
+    p1 = a1 * b1
+
+  (-) = (+)
+  negate = id
+  abs = id
+  signum 0 = 0
+  signum _ = 1
+  fromInteger a
+    | a >= 0 = Nimber a
+    | otherwise = throw NegativeNimber
+
+{- |
+Note: Although nimbers support division, the 'fromRational' operation
+makes little sense because 'Rational's are reduced according to
+ordinary multiplication instead of nimber multiplication.
+-}
+instance Fractional Nimber where
+  recip 0 = throw DivideByZero
+  recip 1 = 1
+  recip a = (a + a1) * recip b where
+    k = nimSize a
+    (a1, a0) = nimSplit k a
+    b = a0 * (a0 + a1) + a1 * a1 * nimBit (k - 1)
+
+  fromRational r = fromInteger (numerator r) / fromInteger (denominator r)
+
+{- |
+This partial 'Floating' instance only supports 'sqrt'.  All other
+operations will throw the 'Innimerable' exception.
+-}
+instance Floating Nimber where
+  sqrt 0 = 0
+  sqrt 1 = 1
+  sqrt a = nimJoin k (sqrt a1, sqrt (a1 * nimBit (k - 1) + a0)) where
+    k = nimSize a
+    (a1, a0) = nimSplit k a
+
+  pi = throw (Innimerable "pi")
+  exp = throw (Innimerable "exp")
+  log = throw (Innimerable "log")
+  (**) = throw (Innimerable "**")
+  logBase = throw (Innimerable "logBase")
+  sin = throw (Innimerable "sin")
+  tan = throw (Innimerable "tan")
+  cos = throw (Innimerable "cos")
+  asin = throw (Innimerable "asin")
+  atan = throw (Innimerable "atan")
+  acos = throw (Innimerable "acos")
+  sinh = throw (Innimerable "sinh")
+  tanh = throw (Innimerable "tanh")
+  cosh = throw (Innimerable "cosh")
+  asinh = throw (Innimerable "asinh")
+  atanh = throw (Innimerable "atanh")
+  acosh = throw (Innimerable "acosh")

LICENSE

@@ -0,0 +1,29 @@
+Copyright © 2013, Anders Kaseorg <[email protected]>
+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 Anders Kaseorg 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

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

nimber.cabal

@@ -0,0 +1,31 @@
+name:                nimber
+version:             0.1.2
+synopsis:            Finite nimber arithmetic
+description:
+  The finite nimbers, 'Nimber', are a quadratically closed field of
+  characteristic 2 introduced in combinatorial game theory.
+homepage:            http://andersk.mit.edu/haskell/nimber/
+license:             BSD3
+license-file:        LICENSE
+author:              Anders Kaseorg <[email protected]>
+maintainer:          Anders Kaseorg <[email protected]>
+copyright:           © 2013 Anders Kaseorg
+category:            Math
+build-type:          Simple
+cabal-version:       >=1.8
+
+library
+  exposed-modules:     Data.Nimber
+  build-depends:
+    arithmoi >=0.1,
+    base ==4.*
+  ghc-options:       -Wall
+
+source-repository head
+  type:                git
+  location:            https://github.com/andersk/haskell-nimber
+
+source-repository this
+  type:                git
+  location:            https://github.com/andersk/haskell-nimber
+  tag:                 0.1.2