This is my response to the Perl Weekly Challenge #131.
Input: (1, 2, 3, 6, 7, 8, 9)
Output: ([1, 2, 3], [6, 7, 8, 9])
Input: (11, 12, 14, 17, 18, 19)
Output: ([11, 12], [14], [17, 18, 19])
Input: (2, 4, 6, 8)
Output: ([2], [4], [6], [8])
Input: (1, 2, 3, 4, 5)
Output: ([1, 2, 3, 4, 5])
Let us dive straight in:
File: coar
#! /usr/bin/env raku
multi MAIN (Str $input = "1 2 3 6 7 8 9", :v(:$verbose)) # [1]
{
my @input = $input.words; # [1a]
MAIN(@input, :$verbose); # [1b]
}
multi MAIN (*@input where @input.elems > 1 && all(@input) ~~ /^\d+$/,
:v(:$verbose)) # [2]
{
die "Not sorted" unless [<] @input; # [3]
my @result; # [4]
my $current = @input.shift; # [5]
my @current = $current,; # [6]
say ": Candidate: $current" if $verbose;
for @input -> $i # [7]
{
if $i > $current +1 # [8]
{
@result.push: @current.clone; # [8a]
say ": Push: [", @current.join(","), "]" if $verbose;
@current = (); # [8b]
}
say ": Candidate: $i" if $verbose;
@current.push: $i; # [9]
$current = $i; # [10]
}
@result.push: @current if @current; # [11]
say @result; # [12]
}
[1] How to specify the input? This version of «multi::Main» takes a single (space separated) string, splits the string into separate values [1a], and and calls the other «Multi MAIN» with those values [1b].
[2] This version of «multi MAIN» takes a list of values. The where
clause ensures that we have at least one element in the list (as a slurpy array can
be empty). Then we use a regex and a junction to ensure that all the values are
integers.
Note that coercing the values to integers (with
$input.words>>.Int in e.g. [1a]) will truncate non-integer numbers.
Non-numbers will cause an error. Coercing them to numbers (with
$input.words>>.Numeric is the thing, as it does not play havoc with
non-integer numbers. But it does not check that the numbers are integers, and is
useless here.
[3] The reduction metaoperator []
(with an operator, code block or procedure call in the middle) ensures that each value
is smaller than the next one.
[4] The result (the array of arrays) will end up here.
[5] Get the first input value.
[6] Store it in a list. Note the , (comma),
which is the list operator.
[7] Iterate over the rest of the values (after the first one; see [5]).
[8] Do we have non-consecutive values? If so, add the array of values
to the result [8a]. Note the clone, as we add a reference - and would end
up with an array with a lot of identical inner arrays if we did not. Then we clear out
the inner array [8b].
[9] Add the value to the inner array (which may or may not be empty by now).
[10] Set the current value, ready for the next iteration.
[11] Add a final inner array, if any.
[12] Print the result.
See
docs.raku.org/syntax/multi
for more information about multi.
See
https://docs.raku.org/routine/MAIN
for more information about MAIN.
See
docs.raku.org/language/operators#Reduction_metaoperators for more
information about the Reduction Metaoperator [].
See
docs.raku.org/routine/,
for more information about the list operator ,.
See
docs.raku.org/routine/clone for
more information about the clone method.
Running it on the first example, first with the default values, then with the values as a string, and finally as separate input strings.
$ ./coar
[[1 2 3] [6 7 8 9]]
$ ./coar "1 2 3 6 7 8 9"
[[1 2 3] [6 7 8 9]]
$ ./coar 1 2 3 6 7 8 9
[[1 2 3] [6 7 8 9]]
All the examples, with verbose mode:
$ ./coar -v 1 2 3 6 7 8 9
: Candidate: 1
: Candidate: 2
: Candidate: 3
: Push: [1,2,3]
: Candidate: 6
: Candidate: 7
: Candidate: 8
: Candidate: 9
[[1 2 3] [6 7 8 9]]
$ ./coar -v 11 12 14 17 18 19
: Candidate: 11
: Candidate: 12
: Push: [11,12]
: Candidate: 14
: Push: [14]
: Candidate: 17
: Candidate: 18
: Candidate: 19
[[11 12] [14] [17 18 19]]
$ ./coar -v 2 4 6 8
: Candidate: 2
: Push: [2]
: Candidate: 4
: Push: [4]
: Candidate: 6
: Push: [6]
: Candidate: 8
[[2] [4] [6] [8]]
$ ./coar -v 1 2 3 4 5
: Candidate: 1
: Candidate: 2
: Candidate: 3
: Candidate: 4
: Candidate: 5
[[1 2 3 4 5]]
Note that simply printing the result, as I have done here works out. But the result is not quite as specified in the challenge. Fixing that is easy-ish:
File: coar-fixed (changes only)
say '(' ~ @result.map({ '[' ~ @$_.join(', ') ~ ']' }).join(', ') ~ ')';
The map block is applied to every top level value in the list, either a
single value or a sublist. If there are more than one value, they are combined with
commas. The resulting string is placed in brackets ([ and ]).
The resulting strings are combined with commas, and surrounded in parens
(( and )). Easy-ish, indeed…
Running it gives the required output:
$ ./coar-fixed
([1, 2, 3], [6, 7, 8, 9])
$ ./coar-fixed 11 12 14 17 18 19
([11, 12], [14], [17, 18, 19])
$ ./coar-fixed 2 4 6 8
([2], [4], [6], [8])
$ ./coar-fixed 1 2 3 4 5
([1, 2, 3, 4, 5])
#! /usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use Getopt::Long;
use Perl6::Junction 'all'; # [1]
my $verbose = 0;
GetOptions("verbose" => \$verbose);
die "Integers only" unless all(@ARGV) == qr/^\d+$/; # [1]
my @result;
my $current = shift(@ARGV) // die "No numbers";
my @current = ($current);
say ": Candidate: $current" if $verbose;
for my $i (@ARGV)
{
if ($i > $current +1)
{
my @copy = @current;
push(@result, \@copy); #clone??
say ": Push: [", join(",", @current), "]" if $verbose;
@current = ();
}
die "Not sorted ($current < $i)" unless $i > $current; # [2]
say ": Candidate: $i" if $verbose;
push(@current, $i);
$current = $i;
}
push(@result, \@current) if @current;
say "(", join(", ", map { "[" . join(", ", @$_) . "]" } @result), ")";
[1] Junctions make life easier (for me as a programmer), so I use this Perl module to get the «all» function.
[2] Perl does not have something similar to the reduction metaoperator in Raku, but a cleverly designed test in the loop does the trick.
Running it gives the same result as the Raku version:
$ ./coar-perl 1 2 3 6 7 8 9
([1, 2, 3], [6, 7, 8, 9])
$ ./coar-perl 11 12 14 17 18 19
([11, 12], [14], [17, 18, 19])
$ ./coar-perl 2 4 6 8
([2], [4], [6], [8])
$ ./coar-perl 1 2 3 4 5
([1, 2, 3, 4, 5])
Note that simply printing the result does not work at all in Perl (as opposed to Raku). The result will be something like this:
say @array; # -> ARRAY(0x564db2477e60)ARRAY(0x564db22ee978)
say @array; # -> ARRAY(0x559f4330fe80)
The first one is from the first example, and the second one is from the fourth example.
Input:
Delimiter pairs: ""[]()
Search String: "I like (parens) and the Apple ][+" they said.
Output:
"(["
")]"
Input:
Delimiter pairs: **//<>
Search String: /* This is a comment (in some languages) */ <could be a tag>
Output:
/**/<
/**/>
#! /usr/bin/env raku
unit sub MAIN ($pairs = '""[]()',
$search = '"I like (parens) and the Apple ][+" they said.',
:v(:$verbose));
my @pairs = $pairs.comb; # [1]
my @open = @pairs[0, 2 ... *]; # [2]
my @close = @pairs[1, 3 ... *]; # [3]
say ": Open: @open[]" if $verbose;
say ": Close @close[]" if $verbose;
my $open = ""; # [4]
my $close = ""; # [4a]
for $search.comb -> $char # [5]
{
$open ~= $char if any(@open) eq $char; # [6]
$close ~= $char if any(@close) eq $char; # [7]
}
say $open; # [8]
say $close; # [8]
[1] Get the individual characters in the delimiter pairs.
[2] Get the characters with an even index (i.e. the starting delimiters). Note the use of an array slice, which works even if the indices are out of bounds.
[3] Get the characters with an odd index (i.e. the ending delimiters).
[4] The opening matches will go here, and ditto for the closing matches [4a].
[5] Iterate over the input string, one character at a time.
[6] Add it (the character) to the opening matches string if is one of the opening characters.
{7] Ditto for the closing matches and characters.
[8] Print the result.
Running it:
$ ./find-pairs
"(["
")]"
$ ./find-pairs '**//<>' \
'/* This is a comment (in some languages) */ <could be a tag>'
/**/<
/**/>
Looking good.
With verbose mode:
$ ./find-pairs -v '""[]()' '"I like (parens) and the Apple ][+" they said.'
: Open: " [ (
: Close " ] )
"(["
")]"
$ ./find-pairs -v '**//<>' \
'/* This is a comment (in some languages) */ <could be a tag>'
: Open: * / <
: Close * / >
/**/<
/**/>
#! /usr/bin/env perl
use strict;
use warnings;
use feature 'all';
use Getopt::Long;
use Perl6::Junction 'all';
my $verbose = 0;
GetOptions("verbose" => \$verbose);
my $pairs = shift(@ARGV) // '""[]()'; # [1]
my $search = shift(@ARGV) // '"I like (parens) and the Apple ][+" they said.';
my @pairs = split(//, $pairs);
my @search = split(//, $search);
my @open;
my @close;
for my $index (0 .. @pairs -1) # [2]
{
$index % 2 ? push(@open, $pairs[$index]) : push(@close, $pairs[$index]);
}
say ": Open: @open" if $verbose;
say ": Close @close" if $verbose;
my $open = "";
my $close = "";
for my $char (@search)
{
$open .= $char if any(@open) eq $char;
$close .= $char if any(@close) eq $char;
}
say $open;
say $close;
[1] I have chosen to have default values this time.
[2] Raku's clever array slices is not available in Perl, but the hard way works just fine.
Running it gives the same result as the Raku version:
$ ./find-pairs-perl -v '""[]()' \
'"I like (parens) and the Apple ][+" they said.'
: Open: " ] )
: Close " [ (
")]"
"(["
$ ./find-pairs-perl -v '**//<>' \
'/* This is a comment (in some languages) */ <could be a tag>'
: Open: * / >
: Close * / <
/**/>
/**/<
And that's it.