Re: Speeding permutation counting

use strict;
use warnings;

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\0c"

for my $i (0..$#strings) {
   for my $j ($i+1..$#strings) {
      my %c;
      ++$c{$_} for ($strings1[$i] | $strings2[$j]) =~ /../g;
      print(join("\t", $i, $j, $c{'00'}||0, $c{'01'}||0, $c{'10'}||0, 
+$c{'11'}||0), "\n");
   }
}
[download]

Comment on Re: Speeding permutation counting Download Code

Replies are listed 'Best First'.
Re^2: Speeding permutation counting by ikegami (Patriarch) on Jul 18, 2007 at 16:55 UTC
Nevermind. It was an interesting idea, but it sucks. `Rate ikegami albert browseruk ikegami 5.76/s -- -26% -89% albert 7.84/s 36% -- -86% browseruk 54.8/s 851% 599% --` [download] Both ikegami and albert's version will be faster per string when processing 1000 strings instead of 100 (since they both have a big overhead), but not enough to even approach BrowserUk's version. Benchmark code: use strict; use warnings; use Benchmark qw( cmpthese ); use constant STRING_LEN => $ARGV[0] \|\| 30; use constant NUM_STRINGS => $ARGV[1] \|\| 100; use constant TIMES => $ARGV[2] \|\| -3; our @strings = map { join '', map int(rand(2)), 1..STRING_LEN } 1..NUM_STRINGS; my $albert = <<'__EOI__'; my $n = length($strings[0]) - 1; $_ = [ /./g ] for my @splitted = @strings; my ( $c00, $c01, $c10, $c11 ) = ( 0, 0, 0, 0 ); for my $i ( 0 .. $#splitted ) { for my $j ( $i+1 .. $#splitted ) { ( $c00, $c01, $c10, $c11 ) = ( 0, 0, 0, 0 ); for my $k ( 0 .. $n ) { if ($splitted[$i][$k]) { if ($splitted[$j][$k]) { $c11++; } else { $c10++; } } else { if ($splitted[$j][$k]) { $c01++; } else { $c00++; } } } } } __EOI__ my $browseruk = <<'__EOI__'; for my $i ( 0 .. $#strings ) { for my $j ( $i+1 .. $#strings ) { my $c00 = ( $strings[$i] \| $strings[$j] ) =~ tr[0][0]; my $c01 = ( ~$strings[$i] & $strings[$j] ) =~ tr[\1][\1]; my $c10 = ( $strings[$i] & ~$strings[$j] ) =~ tr[\1][\1]; my $c11 = ( $strings[$i] & $strings[$j] ) =~ tr[1][1]; } } __EOI__ my $ikegami = <<'__EOI__'; s/(?<=.)/\0/g for my @strings_l = @strings; s/(?=.)/\0/g for my @strings_r = @strings; my %c; for my $i ( 0 .. $#strings ) { for my $j ( $i+1 .. $#strings ) { %c = ( '00' => 0, '01' => 0, '10' => 0, '11' => 0 ); ++$c{$_} for ($strings_l[$i] \| $strings_r[$j]) =~ /../g; } } __EOI__ $_ = "use strict; use warnings; our \@strings; $_" for $albert, $browseruk, $ikegami; cmpthese(TIMES, { albert => $albert, browseruk => $browseruk, ikegami => $ikegami, }); [download]	[reply] [d/l] [select]

Replies are listed 'Best First'.

Re^2: Speeding permutation counting
by ikegami (Patriarch) on Jul 18, 2007 at 16:55 UTC

Nevermind. It was an interesting idea, but it sucks.

            Rate   ikegami    albert browseruk
ikegami   5.76/s        --      -26%      -89%
albert    7.84/s       36%        --      -86%
browseruk 54.8/s      851%      599%        --
[download]

Both ikegami and albert's version will be faster per string when processing 1000 strings instead of 100 (since they both have a big overhead), but not enough to even approach BrowserUk's version.

Benchmark code:

use strict;
use warnings;

use Benchmark qw( cmpthese );

use constant STRING_LEN  => $ARGV[0] || 30;
use constant NUM_STRINGS => $ARGV[1] || 100;
use constant TIMES       => $ARGV[2] || -3;


our @strings = map { join '',
                     map int(rand(2)), 1..STRING_LEN
                   }
               1..NUM_STRINGS;


my $albert = <<'__EOI__';
   my $n = length($strings[0]) - 1;
   $_ = [ /./g ] for my @splitted = @strings;

   my ( $c00, $c01, $c10, $c11 ) = ( 0, 0, 0, 0 );
   for my $i ( 0 .. $#splitted ) {
      for my $j ( $i+1 .. $#splitted ) {
         ( $c00, $c01, $c10, $c11 ) = ( 0, 0, 0, 0 );
         for my $k ( 0 .. $n ) {
            if ($splitted[$i][$k]) {
               if ($splitted[$j][$k]) {
                  $c11++;
               } else {
                  $c10++;
               }
            } else {
               if ($splitted[$j][$k]) {
                  $c01++;
               } else {
                  $c00++;
               }
            }
         }
      }
   }
__EOI__


my $browseruk = <<'__EOI__';
   for my $i ( 0 .. $#strings ) {
      for my $j ( $i+1 .. $#strings ) {
         my $c00 = (  $strings[$i] |  $strings[$j] ) =~ tr[0][0];
         my $c01 = ( ~$strings[$i] &  $strings[$j] ) =~ tr[\1][\1];
         my $c10 = (  $strings[$i] & ~$strings[$j] ) =~ tr[\1][\1];
         my $c11 = (  $strings[$i] &  $strings[$j] ) =~ tr[1][1];
      }
   }
__EOI__


my $ikegami = <<'__EOI__';
   s/(?<=.)/\0/g for my @strings_l = @strings;
   s/(?=.)/\0/g  for my @strings_r = @strings;

   my %c;
   for my $i ( 0 .. $#strings ) {
      for my $j ( $i+1 .. $#strings ) {
         %c = ( '00' => 0, '01' => 0, '10' => 0, '11' => 0 );
         ++$c{$_} for ($strings_l[$i] | $strings_r[$j]) =~ /../g;
      }
   }
__EOI__


$_ = "use strict; use warnings; our \@strings; $_"
   for $albert, $browseruk, $ikegami;

cmpthese(TIMES, {
   albert    => $albert,
   browseruk => $browseruk,
   ikegami   => $ikegami,
});
[download]

[reply]
[d/l]
[select]