use strict;
use Benchmark 'cmpthese';
use Bit::Vector;

# Länge % 8 == 0 trifft nicht immer zu, hier aber der Einfachkeit halber ang.
my $length = 1_000_000; 

# Das Bitmuster hat direkt Einfluss darauf, wie oft ein neuer Wert an @cache
# angehängt und wie oft $cache[-1] erhöht bzw. verringert wird.
# Wir kennen es nicht, da es durch den Nutzer (mittelbar) festgelegt wird.
# Die von rand erzeugte 0<>1-Wechselfrequenz ist eigentlich viel zu groß,
# aber wollen wir uns mal nicht verkünsteln ...
my @array = map { split '', unpack 'B*', pack('C', int rand(256)) }
                1 .. $length/8;

# Vorschlag von topeg++. Der Umweg über $bin_data ist mE unnötig.
# Zwar bräuchte das ähnlich wenig Speicher wie ein Bitvektor, aber da er bei
# jedem Funktionsaufruf neu aufgeblasen werden muss, nützt uns das nicht viel.
# So sparen wir uns wenigstens die Verwaltungsinformationen des Arrays und
# von 999.999 Skalaren
my $str_data = join '', @array;

my $vec = Bit::Vector->new_Bin(1_000_000, $str_data);

# Vorschlag von raubtier++: GeXOR'ter Kovektor
my $vex = $vec->Clone;
$vex->shift_left(!$vec->lsb);
$vex->ExclusiveOr($vex,$vec);

# Perl optimiert nicht für Methodenaufrufe (s. Benchmark unten) 
# Daher müssen wir das machen:
*test = $vec->can('bit_test'); 

my ($start,$end) = (0,999_999);
cmpthese(100, {

    # über Array-Slice iterieren:
    slice => sub {
                 my (@cache, $last);
                 for (@array[$start..$end]) {
                     if ($_ xor $last // !$_) { push @cache, $_ ? 1 : -1 }
                     else { $cache[-1] += $_ }
                     $last = $_;
                 }
             },

    index => sub {
                 my (@cache,$last);
                 for ( my $i = $start; $i <= $end; $i++ ) {
                     my $v = $array[$i];
                     if ($v xor $last // !$v) { push @cache, $v ? 1 : -1 }
                     else { $cache[-1] += $v }
                     $last = $v;
                 }
             },

    # vorher in ein eigenes Array kopieren, denn darüber wird schneller iteriert:                   
    array => sub {
                 my @array = @array[$start .. $end];
                 my (@cache,$last);
                 for ( @array ) {
                     if ($_ xor $last // !$_) { push @cache, $_ ? 1 : -1 }
                     else { $cache[-1] += $_ }
                     $last = $_;
                 }
             },

    # Müssten wir stets über das ganze @array laufen, gäbs also weder @start noch @end:
    theor => sub {
                 # my @array = @array[$start .. $end];
                 my (@cache, $last);
                 for (@array) {
                     if ($_ xor $last // !$_) { push @cache, $_ ? 1 : -1 }
                     else { $cache[-1] += $_ }
                     $last = $_;
                 }
             },

    # Subroutinenaufruf an Bit::Vector, d.h. gecachter Methodenaufruf:
    bitvr => sub {
                 my (@cache, $last);
                 for ( my $i = $start; $i <= $end; $i++ ) {
                     my $v = test($vec,$i);
                     if ($v xor $last // !$v) { push @cache, $v ? 1 : -1 }
                     else { $cache[-1] += $v }
                     $last = $v;
                 }
             },

    # ungecacht:
    bitvm => sub {
                 my (@cache, $last);
                 for ( my $i = $start; $i <= $end; $i++ ) {
                     my $v = $vec->bit_test($i);
                     if ($v xor $last // !$v) { push @cache, $v ? 1 : -1 }
                     else { $cache[-1] += $v }
                     $last = $v;
                 }
             },

    # Test gegen XOR'd Covektor, Vorschlag von raubtier++ ($vex-Init. oben):
    bitvx => sub {
                 my (@cache, $last);
                 for ( my $i = $start; $i <= $end; $i++ ) {
                     my $v = test($vec,$i);
                     if (test($vex,$i)) { push @cache, $v ? 1 : -1 }
                     else { $cache[-1] += $v }
                     # $last = $v; -- EDIT
                 }
             },

    # Sparen wir uns die Strukturdaten des Arrays und von 999.999 Skalaren
    # Vorschlag von topeg++, angeglichen. $bit_data-Initialisierung oben.
    strng => sub {
                 my (@cache, $last);
                 for ( my $i = $start; $i <= $end; $i++ ) {
                     my $v = substr($str_data,$_,1);
                     if (test($vex,$i)) { push @cache, $v ? 1 : -1 }
                     else { $cache[-1] += $v } 
                     $last = $v;
                 }   
             },  

    }
);