fun_w_hamming_code.pl

#! /usr/bin/perl

#####  INCLUDES  #############################################################
use warnings;
use strict;

#####  GLOBALS  ##############################################################
my ($hamLen, $maxDataLen);
my @av = ([3,1], [7,4], [15,11], [31,26], [63,57], [127,120], [255,247]);
# [$n+$maxlen, $maxlen], where $maxlen = (2**$n) - 1 - $n ;

#####  SUBS  #################################################################
sub printHam(@)
{
  my $print_0_as_O = 0;
  my @foo = @_;
  map{'O' unless $_;} @foo if $print_0_as_O;
  print join(', ', @foo) . "     " . join('', @foo) ."\n";
}

# 110 -> 0110 -> 1100110   string or array
# pairing bits   ^^ ^
sub genH($)
{
  my ($bindata) = @_;
  my $ret;

  #=== fill up data w/ 0
  while (length($bindata) < $maxDataLen)
  {
    $bindata = "0" . $bindata;
  }

  #===== fill up the bindata code
  # __0_110
  my $par = 0;
  my @data = split('', $bindata);
  my @ham = ();

  for (my $i = 0; $i < $hamLen; $i++)
  {
    if (($i + 1) == 2**$par)
    {
      $ham[$i] = '0';
      $par++;
    }
    else
    {
      my $n = ($i - $par);
      $ham[$i] = $data[$n];
    }
  }

  #===== fill up pairing codes
  # 11_0___
  for (my $i = 0; $i < ($hamLen - $maxDataLen); $i++)
  {
    my $bit = 2**($i);
    my $h = 0;
    my $hatvany = 0;
    for (my $j = 0; $j < $hamLen; $j++)
    {
      # check the bit pairing
      next unless ($j+1) & $bit;
      # skip myself
      if ($j + 1 == 2**$hatvany)
      {
        $hatvany++;
      }
      else
      {
        $h = $h ^ $ham[$j];
      }
    }
    $ham[$bit-1] = $h;
  }

  $ret = join('', @ham);

  return wantarray ? @ham : $ret;
}

# 1100 110 -> 0,0,0 -> 0
# 1110 110 -> 1,1,0 -> 3
# 0100 110 -> 1,0,0 -> 1
sub checkPar($)
{
  my @ham = split('',$_[0]);
  my $check = 0;
  my @check;

  for (my $i = 0; $i < ($hamLen - $maxDataLen); $i++)
  {
    my $bit = 2**($i);
    my $h = 0;
    for (my $j = 0; $j < $hamLen; $j++)
    {
      $h = $h ^ $ham[$j] if ($j+1) & $bit;
    }
    $check += $bit if $h;
    $check[$i] = $h;
  }

  return wantarray ? @check : $check;
}

sub genError($)
{
  my $txt = shift;
  my @hiba = split('', $txt);
  my $loc = int(rand($hamLen));
  $hiba[$loc] = 1 & ~int($hiba[$loc]);
  return wantarray ? @hiba : join('', @hiba);
}

sub markError($;$)
{
  my ($ham, $n) = @_;
  $n = checkPar($ham) unless defined $n;
  my @ham = map {' '} split('', $ham);
  $ham[$n - 1] = '!';
  return wantarray ? @ham : join('', @ham);
}

sub fixError($;$)
{
  my ($ham, $n) = @_;
  $n = checkPar($ham) unless defined $n;
  my @ham = split('', $ham);
  $ham[$n - 1] = 1 & ~int($ham[$n - 1]);
  return wantarray ? @ham : join('', @ham);
}

#####  CODE  #################################################################
my ($data, $error) = @ARGV;
die "kell egy kezdo adat\n" unless defined($data);
die "binaris szamot fogad el!\n" if $data =~ m/[^10]/;

#== check for applicable length
my $dataLen = length($data);
foreach (@av)
{
  next if ($dataLen > $_->[1]);
  ($hamLen, $maxDataLen) = @{$_};
  last;
}
die "tul hosszu szam\n" if (!$maxDataLen);
die "max $maxDataLen jegyut fogad el a kod\n" if ($dataLen > $maxDataLen);

warn "H($hamLen, $maxDataLen)\n";

my $ham = genH($data);
print "hamming  $ham\n";
# my @ham = genH($data);
# printHam(@ham);

my $c = checkPar($ham);
print "parity   $c\n";

my $ham2 = genError($ham);
print "error    $ham2\n";

$c = checkPar($ham2);
print "parity   $c\n";
my $mark = markError($ham2, $c);
print "         $mark\n";

my $ham3 = fixError($ham2, checkPar($ham2));
print "fixed    $ham3\n";

foreach (0 .. 3)
{
  my $err = genError($ham);
  my $c = checkPar($err);
  my $mark = markError($err, $c);
  my $ham3 = fixError($err, $c);
  print "----------" . "-" x $hamLen . "\n"
      . "error    $err\n"
      . "         $mark\n"
  #    . "         $ham3\n\n"
      ;
}