#!/usr/bin/perl

use strict;
use Benchmark qw/cmpthese/;

cmpthese(
    -1,
    {
        #        orighash  => sub { orighash(); },
        #         twolevel  => sub { twolevel(); },
        #        substring => sub { substring(); },
        #        blokhead  => sub { blokhead(); },
        blokchop  => sub { blokchop(); },
        orig      => sub { orig(); },
        browserUK => sub { browserUK(); },
        ikegami   => sub { ikegami(); }
    }
);

sub browserUK {
    my @strings = qw/111011001010011110100010100001
      111010000010010110000010000001
      000101011100001000110101110000
      000101111101001001111101111110
      111011001010111110100010100001
      000100010100000000010001010000/;

    for my $i ( 0 .. $#strings ) {
        for my $j ( $i + 1 .. $#strings ) {
            my @counts = (
                ( $strings[$i] | $strings[$j] )  =~ tr[0][0],
                ( ~$strings[$i] & $strings[$j] ) =~ tr[\1][\1],
                ( $strings[$i] & ~$strings[$j] ) =~ tr[\1][\1],
                ( $strings[$i] & $strings[$j] )  =~ tr[1][1]
            );
        }
    }

}

sub ikegami {
    my @strings = qw/
      111011001010011110100010100001
      111010000010010110000010000001
      000101011100001000110101110000
      000101111101001001111101111110
      111011001010111110100010100001
      000100010100000000010001010000
      /;

    s/(?<=.)/\0/g for my @strings1 = @strings;    # "abc" => "a\0b\0c\
+0"
    s/(?=.)/\0/g  for my @strings2 = @strings;    # "abc" => "\0a\0b\0
+c"

    for my $i ( 0 .. $#strings ) {
        for my $j ( $i + 1 .. $#strings ) {
            my %c;
            ++$c{$_} for ( $strings1[$i] | $strings2[$j] ) =~ /../g;
        }
    }

}

sub orig {
    my @strings = qw/111011001010011110100010100001
      111010000010010110000010000001
      000101011100001000110101110000
      000101111101001001111101111110
      111011001010111110100010100001
      000100010100000000010001010000/;

    foreach my $string (@strings) {
        my @items = split //, $string;
        $string = \@items;
    }

    for ( my $i = 0 ; $i < @strings ; $i++ ) {
        for ( my $j = $i + 1 ; $j < @strings ; $j++ ) {
            my ( $c00, $c01, $c10, $c11 ) = ( 0, 0, 0, 0 );
            for ( my $k = 0 ; $k < @{ $strings[$i] } ; $k++ ) {
                $c00++
                  if ${ $strings[$i] }[$k] == 0 && ${ $strings[$j] }[$
+k] == 0;
                $c01++
                  if ${ $strings[$i] }[$k] == 0 && ${ $strings[$j] }[$
+k] == 1;
                $c10++
                  if ${ $strings[$i] }[$k] == 1 && ${ $strings[$j] }[$
+k] == 0;
                $c11++
                  if ${ $strings[$i] }[$k] == 1 && ${ $strings[$j] }[$
+k] == 1;
            }
        }
    }
}

sub orighash {
    my @strings = qw/111011001010011110100010100001
      111010000010010110000010000001
      000101011100001000110101110000
      000101111101001001111101111110
      111011001010111110100010100001
      000100010100000000010001010000/;

    foreach my $string (@strings) {
        my @items = split //, $string;
        $string = \@items;
    }

    for ( my $i = 0 ; $i < @strings ; $i++ ) {
        for ( my $j = $i + 1 ; $j < @strings ; $j++ ) {
            my %count;
            ( $count{"00"}, $count{"01"}, $count{"10"}, $count{"11"} )
+ =
              ( 0, 0, 0, 0 );
            for ( my $k = 0 ; $k < @{ $strings[$i] } ; $k++ ) {
                $count{ ${ $strings[$i] }[$k] . ${ $strings[$j] }[$k] 
+}++;
            }
        }
    }
}

sub twolevel {

    my @strings = qw/111011001010011110100010100001
      111010000010010110000010000001
      000101011100001000110101110000
      000101111101001001111101111110
      111011001010111110100010100001
      000100010100000000010001010000/;

    foreach my $string (@strings) {
        my @items = split //, $string;
        $string = \@items;
    }

    for ( my $i = 0 ; $i < @strings ; $i++ ) {
        for ( my $j = $i + 1 ; $j < @strings ; $j++ ) {
            my ( $c00, $c01, $c10, $c11 ) = ( 0, 0, 0, 0 );
            for ( my $k = 0 ; $k < @{ $strings[$i] } ; $k++ ) {
                if ( ${ $strings[$i] }[$k] == 0 ) {
                    if ( ${ $strings[$j] }[$k] == 0 ) {
                        $c00++;
                    }
                    else {
                        $c01++;
                    }
                }
                else {
                    if ( ${ $strings[$j] }[$k] == 0 ) {
                        $c10++;
                    }
                    else {
                        $c11++;
                    }
                }
            }
        }
    }
}

sub substring {
    my @strings = qw/111011001010011110100010100001
      111010000010010110000010000001
      000101011100001000110101110000
      000101111101001001111101111110
      111011001010111110100010100001
      000100010100000000010001010000/;

    for ( my $i = 0 ; $i < @strings ; $i++ ) {
        for ( my $j = $i + 1 ; $j < @strings ; $j++ ) {
            my %count;
            ( $count{"00"}, $count{"01"}, $count{"10"}, $count{"11"} )
+ =
              ( 0, 0, 0, 0 );

            for ( my $k = 0 ; $k < length $strings[$i] ; $k++ ) {
                my $value =
                  substr( $strings[$i], $k, 1 ) . substr( $strings[$j]
+, $k, 1 );
                $count{$value}++;
            }
        }
    }
}

sub blokhead {
    my @strings = qw/111011001010011110100010100001
      111010000010010110000010000001
      000101011100001000110101110000
      000101111101001001111101111110
      111011001010111110100010100001
      000100010100000000010001010000/;

    for my $i ( 0 .. $#strings ) {
        for my $j ( $i + 1 .. $#strings ) {
            my %count;
            ( $count{"00"}, $count{"01"}, $count{"10"}, $count{"11"} )
+ =
              ( 0, 0, 0, 0 );
            $count{ substr( $strings[$i], $_, 1 )
                  . substr( $strings[$j], $_, 1 ) }++
              for 0 .. length( $strings[$i] ) - 1;

            #            print join( "\t",
            #                $i, $j, $count{"00"}, $count{"01"}, $coun
+t{"10"},
            #                $count{"11"} ),
            #              "\n";

        }
    }
}

sub blokchop {
    my @strings = qw/111011001010011110100010100001
      111010000010010110000010000001
      000101011100001000110101110000
      000101111101001001111101111110
      111011001010111110100010100001
      000100010100000000010001010000/;

    for my $i ( 0 .. $#strings ) {
        for my $j ( $i + 1 .. $#strings ) {
            my %count;
            ( $count{"00"}, $count{"01"}, $count{"10"}, $count{"11"} )
+ =
              ( 0, 0, 0, 0 );
            my ( $str1, $str2 ) = @strings[ $i, $j ];
            $count{ chop($str1) . chop($str2) }++ while length($str1)
              and length($str2);

        }
    }
}
[download]