Brutal straightforward computation of minimal distance between words in binary cyclic code. It usually should not be run.

brute-distance.hs

{-# LANGUAGE BangPatterns #-}
import Data.List ((\\), union, sort)
import Data.Foldable
import Debug.Trace

type N = Int
type Mono = Int
type IndexCode = Int

multMonomials :: Mono -> Mono -> Mono
multMonomials = (+)

divMonomial :: Mono -> Mono -> Mono
divMonomial a b = if a > b
  then a - b
  else 0

newtype Poly = Poly {unPoly :: [Mono]}
  deriving (Show, Eq, Ord)

symmDiff :: Eq a => [a] -> [a] -> [a]
symmDiff a b = (a \\ b) `union` (b \\ a)

reduce :: Poly -> Poly
reduce (Poly []) = Poly []
reduce (Poly [a]) = Poly [a]
reduce (Poly (a:b:as)) = if a == b
  then reduce $ Poly as
  else Poly $ a : (unPoly . reduce $ Poly (b:as))

instance Num Poly where
  Poly lst1 + Poly lst2 = Poly (lst1 `symmDiff` lst2)
  Poly [] * _ = Poly []
  _ * Poly [] = Poly []
  (Poly a) * (Poly b) = reduce . Poly . sort $ mconcat $ map (\m -> map (multMonomials m) b) a
  abs = id
  signum _ = Poly [0]
  negate a = a
  fromInteger _ = Poly [0]

maxDegreeMonomial :: Poly -> Mono
maxDegreeMonomial (Poly []) = 0
maxDegreeMonomial (Poly l) = maximum l

divModSingleton :: Poly -> Poly -> Mono
divModSingleton p1 p2 = divMonomial (maxDegreeMonomial p1) (maxDegreeMonomial p2)

divModStep :: (Poly, Poly) -> Poly -> (Poly, Poly)
divModStep (resAccum, p1) p2 = (multiple + resAccum, p1 - p2*multiple)
  where multiple = Poly [divModSingleton p1 p2]

degreePoly :: Poly -> Int
degreePoly = maxDegreeMonomial

residueCondition :: Poly -> Poly -> Bool
residueCondition p1 p2 = degreePoly p1 < degreePoly p2

-- Direct recursion, hence it is probably the only place for optimization.
polyDivMod' :: (Poly, Poly) -> Poly -> (Poly, Poly)
polyDivMod' (pRes, p1) p2 = if residueCondition p1 p2
  then (pRes,p1)
  else polyDivMod' (divModStep (pRes, p1) p2) p2

polyDivMod :: Poly -> Poly -> (Poly, Poly)
polyDivMod p1 p2 = polyDivMod' (Poly [], p1) p2

polyDiv :: Poly -> Poly -> Poly
polyDiv a b = fst $ polyDivMod a b

polyMod :: Poly -> Poly -> Poly
polyMod a b = snd $ polyDivMod a b

rev :: Poly -> Poly
rev (Poly lst) = Poly (map (\a -> m - a) lst)
  where m = maximum lst

phi30 :: Poly
phi30 = Poly [0..30]

extract :: IndexCode -> [Mono]
extract n = extract' n 0 []
  where
    extract' n pow accum = if n == 0
      then accum
      else extract' (n `div` 2) (pow+1) (accum ++ if n `mod` 2 == 1 then [pow] else [])

buildPoly :: IndexCode -> Poly
buildPoly = Poly . reverse . extract

allPolys :: N -> [Poly]
allPolys p = map buildPoly [0..2^p]

minimalDistance :: N -> Poly -> Int
minimalDistance n gen =
  foldl' (\m poly -> min m ((\a -> if a == 0 then m else a) $ length (unPoly poly)))
         n (filter (\p -> p `polyMod` gen == Poly []) $ allPolys n)

main :: IO ()
main = do
  putStr "Insert modulus: "
  n <- read <$> getLine
  putStr "Insert list of degrees of generating polynomial (format [a,b,c]): "
  a <- Poly . read <$> getLine
  putStr "Minimal distance of code (is being computed): "
  print $ minimalDistance n a
  putStr "Minimal distance of dual code (is being computed): "
  print $ minimalDistance n (rev $ polyDiv (Poly [0,31]) a)