diff --git a/Data/Nimber.hs b/Data/Nimber.hs --- a/Data/Nimber.hs +++ b/Data/Nimber.hs @@ -1,76 +1,164 @@ --- |This is an implementation of the nimbers, which are technically a field --- over the non-negative ordinals, but in this case are restricted to the --- non-negative integers. Note that division by n is speedy for n < 16, --- about one second for n < 256, about a minute for n < 65535, and probably --- very, very, very slow for n >= 65535. +{-# LANGUAGE + DeriveDataTypeable #-} + +{- | +Module : Data.Nimber +Description : Finite nimber arithmetic +Copyright : © Anders Kaseorg, 2013 +License : BSD-style + +Maintainer : Anders Kaseorg +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 +. +-} + module Data.Nimber ( - Nimber(fromNimber), -) -where + Nimber, + fromNimber, + NimberException (..), + ) where +import Control.Exception (Exception, ArithException (..), throw) import Data.Bits -import Data.List -import Data.Maybe import Data.Ratio -import Control.Monad -import qualified Data.MemoCombinators as Memo -newtype Nimber = Nimber { - fromNimber :: Integer -} deriving (Eq, Ord) +import Data.Typeable +import Math.NumberTheory.Logarithms -memoNimber = Memo.wrap fromInteger fromNimber Memo.integral +-- |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) --- | cast any non-negative Integer into a Nimber -toNimber :: Integer -> Nimber -toNimber x - | x < 0 = error "negative nimbers not defined" - | otherwise = Nimber x +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 - show (Nimber x) = '*' : show x + 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 x) = Nimber (x-1) - succ (Nimber x) = Nimber (x+1) - toEnum = Nimber . toInteger - fromEnum = fromEnum .fromNimber + 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 - abs = id - negate = id - (+) (Nimber x) (Nimber y) = fromInteger (x `xor` y) - signum 0 = 0 - signum _ = 1 - fromInteger = toNimber - a * b = sum $ fastMult (fromNimber a) (fromNimber b) where - -- fastMult expands out a product of a pair of nimbers into the products of constituent powers of 2 - -- for example, fastMult 5 6 = [2^2 * 2^2, 2^0 * 2^2, 2^2 * 2^1, 2^0 * 2^1] = [6, 4, 8, 2] - fastMult a b = - let aBits = reverse $ toBits a - bBits = reverse $ toBits b - in map (\(xs, ys) -> pow2mult $ bitProduct (toBits $ toInteger xs) (toBits $ toInteger ys)) $ filter (\(m, n) -> aBits !! m * bBits !! n == 1) $ liftM2 (,) [0 .. length aBits - 1] [0 .. length bBits - 1] - -- toBits expands a number into its bits; toBits 13 = [1, 1, 0, 1]; toBits 0 = [] - where toBits n = reverse $ unfoldr (\x -> if x==0 then Nothing else Just (x `rem` 2, x `div` 2)) n - -- pow2mult multiplies together powers of 2 given in a list as follows: - -- pow2mult [3, 0, 1, 0] = (2^(2^3))^3 * 2^(2^1) = 256^3 * 4 = 33152 * 4 = 46256 - pow2mult [] = 1 - pow2mult [0] = 1 - pow2mult [1] = 2 - pow2mult (0:xs) = pow2mult xs - pow2mult (1:xs) = fromInteger $ 2^(2^(length xs)) * (fromNimber $ pow2mult xs) - pow2mult (x:xs) = pow2mult (x-1:xs) + pow2mult (x-2:(map (+1) xs)) - -- bitProduct combines lists of powers of 2 by zero-padding the shorter list: - -- bitProduct [1, 0, 2, 1] [1, 3] = [1, 0, 3, 4] - bitProduct xs ys - | lx == ly = zipWith (+) xs ys - | lx < ly = bitProduct ys xs - | otherwise = zipWith (+) xs (replicate (lx - ly) 0 ++ ys) - where lx = length xs - ly = length ys - + 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 - -- Warning: division takes a second or two for 16 <= n <= 255, - -- a minute or so for 256 <= n < 65535, and probably several minutes - -- for 65536 <= n <= 4294967295. - recip = memoNimber recip' where - recip' a = fromJust $ find (\n -> n * a == 1) [1..] - fromRational r = (fromInteger $ numerator r) / (fromInteger $ denominator r) + 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") diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,24 +1,29 @@ -Copyright (c) 2009, Patrick Hurst +Copyright © 2013, Anders Kaseorg 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 the nor the - names of its contributors may be used to endorse or promote products - derived from this software without specific prior written permission. +modification, are permitted provided that the following conditions are +met: -THIS SOFTWARE IS PROVIDED BY ''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 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. +• 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. diff --git a/nimber.cabal b/nimber.cabal --- a/nimber.cabal +++ b/nimber.cabal @@ -1,22 +1,31 @@ -Name: nimber -Version: 0.1.1 -Synopsis: An implementation of (finite) nimbers -Description: This library provides a method to do arithmetic on - nimbers, which may be considered an alternative field - over the non-negative integers (the general case of - transfinite ordinal nimbers is not implementented.) - Note that division is extremely slow at this point, - due to the lack of a closed-form implementation. -License: BSD3 -License-file: LICENSE -Author: Patrick Hurst -Maintainer: phurst@mit.edu -Build-Type: Simple -Cabal-Version: >=1.2 -Stability: stable -Category: Math +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 +maintainer: Anders Kaseorg +copyright: © 2013 Anders Kaseorg +category: Math +build-type: Simple +cabal-version: >=1.8 -Library - Build-Depends: base >= 2 && < 4, data-memocombinators, containers - Exposed-Modules: Data.Nimber - ghc-options: -W +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