Zuletzt editiert: 31.07.2014 18:02
Skript zum Lösen von Übungsaufgaben in Codierungstheorie
{- Codierungstheorie - SS2014
Hilfsskripte zur Bearbeitung der Übungsaufgaben
Autor: Konstantin Grupp
-}
import Data.List hiding (transpose)
import Data.Matrix
import qualified Data.Vector
import Data.Maybe
import Data.Function
type Word = [Integer]
type Matr = Matrix Integer
-----------------------------------------------------------
-- Berechnet den Hammingabstand
distance :: Word -> Word -> Integer
distance a [] = toInteger(length a)
distance [] b = distance b []
distance (a:as) (b:bs) = (if a == b then 0 else 1) + distance as bs
-- Berechnet den Minimalabstand
minDistanceInef :: [Word] -> Integer
minDistanceInef code = worker code
where worker :: [[Integer]] -> Integer
worker (x:xs) = minimum $ worker xs : map (distance x) (delete x code)
worker [] = 999999
-- Berechnet den Minimalabstand eines linearen Codes mittels des Gewichtes
minDistanceWithWeight :: [Word] -> Integer
minDistanceWithWeight c = minimum $ filter (/= 0) $ map sum c
firstWordWithMinWeight :: [Word] -> Word
firstWordWithMinWeight = worker (999999,[])
where worker (_,y) [] = y
worker (m,y) (x:xs) | sum x < m = worker (sum x, x) xs
| otherwise = worker (m,y) xs
-----------------------------------------------------------
-- Bildet die Menge Z_n^l ab
z :: Integer -> Integer -> [Word]
z l n = worker l word
where word = [[a] | a <- [0..(n-1)]];
worker :: Integer -> [Word] -> [Word]
worker 1 calc = calc
worker len calc = worker (len - 1) [ a ++ b | a <- word, b <- calc]
-- Fuehrt mod n ueber einer Matrix aus
matrixModulo :: Integer -> Matr -> Matr
matrixModulo n mat = worker (nrows mat) mat
where worker :: Int -> Matr -> Matr
worker 0 m = m
worker i m = worker (i - 1) $ mapRow (\_ x -> x `mod` n) i m
-- Berechnet die Codewoerter die zur Kontrollmatrix gehoeren
getCodeFromH :: Matr -> Integer -> [Word]
getCodeFromH h n = filter (checker . toMatrix) zln
where zln = z (toInteger (ncols h)) n
toMatrix y = fromList (length y) 1 y;
checker y = matrixModulo n (h * y) == zero (nrows h) 1
-- Bildet den Code mittels einer Generator Matrix
getCodeFromG :: Matr -> Integer -> [Word]
getCodeFromG g n = map (checker . toMatrix) zln
where zln = z (toInteger (nrows g)) n;
toMatrix y = transpose $ fromList (length y) 1 y;
checker y = convert $ transpose $ matrixModulo n (y * g);
convert y = Data.Vector.toList $ getCol 1 y
addMod :: Integer -> [Integer] -> [Integer] -> [Integer]
addMod n (a:as) (b:bs) = (a + b) `mod` n : addMod n as bs
addMod _ _ _ = []
-----------------------------------------------------------
-- Berechnet die Nebenklassen eines Codes (der über eine Kontrollmatrix definiert wird)
calcCosetClass :: Matr -> Integer -> [[Word]]
calcCosetClass h n = worker setV []
where code = getCodeFromH h n;
setV = z (toInteger (ncols h)) n
worker :: [Word] -> [[Word]] -> [[Word]]
worker [] acc = acc
worker (v:vs) acc | [] == filter (elem v) acc = worker vs ([ addMod n v c | c <- code]:acc)
| otherwise = worker vs acc
-- Berechnet die Nebenklassenführer eines Codes (der über eine Kontrollmatrix definiert wird)
calcCosetClassLeaders :: Matr -> Integer -> [Word]
calcCosetClassLeaders h n = map firstWordWithMinWeight cosetClasses
where cosetClasses = calcCosetClass h n
-- Berechnet die Syndrome (der über eine Kontrollmatrix definiert wird)
calcSyndrom :: Matr -> Integer -> Word -> Word
calcSyndrom h n a = Data.Vector.toList $ getRow 1 $ transpose $ matrixModulo n (h * b)
where b = fromList (length a) 1 a
-- Syndromdecodierung vorbereiten
-- sort $ map (\x -> (calcSyndrom h52 2 x,x)) $ calcCosetClassLeaders h52 2
-----------------------------------------------------------
-- Berechnet die geordnete Menge einer zyklischen Gruppe
calcCyclicGroup :: Integer -> Integer -> [Integer]
calcCyclicGroup a n = reverse $ worker [a] a
where worker acc b | next `elem` acc = acc
| otherwise = worker (next:acc) next
where next = (b * a) `mod` n
-- Überprüft ob mit a in Z_n eine zyklische Gruppe gebildet werden kann
isCyclic :: Integer -> Integer -> Bool
isCyclic a n = sort (calcCyclicGroup a n) == [1..(n-1)]
-----------------------------------------------------------
-- Erstellt für einen Reed-Solomon Code die Kontrollmatrix H
createHforRSCode :: Integer -> Integer -> Integer -> Matr
createHforRSCode d a q = fromLists $ workerV 1
where n = q - 1
workerV d1 | d-1 < d1 = []
| otherwise = workerH 0 d1 : workerV (d1+1)
workerH :: Integer -> Integer -> [Integer]
workerH n1 d1 | n-1 < n1 = []
| otherwise = a^(n1*d1) `mod` q : workerH (n1 + 1) d1
-- minDistanceWithWeight $ map (\x -> x ++ [sum x `mod` 2]) $ getCodeFromG g2 2
-----------------------------------------------------------
-- Verschiedene Generator und Kontrollmatrizen
g1 :: Matr
g1 = fromLists [[1,0,0,1,1,0,0,1,1,1,1,1,0,0,0]
,[1,1,0,0,0,1,1,0,1,1,1,0,1,0,0]
,[0,1,1,0,1,0,1,1,0,1,1,0,0,1,0]
,[0,0,1,1,0,1,1,1,1,0,1,0,0,0,1]]
g2 :: Matr
g2 = fromLists [[1,1,0,1,0,0,0,1]
,[0,1,1,0,1,0,0,1]
,[1,0,1,0,0,1,0,1]
,[1,1,1,0,0,0,1,0]]
h1 :: Matr
h1 = fromLists [[1 , 0 , 0 , 0 , 1 , 0 , 1 , 1]
,[0 , 1 , 0 , 0 , 1 , 1 , 0 , 1]
,[0 , 0 , 1 , 0 , 0 , 1 , 1 , 1]
,[0 , 0 , 0 , 1 , 1 , 1 , 1 , 0]]
-- 5-facher Wiederholungscode, dual Prüfcode
g5fach :: Matr
g5fach = fromLists [[1,1,1,1,1]]
h5fach :: Matr
h5fach = fromLists [[1,1,0,0,0]
,[1,0,1,0,0]
,[1,0,0,1,0]
,[1,0,0,0,1]]
-- [7,4,3] Hamming-Code
g74 :: Matr
g74 = fromLists [[1,0,0,0,1,1,0]
,[0,1,0,0,1,0,1]
,[0,0,1,0,0,1,1]
,[0,0,0,1,1,1,1]]
h74 :: Matr
h74 = fromLists [[1,1,0,1,1,0,0]
,[1,0,1,1,0,1,0]
,[0,1,1,1,0,0,1]]
h74' :: Matr
h74' = fromLists [[0,1,1,1,0,0,1]
,[1,0,1,1,0,1,0]
,[1,1,0,1,1,0,0]]
-- [4,2]_3 Hamming-Code
g423 :: Matr
g423 = fromLists [[1,0,2,2]
,[0,1,1,2]]
h423 :: Matr
h423 = fromLists [[1,2,1,0]
,[1,0,0,1]]
h423' :: Matr
h423' = fromLists [[1,2,1,0]
,[1,1,0,1]]
-- [5,3] Code
g53 :: Matr
g53 = fromLists [[1,1,1,1,0]
,[0,1,1,0,1]
,[0,0,1,1,1]]
h53 :: Matr
h53 = fromLists [[1,1,1,1,0]
,[1,0,1,0,1]]
-- [5,2] Code
g52 :: Matr
g52 = fromLists [[1,1,0,1,0]
,[0,0,1,1,1]]
h52 :: Matr
h52 = fromLists [[1,0,0,1,1]
,[0,1,0,1,1]
,[0,0,1,0,1]]
-----------------------------------------------------------
-- Codewort 'codewordZ' mit RM(1,4) mit Majority-Logic-Decodierung
-- decodieren.
-- 1 dimensionale Unterräume bilden {v_0,v_i} für i = 1,...,15
firstStep :: [[Word]]
firstStep = [[[0,0,0,0],vi] | vi <- z 4 2, [0,0,0,0] /= vi]
-- 2 dimensionale Unterräume bilden {v_0,v_i,v_j,v_i+v_j} für i,j = 1,...,15 aber i != j
-- Insgesamt 7 Stück pro {v_0,v_i}
secondStep :: [(Word,[Word])]
secondStep = nub [(b, sort $ m ++ [vi, map (`mod` 2) (zipWith (+) vi b)]) | m@[_,b] <- firstStep, vi <- z 4 2, vi `notElem` m]
codewordZ :: Word
codewordZ = [1, 0, 1, 0, 1, 1, 1, 1, 0, 0, 0, 0, 1, 0, 1, 1]
-- X_M_j für alle j berechnen
xMj :: [[Integer]]
xMj = [[if a `elem` y then 1 else 0 | a <- z 4 2] | _m@(_,y) <- secondStep]
-- <X_M_j,z> für alle j
skalarOfZandXMj :: [Integer]
skalarOfZandXMj = map ((`mod` 2) . sum . zipWith (*) codewordZ) xMj
-- Nach erstem Tupel gruppieren
groupVi :: [[(Word,Integer)]]
groupVi = groupBy ((==) `on` fst) $ zip (map fst secondStep) skalarOfZandXMj
-- Majoritätsentscheidung vorbereiten
prepareMajorityDecision :: [(Int,[Int])]
prepareMajorityDecision = map (\xs@((g,_):_) -> (fromJust $ elemIndex g (z 4 2), map (fromInteger . snd) xs)) groupVi
-- Majoritätsentscheidung treffen:
majorityDecision :: [(Int,Bool)]
majorityDecision = [(pos, length xs > sum xs * 2) | (pos, xs) <- prepareMajorityDecision]