Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

Merge 2 strings like a zip

by tel2 (Pilgrim)
on Jul 09, 2015 at 02:18 UTC ( #1133857=perlquestion: print w/replies, xml ) Need Help??

tel2 has asked for the wisdom of the Perl Monks concerning the following question:

Hi Monks,

For a Perl web application I'm working on, I'm wanting a function which merges 2 strings (scalars containing any ASCII 0-255 chars) like a zip, i.e. 1 char from each string until the 2nd string (which will be always shorter) runs out, at which point the rest of the 1st string is returned as is.

For example, calling:
   zip("ABCDEFGHIJ", "abcde");
would return
   AaBbCcDdEeFGHIJ

I've just written such a function (below) which does the job, but I know TIMTOWTDI and I'm hoping there's a more concise/elegant way.  Can any of you suggested more concise, elegant & efficient code?

#!/usr/bin/perl print zip('ABCDEFGHIJ', 'abcde') . "\n"; sub zip { my ($str1, $str2) = @_; my $zip; for (my $i=0; $i<length($str1); $i++) { $zip .= substr($str1, $i, 1); if ($i < length($str2)) { $zip .= substr($str2, $i, 1) } else { $zip .= substr($str1, $i+1); $i = length($str1); } } return $zip; }

Replies are listed 'Best First'.
Re: Merge 2 strings like a zip
by kcott (Bishop) on Jul 09, 2015 at 05:14 UTC

    G'day tel2,

    Here's my offering. It just uses length and substr. There's no: concatenation; splitting strings into lists; regexes; or modules to load.

    #!/usr/bin/env perl -l use strict; use warnings; print zip("ABCDEFGHIJ", "abcde"); sub zip { my ($str1, $str2) = @_; for (0 .. length $str2) { substr $str1, $_ * 2 + 1, 0, substr $str2, $_, 1; } return $str1; }

    Output:

    AaBbCcDdEeFGHIJ

    -- Ken

      G'day mate.

      Awesome work from across the ditch!

      Thanks.

Re: Merge 2 strings like a zip
by BrowserUk (Pope) 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

    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!
      Thanks BrowserUk!

      Nice.

      Unfortunately, the following fails with this code:
      zip( 'abcde', 'ABCDEFGHIJ' );
      This is a good example of why a CPAN module is usually the right choice. :-)
        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; }

        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.
        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 1nickt (Abbot) 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__
    Remember: Ne dederis in spiritu molere illegitimi!

      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% --

      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!
        "substr( $a, $n, 0, $_), $n += 2 for split '', $b;"

        Excellent use of substr

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

        Remember: Ne dederis in spiritu molere illegitimi!
      Thanks 1nickt.

      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.

        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 [benchmark]
by kcott (Bishop) 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 ); ], };

    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% --

    -- Ken

      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.

        #! 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!
      Impressive, Ken!

      Oz leading the world.

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; }
      Thanks for that, Anonymous Monk!

      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.

        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; }
Re: Merge 2 strings like a zip
by tel2 (Pilgrim) on Jul 09, 2015 at 05:33 UTC
    Thanks everyone for your awesome solutions.

    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!

      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); }

      Output:

      ABCDEFGHIJ abcde

      -- Ken

        How dare you put us Kiwis to shame...again, Ken.

        Thanks again and keep up the good work!

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

Re: Merge 2 strings like a zip
by tel2 (Pilgrim) on Jul 10, 2015 at 01:22 UTC
    Thanks everyone for your contributions to my education.

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

    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__

    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% --

    Regards, Karl

    «The Crux of the Biscuit is the Apostrophe»

      While in principle I would agree with the statement that there is no need to re-write existing functionality from modules (= re-inventing the wheel), I would argue strongly in favour of the striving for elegance in coding. Questions like this one have an immense value as they inspire the quest for a concise and elegant solution thus fostering an in-depth understanding of Perl's inner workings. Anyway, so much for the philosophical part of my post.

      Here's my code solution now. It essentially achieves the zipping in one single line of code (if you are lenient enough not to count the conversion of one input string into a list). Lemme know what you think.

      use strict; use warnings; my $a = "ABCDEFGHIJ"; my $b = "abcde"; my @b = split "", $b; $a =~ s/(.)/$1.($b[length($`)] or "")/ge; print $a;

        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;

      Thanks for that, Karl.

      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

Re: Merge 2 strings like a zip
by pat_mc (Pilgrim) on Jul 11, 2015 at 14:04 UTC
    While in principle I would agree with the statement that there is no need to re-write existing functionality from modules (= re-inventing the wheel), I would argue strongly in favour of the striving for elegance in coding. Questions like this one have an immense value as they inspire the quest for a concise and elegant solution thus fostering an in-depth understanding of Perl's inner workings. Anyway, so much for the philosophical part of my post.

    Here's my code solution now. It essentially achieves the zipping in one single line of code (if you are lenient enough not to count the conversion of one input string into a list). Lemme know what you think.
    use strict; use warnings; my $a = "ABCDEFGHIJ"; my $b = "abcde"; my @b = split "", $b; $a =~ s/(.)/$1.($b[length($`)] or "")/ge; print $a;

      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; }
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 }
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?

      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.

      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";'

    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

    “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.

      Elegance arises from the concise use of existing and suitable features to achieve the desired effect. Ideally, at least in my view, the solution to the problem can be stated in a declarative rather than a procedural fashion.
      While I would concede that the former is not necessarily more concise, its implicit usage of features required to solve the problem will contribute to the elegance of the solution put forward. Solutions involving an explicit loop stepping through a string character-by-character hence certainly are transparent to inspection ... but way too procedural to be surprising or elegant.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1133857]
Approved by Athanasius
Front-paged by kcott
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (5)
As of 2021-04-21 21:13 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?