From 09ef5973f8cc570cb04372644c8e8b53a58f6a36 Mon Sep 17 00:00:00 2001
From: wchresta <34962284+wchresta@users.noreply.github.com>
Date: Thu, 2 Aug 2018 11:15:17 +0200
Subject: [PATCH] Clean up package strucute, exports and documentation

---
 package.yaml                        | 20 ++++-----
 src/Math/Algebra/Code/Linear.hs     | 46 ++++++++++++--------
 src/Math/Algebra/Field/Instances.hs | 13 ++++++
 src/Math/Algebra/Field/Static.hs    | 16 ++++++-
 src/Math/Algebra/Matrix.hs          | 67 +++++++++++++++++++----------
 test/Main.hs                        | 12 +++++-
 6 files changed, 119 insertions(+), 55 deletions(-)

diff --git a/package.yaml b/package.yaml
index 8ac3d75..f2fde14 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,7 +1,7 @@
 name:                linear-code
-version:             0.1.0.0
+version:             0.1.0
 github:              "wchresta/linear-code"
-license:             GPL3
+license:             GPL-3
 author:              "Wanja Chresta"
 maintainer:          "wanja.hs@chrummibei.ch"
 copyright:           "2018, Wanja Chresta"
@@ -20,17 +20,15 @@ description: Please see the README on GitHub at <https://github.com/wchresta/lin
 
 dependencies:
     - base >= 4.7 && < 5
-    - combinat >= 0.2
-    - containers >= 0.5
-    - data-default >= 0.5
-    - matrix >= 0.3
-    - HaskellForMaths >= 0.4
-    - ghc-typelits-natnormalise >= 0.2
-    - ghc-typelits-knownnat >= 0.4
+    - combinat
+    - containers
+    - data-default
+    - matrix
+    - HaskellForMaths
+    - ghc-typelits-natnormalise
+    - ghc-typelits-knownnat
     - random
     - MonadRandom
-      #   - hmatrix
-      #   - polynomial
 
 library:
   source-dirs: src
diff --git a/src/Math/Algebra/Code/Linear.hs b/src/Math/Algebra/Code/Linear.hs
index 7a9df99..db15808 100644
--- a/src/Math/Algebra/Code/Linear.hs
+++ b/src/Math/Algebra/Code/Linear.hs
@@ -37,11 +37,11 @@ over arbitrary fields, including finite fields. Goes well with the
 @HaskellForMath@ library and its finite field implementations in
 @Math.Algebra.Field@. To use extension fields (fields of prime power, i.e.
 @F_{p^k}@ with @k>1@), use one of the exported finite fields in
-@Math.Algebra.Field.Extension@ like 'F16' and its generator 'a16'.
+"Math.Algebra.Field.Extension" like 'F16' and its generator 'a16'.
 
 As theoretical basis, Introduction to Coding Theory by Yehuda Lindell is used.
 It can be found at
-http://u.cs.biu.ac.il/~lindell/89-662/coding_theory-lecture-notes.pdf
+<http://u.cs.biu.ac.il/~lindell/89-662/coding_theory-lecture-notes.pdf>
 -}
 module Math.Algebra.Code.Linear
     ( LinearCode (..)
@@ -71,12 +71,12 @@ module Math.Algebra.Code.Linear
     , e, e1, e2, e3, e4, e5, e6, e7, e8, e9, e10
     , char
 
-    -- * Reexported matrix functions
+    -- * Reexported matrix functions from "Math.Algebra.Matrix"
     , matrix, zero, transpose, fromList, fromLists
 
-    -- * Reexported finite fields
-    , FiniteField, F2, F3, F5, F7, F11
-    , ExtensionField, F4, F8, F16, F9
+    -- * Reexported finite fields from @Math.Algebra.Field@
+    , F2, F3, F5, F7, F11
+    , F4, F8, F16, F9
     ) where
 
 -- Linear codes from mathematical coding theory, including error correcting
@@ -117,32 +117,37 @@ import Math.Algebra.Matrix
     )
 
 
--- | A Generator is the generator matrix of a linear code, not necessarily
+-- | A 'Generator' is the generator matrix of a linear code, not necessarily
 --   in standard form.
 type Generator (n :: Nat) (k :: Nat) = Matrix k n
+
+-- | A 'CheckMatrix' or parity matrix is the dual of a 'Generator'. It can
+--   be used to check if a word is a valid code word for the code. Also,
+-- > ∀v∈F^k: cG * H^T = 0
+--   i.e. the code is generated by the kernel of a check matrix.
 type CheckMatrix (n :: Nat) (k :: Nat) = Matrix (n-k) n
 
