This is my response to the Perl Weekly Challenge #067.
$m and $n. Write a script print all
possible combinations of $n numbers from the list 1 2 3 … $m.
Input: $m = 5, $n = 2
Output: \
[ [1,2], [1,3], [1,4], [1,5], [2,3], [2,4], [2,5], [3,4], [3,5], [4,5] ]
This is easy in Raku, as combinations are built in (with
the combinations keyword):
In REPL:
> say (1..5).combinations(2)
((1 2) (1 3) (1 4) (1 5) (2 3) (2 4) (2 5) (3 4) (3 5) (4 5))
> say (1..4).combinations(2)
((1 2) (1 3) (1 4) (2 3) (2 4) (3 4))
> say (1..4).combinations(3)
((1 2 3) (1 2 4) (1 3 4) (2 3 4))
See
docs.raku.org/routine/combinations
for more information about combinations.
Wrapping it up in a program taking care of the parameters, and printing the values as specified in the challenge:
File: numcon
#! /usr/bin/env raku
unit sub MAIN (Int $m where $m > 0, Int $n where $n > 0); # [1]
say "[ ", # [2]
(1..$m).combinations($n).map({ "[{ $_.join(",") }]" }).join(", "),
# 3 ### # 4 ############ # 5 ######################### # 6 ######
"]"; # [2]
[1] Both parameters should be positive integers (i.e. greater than zero).
[2] The start and end brackets; [ and ].
[3] The numbers to choose from, from 1 to the upper limit (included).
[4] Get the combinations of $n elements.
[5]
Each combination is a list of $n values. We use
map to add brackets around the list, and commas between the individual
values, resulting in a string.
[6] Combine the combinations (which are strings courtesy of [5]) to a string, separated by commas.
See
docs.raku.org/routine/map
for more information about map.
See
docs.raku.org/routine/join
for more information about join.
Running it:
$ raku numcom 5 2
[ [1,2], [1,3], [1,4], [1,5], [2,3], [2,4], [2,5], [3,4], [3,5], [4,5] ]
$ raku numcom 4 2
[ [1,2], [1,3], [1,4], [2,3], [2,4], [3,4] ]
$ raku numcom 4 3
[ [1,2,3], [1,2,4], [1,3,4], [2,3,4] ]
Perl does not have combinations built in, but we can use a module. Algorithm::Combinatorics fits the bill. See metacpan.org/pod/Algorithm::Combinatorics for details. (The Debian and Ubuntu package name is libalgorithm-combinatorics-perl.)
File: numcom-perl
#! /usr/bin/env perl
use Algorithm::Combinatorics qw(combinations);
use feature 'say';
my $m = shift(@ARGV) || die 'Please specify $m and $n';
my $n = shift(@ARGV) || die 'Please specify $n';
die "XX" unless int($m) == $m;
die "XX" unless int($n) == $n;
die "XX" unless $m > 0;
die "XX" unless $n > 0;
my @numbers = 1 .. $m;
my @answer;
my $iter = combinations(\@numbers, $n);
while (my $c = $iter->next)
{
push(@answer, "[" . join(",", @{$c}) . "]");
}
say "[ ", join(", ", @answer), " ]";
It is considerably longer than the Raku version, mostly caused by the parameter handling.
Running it:
$ perl numcom-perl 5 2
[ [1,2], [1,3], [1,4], [1,5], [2,3], [2,4], [2,5], [3,4], [3,5], [4,5] ]
$ perl numcom-perl 4 2
[ [1,2], [1,3], [1,4], [2,3], [2,4], [3,4] ]
$ perl numcom-perl 4 3
[ [1,2,3], [1,2,4], [1,3,4], [2,3,4] ]
Looking good.
$S. Write a script to print all possible letter combinations
that the given digit string could represent.
Input: $S = '35'
Output: ["dj", "dk", "dl", "ej", "ek", "el", "fj", "fk", "fl"].
The «0» and «#» buttons do not translate to anything, so I have ignored them.
File: letterphone
#! /usr/bin/env raku
unit sub MAIN ($S where $S.chars > 0); # [1]
my %button; # [2]
%button<1> = <_ , @>; # [2a]
%button<2> = <a b c>;
%button<3> = <d e f>;
%button<4> = <g h i>;
%button<5> = <j k l>;
%button<6> = <m n o>;
%button<7> = <p q r s>;
%button<8> = <t u v>;
%button<9> = <w x y z>;
%button<*> = (' ',); # [2b]
my @solutions; # [3]
off-we-go("", $S); # [4]
say "[", @solutions.map({ "\"{ $_ }\"" }).join(", "), "]" if @solutions;
# [5]
sub off-we-go ($so-far, $to-do) # [4]
{
if $to-do.chars == 0 # [6]
{
@solutions.push: $so-far; # [6a]
return; # [6b]
}
my $current = $to-do.substr(0,1); # [7]
my $remainder = $to-do.substr(1); # [8]
die "Illegal character $current" unless %button{$current}; # [9]
for @(%button{$current}) -> $character # [10]
{
off-we-go($so-far ~ $character, $remainder); # [11]
}
}
[1] Ensure that the input has at least one character. The legality of the characters is taken care of by [8].
[2]
This has has the mapping between the buttons and the
letters. The values are a list of letters [2a]. Note the last one, where we cannot use the
<…> Quote Words operator as it would throw away the single
space as a word separator. We want a list, so we use the List Operator
, to get one. The list has only one element, so it is given as a postfix
operator [2b].
[3] We collect the solutions here.
[4] Off we go, with this recursive call. The first parameter is the string so far, and the second is the digits we haven't parsed yet.
[5] As in «numcom», except that we wrap the inner strings in quotes instead of brackets.
[6] If we are done (no more digits to parse), add the string to the list of solutions [6a], and end this recursion [6b].
[7] Get the next digit,
[8] and remove it from the string of digits left to parse.
[9] Bail out if the digit is illegal.
[10] For each letter correpsonding to the current digit,
[11] • add it to the string and do a recursive call. Note that the string of digits left to parse is reduced by one character for each recursive call
See
docs.raku.org/routine/< >
for more information about the Quote Word operator < >.
See
docs.raku.org/routine/,
for more information about the list operator ,.
Running it:
$ raku letterphone 35
["dj", "dk", "dl", "ej", "ek", "el", "fj", "fk", "fl"]
$ raku letterphone 55
["jj", "jk", "jl", "kj", "kk", "kl", "lj", "lk", "ll"]
#! /usr/bin/env perl
use feature 'say';
use feature 'signatures';
no warnings qw(experimental::signatures);
my $S = shift(@ARGV) || die 'Specify $S';
my %button =
(
'1' => [ '_', ',', '@'],
'2' => [ 'a', 'b', 'c'],
'3' => [ 'd', 'e', 'f'],
'4' => [ 'g', 'h', 'i'],
'5' => [ 'j', 'k', 'l'],
'6' => [ 'm', 'n', 'o'],
'7' => [ 'p', 'q', 'r', 's'],
'8' => [ 't', 'u', 'v'],
'9' => [ 'w', 'x', 'y', 'z'],
'*' => [ ' ']
);
my @solutions;
off_we_go("", $S);
say "[", join(", ", map { "\"$_\"" } @solutions), "]" if @solutions;
sub off_we_go ($so_far, $to_do)
{
if (length($to_do) == 0)
{
push(@solutions, $so_far);
return;
}
my $current = substr($to_do, 0,1);
my $remainder = substr($to_do, 1);
die "Illegal character $current" unless $button{$current};
for my $character (@{$button{$current}})
{
off_we_go($so_far . $character, $remainder);
}
}
Running it:
$ perl letterphone-perl 35
["dj", "dk", "dl", "ej", "ek", "el", "fj", "fk", "fl"]
$ perl letterphone-perl 55
["jj", "jk", "jl", "kj", "kk", "kl", "lj", "lk", "ll"]
And that's it.