#!/usr/bin/perl -w

use strict;

my $consolidate = sub {
    my $rp1 = shift;
    my $rp2 = shift;
    my $p1  = $$rp1;
    my $p2  = $$rp2;

    return 1 if($p1 > $p2);
    return 2 if($p2 > $p1);
    return 3;
};

my $sortup = sub {
    my $rp1 = shift;
    my $rp2 = shift;

    ($$rp1,$$rp2) = ($$rp2,$$rp1) if($$rp1 > $$rp2);

    return 3;
};
my $sortdn = sub {
    my $rp1 = shift;

    return &$sortup(shift,$rp1);
};
my $unique = sub {
    my $rp1 = shift;
    my $rp2 = shift;

    return 1 if($$rp1 == $$rp2);
    return 3;
};

my $maximum = sub {
    my $rp1 = shift;
    my $rp2 = shift;
    my $p1  = $$rp1;
    my $p2  = $$rp2;

    return 1 if($p1 >= $p2);
    return 2 if($p2 >= $p1);
    return 3;
};
my $minimum = sub {
    my $rp1 = shift;

    return &$maximum(shift,$rp1);
};
my $unchanged = sub { return 3 };
my $first     = sub { return 1 };
my $last      = sub { return 2 };

my @set    = (7,7,3,2,1,6,1,8,8,4,6,5);
my @conset = &compare_all($consolidate,@set);
my @maxset = &compare_all($maximum,@set);
my @minset = &compare_all($minimum,@set);
my @oriset = &compare_all($unchanged,@set);
my @fstset = &compare_all($first,@set);
my @lstset = &compare_all($last,@set);
my @sruset = &compare_all($sortup,@set);
my @srdset = &compare_all($sortdn,@set);
my @unqset = &compare_all($unique,@set);

print "Original List    : ",@set,"\n";
print "Consolidated List: ",@conset,"\n";
print "Maximum Value    : ",@maxset,"\n";
print "Minimum Value    : ",@minset,"\n";
print "Unchanged List   : ",@oriset,"\n";
print "First Value      : ",@fstset,"\n";
print "Last Value       : ",@lstset,"\n";
print "UpSorted List    : ",@sruset,"\n";
print "DnSorted List    : ",@srdset,"\n";
print "Unique list      : ",@unqset,"\n";
print "Doubles Deleted  : ",@dodset,"\n";
print "Doubles Kept     : ",@kodset,"\n";


# {{{ compare_all             Iterates all elements in a given list fo
+r comparison with eachother
# 1. Arg: Reference to the comparison/action function
# 2+ Arg: list to iterate
# Return: Modified list
sub compare_all {
    my $func = shift;
    my @set  = @_;
    my $size = scalar(@set);
    my @back;

  ca_outer_loop:
    for(my $i=0; $i < $size; $i++) {
      ca_inner_loop:
        for(my $j=$i+1; $j < $size; $j++) {

            my $val = &$func(\$set[$i],\$set[$j]);
            if($val == 1) {                       # s[i] remains
                splice(@set,$j,1);                # => Thus s[j] is de
+leted
                $j--; $size--;                    # ... array shrinks
                next ca_inner_loop;
            } elsif($val == 2) {                  # s[j] remains
                splice(@set,$i,1);                # => Thus s[i] is de
+leted
                $i--; $size--;                    # ... array shrinks
                next ca_outer_loop;
            } elsif($val == 3) {                  # both s[i] and s[j]
+ remain
                                                  # We don't want to m
+odify the set
            } else {                              # none remains
                # We can do this, because here j > i is always true
                print "Lösche $set[$i] und $set[$j]. I: $i J: $j\n";
                splice(@set,$j,1);                # => Thus s[j] is de
+leted
                $j--; $size--;                    # ... array shrinks
                splice(@set,$i,1);                # => Thus s[i] is de
+leted
                $i--; $size--;                    # ... array shrinks
                next ca_outer_loop;
            }
        }
    }


    return @set;
}
# }}}
[download]