--- | 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 generated by the generator matrix.
+-- | 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.
 data LinearCode (n :: Nat) (k :: Nat) (f :: *)
     = LinearCode { generatorMatrix :: Generator n k f
                  -- ^ Generator matrix, used for most of the operations
-                 -- , standardFormGenerator :: Maybe (Generator n k f)
                  , checkMatrix :: CheckMatrix n k f
                  -- ^ Check matrix which can be automatically calculated
                  --   from the standard form generator.
                  , distance :: Maybe Int
                  -- ^ The minimal distance of the code. This is the parameter
-                 --   d in [n,k,d]_q notation of code parameters. The problem
-                 --   of finding the minimal distance is NP-Hard, thus might
-                 --   not be available.
+                 --   @d@ in @[n,k,d]_q@ notation of code parameters. The
+                 --   problem of finding the minimal distance is NP-Hard, thus
+                 --   might not be available.
                  , syndromeTable :: SyndromeTable n k f
                  -- ^ A map of all possible syndromes to their error vector.
                  --   It is used to use syndrome decoding, a very slow decoding
                  --   algorithm.
                  }
 
+-- | Extract an Int from a type level 'KnownNat'.
 natToInt :: forall k. KnownNat k => Proxy k -> Int
 natToInt = fromInteger . natVal
 
@@ -154,11 +159,12 @@ instance forall n k f. (Eq f, Fractional f, KnownNat n, KnownNat k, k <= n)
 instance forall n k f c.
     (KnownNat n, KnownNat k, KnownNat (Characteristic f))
     => Show (LinearCode n k f) where
-        show LinearCode{} =
-            '[':show n<>","<>show k<>"]_"<>show c<>"-Code"
+        show LinearCode{distance=md} =
+            '[':show n<>","<>show k<>dist<>"]_"<>show c<>"-Code"
                 where c = char (Proxy :: Proxy f)
                       n = natToInt @n Proxy
                       k = natToInt @k Proxy
+                      dist = fromMaybe "" $ fmap (\d -> ',':show d) md
 
 instance forall n k f.
     (KnownNat n, KnownNat k, k <= n, Eq f, FinSet f, Num f, Ord f)
@@ -174,7 +180,9 @@ randomPermMatrix g =
     let n = natToInt @n Proxy
         delta i j = if i == j then 1 else 0
         (perm,g') = _randomPermutation n g
-     in (fromLists [ [ delta i (perm !! (j-1)) | j <- [1..n] ] | i <- [1..n] ],g')
+     in (fromLists [ [ delta i (perm !! (j-1)) 
+                     | j <- [1..n] ] 
+                   | i <- [1..n] ],g')
 
 -- | A random code with a generator in standard form. This does not generate
 --   all possible codes but only one representant of the equivalence class
@@ -340,7 +348,9 @@ calcSyndromeTable c = M.fromListWith minWt allSyndromes
           allSyndromes :: [(Syndrome n k f, Vector n f)]
           allSyndromes = [(syndrome c e,e) | e <- lighterWords w]
 
-
+-- | Replace the 'syndromeTable' of a code with a newly calculated syndrome
+--   table for the (current) generator. Useful to get a syndrome table for
+--   transformed codes when the table cannot be transformed, too.
 recalcSyndromeTable :: forall n k f.
     (KnownNat n, KnownNat k, k <= n, Eq f, FinSet f, Num f, Ord f)
       => LinearCode n k f -> LinearCode n k f
diff --git a/src/Math/Algebra/Field/Instances.hs b/src/Math/Algebra/Field/Instances.hs
index 49027f6..2832267 100644
--- a/src/Math/Algebra/Field/Instances.hs
+++ b/src/Math/Algebra/Field/Instances.hs
@@ -15,6 +15,19 @@
     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.Field.Instances
+Description : Missing instnaces for @HaskellForMaths@'s 'Math.Algebra.Field'
+Copyright   : (c) Wanja Chresta, 2018
+License     : GPL-3
+Maintainer  : wanja.hs@chrummibei.ch
+Stability   : experimental
+Portability : POSIX
+
+Some important instances like 'Random' and 'Bounded' are missing from
+@HaskellForMath@'s implementation of finite fiels. Here, orphan instances
+for these classes are added.
+-}
 
 module Math.Algebra.Field.Instances() where
 
diff --git a/src/Math/Algebra/Field/Static.hs b/src/Math/Algebra/Field/Static.hs
index 5ee42b1..eb5d217 100644
--- a/src/Math/Algebra/Field/Static.hs
+++ b/src/Math/Algebra/Field/Static.hs
@@ -20,6 +20,18 @@
     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.Field.Static
+Description : Some type families extracting finite field parameters
+Copyright   : (c) Wanja Chresta, 2018
+License     : GPL-3
+Maintainer  : wanja.hs@chrummibei.ch
+Stability   : experimental
+Portability : POSIX
+
+Some finite field parameters are missing from @HaskellForMaths@ implementation.
+Here, we add type classes to add these parameters to the type level.
+-}
 module Math.Algebra.Field.Static where
 
 import Data.Proxy (Proxy(Proxy))
@@ -57,7 +69,7 @@ type instance Characteristic F.F79 = 79
 type instance Characteristic F.F83 = 83
 type instance Characteristic F.F89 = 89
 type instance Characteristic F.F97 = 97
-type instance Characteristic (F.ExtensionField k poly) 
+type instance Characteristic (F.ExtensionField k poly)
   = Characteristic k -- Extension fields have their base fields char
 
 
@@ -85,7 +97,7 @@ type instance PolyDegree F.ConwayF32 = 5
 --   of a finite field.
 type family Size (f :: *) :: Nat
 type instance Size (F.Fp p) = Characteristic (F.Fp p)
-type instance Size (F.ExtensionField fp poly) = 
+type instance Size (F.ExtensionField fp poly) =
     Characteristic fp ^ PolyDegree poly
 
 
diff --git a/src/Math/Algebra/Matrix.hs b/src/Math/Algebra/Matrix.hs
index ad70ab4..70adcd5 100644
--- a/src/Math/Algebra/Matrix.hs
+++ b/src/Math/Algebra/Matrix.hs
@@ -67,6 +67,9 @@ import Data.Maybe (isNothing, listToMaybe)
 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)
 
