Merge 2 strings like a zip

by tel2 (Pilgrim) on Jul 09, 2015 at 07:07 UTC

Awesome work from across the ditch!

Thanks.

I'm with torvalds on this Agile (and TDD) debunked I told'em LLVM was the way to go. But did they listen!

Re: Merge 2 strings like a zip
by BrowserUk (Patriarch) on Jul 09, 2015 at 02:53 UTC

sub zip($$){ 
   my( $n, $a, $b ) = ( 1, @_ ); 
   substr( $a, $n, 0, $_), $n += 2 for split '', $b; 
   return $a;
};;

print zip( 'ABCDEFGHIJ', 'abcde' );;
AaBbCcDdEeFGHIJ
[download]

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.

by tel2 (Pilgrim) on Jul 09, 2015 at 07:02 UTC

Nice.

by Loops (Curate) on Jul 09, 2015 at 21:28 UTC

   zip( 'abcde', 'ABCDEFGHIJ' );
[download]

I'm with torvalds on this Agile (and TDD) debunked I told'em LLVM was the way to go. But did they listen!

by BrowserUk (Patriarch) on Jul 09, 2015 at 21:39 UTC

This is a good example of why a CPAN module is usually the right choice

Unless the programmer actually read the spec. From the OP "i.e. 1 char from each string until the 2nd string (which will be always shorter)".

Had that not been specified, or if you'd read on a little, you'd have found Re^3: Merge 2 strings like a zip [benchmark] which contains:

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;
}
[download]

BTW, if you think all the code on CPAN is correct, you have a very rude awaking coming.

And if you feel you'll never be a better programmer than the average on CPAN; keep on using it, instead of your own brain; and you'll be right.

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.

Re: Merge 2 strings like a zip [benchmark]
by kcott (Archbishop) on Jul 09, 2015 at 05:35 UTC

Latest benchmark:

#!/usr/bin/env 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 zipD {
    my ($str1, $str2) = @_;
    for (0 .. length $str2) {
        substr $str1, $_ * 2 + 1, 0, substr $str2, $_, 1;
    }
    return $str1;
}

our $A = 'ABCDEFGHIJ';
our $B = 'abcde';

cmpthese -1, {
    A => q[ my $zipped = zipA( $A, $B ); ],
    B => q[ my $zipped = zipB( $A, $B ); ],
    C => q[ my $zipped = zipC( $A, $B ); ],
    D => q[ my $zipped = zipD( $A, $B ); ],
};
[download]

I ran it five times. This seems to be the most representative:

      Rate    B    A    C    D
B  91995/s   -- -39% -66% -72%
A 151837/s  65%   -- -45% -54%
C 274373/s 198%  81%   -- -17%
D 330831/s 260% 118%  21%   --
[download]

-- Ken

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

by roboticus (Chancellor) on Jul 09, 2015 at 10:18 UTC

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%   --
[download]

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.

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%   --
[download]

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!

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

by roboticus (Chancellor) on Jul 09, 2015 at 22:06 UTC

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

by BrowserUk (Patriarch) on Jul 09, 2015 at 22:25 UTC

Some notes below your chosen depth have not been shown here

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

by tel2 (Pilgrim) on Jul 09, 2015 at 07:11 UTC

Oz leading the world.

Re: Merge 2 strings like a zip
by 1nickt (Canon) on Jul 09, 2015 at 02:42 UTC

Use a CPAN module! Preferably one that has a method that does what you want, and is called what you imagine it should be :-)


#!/usr/bin/env perl
use strict;
use warnings;
use List::MoreUtils qw/ zip /;

my @a1 = split('', 'ABCDEFGHIJ');
my @a2 = split('', 'abcde');

no warnings qw/ uninitialized /;

print zip @a1, @a2;

use warnings;

__END__
[download]

Remember: Ne dederis in spiritu molere illegitimi!

I'm with torvalds on this Agile (and TDD) debunked I told'em LLVM was the way to go. But did they listen!

by BrowserUk (Patriarch) on Jul 09, 2015 at 03:11 UTC

Hm.

#! 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;
};;

our $A = 'ABCDEFGHIJ';
our $B = 'abcde';

