noiioiu/nimbers - Change F2J33IDG7QQEVMUX7EEIWSV43BMGWET3EPTR4CUAZ5PZ7SFXIXFQC

Change Nimber to FiniteNimber

Created by rodYtiEfBkWwnTMxdJCjgZfGA58pw5EzYYLWDptiSh1 on May 9, 2024

F2J33IDG7QQEVMUX7EEIWSV43BMGWET3EPTR4CUAZ5PZ7SFXIXFQC

Dependencies

In channels

main

Change contents

Replacement in test/Main.hs at line 16 [11.22]
B:BD[11.184] → [11.184:216]
```
instance Arbitrary Nimber where
```
[11.184]
[12.63]
```
instance Arbitrary FiniteNimber where
```
Replacement in test/Main.hs at line 23 [11.22]
B:BD[11.257] → [11.257:284]
```
prop_neg :: Nimber -> Bool
```
[11.257]
[13.2]
```
prop_neg :: FiniteNimber -> Bool
```
Replacement in test/Main.hs at line 26 [11.22]
B:BD[14.82] → [14.82:112]
```
prop_add_id :: Nimber -> Bool
```
[14.82]
[15.167]
```
prop_add_id :: FiniteNimber -> Bool
```
Replacement in test/Main.hs at line 29 [11.22]
B:BD[11.307] → [14.158:189]
```
prop_mult_id :: Nimber -> Bool
```
[11.307]
[15.209]
```
prop_mult_id :: FiniteNimber -> Bool
```

Replacement in test/Main.hs at line 32 [11.22]

B:BD[9.3] → [9.3:45]

prop_comm_add :: Nimber -> Nimber -> Bool

[9.3]

[9.45]

prop_comm_add :: FiniteNimber -> FiniteNimber -> Bool

Replacement in test/Main.hs at line 35 [11.22]

B:BD[14.236] → [9.81:124]

prop_comm_mult :: Nimber -> Nimber -> Bool

[14.236]

[9.124]

prop_comm_mult :: FiniteNimber -> FiniteNimber -> Bool

Replacement in test/Main.hs at line 38 [11.22]
∅:D[9.161] → [11.307:360]
∅:D[14.236] → [11.307:360]
B:BD[11.307] → [11.307:360]
```
prop_assoc_add :: Nimber -> Nimber -> Nimber -> Bool
```
[9.161]
[16.84]
```
prop_assoc_add :: FiniteNimber -> FiniteNimber -> FiniteNimber -> Bool
```

Replacement in test/Main.hs at line 41 [11.22]

B:BD[11.403] → [15.252:306]

prop_assoc_mult :: Nimber -> Nimber -> Nimber -> Bool

[11.403]

[15.306]

prop_assoc_mult :: FiniteNimber -> FiniteNimber -> FiniteNimber -> Bool

Replacement in test/Main.hs at line 44 [11.22]

B:BD[11.499] → [11.499:550]

prop_distrib :: Nimber -> Nimber -> Nimber -> Bool

[11.499]

[16.186]

prop_distrib :: FiniteNimber -> FiniteNimber -> FiniteNimber -> Bool

Replacement in test/Main.hs at line 47 [11.22]
B:BD[16.237] → [15.358:395]
```
prop_recip :: NonZero Nimber -> Bool
```
[16.237]
[15.395]
```
prop_recip :: NonZero FiniteNimber -> Bool
```
Replacement in test/Main.hs at line 50 [11.22]
B:BD[11.591] → [13.27:54]
```
prop_inv :: Nimber -> Bool
```
[11.591]
[13.54]
```
prop_inv :: FiniteNimber -> Bool
```
Replacement in test/Main.hs at line 53 [11.22]
B:BD[17.3] → [18.109:136]
```
prop_sqr :: Nimber -> Bool
```
[17.3]
[19.2]
```
prop_sqr :: FiniteNimber -> Bool
```

Replacement in test/Main.hs at line 56 [11.22]

B:BD[19.31] → [19.31:77]

