是否有一个优雅的拉链来交错Perl 5中的两个列表?

时间:2008-09-01 19:59:37

标签: perl zip

我最近在Perl 5中“需要”一个zip函数(当时我正在考虑How do I calculate relative time?),即一个带有两个列表的函数,并将它们“拉链”到一个列表中,交错元素。

(伪)例子:

@a=(1, 2, 3);
@b=('apple', 'orange', 'grape');
zip @a, @b; # (1, 'apple', 2, 'orange', 3, 'grape');
内置了

Haskell has zip in the PreludePerl 6 has a zip operator,但是你如何在Perl 5中以优雅的方式做到这一点?

7 个答案:

答案 0 :(得分:36)

假设你有两个列表并且它们的长度完全相同,这里有一个最初由merlyn(Randal Schwartz)提出的解决方案,称其为per per per per per:

sub zip2 {
    my $p = @_ / 2; 
    return @_[ map { $_, $_ + $p } 0 .. $p - 1 ];
}

这里发生的是,对于10个元素的列表,首先,我们在中间找到枢轴点,在本例中为5,并将其保存在$p中。然后我们创建一个到那时为止的索引列表,在这种情况下为0 1 2 3 4.接下来我们使用map将每个索引与另一个索引配对,该索引与枢轴点的距离相同,因为第一个索引是从一开始,给我们(在这种情况下)0 5 1 6 2 7 3 8 4 9.然后我们从@_取一个切片,使用它作为索引列表。这意味着,如果将'a', 'b', 'c', 1, 2, 3传递给zip2,则会将该列表重新排列为'a', 1, 'b', 2, 'c', 3

这可以沿着ysth的行写成单个表达式,如下所示:

sub zip2 { @_[map { $_, $_ + @_/2 } 0..(@_/2 - 1)] }

你是否想要使用这两种变化取决于你是否能够看到自己记住它们是如何工作的,但对我来说,它是一个思维扩展器。

答案 1 :(得分:29)

List::MoreUtils模块有一个zip / mesh函数可以解决这个问题:

use List::MoreUtils qw(zip);

my @numbers = (1, 2, 3);
my @fruit = ('apple', 'orange', 'grape');

my @zipped = zip @numbers, @fruit;

这是网格函数的来源:

sub mesh (\@\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@) {
    my $max = -1;
    $max < $#$_  &&  ($max = $#$_)  for @_;

    map { my $ix = $_; map $_->[$ix], @_; } 0..$max; 
}

答案 2 :(得分:13)

我发现以下解决方案简单易读:

@a = (1, 2, 3);
@b = ('apple', 'orange', 'grape');
@zipped = map {($a[$_], $b[$_])} (0 .. $#a);

我相信它也比首先以错误顺序创建数组然后使用切片重新排序的解决方案或修改@a@b的解决方案更快。

答案 3 :(得分:10)

对于相同长度的数组:

my @zipped = ( @a, @b )[ map { $_, $_ + @a } ( 0 .. $#a ) ];

答案 4 :(得分:2)

my @l1 = qw/1 2 3/;
my @l2 = qw/7 8 9/;
my @out; 
push @out, shift @l1, shift @l2 while ( @l1 || @l2 );

如果列表的长度不同,这会将'undef'放在额外的插槽中,但如果您不想这样做,可以轻松解决这个问题。像(@ l1 [0]&amp;&amp; shift @ l1)这样的东西就可以了。

希望这有帮助!

答案 5 :(得分:2)

如果你做了很多这样的事情,那么

Algorithm::Loops真的很棒。

我自己的代码:

sub zip { @_[map $_&1 ? $_>>1 : ($_>>1)+($#_>>1), 1..@_] }

答案 6 :(得分:0)

这完全不是一个优雅的解决方案,也不是任何想象力的最佳解决方案。但它很有趣!

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

如何处理STORESIZE / PUSH / POP / SHIFT / UNSHIFT / SPLICE是留给读者的一项练习。< / p>