Making the sort stable in Perl - perl

I have an array of refs with me . Something like
$a[0] = [qw( 1 2 3 4 )];
$a[1] = [qw( a b c d )];
The 1,2,3,4 are actually website breadcrumbs which are used for navigation (Home, Profile, Contact-us, Contact-me-specifically).
Now, I have to sort this ladder (And using stable sort in perl 5.8 is not an option sadly)
The sorting criteria is
The depth of the ladder
If two ladders have same depth, then sort them depending on their index.
For example, if the array originally contains
$a[0] = [qw( 1 2 3 4 )];
$a[1] = [qw( 1 2 3 )];
Then after the sort, the array should contain
$a[0] = [qw( 1 2 3 )];
$a[1] = [qw( 1 2 3 4 )];
But if the arrays are something like :-
$a[0] = [qw( 1 2 3 )];
$a[1] = [qw( a b c )];
Then after the sort,
$a[0] = [qw( 1 2 3 )];
$a[1] = [qw( a b c )];
I can't get it to work this way that I tried .
my #sorted_array = sort { #$b <=> #$a || $a <=> $b } #a;
Can someone help me in this?

The description of your data structure (linked list), and the implementation in your sort routine (arrayrefs) do not quite fit together; I will assume the latter.
A non-stable sort can be made stable by sorting by the position as a secondary criterion:
sort { normally or by_index } #stuff
Normally, you seem to want to compare the array length. To be able to test for the index, you have to somehow make the index of the current element available. You can do so by two means:
Do the Schwartzian Transform, and annotate each element with its index. This is silly.
Sort the indices, not the elements.
This would look like:
my #sorted_indices =
sort { #{ $array[$b] } <=> #{ $array[$a] } or $a <=> $b } 0 .. $#array;
my #sorted = #array[#sorted_indices]; # do a slice
What you were previously doing with $a <=> $b was comparing refernces. This is not guaranteed to do anything meaningful.
Test of that sort:
use Test::More;
my #array = (
[qw/1 2 3/],
[qw/a b c/],
[qw/foo bar baz qux/],
);
my #expected = (
[qw/foo bar baz qux/],
[qw/1 2 3/],
[qw/a b c/],
);
...; # above code
is_deeply \#sorted, \#expected;
done_testing;