prop_pow :: NonZero Nimber -> Integer -> Bool

[19.31]

[19.77]

prop_pow :: NonZero FiniteNimber -> Integer -> Bool

Replacement in test/Main.hs at line 62 [11.22]
B:BD[20.46] → [18.163:191]
```
prop_sqrt :: Nimber -> Bool
```
[20.46]
[18.191]
```
prop_sqrt :: FiniteNimber -> Bool
```
Replacement in test/Main.hs at line 65 [11.22]
B:BD[17.68] → [15.445:471]
```
prop_as :: Nimber -> Bool
```
[17.68]
[15.471]
```
prop_as :: FiniteNimber -> Bool
```

Replacement in test/Main.hs at line 68 [11.22]

B:BD[21.3] → [5.2:55]

prop_quadratic :: Nimber -> Nimber -> Nimber -> Bool

[21.3]

[5.55]

prop_quadratic :: FiniteNimber -> FiniteNimber -> FiniteNimber -> Bool

Replacement in test/Main.hs at line 101 [11.22]

B:BD[15.937] → [15.937:1023]

  pure $ fromIntegral @Int @Nimber (nimberAdd i j) == fromIntegral i + fromIntegral j

[15.937]

[22.197]

  pure $ fromIntegral @Int @FiniteNimber (nimberAdd i j) == fromIntegral i + fromIntegral j

Replacement in test/Main.hs at line 107 [11.22]

B:BD[15.1105] → [15.1105:1192]

  pure $ fromIntegral @Int @Nimber (nimberMult i j) == fromIntegral i * fromIntegral j

[15.1105]

[20.965]

  pure $ fromIntegral @Int @FiniteNimber (nimberMult i j) == fromIntegral i * fromIntegral j

Replacement in src/Data/Nimber.hs at line 1 [11.880]

B:BD[11.880] → [12.305:341]

∅:D[12.341] → [16.530:570]

B:BD[11.880] → [16.530:570]

∅:D[16.570] → [11.881:1080]

B:BD[11.880] → [11.881:1080]

B:BD[11.1080] → [2.4:179]

∅:D[2.179] → [11.1186:1338]

B:BD[11.1186] → [11.1186:1338]

B:BD[11.1338] → [19.269:387]

B:BD[19.387] → [23.5:96]

B:BD[23.96] → [21.168:188]

∅:D[21.188] → [23.96:106]

B:BD[23.96] → [23.96:106]

∅:D[24.101] → [25.4:5]

∅:D[23.106] → [25.4:5]

B:BD[11.1521] → [25.4:5]

B:BD[25.5] → [12.342:359]

B:BD[12.359] → [3.5:28]

∅:D[3.28] → [11.1521:1522]

∅:D[25.48] → [11.1521:1522]

∅:D[12.359] → [11.1521:1522]

∅:D[16.686] → [11.1521:1522]

B:BD[11.1521] → [11.1521:1522]

B:BD[11.2147] → [12.360:454]

∅:D[12.454] → [11.2455:2456]

B:BD[11.2455] → [11.2455:2456]

B:BD[11.2456] → [23.107:169]

B:BD[23.169] → [6.5:117]

∅:D[26.42] → [11.2740:2741]

∅:D[6.117] → [11.2740:2741]

∅:D[12.744] → [11.2740:2741]

B:BD[11.2740] → [11.2740:2741]

B:BD[11.2741] → [23.187:359]

B:BD[23.359] → [26.43:185]

∅:D[26.185] → [23.517:547]

B:BD[23.517] → [23.517:547]

B:BD[23.547] → [26.186:293]

∅:D[26.293] → [23.658:659]

B:BD[23.658] → [23.658:659]

∅:D[23.659] → [27.5:182]

B:BD[11.2741] → [27.5:182]

∅:D[27.182] → [28.176:179]

B:BD[28.176] → [28.176:179]

B:BD[28.179] → [27.183:397]

∅:D[27.397] → [28.388:504]

B:BD[28.388] → [28.388:504]

