finite-field-0.8.0/0000755000000000000000000000000012337373454012257 5ustar0000000000000000finite-field-0.8.0/.gitignore0000644000000000000000000000006312337373454014246 0ustar0000000000000000dist cabal-dev *.o *.hi *.chi *.chs.h .virthualenv finite-field-0.8.0/.travis.yml0000644000000000000000000000406412337373454014374 0ustar0000000000000000# NB: don't set `language: haskell` here # The following enables several GHC versions to be tested; often it's enough to test only against the last release in a major GHC version. Feel free to omit lines listings versions you don't need/want testing for. env: # - GHCVER=6.12.3 # - GHCVER=7.0.1 # - GHCVER=7.0.2 # - GHCVER=7.0.3 # - GHCVER=7.0.4 # - GHCVER=7.2.1 # - GHCVER=7.2.2 # - GHCVER=7.4.1 # - GHCVER=7.4.2 # - GHCVER=7.6.1 # - GHCVER=7.6.2 - GHCVER=7.6.3 # - GHCVER=7.8.1 # see note about Alex/Happy - GHCVER=7.8.2 # see note about Alex/Happy # - GHCVER=head # see section about GHC HEAD snapshots # Note: the distinction between `before_install` and `install` is not important. before_install: - travis_retry sudo add-apt-repository -y ppa:hvr/ghc - travis_retry sudo apt-get update - travis_retry sudo apt-get install cabal-install-1.18 ghc-$GHCVER # see note about happy/alex - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/1.18/bin:$PATH - | if [ $GHCVER = "head" ] || [ ${GHCVER%.*} = "7.8" ]; then travis_retry sudo apt-get install happy-1.19.3 alex-3.1.3 export PATH=/opt/alex/3.1.3/bin:/opt/happy/1.19.3/bin:$PATH else travis_retry sudo apt-get install happy alex fi install: - cabal update - cabal install --only-dependencies --enable-tests -v2 # -v2 provides useful information for debugging # Here starts the actual work to be performed for the package under test; any command which exits with a non-zero exit code causes the build to fail. script: - cabal configure --enable-tests -v2 # -v2 provides useful information for debugging - cabal build # this builds all libraries and executables (including tests/benchmarks) - cabal test - cabal check - cabal sdist # tests that a source-distribution can be generated # The following scriptlet checks that the resulting source distribution can be built & installed - export SRC_TGZ=$(cabal-1.18 info . | awk '{print $2 ".tar.gz";exit}') ; cd dist/; if [ -f "$SRC_TGZ" ]; then cabal install "$SRC_TGZ"; else echo "expected '$SRC_TGZ' not found"; exit 1; fi finite-field-0.8.0/CHANGELOG.markdown0000644000000000000000000000057612337373454015322 0ustar00000000000000000.8.0 ----- * remove dependency on `algebra` package, since it is outdated and not compatible with recent version of other packages 0.7.0 ----- * use extended GCD to compute reciprocals * conform with the addition of SomeNat type to type-level-numbers-0.1.1.0. 0.6.0 ----- * add Hashable instance * add allValues to FiniteField class . 0.5.0 ----- * introduce FiniteField class finite-field-0.8.0/COPYING0000644000000000000000000000262012337373454013312 0ustar0000000000000000Copyright 2013 Masahiro Sakai. 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. The name of the author may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``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 AUTHOR 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. finite-field-0.8.0/finite-field.cabal0000644000000000000000000000300012337373454015573 0ustar0000000000000000Name: finite-field Version: 0.8.0 License: BSD3 License-File: COPYING Author: Masahiro Sakai (masahiro.sakai@gmail.com) Maintainer: masahiro.sakai@gmail.com Category: Math, Algebra, Data Cabal-Version: >= 1.10 Synopsis: Finite Fields Description: This is an implementation of finite fields. Currently only prime fields are supported. Bug-Reports: https://github.com/msakai/finite-field/issues Extra-Source-Files: README.md COPYING CHANGELOG.markdown .travis.yml .gitignore Build-Type: Simple source-repository head type: git location: git://github.com/msakai/finite-field.git Library Hs-source-dirs: src Build-Depends: base >=4 && <5, template-haskell, deepseq, hashable, type-level-numbers >=0.1.1.0 && <0.2.0.0 Default-Language: Haskell2010 Other-Extensions: DeriveDataTypeable MultiParamTypeClasses ScopedTypeVariables Rank2Types GADTs TemplateHaskell BangPatterns Exposed-Modules: Data.FiniteField Data.FiniteField.Base Data.FiniteField.PrimeField Test-suite TestPrimeField Type: exitcode-stdio-1.0 HS-Source-Dirs: test Main-is: TestPrimeField.hs Build-depends: base >=4 && <5, containers, test-framework, test-framework-th, test-framework-hunit, test-framework-quickcheck2, HUnit, QuickCheck >=2 && <3, finite-field, primes, type-level-numbers >=0.1.1.0 && <0.2.0.0 Default-Language: Haskell2010 Other-Extensions: TemplateHaskell finite-field-0.8.0/README.md0000644000000000000000000000023312337373454013534 0ustar0000000000000000finite-field ============ [![Build Status](https://secure.travis-ci.org/msakai/finite-field.png?branch=master)](http://travis-ci.org/msakai/finite-field) finite-field-0.8.0/Setup.lhs0000644000000000000000000000012212337373454014062 0ustar0000000000000000#! /usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain finite-field-0.8.0/src/0000755000000000000000000000000012337373454013046 5ustar0000000000000000finite-field-0.8.0/src/Data/0000755000000000000000000000000012337373454013717 5ustar0000000000000000finite-field-0.8.0/src/Data/FiniteField.hs0000644000000000000000000000107112337373454016434 0ustar0000000000000000{-# OPTIONS_GHC -Wall #-} ----------------------------------------------------------------------------- -- | -- module : Data.FiniteField -- Copyright : (c) Masahiro Sakai 2013 -- License : BSD-style -- -- Maintainer : masahiro.sakai@gmail.com -- Stability : provisional -- Portability : portable -- ----------------------------------------------------------------------------- module Data.FiniteField ( module Data.FiniteField.Base , module Data.FiniteField.PrimeField ) where import Data.FiniteField.Base import Data.FiniteField.PrimeField finite-field-0.8.0/src/Data/FiniteField/0000755000000000000000000000000012337373454016101 5ustar0000000000000000finite-field-0.8.0/src/Data/FiniteField/Base.hs0000644000000000000000000000167612337373454017321 0ustar0000000000000000{-# OPTIONS_GHC -Wall #-} ----------------------------------------------------------------------------- -- | -- module : Data.FiniteField.Base -- Copyright : (c) Masahiro Sakai 2013 -- License : BSD-style -- -- Maintainer : masahiro.sakai@gmail.com -- Stability : provisional -- Portability : portable -- ----------------------------------------------------------------------------- module Data.FiniteField.Base ( FiniteField (..) ) where -- | Type class for finite fields class Fractional k => FiniteField k where -- | The order is number of elements of a finite field @k@. -- It of the form @p^n@, where @p@ is prime number called the characteristic -- of the field, and @n@ is a positive integer. order :: k -> Integer -- | The characteristic of a field, @p@. char :: k -> Integer -- | The inverse of Frobenius endomorphism @x@ ↦ @x^p@. pthRoot :: k -> k -- | All values of a field allValues :: [k] finite-field-0.8.0/src/Data/FiniteField/PrimeField.hs0000644000000000000000000000777212337373454020472 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables, MultiParamTypeClasses, DeriveDataTypeable, TemplateHaskell, BangPatterns #-} {-# OPTIONS_GHC -Wall #-} ----------------------------------------------------------------------------- -- | -- Module : Data.FiniteField.PrimeField -- Copyright : (c) Masahiro Sakai 2013 -- License : BSD-style -- -- Maintainer : masahiro.sakai@gmail.com -- Stability : provisional -- Portability : non-portable (ScopedTypeVariables, MultiParamTypeClasses, DeriveDataTypeable, TemplateHaskell, BangPatterns) -- -- Finite field of prime order p, Fp = Z/pZ. -- -- References: -- -- * -- ----------------------------------------------------------------------------- module Data.FiniteField.PrimeField ( PrimeField , toInteger -- * Template haskell utilities -- $TH , primeField ) where import Prelude hiding (toInteger) import Control.DeepSeq import Data.Hashable import Data.Ratio (denominator, numerator) import Data.Typeable import qualified Language.Haskell.TH as TH import qualified TypeLevel.Number.Nat as TL import Data.FiniteField.Base -- | Finite field of prime order p, Fp = Z/pZ. -- -- NB: Primality of @p@ is assumed, but not checked. newtype PrimeField p = PrimeField Integer deriving (Eq, Typeable) -- | conversion to 'Integer' toInteger :: PrimeField p -> Integer toInteger (PrimeField a) = a toInt :: Integral a => PrimeField p -> a toInt = fromInteger . toInteger instance Show (PrimeField p) where showsPrec n (PrimeField x) = showsPrec n x instance TL.Nat p => Read (PrimeField p) where readsPrec n s = [(fromInteger a, s') | (a,s') <- readsPrec n s] instance NFData (PrimeField p) where rnf (PrimeField a) = rnf a instance TL.Nat p => Num (PrimeField p) where PrimeField a + PrimeField b = fromInteger $ a+b PrimeField a * PrimeField b = fromInteger $ a*b PrimeField a - PrimeField b = fromInteger $ a-b negate (PrimeField a) = fromInteger $ negate a abs a = a signum _ = 1 fromInteger a = PrimeField $ a `mod` TL.toInt (undefined :: p) instance TL.Nat p => Fractional (PrimeField p) where fromRational r = fromInteger (numerator r) / fromInteger (denominator r) -- recip a = a ^ (TL.toInt (undefined :: p) - 2 :: Integer) recip (PrimeField a) = case exgcd a p of (_, r, _) -> fromInteger r where p :: Integer p = TL.toInt (undefined :: p) instance TL.Nat p => Bounded (PrimeField p) where minBound = PrimeField 0 maxBound = PrimeField (TL.toInt (undefined :: p) - 1) instance TL.Nat p => Enum (PrimeField p) where toEnum x | toInt (minBound :: PrimeField p) <= x && x <= toInt (maxBound :: PrimeField p) = fromIntegral x | otherwise = error "PrimeField.toEnum: bad argument" fromEnum = toInt instance Ord (PrimeField p) where PrimeField a `compare` PrimeField b = a `compare` b PrimeField a `max` PrimeField b = PrimeField (a `max` b) PrimeField a `min` PrimeField b = PrimeField (a `min` b) instance TL.Nat p => FiniteField (PrimeField p) where order _ = TL.toInt (undefined :: p) char _ = TL.toInt (undefined :: p) pthRoot a = a allValues = [minBound .. maxBound] instance TL.Nat p => Hashable (PrimeField p) where hashWithSalt s (PrimeField a) = s `hashWithSalt` (TL.toInt (undefined :: p) :: Int) `hashWithSalt` a -- | Extended GCD algorithm exgcd :: (Eq a, Integral a) => a -> a -> (a, a, a) exgcd f1 f2 = f $ go f1 f2 1 0 0 1 where go !r0 !r1 !s0 !s1 !t0 !t1 | r1 == 0 = (r0, s0, t0) | otherwise = go r1 r2 s1 s2 t1 t2 where (q, r2) = r0 `divMod` r1 s2 = s0 - q*s1 t2 = t0 - q*t1 f (g,u,v) | g < 0 = (-g, -u, -v) | otherwise = (g,u,v) -- --------------------------------------------------------------------------- -- | Create a PrimeField type primeField :: Integer -> TH.TypeQ primeField n | n <= 0 = error "primeField: negative value" | otherwise = [t| PrimeField $(TL.natT n) |] -- $TH -- Here is usage example for primeField: -- -- > a :: $(primeField 15485867) -- > a = 1 finite-field-0.8.0/test/0000755000000000000000000000000012337373454013236 5ustar0000000000000000finite-field-0.8.0/test/TestPrimeField.hs0000644000000000000000000000747712337373454016471 0ustar0000000000000000{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-} {-# OPTIONS_GHC -fcontext-stack=32 #-} import Test.HUnit hiding (Test) import Test.QuickCheck import Test.Framework.TH import Test.Framework.Providers.QuickCheck2 import Test.Framework.Providers.HUnit import Control.Monad import Data.List (genericLength) import Data.Numbers.Primes (primes) import Data.FiniteField import TypeLevel.Number.Nat -- ---------------------------------------------------------------------- -- addition prop_add_comm = forAll smallPrimes $ \(SomeNat (_ :: p)) -> forAll arbitrary $ \(a :: PrimeField p) -> forAll arbitrary $ \b -> a + b == b + a prop_add_assoc = forAll smallPrimes $ \(SomeNat (_ :: p)) -> forAll arbitrary $ \(a :: PrimeField p) -> forAll arbitrary $ \b -> forAll arbitrary $ \c -> (a + b) + c == a + (b + c) prop_add_unitl = forAll smallPrimes $ \(SomeNat (_ :: p)) -> forAll arbitrary $ \(a :: PrimeField p) -> 0 + a == a prop_add_unitr = forAll smallPrimes $ \(SomeNat (_ :: p)) -> forAll arbitrary $ \(a :: PrimeField p) -> a + 0 == a prop_negate = forAll smallPrimes $ \(SomeNat (_ :: p)) -> forAll arbitrary $ \(a :: PrimeField p) -> a + negate a == 0 -- ---------------------------------------------------------------------- -- multiplication prop_mult_comm = forAll smallPrimes $ \(SomeNat (_ :: p)) -> forAll arbitrary $ \(a :: PrimeField p) -> forAll arbitrary $ \b -> a * b == b * a prop_mult_assoc = forAll smallPrimes $ \(SomeNat (_ :: p)) -> forAll arbitrary $ \(a :: PrimeField p) -> forAll arbitrary $ \b -> forAll arbitrary $ \c -> (a * b) * c == a * (b * c) prop_mult_unitl = forAll smallPrimes $ \(SomeNat (_ :: p)) -> forAll arbitrary $ \(a :: PrimeField p) -> 1 * a == a prop_mult_unitr = forAll smallPrimes $ \(SomeNat (_ :: p)) -> forAll arbitrary $ \(a :: PrimeField p) -> a * 1 == a prop_mult_zero_l = forAll smallPrimes $ \(SomeNat (_ :: p)) -> forAll arbitrary $ \(a :: PrimeField p) -> 0*a == 0 prop_mult_zero_r = forAll smallPrimes $ \(SomeNat (_ :: p)) -> forAll arbitrary $ \(a :: PrimeField p) -> a*0 == 0 -- ---------------------------------------------------------------------- -- distributivity prop_distl = forAll smallPrimes $ \(SomeNat (_ :: p)) -> forAll arbitrary $ \(a :: PrimeField p) -> forAll arbitrary $ \b -> forAll arbitrary $ \c -> a * (b + c) == a*b + a*c prop_distr = forAll smallPrimes $ \(SomeNat (_ :: p)) -> forAll arbitrary $ \(a :: PrimeField p) -> forAll arbitrary $ \b -> forAll arbitrary $ \c -> (b + c) * a == b*a + c*a -- ---------------------------------------------------------------------- -- recip prop_recip = forAll smallPrimes $ \(SomeNat (_ :: p)) -> forAll arbitrary $ \(a :: PrimeField p) -> a /= 0 ==> a * (recip a) == 1 -- ---------------------------------------------------------------------- -- FiniteField type class prop_pthRoot = forAll smallPrimes $ \(SomeNat (_ :: p)) -> forAll arbitrary $ \(a :: PrimeField p) -> pthRoot a ^ char a == a prop_allValues = do forAll smallPrimes $ \(SomeNat (_ :: p)) -> genericLength (allValues :: [PrimeField p]) == order (undefined :: PrimeField p) -- ---------------------------------------------------------------------- case_primeFieldT = a @?= 1 where a :: $(primeField 15485867) a = 15485867 + 1 ------------------------------------------------------------------------ smallPrimes :: Gen SomeNat smallPrimes = do i <- choose (0, 2^(16::Int)) return $ withNat SomeNat (primes !! i) instance Nat p => Arbitrary (PrimeField p) where arbitrary = liftM fromInteger arbitrary ------------------------------------------------------------------------ -- Test harness main :: IO () main = $(defaultMainGenerator)