@@ -115,67 +118,87 @@ instance forall m n a. (KnownNat m, KnownNat n, R.Random a)
 (^*) :: 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 (Proxy @m)
-          n' = fromInteger $ natVal (Proxy @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
 
+-- | /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 (Proxy @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 (Proxy @n)
-          m' = fromInteger $ natVal (Proxy @m)
+    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
+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 (Proxy @n)
-          m' = fromInteger $ natVal (Proxy @m)
+                                <>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' && length (head as) == n'
+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 (Proxy @n)
-          m' = fromInteger $ natVal (Proxy @m)
-
+                                <>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 $ Proxy @n'
-          m' = fromInteger . natVal $ Proxy @m'
+    where n' = fromInteger $ natVal @n' Proxy
+          m' = fromInteger $ natVal @m' Proxy
 
 
 
@@ -212,7 +235,7 @@ rref mat = fromLists $ f m 0 [0 .. rows - 1]
             | otherwise = zipWith h newRow row
               where h = subtract . (* row !! lead')
 
-replace :: Int -> a -> [a] -> [a]
-{- Replaces the element at the given index. -}
-replace n e l = a ++ e : b
-  where (a, _ : b) = splitAt n l
+        replace :: Int -> b -> [b] -> [b]
+        {- Replaces the element at the given index. -}
+        replace n e l = a ++ e : b
+          where (a, _ : b) = splitAt n l
diff --git a/test/Main.hs b/test/Main.hs
index 1f8d2e8..9a6478b 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -41,7 +41,15 @@ codeTests =
     let tc = trivialCode :: BinaryCode 5 3
         hamming74 = hamming :: BinaryCode 7 4
      in testGroup "Codes"
-        [ testGroup "Trivial code"
+        [ testGroup "Instances"
+            [ testCase "Show works for unknown distance" $
+                show (trivialCode {distance=Nothing} :: LinearCode 7 4 F.F3)
+                    @?= "[7,4]_3-Code"
+            , testCase "Show works for known distance" $
+                show (trivialCode {distance=Just 3} :: LinearCode 7 4 F.F3)
+                    @?= "[7,4,3]_3-Code"
+            ]
+        , testGroup "Trivial code"
             [ testCase "Trivial binary code == codeFromA zero, [5,3]" $
                 tc @?= codeFromA zero
             , testCase "Trivial binary code == codeFromA zero, [3,3]" $
@@ -88,7 +96,7 @@ codeTests =
         ]
 
 -- SmallCheck Series for GF
-instance forall m f. (Monad m, FiniteField f) => S.Serial m f where
+instance forall m f. (Monad m, F.FiniteField f) => S.Serial m f where
     series = S.generate $ \d -> take (d+1) (F.eltsFq 1 :: [f])
 
 instance forall m n f. (KnownNat m, KnownNat n, Q.Arbitrary f)