∅:D[29.69] → [11.2741:2767]

∅:D[28.605] → [11.2741:2767]

B:BD[11.2741] → [11.2741:2767]

B:BD[11.2767] → [12.745:801]

B:BD[12.801] → [7.5:17]

∅:D[7.17] → [30.49:211]

∅:D[31.29] → [30.49:211]

B:BD[30.49] → [30.49:211]

B:BD[15.1712] → [15.1712:1732]

∅:D[31.125] → [11.3728:3753]

∅:D[30.501] → [11.3728:3753]

∅:D[15.1732] → [11.3728:3753]

B:BD[11.3728] → [11.3728:3753]

B:BD[11.3753] → [29.70:100]

∅:D[29.100] → [18.738:739]

B:BD[18.738] → [18.738:739]

B:BD[18.739] → [23.660:729]

B:BD[23.729] → [26.294:353]

∅:D[26.353] → [23.796:866]

B:BD[23.796] → [23.796:866]

B:BD[23.866] → [32.5:38]

B:BD[32.38] → [26.354:416]

∅:D[32.104] → [23.964:965]

∅:D[26.416] → [23.964:965]

B:BD[23.964] → [23.964:965]

∅:D[23.965] → [18.739:827]

B:BD[18.739] → [18.739:827]

B:BD[18.847] → [18.847:959]

B:BD[15.2047] → [15.2047:2062]