cmpthese -1, {
    A => q[ my $zipped = zipA( $A, $B ); ],
    B => q[ my $zipped = zipB( $A, $B ); ],
    C => q[ my $zipped = zipC( $A, $B ); ],
};

__END__
C:\test>\perl5.18\perl\bin\perl.exe 1133857.pl
      Rate    B    A    C
B  43932/s   -- -48% -72%
A  84167/s  92%   -- -47%
C 159444/s 263%  89%   --
[download]

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.

by SimonPratt (Friar) on Jul 09, 2015 at 10:43 UTC

"substr( $a, $n, 0, $_), $n += 2 for split '', $b;"

Excellent use of substr

by 1nickt (Canon) on Jul 09, 2015 at 04:03 UTC

The race is not always to the swift, my friend.

Remember: Ne dederis in spiritu molere illegitimi!

Re^4: Merge 2 strings like a zip

by roboticus (Chancellor) on Jul 09, 2015 at 10:07 UTC

Re^5: Merge 2 strings like a zip

by 1nickt (Canon) on Jul 09, 2015 at 11:58 UTC

by Athanasius (Archbishop) on Jul 09, 2015 at 03:00 UTC

Hello 1nickt,

As a cleaner alternative to:

no warnings qw/ uninitialized /;

print zip @a1, @a2;

use warnings;
[download]

you can just filter the list returned by zip:

print grep { defined } zip @a1, @a2;
[download]

Hope that helps,

