我正在尝试根据每个字符串的第一部分(即如果有选项卡的话在第一个选项卡之前的部分或如果没有选项卡的话整个字符串)将字符串列表中的多个项目分组。

这有效:

use Test;

my @lines    = "A\tFoo"
             , "A\tBar"
             , "B"
             , "B"
             , "A\tBaz"
             , "B"
             ;

my @expected = ["A\tFoo", "A\tBar"]
             , ["B", "B"]
             , ["A\tBaz"]
             , ["B"]
             ;

my @result = group-lines(@lines);

is @result, @expected, "Grouped correctly";

sub group-lines (@records) {
    my @groups;
    my @current-records;

    my $last-type;
    for @records -> $record {

        my $type = $record.split("\t")[0];

        once { $last-type = $type }

        if $type ne $last-type {
            @groups.push: [@current-records];
            @current-records = ();
        }
        @current-records.push: $record;

        LAST { @groups.push: [@current-records] }
    }

    return @groups;
}

但是似乎太冗长了。 Perl 6中没有更短的方法吗?请注意,我只想对属于原始列表连续成员的项目进行分组。

(更新)组内的顺序很重要。

更新

这是一个更加数字化的示例。它根据后继数字除以第一个数字将数字分组。
#!/bin/env perl6
use Test;

my @numbers = 2, 4, 6, 3, 6, 9, 12, 14;

my @expected = [2, 4, 6], [3, 6, 9, 12], [14];

my @result = group-nums(@numbers);

is @result, @expected, "Grouped correctly";

sub group-nums (@numbers) {
    my @groups;
    my @current-group;

    my $denominator = @numbers[0];

    for @numbers -> $num {

        if $num % $denominator {
            @groups.push: [@current-group];
            @current-group = ();
        }
        @current-group.push: $num;

    }
    @groups.push: [@current-group];

    return @groups;
}

最佳答案

这是一些受功能启发的解决方案,尽管可能有些令人费解:

use Test;

my @lines    = "A\tFoo"
             , "A\tBar"
             , "B"
             , "B"
             , "A\tBaz"
             , "B"
             ;

my @expected = ["A\tFoo", "A\tBar"]
             , ["B", "B"]
             , ["A\tBaz"]
             , ["B"]
             ;

my @eq = @lines.map(*.split("\t")[0]).rotor(2 => -1).map({ [eq] .list});
my @result = [@lines[0],],;
for @lines[1..*] Z @eq -> ($line, $eq) {
    @result.push([]) unless $eq;
    @result[*-1].push: $line;
}

plan 1;
is-deeply @result, @expected;

这个想法是,如果前一个元素的前缀与当前元素的前缀相同,则@eq会为每个位置(第一个位置除外)包含一个True

但是我们不假装Lisp是独一的真神,而carcdr是她的先知,我们可以内联该决定,只需在需要时使用数组索引访问上一个元素即可:
my @result;
for @lines.kv ->  $idx, $elem {
    @result.push([]) if $idx == 0 || $elem.split("\t")[0] ne @lines[$idx-1].split("\t")[0];
    @result[*-1].push: $elem;
}

plan 1;
is-deeply @result, @expected;

09-04 21:33
查看更多