Creating sublists of arbitrary grouping - raku

Question

I'm trying to group several items from a list of strings based on the first part of each string (i.e. the part before the first tab if there is a tab or the whole string if there isn't a tab).
This works:
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;
}
But it seems so verbose. Isn't there a shorter way to do this in Perl 6? Please note that I only want to group like items that are consecutive members of the original list.
(update) The order within groups is important.
UPDATE
Here is a more numerically oriented example. It groups numbers based on divisibility of subsequent numbers by the first number.
#!/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;
}

Answer 1

You can use categorize (or categorize-list, or the classify variations if you want elements to be present in more than one category). Since your groupings are dynamic, depending on the keys that have come before, use a state variable to remember what has come before. The second example is easy because while the order matters, it's not prevented from re-adding elements to an older group:
my #numbers = <2 4 6 3 6 9 12 14>;
#numbers.classify: {
state $denom = $_; if $_ !%% $denom { $denom = $_ }; $denom;
};
# result: {2 => [2 4 6], 3 => [3 6 9 12], 14 => [14]}
Your first example needs to distinguish each grouping from groupings that came before, so the quick and dirty way is to index each group, so you can have two A groups:
my %result = #lines.classify: {
state $index = 0; # first group is group 0
state $prefix = .split("\t")[0]; # The first prefix is based on the first string
if !.starts-with($prefix) {
$prefix = .split("\t")[0]; # This is a new prefix. Remember it.
++$index; # start a new group
};
($index<> => $prefix<>); # Classify this element with a decontainerized pair. See note.
};
# result: {0 A => [A Foo A Bar], 1 B => [B B], 2 A => [A Baz], 3 B => [B]}
say %result.values; # output: ([B] [B B] [A Baz] [A Foo A Bar])
Do you need these to be in order? Since these two methods use hashes to store the data, the result is unordered.
Note: I used the <> operator to explicitly decontainerize the values that go into the Pair which is used as the classification value. Since this value is a hash key, without decontainerizing, the object ID (technically the .WHICH value) is used for hashing, and you will find that given $one = 1, (a => 1).WHICH !eqv (a => $one).WHICH. Hence, you remove the containers so the pair is treated as a pair of plain values, which will have the same hash key.
Note 2: The classification keys can be lists, which will result in a nested data structure. You won't need to decontainerize the keys, and you won't need to worry about forgetting the order. The only annoyance is an extra level of nesting in the output. To get a nested result, your classification key would be ($index, $prefix).

Answer 2

Here is a bit of functionally-inspired solution, though maybe a bit convoluted:
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;
The idea is that #eq contains for each position (except the first) a True if the previous element has the same prefix as the current one.
But we don't pretend that Lisp is the One True God, and car and cdr are Her prophets, we can inline that decision, simply by using the array index to access the previous element when we need it:
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;