linear-code 0.1.1 → 0.2.0
raw patch · 6 files changed
+161/−317 lines, 6 filesdep +matrix-staticdep −matrixdep ~base
Dependencies added: matrix-static
Dependencies removed: matrix
Dependency ranges changed: base
Files
- ChangeLog.md +14/−0
- README.md +3/−1
- linear-code.cabal +7/−7
- src/Math/Algebra/Code/Linear.hs +110/−39
- src/Math/Algebra/Matrix.hs +0/−248
- test/Main.hs +27/−22
ChangeLog.md view
@@ -1,3 +1,17 @@+0.2.0+-----+* Major changes+ - Replaced matrix with matrix-static+ - Removed Data.Algebra.Matrix+ - No reexporting of Matrix functions anymore+ - Dropped support for lts-9, GHC <= 8.2++* Minor changes+ - Fixed base min version to 4.9+ - Fixed some static equations to allow support for GHC<8.4+ - Default stackage lts resolver is lts-12.2++ 0.1.1 ----- * Backwards compatible changes
README.md view
@@ -1,4 +1,6 @@-[](https://hackage.haskell.org/package/linear-code) [](http://packdeps.haskellers.com/reverse/linear-code)+[](https://travis-ci.com/wchresta/linear-code)+[](https://hackage.haskell.org/package/linear-code)+[](http://packdeps.haskellers.com/reverse/linear-code) # linear-code Library to handle linear codes from coding theory.
linear-code.cabal view
@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 55bce838924f0e4cb6a0546858fe4c3e48ed8f6aad2203e308d94f3bf40087a4+-- hash: 387b26f0c2a0e5dc5158b9d69c070c460694134f06f217fdacba63f28c507d08 name: linear-code-version: 0.1.1+version: 0.2.0 synopsis: A simple library for linear codes (coding theory, error correction) description: Please see the README on GitHub at <https://github.com/wchresta/linear-code#readme> category: Math@@ -16,6 +16,7 @@ copyright: 2018, Wanja Chresta license: GPL-3 license-file: LICENSE+tested-with: GHC == 8.4.3, GHC == 8.2.2 build-type: Simple cabal-version: >= 1.10 extra-source-files:@@ -31,7 +32,6 @@ Math.Algebra.Code.Linear Math.Algebra.Field.Instances Math.Algebra.Field.Static- Math.Algebra.Matrix other-modules: Paths_linear_code hs-source-dirs:@@ -39,12 +39,12 @@ ghc-options: -Wall build-depends: HaskellForMaths- , base >=4.7 && <5+ , base >=4.10 && <5 , containers , data-default , ghc-typelits-knownnat , ghc-typelits-natnormalise- , matrix+ , matrix-static , random , random-shuffle default-language: Haskell2010@@ -60,13 +60,13 @@ build-depends: HaskellForMaths , QuickCheck- , base >=4.7 && <5+ , base >=4.10 && <5 , containers , data-default , ghc-typelits-knownnat , ghc-typelits-natnormalise , linear-code- , matrix+ , matrix-static , random , random-shuffle , smallcheck
src/Math/Algebra/Code/Linear.hs view
@@ -60,7 +60,7 @@ >>> v = encode c e1 >>> v ( 1 0 1 0 0 2 0 )->>> 2 ^* e4 :: Vector 7 F3+>>> 2 ^* e4 :: Vector 7 F5 ( 0 0 0 2 0 0 0 ) >>> vWithError = v + 2 ^* e4 >>> vWithError@@ -122,9 +122,6 @@ , eVec, e1, e2, e3, e4, e5, e6, e7, e8, e9, e10 , char - -- * Reexported matrix functions from "Math.Algebra.Matrix"- , matrix, zero, transpose, fromList, fromLists- -- * Reexported finite fields from @Math.Algebra.Field@ , F2, F3, F5, F7, F11 , F4, F8, F16, F9@@ -138,11 +135,12 @@ ) import Data.Bifunctor (first)+import Data.Maybe (isNothing) import Data.Monoid ((<>))-import Data.List (permutations)+import Data.List (find, permutations) import qualified Data.Map.Strict as M import Data.Proxy (Proxy (..))-import System.Random (Random, RandomGen, random, randomR, split)+import System.Random (Random, RandomGen, random, randoms, randomR, split) import System.Random.Shuffle (shuffle') import Math.Core.Utils (FinSet, elts)@@ -151,9 +149,10 @@ import Math.Algebra.Field.Static (Size, Characteristic, char) import Math.Algebra.Field.Extension (F4, F8, F16, F9) import Math.Algebra.Field.Instances () -- import Random instances for Fields-import Math.Algebra.Matrix+import Data.Matrix.Static ( Matrix, matrix, transpose, (<|>), (<->), (.*)- , identity, zero, fromList, fromLists, Vector, rref, submatrix+ , identity, zero, fromListUnsafe, fromListsUnsafe, toList, toLists+ , submatrix ) @@ -167,9 +166,13 @@ -- i.e. the code is generated by the kernel of a check matrix. type CheckMatrix (n :: Nat) (k :: Nat) = Matrix (n-k) n +-- | For convenience, Vector is a one-row Matrix+type Vector = Matrix 1+ -- | A \([n,k]\)-Linear code over the field @f@. The code parameters @f@,@n@ and -- @k@ are carried on the type level.--- A linear code is a subspace @C@ of \(f^n\) generated by the generator matrix.+-- A linear code is a subspace @C@ of \(f^n\) generated by the generator+-- matrix. data LinearCode (n :: Nat) (k :: Nat) (f :: *) = LinearCode { generatorMatrix :: Generator n k f -- ^ Generator matrix, used for most of the operations@@ -221,9 +224,9 @@ delta i j = if i == j then 1 else 0 (g1,g2) = split g perm = shuffle' [1..n] n g1- in (fromLists [ [ delta i (perm !! (j-1))- | j <- [1..n] ]- | i <- [1..n] ],g2)+ in (fromListsUnsafe [ [ delta i (perm !! (j-1))+ | j <- [1..n] ]+ | i <- [1..n] ],g2) -- | A random code with a generator in standard form. This does not generate -- all possible codes but only one representant of the equivalence class@@ -232,24 +235,47 @@ ( KnownNat n, KnownNat k, k <= n , Eq f, FinSet f, Num f, Ord f, Random f, RandomGen g) => g -> (LinearCode n k f, g)-randomStandardFormCode = first codeFromA . randomAMatrix+randomStandardFormCode = first (codeFromA . getRMat) . randomAMatrix where- randomAMatrix :: RandomGen g => g -> (Matrix k (n-k) f,g)+ randomAMatrix :: RandomGen g => g -> (RMat k (n-k) f,g) randomAMatrix = random +-- Newtype for Random instances for Matrix to avoid orphans+newtype RMat m n a = RMat { getRMat :: Matrix m n a }+ deriving (Eq, Ord) +instance forall m n a. (KnownNat m, KnownNat n, Random a)+ => Random (RMat m n a) where+ random g =+ let m = fromInteger . natVal $ Proxy @m+ n = fromInteger . natVal $ Proxy @n+ (g1,g2) = split g+ rmat = fromListUnsafe . take (m*n) . randoms $ g1+ in (RMat rmat, g2)+ randomR (RMat lm, RMat hm) g =+ -- lm and hm are matrices. We zip the elements and use these as+ -- hi/lo bounds for the random generator+ let zipEls :: [(a,a)]+ zipEls = zip (toList lm) (toList hm)+ rmatStep :: RandomGen g => (a,a) -> ([a],g) -> ([a],g)+ rmatStep hilo (as,g1) = let (a,g2) = randomR hilo g1+ in (a:as,g2)+ (rElList,g') = foldr rmatStep ([],g) zipEls+ in (RMat $ fromListUnsafe rElList,g')+ instance forall n k f.- ( KnownNat n, KnownNat k, k <= n+ ( KnownNat n, KnownNat k, 1 <= k, k+1 <= n+ -- These are trivial deductions from the above; GHC<8.4 needs them+ , k <= n , Eq f, FinSet f, Num f, Ord f, Random f)- => Random (LinearCode n k f) where- random g = uncurry shuffleCode $ randomStandardFormCode g+ => Random (LinearCode n k f) where+ random g = uncurry shuffleCode $ randomStandardFormCode g - randomR (hc,lc) g =- let k = natToInt @k Proxy- extractA = submatrix 1 k . generatorMatrix- (rmat,g2) = randomR (extractA hc, extractA lc) g- rcode = codeFromA rmat- in shuffleCode rcode g2+ randomR (hc,lc) g =+ let extractA = RMat . submatrix @1 @(k+1) @k @n . generatorMatrix+ (RMat rmat,g2) = randomR (extractA hc, extractA lc) g+ rcode = codeFromA rmat+ in shuffleCode rcode g2 -- | Uses Gaussian eleminiation via 'rref' from 'Math.Algebra.Matrix' to@@ -257,7 +283,7 @@ standardForm :: forall n k f. (Eq f, Fractional f, KnownNat n, KnownNat k, k <= n) => Generator n k f -> Generator n k f-standardForm = rref+standardForm = rrefFixed -- | The standard from generator of a linear code. Uses 'standardForm' to@@ -319,7 +345,7 @@ -- | List all vectors of length n over field f allVectors :: forall n f. (KnownNat n, FinSet f, Num f, Eq f) => [Vector n f]-allVectors = fromList <$> allVectorsI (natToInt @n Proxy)+allVectors = fromListUnsafe <$> allVectorsI (natToInt @n Proxy) -- | List all lists given length over field f allVectorsI :: forall f. (FinSet f, Num f, Eq f) => Int -> [[f]]@@ -328,7 +354,7 @@ -- | List all vectors of length n with non-zero elements over field f fullVectors :: forall n f. (KnownNat n, FinSet f, Num f, Eq f) => [Vector n f]-fullVectors = fromList <$> fullVectorsI (natToInt @n Proxy)+fullVectors = fromListUnsafe <$> fullVectorsI (natToInt @n Proxy) -- | List all vectors of given length with non-zero elements over field f fullVectorsI :: forall f. (FinSet f, Num f, Eq f) => Int -> [[f]]@@ -338,7 +364,7 @@ -- | List of all words with given hamming weight hammingWords :: forall n f. (KnownNat n, FinSet f, Num f, Eq f) => Int -> [Vector n f]-hammingWords w = fromList <$> shuffledVecs+hammingWords w = fromListUnsafe <$> shuffledVecs where n = natToInt @n Proxy orderedVecs :: [[f]] -- [1,x,1,1,0..0]@@ -434,7 +460,7 @@ -- * Code transformers -- | The dual code is the code generated by the check matrix--- +-- -- This drops already calculated syndromeTables. dualCode :: forall n k f. (KnownNat n, KnownNat k, k <= n, Eq f, FinSet f, Num f, Ord f)@@ -443,7 +469,7 @@ -- | The dual code is the code generated by the check matrix.--- +-- -- This drops already calculated syndromeTables. dualCodeD :: forall n k f. (KnownNat n, KnownNat k, k <= n, Eq f, FinSet f, Num f, Ord f)@@ -461,7 +487,7 @@ -- matrix must be a valid permutation matrix; this is not checked. -- This effectively multiplies the generator and check matrix from the right. -- Te distance of the resulting code stays the same.--- +-- -- This drops already calculated syndromeTables. permuteCode :: forall n k f. (KnownNat n, KnownNat k, k <= n, Eq f, FinSet f, Num f, Ord f)@@ -478,7 +504,7 @@ -- | Randomly permute the elements of the code. This is a shuffle of the -- positions of elements of all codewords. The distance of the resulting -- code stays the same.--- +-- -- This drops already calculated syndromeTables. shuffleCode :: forall n k f g. (KnownNat n, KnownNat k, k <= n, RandomGen g, Eq f, FinSet f, Num f, Ord f)@@ -488,8 +514,8 @@ in (permuteCode c p, g') --- | Extend the given code \( c \) by zero-columns. Vectors --- \( v_{ext} \in c_{ext} \) have the form +-- | Extend the given code \( c \) by zero-columns. Vectors+-- \( v_{ext} \in c_{ext} \) have the form -- \( v = (v_1, \dots , v_n, 0, \dots, 0) \) . The distance of the extended -- code stays the same. -- This drops a calculated syndromeTable and makes it necessary to recalculate@@ -524,15 +550,15 @@ -- of 0's and 1's except the zero vector. simplex :: forall k p s. ( KnownNat s, KnownNat k , IntegerAsType p- , 1 <= s^k, k <= s^k, 1+k <= s^k, Size (Fp p) ~ s)+ , 1 <= s^k, k <= s^k, 1 <= s^k-k, k <= s^k-1, Size (Fp p) ~ s) => LinearCode (s^k-1) k (Fp p)-simplex = codeFromA . transpose $ fromLists nonUnit+simplex = codeFromA . transpose $ fromListsUnsafe nonUnit where k = natToInt @k Proxy nonUnit = filter ((>1) . weight) $ allVectorsI k -- | The /Hamming(7,4)/-code. It is a [7,4,3]_2 code-hamming :: (KnownNat m, 2 <= m, m <= 2^m, 1+m <= 2^m)+hamming :: (KnownNat m, 2 <= m, m <= 2^m, m <= 2^m-1, 1 <= 2^m-m) => LinearCode (2^m-1) (2^m-m-1) F2 hamming = dualCodeD (Just 3) simplex @@ -540,12 +566,12 @@ -- | The _Golay_-code is a perfect [24,12,7]-code. -- It is the only other non-trivial perfect code and the only perfect code -- that is able to correct 3 errors.--- +-- -- Syndrome decoding on this code takes a very, very long time. golay :: LinearCode 23 12 F2 golay = codeFromAD (Just 7) golayA where- golayA = fromList+ golayA = fromListUnsafe [0,1,1,1,1,1,1,1,1,1,1 ,1,1,1,0,1,1,1,0,0,0,1 ,1,1,0,1,1,1,0,0,0,1,0@@ -564,7 +590,7 @@ -- | Standard base vector [0..0,1,0..0] for any field. Parameter must be >=1 eVec :: forall n f. (KnownNat n, Num f) => Int -> Vector n f-eVec i = fromList $ replicate (i-1) 0 ++ 1 : replicate (n-i) 0+eVec i = fromListUnsafe $ replicate (i-1) 0 ++ 1 : replicate (n-i) 0 where n = natToInt @n Proxy @@ -599,5 +625,50 @@ e10 :: forall n f. (KnownNat n, Num f) => Vector n f e10 = eVec 10+++------------------------+-- There is a bug in Data.Matrix's rref. So we need to implement our own+-- version until it's fixed.++-- | Reduced row echelon form. Taken from rosettacode. This is not the+-- implementation provided by the 'matrix' package.+-- https://rosettacode.org/wiki/Reduced_row_echelon_form#Haskell+rrefFixed :: forall m n a. (KnownNat m, KnownNat n, m <= n, Fractional a, Eq a)+ => Matrix m n a -> Matrix m n a+rrefFixed mat = fromListsUnsafe $ f matM 0 [0 .. rows - 1]+ where+ matM = toLists mat+ rows = length matM+ cols = length $ head matM++ f m _ [] = m+ f m lead (r : rs)+ | isNothing indices = m+ | otherwise = f m' (lead' + 1) rs+ where+ indices = find p l+ p (col, row) = m !! row !! col /= 0+ l = [(col, row) |+ col <- [lead .. cols - 1],+ row <- [r .. rows - 1]]++ Just (lead', i) = indices+ newRow = map (/ m !! i !! lead') $ m !! i++ m' = zipWith g [0..] $+ replace r newRow $+ replace i (m !! r) m+ g n row+ | n == r = row+ | otherwise = zipWith h newRow row+ where h = subtract . (* row !! lead')++ replace :: Int -> b -> [b] -> [b]+ {- Replaces the element at the given index. -}+ replace n e t = a ++ e : b+ where (a, _ : b) = splitAt n t++ -- vim : set colorcolumn=80
− src/Math/Algebra/Matrix.hs
@@ -1,248 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveTraversable #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-- This file is part of linear-codes.-- Linear-Codes is free software: you can redistribute it and/or modify- it under the terms of the GNU General Public License as published by- the Free Software Foundation, either version 3 of the License, or- (at your option) any later version.-- Foobar is distributed in the hope that it will be useful,- but WITHOUT ANY WARRANTY; without even the implied warranty of- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the- GNU General Public License for more details.-- You should have received a copy of the GNU General Public License- along with Foobar. If not, see <https://www.gnu.org/licenses/>.--}-{-|-Module : Math.Algebra.Matrix-Description : Type safe matrix wrapper over the matrix library-Copyright : (c) Wanja Chresta, 2018-License : GPL-3-Maintainer : wanja dot hs at chrummibei dot ch-Stability : experimental-Portability : POSIX--Math.Algebra.Matrix wraps @matrix@'s Data.Matrix functions and adds size-information on the type level. Additionally, it fixes some issues that makes-the library work well with finite fields. The name of most functions is the-same as in Data.Matrix--}--module Math.Algebra.Matrix- ( Matrix(..)- , matrix- , Vector- , transpose- , (<|>)- , (<->)- , identity- , zero- , fromList- , fromLists- , toList- , toLists- , (.*)- , (^*)- , rref- , submatrix- ) where--import GHC.TypeLits (Nat, KnownNat, natVal, type (+), type (<=))-import Data.List (find)-import Data.Proxy (Proxy(..))-import Data.Semigroup ((<>))-import Data.Maybe (isNothing)--import qualified Data.Matrix as M-import qualified System.Random as R----- | A matrix over the type @f@ with @m@ rows and @n@ columns. This just wraps--- the 'Data.Matrix.Matrix' constructor and adds size information to the type-newtype Matrix (m :: Nat) (n :: Nat) (f :: *) = Matrix (M.Matrix f)- deriving (Eq, Functor, Applicative, Foldable, Traversable, Monoid)--instance forall m n f. Show f => Show (Matrix m n f) where- show (Matrix mat) = M.prettyMatrix mat--instance forall m n f. Ord f => Ord (Matrix m n f) where- compare x y = toList x `compare` toList y -- TODO: Do not use `toList`?--instance forall f m n. Num f => Num (Matrix m n f) where- (Matrix x) + (Matrix y) = Matrix $ x + y- (Matrix x) - (Matrix y) = Matrix $ x - y- (*) = error "Data.Matrix.Safe: (*) not allowed. Use (.*) instead"- negate = fmap negate- abs = fmap abs- signum = fmap signum- fromInteger = Matrix . fromInteger--instance forall m n a. (KnownNat m, KnownNat n, R.Random a)- => R.Random (Matrix m n a) where- random g =- let m = fromInteger . natVal $ Proxy @m- n = fromInteger . natVal $ Proxy @n- (g1,g2) = R.split g- rmat = fromList . take (m*n) . R.randoms $ g1- in (rmat, g2)- randomR (lm,hm) g =- -- lm and hm are matrices. We zip the elements and use these as- -- hi/lo bounds for the random generator- let zipEls :: [(a,a)]- zipEls = zip (toList lm) (toList hm)- rmatStep :: R.RandomGen g => (a,a) -> ([a],g) -> ([a],g)- rmatStep hilo (as,g1) = let (a,g2) = R.randomR hilo g1- in (a:as,g2)- (rElList,g') = foldr rmatStep ([],g) zipEls- in (fromList rElList,g')----- | Type safe matrix multiplication-(.*) :: forall m k n a. Num a => Matrix m k a -> Matrix k n a -> Matrix m n a-(Matrix m) .* (Matrix n) = Matrix $ m * n---- | Type safe scalar multiplication-(^*) :: forall m n a. Num a => a -> Matrix m n a -> Matrix m n a-x ^* (Matrix n) = Matrix $ M.scaleMatrix x n---- | A row vector (a matrix with one row).-type Vector = Matrix 1---- | /O(rows*cols)/. Generate a matrix from a generator function.--- | The elements are 1-indexed, i.e. top-left element is @(1,1)@.-matrix :: forall m n a. (KnownNat m, KnownNat n)- => ((Int, Int) -> a) -> Matrix (m :: Nat) (n :: Nat) a-matrix = Matrix . M.matrix m' n'- where m' = fromInteger $ natVal @m Proxy- n' = fromInteger $ natVal @n Proxy---- | /O(rows*cols)/. The transpose of a matrix.-transpose :: forall m n a. Matrix m n a -> Matrix n m a-transpose (Matrix m) = Matrix . M.transpose $ m---- | Horizontally join two matrices. Visually:------ > ( A ) <|> ( B ) = ( A | B )-(<|>) :: forall m n k a. (KnownNat n, KnownNat k)- => Matrix m n a -> Matrix m k a -> Matrix m (k+n) a-Matrix x <|> Matrix y = Matrix $ x M.<|> y---- | Horizontally join two matrices. Visually:------ > ( A )--- > ( A ) <-> ( B ) = ( - )--- > ( B )-(<->) :: forall m k n a. (KnownNat m, KnownNat k)- => Matrix m n a -> Matrix k n a -> Matrix (m+k) n a-Matrix x <-> Matrix y = Matrix $ x M.<-> y----- | /O(rows*cols)/. Identity matrix-identity :: forall n a. (Num a, KnownNat n) => Matrix n n a-identity = Matrix $ M.identity n'- where n' = fromInteger $ natVal @n Proxy---- | /O(rows*cols)/. The zero matrix-zero :: forall m n a. (Num a, KnownNat n, KnownNat m) => Matrix m n a-zero = Matrix $ M.zero m' n'- where n' = fromInteger $ natVal @n Proxy- m' = fromInteger $ natVal @m Proxy---- | Create a matrix from a list of elements.--- The list must have exactly length @n*m@. This is checked or else an --- exception is thrown.-fromList :: forall m n a. (KnownNat m, KnownNat n) => [a] -> Matrix m n a-fromList as = if length as == n*m- then Matrix $ M.fromList m n as- else error $ "List has wrong dimension: "- <>show (length as)- <>" instead of "- <>show (n*m)- where n = fromInteger $ natVal @n Proxy- m = fromInteger $ natVal @m Proxy---- | Create a matrix from a list of rows. The list must have exactly @m@--- lists of length @n@. An exception is thrown otherwise.-fromLists :: forall m n a. (KnownNat m, KnownNat n) => [[a]] -> Matrix m n a-fromLists as = if length as == m && all (\row -> length row == n) as- then Matrix $ M.fromLists as- else error $ "List has wrong dimension: "- <>show (length as)<>":"- <>show (length $ head as)- <>" instead of "- <>show m <>":"<> show n- where n = fromInteger $ natVal @n Proxy- m = fromInteger $ natVal @m Proxy---- | Get the elements of a matrix stored in a list.-toList :: forall m n a. Matrix m n a -> [a]-toList (Matrix m) = M.toList m---- | Get the elements of a matrix stored in a list of lists,--- where each list contains the elements of a single row.-toLists :: forall m n a. Matrix m n a -> [[a]]-toLists (Matrix m) = M.toLists m----- | /O(1)/. Extract a submatrix from the given position. The size of the--- extract is determined by the types, i.e. the parameters define which--- element is the top-left element of the extract.--- CAUTION: It is not checked if an extract is possible. Wrong parameters--- will cause an exception.-submatrix :: forall m n m' n' a.- (KnownNat m, KnownNat n, KnownNat m', KnownNat n'- , m' <= m, n' <= n)- => Int -> Int -> Matrix m n a -> Matrix m' n' a-submatrix i j (Matrix mat) = Matrix $ M.submatrix i (i+m'-1) j (j+n'-1) mat- where n' = fromInteger $ natVal @n' Proxy- m' = fromInteger $ natVal @m' Proxy------ | Reduced row echelon form. Taken from rosettacode. This is not the--- implementation provided by the 'matrix' package.--- https://rosettacode.org/wiki/Reduced_row_echelon_form#Haskell-rref :: forall m n a. (KnownNat m, KnownNat n, m <= n, Fractional a, Eq a)- => Matrix m n a -> Matrix m n a-rref mat = fromLists $ f matM 0 [0 .. rows - 1]- where - matM = toLists mat- rows = length matM- cols = length $ head matM-- f m _ [] = m- f m lead (r : rs)- | isNothing indices = m- | otherwise = f m' (lead' + 1) rs- where - indices = find p l- p (col, row) = m !! row !! col /= 0- l = [(col, row) |- col <- [lead .. cols - 1],- row <- [r .. rows - 1]]-- Just (lead', i) = indices- newRow = map (/ m !! i !! lead') $ m !! i-- m' = zipWith g [0..] $- replace r newRow $- replace i (m !! r) m- g n row- | n == r = row- | otherwise = zipWith h newRow row- where h = subtract . (* row !! lead')-- replace :: Int -> b -> [b] -> [b]- {- Replaces the element at the given index. -}- replace n e t = a ++ e : b- where (a, _ : b) = splitAt n t
test/Main.hs view
@@ -1,12 +1,14 @@ {-# LANGUAGE ScopedTypeVariables, DataKinds, TypeOperators, TypeFamilies #-} {-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise #-}+{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Main where -import GHC.TypeLits (KnownNat, natVal, type (<=))+import GHC.TypeLits (KnownNat, natVal, type (<=), type (+)) import Data.Proxy (Proxy(..)) -import qualified Math.Algebra.Matrix as M+import qualified Data.Matrix.Static as M import Math.Algebra.Field.Instances() -- Import random instances import qualified Math.Core.Utils as F import qualified Math.Algebra.Field.Base as F@@ -39,7 +41,7 @@ codeTests = let tc = trivialCode :: BinaryCode 5 3 hamming74 = hamming :: BinaryCode 7 4- eHamming94 = extendCode hamming74 :: BinaryCode 9 4+ --eHamming94 = extendCode hamming74 :: BinaryCode 9 4 in testGroup "Codes" [ testGroup "Instances" [ testCase "Show works for unknown distance" $@@ -51,16 +53,16 @@ ] , testGroup "Trivial code" [ testCase "Trivial binary code == codeFromA zero, [5,3]" $- tc @?= codeFromA zero+ tc @?= codeFromA M.zero , testCase "Trivial binary code == codeFromA zero, [3,3]" $- (trivialCode :: BinaryCode 3 3) @?= codeFromA zero+ (trivialCode :: BinaryCode 3 3) @?= codeFromA M.zero , testCase "Trivial binary code == codeFromA zero, [7,1]" $- (trivialCode :: BinaryCode 7 1) @?= codeFromA zero+ (trivialCode :: BinaryCode 7 1) @?= codeFromA M.zero , testCase "zero vector is a code word" $- assertBool ("H*c' = "++show (syndrome tc zero)) $- isCodeword tc zero+ assertBool ("H*c' = "++show (syndrome tc M.zero)) $+ isCodeword tc M.zero , testCase "ones-vector is not a code word" $- let ones = fromList [1,1,1,1,1]+ let ones = M.fromListUnsafe [1,1,1,1,1] in assertBool ("H*c' = "++show (syndrome tc ones)) $ not $ isCodeword tc ones ]@@ -69,12 +71,12 @@ \(c :: LinearCode 7 4 F.F3) -> seq c True , Q.testProperty "All generated codewords are codewords" $ \c x y z w -> isCodeword (c :: LinearCode 7 4 F.F5) $- encode c $ fromList ([x,y,z,w] :: [F.F5])+ encode c $ M.fromListUnsafe ([x,y,z,w] :: [F.F5]) ] , testGroup "Hamming(7,4)" [ S.testProperty "All encoded words are codewords" $ \((x,y,z,w)::(F2,F2,F2,F2)) -> isCodeword hamming74- (encode hamming74 (fromList [x,y,z,w]))+ (encode hamming74 (M.fromListUnsafe [x,y,z,w])) , Q.testProperty "List all codewords" $ \(c :: LinearCode 7 4 F.F5) -> length (codewords c) == 5^(4 :: Int)@@ -90,15 +92,15 @@ ] {- This test is too slow , testGroup "Golay"- [ testCase "Golay can correct 3 errors" $- -- \((w,a,b,c) :: (Vector 12 F2,F2,F2,F2)) ->- let w = fromList [0,0,1,0,1,1,1,1,0,1,0,1] :: Vector 12 F2- (a,b,c) = (1,1,1) :: (F2,F2,F2)- in- let v = encode golay w- ve = v + a M.^* e3 + b M.^* e7 + c M.^* eVec 14- in decode golay ve @?= Just v- ]+ [ testCase "Golay can correct 3 errors" $+ -- \((w,a,b,c) :: (Vector 12 F2,F2,F2,F2)) ->+ let w = M.fromListUnsafe [0,0,1,0,1,1,1,1,0,1,0,1] :: Vector 12 F2+ (a,b,c) = (1,1,1) :: (F2,F2,F2)+ in+ let v = encode golay w+ ve = v + a M.^* e3 + b M.^* e7 + c M.^* eVec 14+ in decode golay ve @?= Just v+ ] -} , testGroup "Standard form" [ Q.testProperty "Standard form of standard form is equal" $@@ -114,6 +116,7 @@ distance (extendCode c :: LinearCode 9 4 F5) == distance c , testCase "Extended hamming have distance 3" $ distance (extendCode hamming74 :: BinaryCode 9 4) @?= Just 3+{- -- These tests are too slow , Q.testProperty "Extended hamming can correct 1 error" $ \(v :: Vector 4 F2) -> let w = encode eHamming94 v@@ -122,6 +125,7 @@ \(v :: Vector 4 F2) -> let w = encode eHamming94 v in decode eHamming94 (w + e8) == Just w+-} ] ] @@ -131,7 +135,7 @@ instance forall m n f. (KnownNat m, KnownNat n, Q.Arbitrary f) => Q.Arbitrary (M.Matrix m n f) where- arbitrary = fromList <$> Q.vectorOf (n*m) Q.arbitrary+ arbitrary = M.fromListUnsafe <$> Q.vectorOf (n*m) Q.arbitrary where n = fromInteger . natVal $ (Proxy :: Proxy n) m = fromInteger . natVal $ (Proxy :: Proxy m)@@ -140,7 +144,8 @@ arbitrary = Q.arbitraryBoundedRandom instance forall n k f.- (KnownNat n, KnownNat k, k <= n, Num f, Ord f, Eq f, F.FinSet f, Random f)+ ( KnownNat n, KnownNat k, 1 <= k, k <= n, k+1 <= n+ , Num f, Ord f, Eq f, F.FinSet f, Random f) => Q.Arbitrary (LinearCode n k f) where arbitrary = Q.arbitraryBoundedRandom