sub compress(&@) {
  my $cr=shift;
  my$x;
  my @aResult;

  local $_=undef;
  foreach (map {
    defined($x)
      ? defined($_) && ($x eq $_) ? () : ($x = $_)
        : defined($_) ? ($x = $_) : ()
      } @_) {
    push @aResult, $cr->();
  }
  return @aResult;
}

my @aData=(qw(a a a a b c c a a d e e e e), undef, undef, qw(f g g));
my @aCompressed
  = compress {'*' . (defined($_)?$_:'<undef>').'*'} @aData;
print "compress: @aCompressed\n";

# output:
compress: *a* *b* *c* *a* *d* *e* *<undef>* *f* *g*


##</code><code>##

sub compressPair(&@) {
  my $cr=shift;
  my @aResult;
  my $x;

  local $a=undef;
  local $b=undef;
  foreach (map {
    defined($x) ? ($x eq$_?():($x=$_)) : defined($_)?($x=$_):()
  } @_) {
    $a=$b;
    $b=$_;
    push @aResult, $cr->();
  }
  return @aResult;
}

my @aData=(qw(a a a a b c c a a d e e e e), undef, undef, qw(f g g));
my @aCompressed = compressPairs { '(' . (defined($a)?$a:'<undef>')
                            . ',' . (defined($b)?$b:'<undef>') . ')'
                        } @aData;

print "compressPairs: @aCompressed\n";

#output
compressPairs: (<undef>,a) (a,b) (b,c) (c,a) (a,d) (d,e) (e,<undef>) (<undef>,f) (f,g)

##</code><code>##

sub compressPairsWithCount(&@) {
  my $cr=shift;
  my @aResult;
  my $x;
  my @aRuns=(0);
  my $i=defined($_[0])?-1:0;
  my $j=0;

  local $a=undef;
  local $b=undef;
  foreach (map {
    if ((defined($x) && defined($_) && ($x eq $_))
        || (!defined($x) && !defined($_))) {
      $aRuns[$i]++;
      ()
    } else {
      $aRuns[++$i]=1;
      ($x = $_);
    }
  } @_) {

    $a=$b;
    $b=$_;
    $_=$aRuns[$j++];
    push @aResult, $cr->();
  }
  return @aResult;
}

@aCompressed = compressPairsWithCount
  { '(' . (defined($a)?$a:'<undef>') . ','
      . (defined($b)?$b:'<undef>') . "=$_)" } @aData;
print "compressPairsWithCount: @aCompressed\n";

#outputs
compressPairsWithCount: (<undef>,a=4) (a,b=1) (b,c=2) (c,a=2) (a,d=1) (d,e=4) (e,<undef>=2) (<undef>,f=1) (f,g=2)