/***************************************************************** File: BCH.mu Authors: Florent Hivert Created: 29/11/2004 Purpose: Demonstration of the binary BCH codes. Bose-Chaudhuri (1960) et Hocquenghem (1959) License: GPL ******************************************************************/ ////////////////////////////////////////////////////////////////// // Codes BCH binaires : ////////////////////////////////////////////////////////////////// // code BCH en bloc de taille 2^M -1, T-correcteur /* Usage : bch := binaryBCHCode(4,3); bch::parameters; bch::trueCorrection; mes := bch::randomMessage(); code := bch::encode(mes); recv := bch::scrambleCode(code); bch::decode(code); Quelques exemples de codes amusants: binaryBCHCode(2, 1) : [ 3, 1, 1] binaryBCHCode(3, 1) : [ 7, 4, 1] binaryBCHCode(5, 3) : [ 31, 16, 3] binaryBCHCode(7, 10) : [ 127, 64, 10] binaryBCHCode(11, 106) : [2047, 1024, 106] *****************************************************************/ domain binaryBCHCode(M: Type::PosInt, T: Type::PosInt) local N, // 2^M -1 F2, K, // corps Z/2Z et F2^N Alpha, // element primitif de K PolK, // polynome K[X] Dist, // Distance de deux mots du code : 2*T+1 UClass, // Union, pour i < Dist, des classes cyclotomiques de i Gener, // Polynome generateur du code Long, // Longueur des blocs de messages RandomBits; // Generateur de Bits; interface := {hold(trueCorrection), hold(parameters), hold(polK), hold(uClass), hold(generator), hold(binaryWord2Pol), hold(pol2BinaryWord), hold(encodePol), hold(decodePol), hold(correctPol), hold(syndrome), hold(localisatorFromSyndrome), hold(rootsLocalisator), hold(encode), hold(decode), hold(randomMessage), hold(scrambleCode)}; ////////////////////////////////////////////////////////////////// // Infomations diverses uClass := UClass; parameters := [N, Long, T]; generator := Gener; polK := PolK; /* vrai taux de correction du code */ trueCorrection := (min(op({$1..N} minus UClass)) - 1)/2; ////////////////////////////////////////////////////////////////// // Traduction Polynome <-> mots sur 0,1 binaryWordOfLenght := (l) -> Type::ListProduct(Type::Union(Type::Singleton(0), Type::Singleton(1)) $ l); binaryWord2Pol := proc(l: Type::PosInt) option escape; begin proc(m: dom::binaryWordOfLenght(l)) begin _plus((m[i+1] * PolK(X^i)) $ i=0..l-1); end_proc; end_proc; pol2BinaryWord := proc(l: Type::PosInt) option escape; begin proc(p: PolK) begin if testargs() and degree(p) >= l then error("Invalid Polynomial"); end_if; [expr(coeff(p, X, i)) $ i=0..l-1]; end_proc; end_proc; ////////////////////////////////////////////////////////////////// // Encodage et decodage des polynomes encodePol := proc(p: PolK) begin res := p * PolK(X^(N-Long)); res - PolK::rem(res, Gener); end_proc; decodePol := proc(p: PolK) begin PolK::quo(p, PolK(X^(N-Long))); end_proc; ////////////////////////////////////////////////////////////////// // Corrections des erreurs de transmissions syndrome := proc(p: PolK) local i; begin PolK([[PolK::evalp(p, X=Alpha^i),[i-1]] $ i=1..2*T]); end_proc; localisatorFromSyndrome := proc(synd: PolK) local p0, p1, b0, b1, b2, quo, rest, cnst; begin [p0, b0] := [PolK(X^(2*T)), PolK::zero]; [p1, b1] := [synd, PolK::one]; while degree(p1) >= T do [quo, rest] := [divide(p0, p1)]; p0 := p1; p1 := rest; b2 := b0 - b1*quo; b0 := b1; b1 := b2; end_while; cnst := PolK::evalp(b1, X=0); if iszero(cnst) then error("Too many errors... unable to correct"); end_if; b1 / cnst; end_proc; rootsOfLocalisator := proc(sigma: PolK) local res, i; begin res := []; for i from 1 to N do if iszero(PolK::evalp(sigma, X=Alpha^i)) then res := append(res, N-i); end_if; end_for; res; end_proc; correctPol := proc(code: PolK) local synd, sigma, errsC; begin synd := dom::syndrome(code); sigma := dom::localisatorFromSyndrome(synd); errsC := dom::rootsOfLocalisator(sigma); errsC := PolK(map(errsC, z -> [1,[z]])); code + errsC; end_proc; ////////////////////////////////////////////////////////////////// // Fonctions d'encodage et de decodage principales encode := dom::pol2BinaryWord(N)@dom::encodePol@ dom::binaryWord2Pol(Long); decode := dom::pol2BinaryWord(Long)@ dom::decodePol@dom::correctPol@dom::binaryWord2Pol(N); ////////////////////////////////////////////////////////////////// // Fonctions d'utilisation et de test randomBits := RandomBits; randomMessage := proc() local i; begin [RandomBits() $ i=1..Long]; end_proc; scrambleCode := proc(c : dom::binaryWordOfLenght(N), nErr = T: Type::NonNegInt) local i; begin for i in combinat::subwords::random([$1..nops(c)], nErr) do c[i] := 1 - c[i]; end_for; c; end_proc; ////////////////////////////////////////////////////////////////// begin N := 2^M - 1; Dist := 2*T+1: F2 := Dom::IntegerMod(2); K := Dom::GaloisField(F2, M); Alpha := K::randomPrimitive(); PolK := Dom::UnivariatePolynomial(X, K); /* Calcul la plus petite partie de Z/NZ stable par multiplication par 2 et qui contient {$1..Dist-1}. */ UClass := (i) -> (UClass(i) := TRUE; UClass((i+i) mod N)); UClass(i) $ i=1..Dist-1; // Fill and read UClass := map({op(op(UClass, 5))}, op, 1); // the remember table Gener := _mult((PolK(X) - PolK(Alpha^i)) $ i in UClass); Long := N-degree(Gener): RandomBits := random(2) end_domain: //////////////////////////////////////////////////////////////////