diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,6 @@ -[![Hackage](https://img.shields.io/hackage/v/linear-code.svg)](https://hackage.haskell.org/package/linear-code) [![Hackage Deps](https://img.shields.io/hackage-deps/v/linear-code.svg)](http://packdeps.haskellers.com/reverse/linear-code) +[![Build Status](https://travis-ci.com/wchresta/linear-code.svg?branch=master)](https://travis-ci.com/wchresta/linear-code) +[![Hackage](https://img.shields.io/hackage/v/linear-code.svg)](https://hackage.haskell.org/package/linear-code) +[![Hackage Deps](https://img.shields.io/hackage-deps/v/linear-code.svg)](http://packdeps.haskellers.com/reverse/linear-code) # linear-code Library to handle linear codes from coding theory. diff --git a/linear-code.cabal b/linear-code.cabal --- a/linear-code.cabal +++ b/linear-code.cabal @@ -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 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 diff --git a/src/Math/Algebra/Code/Linear.hs b/src/Math/Algebra/Code/Linear.hs --- a/src/Math/Algebra/Code/Linear.hs +++ b/src/Math/Algebra/Code/Linear.hs @@ -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 diff --git a/src/Math/Algebra/Matrix.hs b/src/Math/Algebra/Matrix.hs deleted file mode 100644 --- a/src/Math/Algebra/Matrix.hs +++ /dev/null @@ -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 . --} -{-| -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 diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -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