{-# LANGUAGE DerivingStrategies #-}
{-# OPTIONS_GHC -Wno-type-defaults #-}
-- | In combinatorial game theory, nimbers represent the values of impartial games.  They are the simplest way of making the ordinals into a Field.
--   See /On Numbers and Games/ by John Conway.
--
--   Nimber addition is defined by \(\alpha+\beta = \operatorname{mex}\{\alpha'+\beta, \alpha+\beta'\}\), where \(\operatorname{mex} S\) is the smallest ordinal not in \(S\).
--
--   Nimber multiplication is defined by \(\alpha\cdot\beta = \operatorname{mex}\{\alpha'\cdot\beta + \alpha\cdot\beta' - \alpha'\cdot\beta'\}\).
--
--   This module implements /finite/ nimbers, which form the smallest quadratically closed field of characteristic 2.
module Data.Nimber
  ( Nimber (..),
    floorLog,
    sqr,
    pow,
    artinSchreierRoot,
    solveQuadratic,
  )
where
import Data.Bits
import Numeric.Natural
newtype Nimber = Nimber {getNimber :: Natural}
  deriving newtype (Show, Eq, Ord, Enum, Bits)
-- | Index of highest-order set bit, or -1 if there are none.
floorLog :: (Bits a, Num b) => a -> b
floorLog n
  | n == zeroBits = -1
  | otherwise = 1 + floorLog (n .>>. 1)
mult' :: Int -> Nimber -> Nimber -> Nimber
mult' _ 0 _ = 0
mult' _ _ 0 = 0
mult' _ 1 b = b
mult' _ a 1 = a
mult' m a b =
  let semiD = bit (bit m - 1) -- semimultiple of D
      s1 = a .>>. bit m -- a = a1D+a2
      s2 = a .^. (s1 .<<. bit m)
      t1 = b .>>. bit m -- b = b1D+b2
      t2 = b .^. (t1 .<<. bit m)
      c = mult' (m - 1) s2 t2
   in ((mult' (m - 1) (s1 + s2) (t1 + t2) - c) .<<. bit m) + mult' (m - 1) (mult' (m - 1) s1 t1) semiD + c
-- | Finite nimber addition is calculated as follows: the nimber sum of a two-power and itself is 0, while the nimber sum of a set of distinct two-powers is their ordinary sum.
--
--   Finite nimber multiplication is calculated as follows: the nimber square of a Fermat two-power is its sesquimultiple, while the nimber product of a set of distinct Fermat two-powers is their ordinary product.
--   The sesquimultiple of a Fermat two-power is equal to itself plus the product of all smaller Fermat two-powers.
instance Num Nimber where
  fromInteger = Nimber . fromIntegral . abs
  (+) = xor
  (-) = xor
  a * b =
    let m = max (floorLog @Int (floorLog a)) (floorLog @Int (floorLog b)) -- D = 2^2^m is the largest Fermat 2-power less than or equal to both a and b
     in mult' m a b
  negate = id
  abs = id
  signum 0 = 0
  signum _ = 1
sqr' :: Int -> Nimber -> Nimber
sqr' _ 0 = 0
sqr' _ 1 = 1
sqr' m n =
  let a = n .>>. bit m -- n = aD+b
      aD = a .<<. bit m
      b = n .^. aD
      semiD = bit (bit m - 1) -- semimultiple of D
      a2 = sqr' (m - 1) a -- a^2
   in a2 .<<. bit m + mult' (m - 1) a2 semiD + sqr' (m - 1) b
-- | Squaring function.  Faster than multiplying @n@ by itself.
sqr :: Nimber -> Nimber
sqr n =
  let m = floorLog @Int $ floorLog n -- D = 2^2^m is the largest Fermat 2-power less than or equal to n
   in sqr' m n

[11.880]

[19.388]

module Data.Nimber (module M) where

Replacement in src/Data/Nimber.hs at line 3 [11.880]

B:BD[19.389] → [19.389:467]

B:BD[19.467] → [15.2063:2161]

B:BD[15.2161] → [23.966:1023]

B:BD[23.1023] → [8.5:132]

∅:D[8.132] → [33.5:6]

∅:D[19.786] → [33.5:6]

∅:D[23.1143] → [33.5:6]

∅:D[18.1164] → [33.5:6]

∅:D[15.2282] → [33.5:6]

B:BD[34.58] → [33.5:6]

B:BD[33.6] → [35.5:291]

B:BD[35.340] → [35.340:458]

B:BD[35.458] → [23.1144:1188]

∅:D[23.1188] → [15.2283:2327]

B:BD[35.458] → [15.2283:2327]

B:BD[15.2327] → [26.417:492]

∅:D[26.492] → [15.2410:2496]

B:BD[15.2410] → [15.2410:2496]

B:BD[15.2496] → [4.5:117]

∅:D[4.117] → [15.2570:2589]

∅:D[23.1306] → [15.2570:2589]

B:BD[15.2570] → [15.2570:2589]

∅:D[15.2589] → [35.656:657]

B:BD[35.656] → [35.656:657]

∅:D[35.657] → [33.6:168]

B:BD[33.6] → [33.6:168]

B:BD[33.194] → [33.194:311]

B:BD[33.311] → [15.2590:2654]

B:BD[15.2654] → [26.493:568]

∅:D[26.568] → [15.2737:2764]

B:BD[15.2737] → [15.2737:2764]

B:BD[15.2764] → [7.18:77]

∅:D[7.77] → [15.2823:2861]

B:BD[15.2823] → [15.2823:2861]

B:BD[15.2861] → [26.569:662]

∅:D[26.662] → [15.2935:2953]

∅:D[23.1404] → [15.2935:2953]

B:BD[15.2935] → [15.2935:2953]

∅:D[18.1247] → [33.517:1401]

∅:D[15.2953] → [33.517:1401]

B:BD[33.517] → [33.517:1401]

B:BD[33.1401] → [15.2954:3819]

B:BD[15.3819] → [23.1405:1440]

∅:D[23.1440] → [15.3849:3878]

B:BD[15.3849] → [15.3849:3878]

B:BD[15.3878] → [23.1441:1556]

∅:D[23.1556] → [15.3981:4111]

B:BD[15.3981] → [15.3981:4111]

B:BD[15.4111] → [23.1557:1666]

∅:D[23.1666] → [15.4213:4289]

B:BD[15.4213] → [15.4213:4289]

B:BD[15.4289] → [10.5:160]

∅:D[10.160] → [15.4418:4538]

B:BD[15.4418] → [15.4418:4538]

B:BD[15.4538] → [21.189:371]

B:BD[21.371] → [5.151:248]

-- | Raise a @'Nimber'@ to an integral power.  Faster than using '^' or '^^'.
pow :: (Integral a, Bits a) => Nimber -> a -> Nimber
x `pow` n
  | n < 0 = recip x `pow` negate n
  | otherwise =
      let m = floorLog @Int $ floorLog x
       in (foldr (mult' m . snd) 1 . filter (testBit n . fst) . zip [0 ..] . take (1 + floorLog (n + 1))) $ iterate (sqr' m) x
-- | The finite nimbers are a field of characteristic 2.  There is no field homomorphism from the rationals to the nimbers, so @'fromRational'@ is always an error.
instance Fractional Nimber where
  fromRational _ = error "Cannot map from field of characteristic 0 to characteristic 2"
  recip n =
    let m = floorLog @Int $ floorLog n -- D = 2^2^m is the largest Fermat 2-power less than or equal to n
        recip' _ 0 = error "Divide by zero"
        recip' _ 1 = 1
        recip' k l =
          let a = l .>>. bit k -- n = aD+b
              aD = a .<<. bit k
              b = l .^. aD
              semiD = bit (bit k - 1) -- semimultiple of D
           in mult' k (l + a) $ recip' (k - 1) (mult' (k - 1) semiD (sqr' (k - 1) a) + mult' (k - 1) b (a + b))
     in recip' m n
-- | The only reason this instance exists is to define square roots.  None of the other @'Floating'@ methods apply to @'Nimber'@s.
instance Floating Nimber where
  sqrt n =
    let m = floorLog @Int $ floorLog n -- D = 2^2^m is the largest Fermat 2-power less than or equal to n
        sqrt' _ 0 = 0
        sqrt' _ 1 = 1
        sqrt' k l =
          let a = l .>>. bit k -- n = aD+b
              aD = a .<<. bit k
              b = l .^. aD
              semiD = bit $ bit k - 1 -- semimultiple of D
              sqrta = sqrt' (k - 1) a
           in sqrta .<<. bit k + mult' (k - 1) sqrta (sqrt' (k - 1) semiD) + sqrt' (k - 1) b
     in sqrt' m n
  pi = error "π is not a nimber"
  exp _ = error "exp undefined for nimbers"
  log _ = error "log undefined for nimbers"
  sin _ = error "Trigonometric functions undefined for nimbers"
  cos _ = error "Trigonometric functions undefined for nimbers"
  tan _ = error "Trigonometric functions undefined for nimbers"
  asin _ = error "Trigonometric functions undefined for nimbers"
  acos _ = error "Trigonometric functions undefined for nimbers"
  atan _ = error "Trigonometric functions undefined for nimbers"
  sinh _ = error "Hyperbolic functions undefined for nimbers"
  cosh _ = error "Hyperbolic functions undefined for nimbers"
  tanh _ = error "Hyperbolic functions undefined for nimbers"
  asinh _ = error "Hyperbolic functions undefined for nimbers"
  acosh _ = error "Hyperbolic functions undefined for nimbers"
  atanh _ = error "Hyperbolic functions undefined for nimbers"
evens :: [a] -> [a]
evens (x : _ : xs) = x : evens xs
evens xs = xs
-- | @'artinSchreierRoot' n@ is the smallest solution to the equation \(x^2 - x = n\).
--   The algorithm is due to Chin-Long Chen: <https://ieeexplore.ieee.org/document/1056557>.
--   In fields of characteristic 2, the standard quadratic formula does not work, but any quadratic equation can be solved using square roots and Artin-Schreier roots.
--
--   This function is __much__ slower than @'sqrt'@.
artinSchreierRoot :: Nimber -> Nimber
artinSchreierRoot 0 = 0
artinSchreierRoot 1 = 2
artinSchreierRoot 2 = 4
artinSchreierRoot 3 = 6
artinSchreierRoot n =
  let m = 1 + floorLog @Int (floorLog n) -- 2^2^m is the order of the smallest field containing n
      m' = if n < bit (bit m - 1) then m else m + 1 -- 2^2^m' is the order of the smallest field containing the Artin-Schreier root of n
      squares = iterate (sqr' m) n
      quarts = evens squares
      semiTrace = sum $ take (bit (m' - 1)) quarts -- trace of the Artin-Screier root of n
   in if semiTrace == 1
        then
          let s = sum $ do
                j <- [1 .. bit (m' - 2) - 1]
                i <- [j .. bit (m' - 2) - 1]
                pure $ mult' m' (squares !! (shiftL i 1 - 1 .^. bit (m' - 1))) (squares !! (shiftL j 1 - 2))
           in flip clearBit 0 $
                s
                  + sqr s
                  + mult' m
                    (squares !! (bit m' - 1))
                    (1 + sum (take (bit (m' - 2)) $ drop (bit (m' - 2)) quarts))
        else
          let y = bit $ bit m' - 1
              z = artinSchreierRoot $ sqr y + y + n
           in y + z
-- | @'solveQuadratic' p q@ returns the solutions to the equation \(X^2 + px + q = 0\).
solveQuadratic :: Nimber -> Nimber -> (Nimber, Nimber)
solveQuadratic 0 q = (sqrt q, sqrt q)
solveQuadratic p q = let x = p * artinSchreierRoot (q / sqr p) in (min x $ x + p, max x $ x + p)

[19.389]

import Data.Nimber.Finite as M

File addition: Nimber (d--x------)
[24.24]

File addition: Finite.hs (----------)

[0.1053]

{-# LANGUAGE DerivingStrategies #-}
{-# OPTIONS_GHC -Wno-type-defaults #-}
-- | In combinatorial game theory, nimbers represent the values of impartial games.  They are the simplest way of making the ordinals into a Field.
--   See /On Numbers and Games/ by John Conway.
--
--   Nimber addition is defined by \(\alpha+\beta = \operatorname{mex}\{\alpha'+\beta, \alpha+\beta'\}\), where \(\operatorname{mex} S\) is the smallest ordinal not in \(S\).
--
--   Nimber multiplication is defined by \(\alpha\cdot\beta = \operatorname{mex}\{\alpha'\cdot\beta + \alpha\cdot\beta' - \alpha'\cdot\beta'\}\).
--
--   This module implements /finite/ nimbers, which form the smallest quadratically closed field of characteristic 2.
module Data.Nimber.Finite
  ( FiniteNimber (..),
    floorLog,
    sqr,
    pow,
    artinSchreierRoot,
    solveQuadratic,
  )
where
import Data.Bits
import Numeric.Natural
newtype FiniteNimber = FiniteNimber {getFiniteNimber :: Natural}
  deriving newtype (Show, Eq, Ord, Enum, Bits)
-- | Index of highest-order set bit, or -1 if there are none.
floorLog :: (Bits a, Num b) => a -> b
floorLog n
  | n == zeroBits = -1
  | otherwise = 1 + floorLog (n .>>. 1)
mult' :: Int -> FiniteNimber -> FiniteNimber -> FiniteNimber
mult' _ 0 _ = 0
mult' _ _ 0 = 0
mult' _ 1 b = b
mult' _ a 1 = a
mult' m a b =
  let semiD = bit (bit m - 1) -- semimultiple of D
      s1 = a .>>. bit m -- a = a1D+a2
      s2 = a .^. (s1 .<<. bit m)
      t1 = b .>>. bit m -- b = b1D+b2
      t2 = b .^. (t1 .<<. bit m)
      c = mult' (m - 1) s2 t2
   in ((mult' (m - 1) (s1 + s2) (t1 + t2) - c) .<<. bit m) + mult' (m - 1) (mult' (m - 1) s1 t1) semiD + c
-- | Finite nimber addition is calculated as follows: the nimber sum of a two-power and itself is 0, while the nimber sum of a set of distinct two-powers is their ordinary sum.
--
--   Finite nimber multiplication is calculated as follows: the nimber square of a Fermat two-power is its sesquimultiple, while the nimber product of a set of distinct Fermat two-powers is their ordinary product.
--   The sesquimultiple of a Fermat two-power is equal to itself plus the product of all smaller Fermat two-powers.
instance Num FiniteNimber where
  fromInteger = FiniteNimber . fromIntegral . abs
  (+) = xor
  (-) = xor
  a * b =
    let m = max (floorLog @Int (floorLog a)) (floorLog @Int (floorLog b)) -- D = 2^2^m is the largest Fermat 2-power less than or equal to both a and b
     in mult' m a b
  negate = id
  abs = id
  signum 0 = 0
  signum _ = 1
sqr' :: Int -> FiniteNimber -> FiniteNimber
sqr' _ 0 = 0
sqr' _ 1 = 1
sqr' m n =
  let a = n .>>. bit m -- n = aD+b
      aD = a .<<. bit m
      b = n .^. aD
      semiD = bit (bit m - 1) -- semimultiple of D
      a2 = sqr' (m - 1) a -- a^2
   in a2 .<<. bit m + mult' (m - 1) a2 semiD + sqr' (m - 1) b
-- | Squaring function.  Faster than multiplying @n@ by itself.
sqr :: FiniteNimber -> FiniteNimber
sqr n =
  let m = floorLog @Int $ floorLog n -- D = 2^2^m is the largest Fermat 2-power less than or equal to n
   in sqr' m n
-- | Raise a @'FiniteNimber'@ to an integral power.  Faster than using '^' or '^^'.
pow :: (Integral a, Bits a) => FiniteNimber -> a -> FiniteNimber
x `pow` n
  | n < 0 = recip x `pow` negate n
  | otherwise =
      let m = floorLog @Int $ floorLog x
       in (foldr (mult' m . snd) 1 . filter (testBit n . fst) . zip [0 ..] . take (1 + floorLog (n + 1))) $ iterate (sqr' m) x
-- | The finite nimbers are a field of characteristic 2.  There is no field homomorphism from the rationals to the nimbers, so @'fromRational'@ is always an error.
instance Fractional FiniteNimber where
  fromRational _ = error "Cannot map from field of characteristic 0 to characteristic 2"
  recip n =
    let m = floorLog @Int $ floorLog n -- D = 2^2^m is the largest Fermat 2-power less than or equal to n
        recip' _ 0 = error "Divide by zero"
        recip' _ 1 = 1
        recip' k l =
          let a = l .>>. bit k -- n = aD+b
              aD = a .<<. bit k
              b = l .^. aD
              semiD = bit (bit k - 1) -- semimultiple of D
           in mult' k (l + a) $ recip' (k - 1) (mult' (k - 1) semiD (sqr' (k - 1) a) + mult' (k - 1) b (a + b))
     in recip' m n
-- | The only reason this instance exists is to define square roots.  None of the other @'Floating'@ methods apply to @'FiniteNimber'@s.
instance Floating FiniteNimber where
  sqrt n =
    let m = floorLog @Int $ floorLog n -- D = 2^2^m is the largest Fermat 2-power less than or equal to n
        sqrt' _ 0 = 0
        sqrt' _ 1 = 1
        sqrt' k l =
          let a = l .>>. bit k -- n = aD+b
              aD = a .<<. bit k
              b = l .^. aD
              semiD = bit $ bit k - 1 -- semimultiple of D
              sqrta = sqrt' (k - 1) a
           in sqrta .<<. bit k + mult' (k - 1) sqrta (sqrt' (k - 1) semiD) + sqrt' (k - 1) b
     in sqrt' m n
  pi = error "π is not a nimber"
  exp _ = error "exp undefined for nimbers"
  log _ = error "log undefined for nimbers"
  sin _ = error "Trigonometric functions undefined for nimbers"
  cos _ = error "Trigonometric functions undefined for nimbers"
  tan _ = error "Trigonometric functions undefined for nimbers"
  asin _ = error "Trigonometric functions undefined for nimbers"
  acos _ = error "Trigonometric functions undefined for nimbers"
  atan _ = error "Trigonometric functions undefined for nimbers"
  sinh _ = error "Hyperbolic functions undefined for nimbers"
  cosh _ = error "Hyperbolic functions undefined for nimbers"
  tanh _ = error "Hyperbolic functions undefined for nimbers"
  asinh _ = error "Hyperbolic functions undefined for nimbers"
  acosh _ = error "Hyperbolic functions undefined for nimbers"
  atanh _ = error "Hyperbolic functions undefined for nimbers"
evens :: [a] -> [a]
evens (x : _ : xs) = x : evens xs
evens xs = xs
-- | @'artinSchreierRoot' n@ is the smallest solution to the equation \(x^2 - x = n\).
--   The algorithm is due to Chin-Long Chen: <https://ieeexplore.ieee.org/document/1056557>.
--   In fields of characteristic 2, the standard quadratic formula does not work, but any quadratic equation can be solved using square roots and Artin-Schreier roots.
--
--   This function is __much__ slower than @'sqrt'@.
artinSchreierRoot :: FiniteNimber -> FiniteNimber
artinSchreierRoot 0 = 0
artinSchreierRoot 1 = 2
artinSchreierRoot 2 = 4
artinSchreierRoot 3 = 6
artinSchreierRoot n =
  let m = 1 + floorLog @Int (floorLog n) -- 2^2^m is the order of the smallest field containing n
      m' = if n < bit (bit m - 1) then m else m + 1 -- 2^2^m' is the order of the smallest field containing the Artin-Schreier root of n
      squares = iterate (sqr' m) n
      quarts = evens squares
      semiTrace = sum $ take (bit (m' - 1)) quarts -- trace of the Artin-Screier root of n
   in if semiTrace == 1
        then
          let s = sum $ do
                j <- [1 .. bit (m' - 2) - 1]
                i <- [j .. bit (m' - 2) - 1]
                pure $ mult' m' (squares !! (shiftL i 1 - 1 .^. bit (m' - 1))) (squares !! (shiftL j 1 - 2))
           in flip clearBit 0 $
                s
                  + sqr s
                  + mult' m
                    (squares !! (bit m' - 1))
                    (1 + sum (take (bit (m' - 2)) $ drop (bit (m' - 2)) quarts))
        else
          let y = bit $ bit m' - 1
              z = artinSchreierRoot $ sqr y + y + n
           in y + z
-- | @'solveQuadratic' p q@ returns the solutions to the equation \(X^2 + px + q = 0\).
solveQuadratic :: FiniteNimber -> FiniteNimber -> (FiniteNimber, FiniteNimber)
solveQuadratic 0 q = (sqrt q, sqrt q)
solveQuadratic p q = let x = p * artinSchreierRoot (q / sqr p) in (min x $ x + p, max x $ x + p)

Replacement in nimbers.cabal at line 62 [11.4726]

B:BD[11.6709] → [24.103:137]

    exposed-modules:  Data.Nimber

[11.6709]

[11.6739]

    exposed-modules:  Data.Nimber,
                      Data.Nimber.Finite

Change Nimber to FiniteNimber

Dependencies

In channels

Change contents

Replacement in test/Main.hs at line 16 [11.22]

Replacement in test/Main.hs at line 23 [11.22]

Replacement in test/Main.hs at line 26 [11.22]

Replacement in test/Main.hs at line 29 [11.22]

Replacement in test/Main.hs at line 32 [11.22]

Replacement in test/Main.hs at line 35 [11.22]

Replacement in test/Main.hs at line 38 [11.22]

Replacement in test/Main.hs at line 41 [11.22]

Replacement in test/Main.hs at line 44 [11.22]

Replacement in test/Main.hs at line 47 [11.22]

Replacement in test/Main.hs at line 50 [11.22]

Replacement in test/Main.hs at line 53 [11.22]