UDCode - Does a set of code words form a uniquely decodable code?

UDCode documentation Contained in the UDCode distribution.

Index

Code Index:

NAME

Top

UDCode - Does a set of code words form a uniquely decodable code?

SYNOPSIS

Top

        use UDCode;

        if (is_udcode(@words)) { ... }

        my ($x1, $x2) = ud_pair(@words);

DESCRIPTION

Top

A code is a set of strings, called the code words. A code is "uniquely decodable" if any string S that is a concatenation of code words is so in exactly one way.

For example, the code "ab", "abba", "b" is not uniquely decodable, because "abba" . "b" eq "ab" . "b" . "ab". But the code "a", "ab", "abb" is uniquely decodable, because there is no such pair of sequences of code words.

is_udcode

is_udcode(@words) returns true if and only if the specified code is uniquely decodable.

ud_pair

If @words is not a uniquely decodable code, then ud_pair(@words) returns a proof of that fact, in the form of two distinct sequences of code words whose concatenations are equal.

If @words is not uniquely decodable, then ud_pair returns references to two arrays of code words, $a, and $b, such that:

	join("", @$a) eq join("", @$b)

For example, given @words = qw(ab abba b), ud_pair might return the two arrays ["ab", "b", "ab"] and ["abba", "b"].

If @words is uniquely decodable, ud_pair returns false.

AUTHOR

Top

Mark Jason Dominus (mjd@plover.com)

COPYRIGHT

Top

This software is hereby released into the public domain. You may use, modify, or distribute it for any purpose whatsoever without restriction.

UDCode documentation Contained in the UDCode distribution. 
package UDCode;

$VERSION = "1.03";

use base 'Exporter';
@EXPORT = qw(is_udcode ud_pair);


sub is_udcode {
  my $N = my ($a, $b) = ud_pair(@_);
  return $N == 0;
}


sub ud_pair {
  # Code words
  my @c = @_;

  # $h{$x} = [$y, $z]  means that $x$y eq $z
  my %h;

  # Queue
  my @q;

  for my $c1 (@c) {
    for my $c2 (@c) {
      next if $c1 eq $c2;
      if (is_prefix_of($c1, $c2)) {
        my $x = subtract($c1, $c2);
        $h{$x} = [[$c1], [$c2]];
        push @q, $x;
      }
    }
  }

  while (@q) {
    my $x = shift @q;
    return unless defined $x;

    my ($a, $b) = @{$h{$x}};
    for my $c (@c) {
      die unless defined $b;      # Can't happen
      # $a$x eq $b

      my $y;
      if (is_prefix_of($c, $x)) {
        $y = subtract($c, $x);
        next if exists $h{$y};  # already tried this
        $h{$y} = [[@$a, $c], $b];
        push @q, $y;
      } elsif (is_prefix_of($x, $c)) {
        $y = subtract($x, $c);
        next if exists $h{$y};  # already tried this
        $h{$y} = [$b, [@$a, $c]];
        push @q, $y;
      }

      return @{$h{""}} if defined($y) && $y eq "";
    }
  }
  return;                       # failure
}

sub is_prefix_of {
  index($_[1], $_[0]) == 0;
}

sub subtract {
  substr($_[1], length($_[0]));
}


unless (caller) {
  my ($a, $b) = ud_pair("ab", "abba", "b");
  print "@$a == @$b\n";
}

1;