Your code doesn't work because you expect $a and $b to contain the element's value in one place (#$b <=> #$a) and the element's index in another ($a <=> $b).
You need the indexes in your comparison, so your comparison function is going to need the indexes.
By passing the indexes of the array to sort, you have access to both the indexes and the values at those indexes, so your code is going to include
sort { ... } 0..$#array;
After we're finished sorting, we want to retrieve the elements for those indexes. For that, we can use
my #sorted = map $array[$_], #sorted_indexes;
or
my #sorted = #array[ #sorted_indexes ];
All together, we get:
my #sorted =
map $array[$_],
sort { #{ $array[$a] } <=> #{ $array[$b] } || $a <=> $b }
0..$#array;
or
my #sorted = #array[
sort { #{ $array[$a] } <=> #{ $array[$b] } || $a <=> $b }
0..$#array
];

I think we need to clear up your sorting algorithm. You said:
The depth of the ladder
Sort them depending on their index.
Here's an example:
$array[0] = [ qw(1 a b c d e) ];
$array[2] = [ qw(1 2 b c d e) ];
$array[3] = [ qw(a b c) ];
$array[4] = [ qw(a b c d e) ];
You want them sorted this way:
$array[3] = [ qw(a b c) ];
$array[2] = [ qw(1 2 b c d e) ];
$array[0] = [ qw(1 a b c d e) ];
$array[4] = [ qw(a b c d e) ];
Is that correct?
What about this?
$array[0] = [ qw(100, 21, 15, 32) ];
$array[1] = [ qw(32, 14, 32, 20) ];
Sorting by numeric, $array[1] should be before $array[0], but sorting by string, $array[0] is before $array[1].
Also, you notice that I cannot tell whether $array[0] should be before or after $array[1] until I look at the second element of the array.
This makes sorting very difficult to do on a single line function. Even if you can somehow reduce it, It'll make it very difficult for someone to analyze what you are doing, or for you to debug the statement.
Fortunately, you can use an entire subroutine as a sort routine:
use warnings;
use strict;
use autodie;
use feature qw(say);
use Data::Dumper;
my #array;
$array[0] = [ qw(1 2 3 4 5 6) ];
$array[1] = [ qw(1 2 3) ];
$array[2] = [ qw(a b c d e f) ];
$array[3] = [ qw(0 1 2) ];
my #sorted_array = sort sort_array #array;
say Dumper \#sorted_array;
sub sort_array {
#my $a = shift; #Array reference to an element in #array
#my $b = shift; $Array reference to an element in #array
my #a_array = #{ $a };
my #b_array = #{ $b };
#
#First sort on length of arrays
#
if ( scalar #a_array ne scalar #b_array ) {
return scalar #a_array <=> scalar #b_array;
}
#
# Arrays are the same length. Sort on first element in array that differs
#
for my $index (0..$#a_array ) {
if ( $a_array[$index] ne $b_array[$index] ) {
return $a_array[$index] cmp $b_array[$index];
}
}
#
# Both arrays are equal in size and content
#
return 0;
}
This returns:
$VAR1 = [
[
'0',
'1',
'2'
],
[
'1',
'2',
'3'
],
[
'1',
'2',
'3',
'4',
'5',
'6'
],
[
'a',
'b',
'c',
'd',
'e',
'f'
]
];

Related

Sort Hash Key and Value simultaneously Perl

I have a hash that I want to sort the keys numerically in ascending order and
its values in ascending alphabetically manner.
#!/usr/bin/perl
use warnings;
use strict;
use List::MoreUtils;
use Tie::IxHash;
my %KEY_VALUE;
#tie %KEY_VALUE,'Tie::IxHash';
my %KEY_VALUE= (
0 => [ 'A', 'C', 'B', 'A' ,'D'],
5 => [ 'D', 'F', 'E', ],
2 => [ 'Z', 'X', 'Y' ],
4 => [ 'E', 'R', 'M' ],
3 => [ 'A', 'B', 'B', 'A' ],
1 => [ 'C', 'C', 'F', 'E' ],
);
#while (my ($k, $av) = each %KEY_VALUE)
#{
# print "$k #$av\n ";
#}
#Sort the key numerically
foreach my $key (sort keys %KEY_VALUE)
{
print "$key\n";
}
#To sort the value alphabetically
foreach my $key (sort {$KEY_VALUE{$a} cmp $KEY_VALUE{$b}} keys %KEY_VALUE){
print "$key: $KEY_VALUE{$key}\n";
}
The wanted input is like this, and I want to print out the sorted keys and values.
%KEY_VALUE= (
0 => [ 'A','A','B','C','D'],
1 => [ 'C','C','E','F' ],
2 => [ 'X','Y','Z' ],
3 => [ 'A', 'A', 'B', 'B' ],
4 => [ 'E','M','R' ],
5 => [ 'D','E','F', ],
);
Additional problem, how to print the key and the scalar value of the first different value
Wanted Output:
KEY= 0 VALUE:0 2 3 4 #The scalar value of first A B C D, start with 0
KEY= 1 VALUE:0 2 3 #The scalar value of first C E F
KEY= 2 VALUE:0 1 2 #The scalar value of first X Y Z
KEY= 3 VALUE:0 2 #The scalar value of first A B
KEY= 4 VALUE:0 1 2 #The scalar value of first E M R
KEY= 5 VALUE:0 1 2 #The scalar value of first D E F
Hash keys have no defined order. Generally you sort the keys as you're iterating through the hash.
The values can be sorted as you iterate through the hash.
# Iterate through the keys in numeric order.
for my $key (sort {$a <=> $b } keys %hash) {
# Get the value
my $val = $hash{$key};
# Sort it in place
#$val = sort { $a cmp $b } #$val;
# Display it
say "$key -> #$val";
}
Note that by default sort sorts in ASCII order as strings. That means sort keys %KEY_VALUE is not sorting as numbers but as strings. sort(2,3,10) is (10,2,3). "10" is less than "2" like "ah" is less than "b". Be sure to use sort { $a <=> $b } for numeric sorting and sort { $a cmp $b } for strings.
You could use a different data structure such as Tie::Ixhash though tying has a significant performance penalty. Generally it's better to sort in place unless your hash gets very large.
You can't sort a hash, you can at best print it sorted (or keep the sorted keys in another array). Finding the position of the first value can be done with first_index; we remove duplicates with uniq.
foreach my $key (sort keys %KEY_VALUE) {
my #value = #{$KEY_VALUE{$key}};
my #indices = map { my $e = $_; first_index { $_ eq $e } #value } (uniq (sort #value));
print "$key: " . (join ', ', #indices) . "\n";
}

Perl to sort words by user-defined alphabet sequence

I have an array of "words" (strings), which consist of letters from an "alphabet" with user-defined sequence. E.g my "alphabet" starts with "ʔ ʕ b g d", so a list of "words" (bʔd ʔbg ʕʔb bʕd) after sort by_my_alphabet should be ʔbd ʕʔb bʔd bʕd.
sort by_my_alphabet (bʔd ʔbg ʕʔb bʕd) # gives ʔbd ʕʔb bʔd bʕd
Is there a way to make a simple subroutine by_my_alphabet with $a and $b to solve this problem?
Simple, and very fast because it doesn't use a compare callback, but it needs to scan the entire string:
use utf8;
my #my_chr = split //, "ʔʕbgd";
my %my_ord = map { $my_chr[$_] => $_ } 0..$#my_chr;
my #sorted =
map { join '', #my_chr[ unpack 'W*', $_ ] } # "\x00\x01\x02\x03\x04" ⇒ "ʔʕbgd"
sort
map { pack 'W*', #my_ord{ split //, $_ } } # "ʔʕbgd" ⇒ "\x00\x01\x02\x03\x04"
#unsorted;
Optimized for long strings since it only scans a string up until a difference is found:
use utf8;
use List::Util qw( min );
my #my_chr = split //, "ʔʕbgd";
my %my_ord = map { $my_chr[$_] => $_ } 0..$#my_chr;
sub my_cmp($$) {
for ( 0 .. ( min map length($_), #_ ) - 1 ) {
my $cmp = $my_ord{substr($_[0], $_, 1)} <=> $my_ord{substr($_[1], $_, 1)};
return $cmp if $cmp;
}
return length($_[0]) <=> length($_[1]);
}
my #sorted = sort my_cmp #unsorted;
Both should be faster than Sobrique's. Theirs uses a compare callback, and it scans the entire strings being compared.
Yes.
sort can take any function that returns a relative sort position. All you need is a function that correctly looks up the 'sort value' of a string for comparing.
So all you need to do here is define a 'relative weight' of your extra letters, and then compare the two.
#!/usr/bin/env perl
use strict;
use warnings;
use Data::Dumper;
my #sort_order = qw ( B C A D );
my #array_to_sort = qw ( A B C D A B C D AB BB CCC ABC );
my $count = 0;
my %position_of;
$position_of{$_} = $count++ for #sort_order;
print Dumper \%position_of;
sub sort_by_pos {
my #a = split //, $a;
my #b = split //, $b;
#iterate one letter at a time, using 'shift' to take it off the front
#of the array.
while ( #a and #b ) {
my $result = $position_of{shift #a} <=> $position_of{shift #b};
#result is 'true' if it's "-1" or "1" which indicates relative position.
# 0 is false, and that'll cause the next loop iteration to test the next
#letter-pair
return $result if $result;
}
#return a value based on remaining length - longest 'string' will sort last;
#That's so "AAA" comparing with "AA" comparison actually work,
return scalar #a <=> scalar #b;
}
my #new = sort { sort_by_pos } #array_to_sort;
print Dumper \#new;
Bit of a simple case, but it sorts our array into:
$VAR1 = [
'B',
'B',
'BB',
'C',
'C',
'CCC',
'A',
'A',
'AB',
'ABC',
'D',
'D'
];

How can I partition a Perl array into equal sized chunks?

I have a fixed-sized array where the size of the array is always in factor of 3.
my #array = ('foo', 'bar', 'qux', 'foo1', 'bar', 'qux2', 3, 4, 5);
How can I cluster the member of array such that we can get
an array of array group by 3:
$VAR = [ ['foo','bar','qux'],
['foo1','bar','qux2'],
[3, 4, 5] ];
my #VAR;
push #VAR, [ splice #array, 0, 3 ] while #array;
or you could use natatime from List::MoreUtils
use List::MoreUtils qw(natatime);
my #VAR;
{
my $iter = natatime 3, #array;
while( my #tmp = $iter->() ){
push #VAR, \#tmp;
}
}
I really like List::MoreUtils and use it frequently. However, I have never liked the natatime function. It doesn't produce output that can be used with a for loop or map or grep.
I like to chain map/grep/apply operations in my code. Once you understand how these functions work, they can be very expressive and very powerful.
But it is easy to make a function to work like natatime that returns a list of array refs.
sub group_by ($#) {
my $n = shift;
my #array = #_;
croak "group_by count argument must be a non-zero positive integer"
unless $n > 0 and int($n) == $n;
my #groups;
push #groups, [ splice #array, 0, $n ] while #array;
return #groups;
}
Now you can do things like this:
my #grouped = map [ reverse #$_ ],
group_by 3, #array;
** Update re Chris Lutz's suggestions **
Chris, I can see merit in your suggested addition of a code ref to the interface. That way a map-like behavior is built in.
# equivalent to my map/group_by above
group_by { [ reverse #_ ] } 3, #array;
This is nice and concise. But to keep the nice {} code ref semantics, we have put the count argument 3 in a hard to see spot.
I think I like things better as I wrote it originally.
A chained map isn't that much more verbose than what we get with the extended API.
With the original approach a grep or other similar function can be used without having to reimplement it.
For example, if the code ref is added to the API, then you have to do:
my #result = group_by { $_[0] =~ /foo/ ? [#_] : () } 3, #array;
to get the equivalent of:
my #result = grep $_->[0] =~ /foo/,
group_by 3, #array;
Since I suggested this for the sake of easy chaining, I like the original better.
Of course, it would be easy to allow either form:
sub _copy_to_ref { [ #_ ] }
sub group_by ($#) {
my $code = \&_copy_to_ref;
my $n = shift;
if( reftype $n eq 'CODE' ) {
$code = $n;
$n = shift;
}
my #array = #_;
croak "group_by count argument must be a non-zero positive integer"
unless $n > 0 and int($n) == $n;
my #groups;
push #groups, $code->(splice #array, 0, $n) while #array;
return #groups;
}
Now either form should work (untested). I'm not sure whether I like the original API, or this one with the built in map capabilities better.
Thoughts anyone?
** Updated again **
Chris is correct to point out that the optional code ref version would force users to do:
group_by sub { foo }, 3, #array;
Which is not so nice, and violates expectations. Since there is no way to have a flexible prototype (that I know of), that puts the kibosh on the extended API, and I'd stick with the original.
On a side note, I started with an anonymous sub in the alternate API, but I changed it to a named sub because I was subtly bothered by how the code looked. No real good reason, just an intuitive reaction. I don't know if it matters either way.
Or this:
my $VAR;
while( my #list = splice( #array, 0, 3 ) ) {
push #$VAR, \#list;
}
Another answer (a variation on Tore's, using splice but avoiding the while loop in favor of more Perl-y map)
my $result = [ map { [splice(#array, 0, 3)] } (1 .. (scalar(#array) + 2) % 3) ];
Try this:
$VAR = [map $_ % 3 == 0 ? ([ $array[$_], $array[$_ + 1], $array[$_ + 2] ])
: (),
0..$#array];
Another generic solution, non-destructive to the original array:
use Data::Dumper;
sub partition {
my ($arr, $N) = #_;
my #res;
my $i = 0;
while ($i + $N-1 <= $#$arr) {
push #res, [#$arr[$i .. $i+$N-1]];
$i += $N;
}
if ($i <= $#$arr) {
push #res, [#$arr[$i .. $#$arr]];
}
return \#res;
}
print Dumper partition(
['foo', 'bar', 'qux', 'foo1', 'bar', 'qux2', 3, 4, 5],
3
);
The output:
$VAR1 = [
[
'foo',
'bar',
'qux'
],
[
'foo1',
'bar',
'qux2'
],
[
3,
4,
5
]
];
As a learning experience I decided to do this in Perl6
The first, perhaps most simplest way I tried was to use map.
my #output := #array.map: -> $a, $b?, $c? { [ $a, $b // Nil, $c // Nil ] };
.say for #output;
foo bar qux
foo1 bar qux2
3 4 5
That didn't seem very scalable. What if I wanted to take the items from the list 10 at a time, that would get very annoying to write. ... Hmmm I did just mention "take" and there is a keyword named take lets try that in a subroutine to make it more generally useful.
sub at-a-time ( Iterable \sequence, Int $n where $_ > 0 = 1 ){
my $is-lazy = sequence.is-lazy;
my \iterator = sequence.iterator;
# gather is used with take
gather loop {
my Mu #current;
my \result = iterator.push-exactly(#current,$n);
# put it into the sequence, and yield
take #current.List;
last if result =:= IterationEnd;
}.lazy-if($is-lazy)
}
For kicks let's try it against an infinite list of the fibonacci sequence
my $fib = (1, 1, *+* ... *);
my #output = at-a-time( $fib, 3 );
.say for #output[^5]; # just print out the first 5
(1 1 2)
(3 5 8)
(13 21 34)
(55 89 144)
(233 377 610)
Notice that I used $fib instead of #fib. It was to prevent Perl6 from caching the elements of the Fibonacci sequence.
It might be a good idea to put it into a subroutine to create a new sequence everytime you need one, so that the values can get garbage collected when you are done with them.
I also used .is-lazy and .lazy-if to mark the output sequence lazy if the input sequence is. Since it was going into an array #output it would have tried to generate all of the elements from an infinite list before continuing onto the next line.
Wait a minute, I just remembered .rotor.
my #output = $fib.rotor(3);
.say for #output[^5]; # just print out the first 5
(1 1 2)
(3 5 8)
(13 21 34)
(55 89 144)
(233 377 610)
.rotor is actually far more powerful than I've demonstrated.
If you want it to return a partial match at the end you will need to add a :partial to the arguments of .rotor.
Use the spart function from the List::NSect package on CPAN.
perl -e '
use List::NSect qw{spart};
use Data::Dumper qw{Dumper};
my #array = ("foo", "bar", "qux", "foo1", "bar", "qux2", 3, 4, 5);
my $var = spart(3, #array);
print Dumper $var;
'
$VAR1 = [
[
'foo',
'bar',
'qux'
],
[
'foo1',
'bar',
'qux2'
],
[
3,
4,
5
]
];
Below a more generic solution to the problem:
my #array = ('foo', 'bar', 1, 2);
my $n = 3;
my #VAR = map { [] } 1..$n;
my #idx = sort map { $_ % $n } 0..$#array;
for my $i ( 0..$#array ){
push #VAR[ $idx[ $i ] ], #array[ $i ];
}
This also works when the number of items in the array is not a factor of 3.
In the above example, the other solutions with e.g. splice would produce two arrays of length 2 and one of length 0.

In Perl, how can I iterate over the Cartesian product of multiple sets?

Given x number of arrays, each with a possibly different number of elements, how can I iterate through all combinations where I select one item from each array?
Example:
[ ] [ ] [ ]
foo cat 1
bar dog 2
baz 3
4
Returns
[foo] [cat] [ 1 ]
[foo] [cat] [ 2 ]
...
[baz] [dog] [ 4 ]
I'm doing this in Perl, btw.
My Set::CrossProduct module does exactly what you want. Note that you aren't really looking for permutations, which is the ordering of the elements in a set. You're looking for the cross product, which is the combinations of elements from different sets.
My module gives you an iterator, so you don't create it all in memory. You create a new tuple only when you need it.
use Set::Crossproduct;
my $iterator = Set::CrossProduct->new(
[
[qw( foo bar baz )],
[qw( cat dog )],
[qw( 1 2 3 4 )],
]
);
while( my $tuple = $iterator->get ) {
say join ' ', $tuple->#*;
}
A simple recursive solution for an arbitrary number of lists:
sub permute {
my ($first_list, #remain) = #_;
unless (defined($first_list)) {
return []; # only possibility is the null set
}
my #accum;
for my $elem (#$first_list) {
push #accum, (map { [$elem, #$_] } permute(#remain));
}
return #accum;
}
A not-so-simple non-recursive solution for an arbitrary number of lists:
sub make_generator {
my #lists = reverse #_;
my #state = map { 0 } #lists;
return sub {
my $i = 0;
return undef unless defined $state[0];
while ($i < #lists) {
$state[$i]++;
last if $state[$i] < scalar #{$lists[$i]};
$state[$i] = 0;
$i++;
}
if ($i >= #state) {
## Sabotage things so we don't produce any more values
$state[0] = undef;
return undef;
}
my #out;
for (0..$#state) {
push #out, $lists[$_][$state[$_]];
}
return [reverse #out];
};
}
my $gen = make_generator([qw/foo bar baz/], [qw/cat dog/], [1..4]);
while ($_ = $gen->()) {
print join(", ", #$_), "\n";
}
Recursive and more-fluent Perl examples (with commentary and documentation) for doing the Cartesian product can be found at http://www.perlmonks.org/?node_id=7366
Example:
sub cartesian {
my #C = map { [ $_ ] } #{ shift #_ };
foreach (#_) {
my #A = #$_;
#C = map { my $n = $_; map { [ $n, #$_ ] } #C } #A;
}
return #C;
}
You can use nested loops.
for my $e1 (qw( foo bar baz )) {
for my $e2 (qw( cat dog )) {
for my $e3 (qw( 1 2 3 4 )) {
my #choice = ($e1, $e2, $e3);
...
}}}
When you need an arbitrary number of nested loops, you can use Algorithm::Loops's NestedLoops.
use Algorithm::Loops qw( NestedLoops );
my #lists = (
[qw( foo bar baz )],
[qw( cat dog )],
[qw( 1 2 3 4 )],
);
my $iter = NestedLoops(\#lists);
while ( my #choice = $iter->() ) {
...
}
There's one method I thought of first that uses a couple for loops and no recursion.
find total number of permutations
loop from 0 to total_permutations-1
observe that, by taking the loop index modulus the number of elements in an array, you can get every permutations
Example:
Given A[3], B[2], C[3],
for (index = 0..totalpermutations) {
print A[index % 3];
print B[(index / 3) % 2];
print C[(index / 6) % 3];
}
where of course a for loop can be substituted to loop over [A B C ...], and a small part can be memoized. Of course, recursion is neater, but this might be useful for languages in which recursion is severely limited by stack size.

Is there an elegant zip to interleave two lists in Perl 5?

I recently "needed" a zip function in Perl 5 (while I was thinking about How do I calculate relative time?), i.e. a function that takes two lists and "zips" them together to one list, interleaving the elements.
(Pseudo)example:
#a=(1, 2, 3);
#b=('apple', 'orange', 'grape');
zip #a, #b; # (1, 'apple', 2, 'orange', 3, 'grape');
Haskell has zip in the Prelude and Perl 6 has a zip operator built in, but how do you do it in an elegant way in Perl 5?
Assuming you have exactly two lists and they are exactly the same length, here is a solution originally by merlyn (Randal Schwartz), who called it perversely perlish:
sub zip2 {
my $p = #_ / 2;
return #_[ map { $_, $_ + $p } 0 .. $p - 1 ];
}
What happens here is that for a 10-element list, first, we find the pivot point in the middle, in this case 5, and save it in $p. Then we make a list of indices up to that point, in this case 0 1 2 3 4. Next we use map to pair each index with another index that’s at the same distance from the pivot point as the first index is from the start, giving us (in this case) 0 5 1 6 2 7 3 8 4 9. Then we take a slice from #_ using that as the list of indices. This means that if 'a', 'b', 'c', 1, 2, 3 is passed to zip2, it will return that list rearranged into 'a', 1, 'b', 2, 'c', 3.
This can be written in a single expression along ysth’s lines like so:
sub zip2 { #_[map { $_, $_ + #_/2 } 0..(#_/2 - 1)] }
Whether you’d want to use either variation depends on whether you can see yourself remembering how they work, but for me, it was a mind expander.
The List::MoreUtils module has a zip/mesh function that should do the trick:
use List::MoreUtils qw(zip);
my #numbers = (1, 2, 3);
my #fruit = ('apple', 'orange', 'grape');
my #zipped = zip #numbers, #fruit;
Here is the source of the mesh function:
sub mesh (\#\#;\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#) {
my $max = -1;
$max < $#$_ && ($max = $#$_) for #_;
map { my $ix = $_; map $_->[$ix], #_; } 0..$max;
}
I find the following solution straightforward and easy to read:
#a = (1, 2, 3);
#b = ('apple', 'orange', 'grape');
#zipped = map {($a[$_], $b[$_])} (0 .. $#a);
I believe it's also faster than solutions that create the array in a wrong order first and then use slice to reorder, or solutions that modify #a and #b.
For arrays of the same length:
my #zipped = ( #a, #b )[ map { $_, $_ + #a } ( 0 .. $#a ) ];
my #l1 = qw/1 2 3/;
my #l2 = qw/7 8 9/;
my #out;
push #out, shift #l1, shift #l2 while ( #l1 || #l2 );
If the lists are a different length, this will put 'undef' in the extra slots but you can easily remedy this if you don't wish to do this. Something like ( #l1[0] && shift #l1 ) would do it.
Hope this helps!
Algorithm::Loops is really nice if you do much of this kind of thing.
My own code:
sub zip { #_[map $_&1 ? $_>>1 : ($_>>1)+($#_>>1), 1..#_] }
This is totally not an elegant solution, nor is it the best solution by any stretch of the imagination. But it's fun!
package zip;
sub TIEARRAY {
my ($class, #self) = #_;
bless \#self, $class;
}
sub FETCH {
my ($self, $index) = #_;
$self->[$index % #$self][$index / #$self];
}
sub STORE {
my ($self, $index, $value) = #_;
$self->[$index % #$self][$index / #$self] = $value;
}
sub FETCHSIZE {
my ($self) = #_;
my $size = 0;
#$_ > $size and $size = #$_ for #$self;
$size * #$self;
}
sub CLEAR {
my ($self) = #_;
#$_ = () for #$self;
}
package main;
my #a = qw(a b c d e f g);
my #b = 1 .. 7;
tie my #c, zip => \#a, \#b;
print "#c\n"; # ==> a 1 b 2 c 3 d 4 e 5 f 6 g 7
How to handle STORESIZE/PUSH/POP/SHIFT/UNSHIFT/SPLICE is an exercise left to the reader.