in reply to Challenge: CPU-optimized byte-wise or-equals (for a meter of beer)

This offloads the work to the regex engine and is *much* faster:
sh-3.1$ perl benchmark.pl Rate split1 substr1 subst split1 5.05/s -- -82% -100% substr1 27.7/s 449% -- -99% subst 3551/s 70273% 12719% -- ok 1 ok 2 1..2
The function, could be done in-place which would be even faster:
sub subst { my ($s1, $s2) = @_; my $s3 = $s1; { use bytes; $s3 =~ s/(\0)/substr $s2, $+[0]-1, 1/eg; } $s3; }
The complete benchmark file (now with tests):
#!/usr/bin/perl use 5.6.0; use strict; use warnings FATAL => 'all'; use Benchmark qw( cmpthese ); use Test::More 'no_plan'; my $s1 = join '', (do_rand(1) x 100_000); my $s2 = join '', (do_rand(0) x 100_000); cmpthese( -2, { 'split1' => sub { my $s3 = split1( $s1, $s2 ) }, 'substr1' => sub { my $s3 = substr1( $s1, $s2 ) }, 'subst' => sub { my $s3 = subst($s1, $s2) }, }); my $s30 = split1( $s1, $s2 ); my $s31 = substr1( $s1, $s2 ); my $s32 = subst( $s1, $s2 ); is($s30, $s31); is($s31, $s32); sub split1 { my ($s1, $s2) = @_; my @s1 = split //, $s1; my @s2 = split //, $s2; foreach my $idx ( 0 .. $#s1 ) { if ( $s1[$idx] eq chr(0) ) { $s1[$idx] = $s2[$idx]; } } return join '', @s1; } sub substr1 { my ($s1, $s2) = @_; for my $idx ( 0 .. length($s1) ) { if ( substr($s1,$idx,1) eq chr(0) ) { substr($s1, $idx, 1) = substr($s2, $idx, 1); } } return $s1; } sub subst { my ($s1, $s2) = @_; my $s3 = $s1; { use bytes; $s3 =~ s/(\0)/substr $s2, $+[0]-1, 1/eg; } $s3; } # This makes sure that $s1 has chr(0)'s in it and $s2 does not. sub do_rand { my $n = (shift) ? int(rand(255)) : int(rand(254)) + 1; return chr( $n ); }

Replies are listed 'Best First'.
Re^2: Challenge: CPU-optimized byte-wise or-equals (for a meter of beer)
by avar (Beadle) on Sep 12, 2007 at 14:29 UTC
    This is the in-place version:
    Rate split1 substr1 subst subst_i +nplace split1 2.93/s -- -72% -100% + -100% substr1 10.3/s 253% -- -99% + -99% subst 901/s 30682% 8623% -- + -24% subst_inplace 1179/s 40176% 11313% 31% + -- ok 1 ok 2 ok 3 1..3
    code:
    sub subst_inplace { my ($s1, $s2) = @_; use bytes; $$s1 =~ s/(\0)/substr $s2, $+[0]-1, 1/eg; }

      Drop the unneeded capturing parens for a likely boost in speed. Someone should add "use bytes" to ikegami's tr/// version also.

      - tye        

        You're right. I erroneously thought the capture was needed for $-[0] to work. But of course that's not the case.