Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

Re^2: Merge 2 strings like a zip [benchmark]

by roboticus (Chancellor)
on Jul 09, 2015 at 10:18 UTC ( [id://1133927]=note: print w/replies, xml ) Need Help??


in reply to Re: Merge 2 strings like a zip [benchmark]
in thread Merge 2 strings like a zip

While the OP specified that the second string is always the shortest, I wanted one that worked without that restriction:

#! perl -slw use strict; use Benchmark qw[ cmpthese ]; use List::MoreUtils qw[ zip ]; sub zipA { my( $str1, $str2 ) = @_; $str1 =~ s/.\K/ substr $str2, 0, 1, ''/gesr; } sub zipB { no warnings qw/ uninitialized /; my( $a, $b ) = @_; my @a1 = split( '', $a ); my @a2 = split( '', $b ); return join'', zip @a1, @a2; } sub zipC($$){ my( $n, $a, $b ) = ( 1, @_ ); substr( $a, $n, 0, $_), $n += 2 for split '', $b; return $a; };; sub zipR { my ($s1, $s2) = @_; my ($ls1, $ls2, $l, $tmp) = (length($s1), length($s2)); $l = $ls1<$ls2 ? $ls1 : $ls2; $tmp = join("", map{substr($s1,$_,1), substr($s2,$_,1)} 0 .. $l-1) . substr($l==$ls2 ? $s1 : $s2,$l); return $tmp; } sub zipD { my ($str1, $str2) = @_; for (0 .. length $str2) { substr $str1, $_ * 2 + 1, 0, substr $str2, $_, 1; } return $str1; } our $A = 'ABCDEFGHIJ'; our $B = 'abcde'; my (%tests,%results); for my $T (qw(A B C D R)) { $tests{$T.'a'} = "my \$z = zip$T( \$A, \$B )"; $tests{$T.'b'} = "my \$z = zip$T( \$B, \$A )"; my $a = eval($tests{$T.'a'}); my $b = eval($tests{$T.'b'}); } my %R = ( a=>eval $tests{Ba}, b=>eval $tests{Bb} ); print "Expected: a=<$R{a}>, b=<$R{b}>"; for my $test (sort keys %tests) { no warnings 'uninitialized'; my $S = eval $tests{$test}; my $R = $R{substr($test,1,1)}; if ($R ne $S) { print "test $test failed: <$S>"; delete $tests{$test}; } } cmpthese -1, \%tests; __END__ $ perl 1133865.pl Expected: a=<AaBbCcDdEeFGHIJ>, b=<aAbBcCdDeEFGHIJ> test Ab failed: <aAbBcCdDeE> test Cb failed: <> test Db failed: <> Rate Bb Ba Aa Rb Ra Ca Da Bb 105326/s -- 0% -62% -69% -69% -81% -86% Ba 105326/s 0% -- -62% -69% -69% -81% -86% Aa 276648/s 163% 163% -- -18% -19% -50% -62% Rb 336364/s 219% 219% 22% -- -1% -39% -54% Ra 339856/s 223% 223% 23% 1% -- -39% -54% Ca 553781/s 426% 426% 100% 65% 63% -- -25% Da 735965/s 599% 599% 166% 119% 117% 33% --

So I have the fastest one that works without that restriction. (Prediction, someone else will hold that title within 20 minutes......)

...roboticus

When your only tool is a hammer, all problems look like your thumb.

Replies are listed 'Best First'.
Re^3: Merge 2 strings like a zip [benchmark]
by BrowserUk (Patriarch) on Jul 09, 2015 at 13:08 UTC

    #! perl -slw use strict; use Benchmark qw[ cmpthese ]; use List::MoreUtils qw[ zip ]; sub zipD($$) { my( $a, $b ) = length( $_[0] ) < length( $_[1] ) ? @_[ 1, 0 ] : @ +_[ 0, 1 ]; substr( $a, $_*2+1, 0, substr( $b, $_, 1 ) ) for 0 .. length( $b ) + -1; return $a; } sub zipR { my ($s1, $s2) = @_; my ($ls1, $ls2, $l, $tmp) = (length($s1), length($s2)); $l = $ls1<$ls2 ? $ls1 : $ls2; $tmp = join("", map{substr($s1,$_,1), substr($s2,$_,1)} 0 .. $l-1) . substr($l==$ls2 ? $s1 : $s2,$l); return $tmp; } our $A = 'ABCDEFGHIJ'; our $B = 'abcde'; print zipD( $A, $B ), zipD( $B, $A ); print zipR( $A, $B ), zipD( $B, $A ); cmpthese -1, { Dd => q[ my $zipped = zipD( $A, $B ); ], Rr => q[ my $zipped = zipR( $A, $B ); ], dD => q[ my $zipped = zipD( $B, $A ); ], rR => q[ my $zipped = zipR( $B, $A ); ], }; __END__ C:\test>1133857.pl AaBbCcDdEeFGHIJAaBbCcDdEeFGHIJ AaBbCcDdEeFGHIJAaBbCcDdEeFGHIJ Rate Rr rR dD Dd Rr 82878/s -- -1% -43% -44% rR 83720/s 1% -- -42% -44% dD 145211/s 75% 73% -- -2% Dd 148473/s 79% 77% 2% --

    With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.
    I'm with torvalds on this Agile (and TDD) debunked I told'em LLVM was the way to go. But did they listen!

      BrowserUk:

      When I saw your original version, I did basically the same thing (swap strings to make the shorter one last). The only problem is that it flips the order of the alternating characters--I expect the first argument to provide the first character, the second argument to provide the second, etc.

      I tried a couple quick hacks on yours (and kcotts) version to make it work the way I wanted, but when I didn't get it quickly, I punted. My quick hacks caused the strings to truncate when I was munging with substr on the left because it seems that I can't count properly today--I got bit several times by fencepost errors. For example, one of my attempts was to use zipC and change the starting value of $n based on which string was shorter, but had no luck--nor patience.

      You can see what I mean if you fix line 25:

      $ cat 1133959.pl #! perl -slw use strict; . . . snip . . . print zipD( $A, $B ), zipD( $B, $A ); print zipR( $A, $B ), zipR( $B, $A ); . . . snip . . . $ perl 1133959.pl AaBbCcDdEeFGHIJAaBbCcDdEeFGHIJ AaBbCcDdEeFGHIJaAbBcCdDeEFGHIJ Rate rR Rr Dd dD rR 327095/s -- -2% -55% -55% Rr 334881/s 2% -- -54% -54% Dd 720854/s 120% 115% -- -0% dD 721504/s 121% 115% 0% --

      ...roboticus

      When your only tool is a hammer, all problems look like your thumb.

        Try this:

        sub zipD($$) { my( $a, $b ) = (my $o = length( $_[0] ) >= length( $_[1] ) ) ? @_ +[ 0, 1 ] : @_[ 1, 0 ]; substr( $a, $_*2+$o, 0, substr( $b, $_, 1 ) ) for 0 .. length( $b +) -1; return $a; }

        Output:

        C:\test>1133857.pl AaBbCcDdEeFGHIJaAbBcCdDeEFGHIJ AaBbCcDdEeFGHIJaAbBcCdDeEFGHIJ Rate Rr rR Dd dD Rr 85339/s -- -1% -40% -41% rR 86543/s 1% -- -39% -40% Dd 142186/s 67% 64% -- -2% dD 145076/s 70% 68% 2% --

        With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
        Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
        "Science is about questioning the status quo. Questioning authority".
        In the absence of evidence, opinion is indistinguishable from prejudice.
        I'm with torvalds on this Agile (and TDD) debunked I told'em LLVM was the way to go. But did they listen!

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://1133927]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others rifling through the Monastery: (5)
As of 2024-03-29 13:56 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found