Athanasius <°(((>< contra mundum Iustus alius egestas vitae, eros Piratica,

by tel2 (Pilgrim) on Jul 09, 2015 at 05:47 UTC

While I didn't think it would be worth the overhead of a module for something so small/simple, I do appreciate your input, and I wasn't aware of that module or function.

by 1nickt (Canon) on Jul 09, 2015 at 10:10 UTC

I didn't think it would be worth the overhead of a module for something so small/simple,

Personally I don't like the overhead of writing code that I don't need to.
Small/simple things have a way of growing.
There is more than one way to do it :-)

Remember: Ne dederis in spiritu molere illegitimi!

Re: Merge 2 strings like a zip
by Anonymous Monk on Jul 09, 2015 at 02:37 UTC

#!/usr/bin/perl

# http://perlmonks.org/?node_id=1133857

use warnings;
use strict;

print zip("ABCDEFGHIJ", "abcde"), "\n";

sub zip
  {
  my ($str1, $str2) = @_;
  $str1 =~ s/.\K/ substr $str2, 0, 1, ''/gesr;
  }
[download]

by tel2 (Pilgrim) on Jul 09, 2015 at 05:24 UTC

I don't fully understand it yet, but it looks beautiful. 8)

That's the first time I've seen /K and /r. No problems with /K, but my webhost is still using v5.10.1 and I see that /r didn't come in until 5.14. So how could I write that without the /r modifier? I think I understand what /r is supposed to do, but I don't yet understand your code enough to replace it in this context.

I've added a 2nd (unzip) function request, below, which I'd appreciate your input on, if you have time.

Thanks again.

by Anonymous Monk on Jul 09, 2015 at 14:41 UTC

zip() without /r and unzip()

#!/usr/bin/perl

# http://perlmonks.org/?node_id=1133857

use warnings;
use strict;

print zip("ABCDEFGHIJ", "abcde"), "\n";

print "@{[ unzip('AaBbCcDdEeFGHIJ', 5) ]}\n";

sub zip # if no /r
  {
  my ($str1, $str2) = @_;
  $str1 =~ s/.\K/ substr $str2, 0, 1, ''/ges;
  $str1
  }

sub unzip
  {
  my ($input, $length2) = @_;
  return
    join('', unpack "(ax)$length2 a*", $input),
    join '', unpack "(xa)$length2", $input;
  }
[download]

Re^4: Merge 2 strings like a zip

by tel2 (Pilgrim) on Jul 10, 2015 at 00:18 UTC

Re: Merge 2 strings like a zip
by tel2 (Pilgrim) on Jul 09, 2015 at 05:33 UTC

Also, since posting my original question, I realised that I forgot to also ask for an unzip function which takes a zipped string and the length of $str2, and generates $str1 & $str2 from it. I guess I could do it with a verbose style similar to my original function, but would love to see more elegant, concise & efficient options. Any offers?

I would probably call it something like this:
($str1, $str2) = unzip('AaBbCcDdEeFGHIJ', 5);

Thanks again!

Re^2: Merge 2 strings like a zip [unzip()]

by kcott (Archbishop) on Jul 09, 2015 at 05:53 UTC

Based on my earlier zip(): this only uses substr.

#!/usr/bin/env perl -l

use strict;
use warnings;

print for unzip('AaBbCcDdEeFGHIJ', 5);

sub unzip {
    my ($str1, $len) = @_;

    my $str2 = '';

    for (0 .. $len - 1) {
        substr $str2, $_, 0, substr $str1, $_ + 1, 1, ''; 
    }

    return ($str1, $str2);
}
[download]

Output:

ABCDEFGHIJ
abcde
[download]

-- Ken

Re^3: Merge 2 strings like a zip [unzip()]

by tel2 (Pilgrim) on Jul 09, 2015 at 07:08 UTC

Thanks again and keep up the good work!

BTW, what's the 'for' for in:
print for unzip...

Re^4: Merge 2 strings like a zip [unzip()]

by kcott (Archbishop) on Jul 09, 2015 at 14:18 UTC

Re^5: Merge 2 strings like a zip [unzip()]

by tel2 (Pilgrim) on Jul 10, 2015 at 00:39 UTC

Some notes below your chosen depth have not been shown here

Re^4: Merge 2 strings like a zip [unzip()]

by hexcoder (Curate) on Jul 09, 2015 at 08:09 UTC

Re^5: Merge 2 strings like a zip [unzip()]

by Anonymous Monk on Jul 09, 2015 at 08:24 UTC

Re: Merge 2 strings like a zip
by tel2 (Pilgrim) on Jul 10, 2015 at 01:22 UTC

I now realise my original code could have been simplified (and sped up) like this:

sub zip
{
  my ($str1, $str2) = @_;
  my $zip;
  for (0 .. length($str2)-1)
  { $zip .= substr($str1, $_, 1) . substr($str2, $_, 1) }
  $zip .= substr($str1, length($str2));
  return $zip;
}
[download]

Of course that only meets my original spec's (i.e. 2nd string must be the shortest) but it seems to be pretty fast (though I guess the concatenation would slow it down if my data was much longer).

Re: Merge 2 strings like a zip
by karlgoethebier (Abbot) on Jul 10, 2015 at 14:36 UTC

"TIMTOWTDI"

My 2 ¢:

use warnings;
use strict;
use feature qw(say);
sub zip;

say zip 'ABCDEFGHIJ', 'abcde';

sub zip {
    join "", sort { lc $a cmp lc $b } split "", $_[0] . $_[1];
}

__END__
[download]

I guess it's slower than some of the examples above but it doesn't look bad ;-)

And i learned something. See Strange Observation [SOLVED] for details. Thanks to toolic, KurtSchwind, Athanasius and some unknown soldier.

Update: Same benchmark as used by BrowserUK:

karls-mac-mini:monks karl$ ./benchzip.pl 
         Rate    B Karl    A    C
B     98641/s   -- -17% -44% -68%
Karl 118153/s  20%   -- -33% -62%
A    176987/s  79%  50%   -- -43%
C    312785/s 217% 165%  77%   --
[download]

Regards, Karl

�The Crux of the Biscuit is the Apostrophe�

The Regex Approach: Merging 2 strings like a zip

by pat_mc (Pilgrim) on Jul 11, 2015 at 11:59 UTC

use strict;
use warnings;

my $a = "ABCDEFGHIJ";
my $b = "abcde";
my @b = split "", $b;

$a =~ s/(.)/$1.($b[length($`)] or "")/ge;

print $a;
[download]

Re: The Regex Approach: Merging 2 strings like a zip

by Anonymous Monk on Jul 11, 2015 at 18:43 UTC

You'll need a // operator there, otherwise it eats the 0's in $b...

An alternative:

$b = reverse $b;
$a =~ s{.\K}{chop $b}sge;
print $a;
[download]

by tel2 (Pilgrim) on Jul 12, 2015 at 23:44 UTC

It seems to work with my original sample data, but with this:
say zip 'ABCDEFGH0J', 'a0cde';
it produces this:
00AaBCcDdEeFGHJ
but should be producing this:
AaB0CcDdEeFGH0J

by karlgoethebier (Abbot) on Jul 13, 2015 at 07:07 UTC

New specs ;-)

First hint in a hurry: How do I do a natural sort on an array?

Regards, Karl

�The Crux of the Biscuit is the Apostrophe�

Re: Merge 2 strings like a zip
by pat_mc (Pilgrim) on Jul 11, 2015 at 14:04 UTC

use strict;
use warnings;

my $a = "ABCDEFGHIJ";
my $b = "abcde";
my @b = split "", $b;

$a =~ s/(.)/$1.($b[length($`)] or "")/ge;

print $a;
[download]

by Anonymous Monk on Jul 11, 2015 at 20:34 UTC

In keeping with your philosophy, here's something completely different :)

#!/usr/bin/perl

# http://perlmonks.org/?node_id=1133857

use warnings;
use strict;

print zip("ABCDEFGHIJ", "abcde"), "\n";

sub zip
  {
  my ($str1, $str2) = @_;
  my $gap = length($str1) - 1;
  my $len2 = length $str2;

  join '', grep defined, "$str1$str2" =~ /(.)(?=.{$gap}(.)|.{$len2})/g
+s;
  }
[download]

Re: Merge 2 strings like a zip
by Anonymous Monk on Jul 09, 2015 at 22:32 UTC

hehehe

#!/usr/bin/perl

# http://perlmonks.org/?node_id=1133857

use warnings;
use strict;

print zip("ABCDEFGHIJ", "abcde"), "\n";

sub zip
  {
  my ($str1, $str2) = @_;
  my $len = length $str2;
  pack("(ax)$len (a)*", split //, $str1) | pack "(xa)$len", split //, 
+$str2
  }
[download]

Re: Merge 2 strings like a zip
by Anonymous Monk on Jul 09, 2015 at 11:01 UTC

How many computer programmers does it take to . . . re-rewrite something that apparently works just fine as-is, in the vain pursuit of elegance?

by roboticus (Chancellor) on Jul 09, 2015 at 12:58 UTC

Only one, but that doesn't stop the other 999 guys!

...roboticus

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

by Anonymous Monk on Jul 09, 2015 at 13:11 UTC

How many dumb pissants does it take to think the pursuit of excellence is vain?

Re: Merge 2 strings like a zip
by sundialsvc4 (Abbot) on Jul 09, 2015 at 11:50 UTC

Just to show the crowd that I can, in fact, whip-up a “one-liner” ...

perl -e 'use strict; use warnings; my $a="ABCDE"; my $b="xyz"; my $res
+ult=""; my $i; for ($i=0; $i<length($b); $i++) { $result .= substr($a
+, $i, 1) . substr($b, $i, 1) }; $result .= substr($a, $i); print "$re
+sult\n";'
[download]

If you really, really, know that one string is always shorter than the other, then this problem simply consists of taking a character from both strings until the shorter string is exhausted. Then, you append the remainder of the first (longer) string.

But I wouldn’t make such an assumption. I would allow either string to be longer:

use strict;
use warnings;

sub zip {
  my ($a, $b) = @_;
  my $result = "";

  my $max = ( length($a) > length($b) ) ? length($a) : length($b);

  my $i;
  for ($i = 0; $i < $max; $i++) {
    if ($i < length($a)) { $result .= substr($a, $i, 1); }
    if ($i < length($b)) { $result .= substr($b, $i, 1); }
  }
  print "$result\n";
}

zip("XYZZY", "ABC");
zip("ABC",   "XYZZY");
zip("XYZZY", "XYZZY");
zip("", "");

. . .

XAYBZCZY
AXBYCZZY
XXYYZZZZYY
[download]

“Elegant?” “Not?” My response is the same as Rhett Butler’s. The algorithm can be demonstrated to work in every case, by accompanying tests, and it is easy to eyeball it.

And, yes ... if I had any other reason to install and use an existing CPAN module that can zip a string, I would use that module. I probably would not install it, just to zip a string, since the alternative is trivial.

by Anonymous Monk on Jul 11, 2015 at 20:02 UTC