This is my response to The Weekly Challenge #303.
@ints.
Input: @ints = (2, 1, 3, 0)
Output: (102, 120, 130, 132, 210, 230, 302, 310, 312, 320)
Input: @ints = (2, 2, 8, 8, 2)
Output: (222, 228, 282, 288, 822, 828, 882)
In this program we get to use use both combinations and permutations.
Happy days...
#! /usr/bin/env raku
unit sub MAIN (*@ints where @ints.elems > 2 && all(@ints) eq any(0..9), # [1]
:v(:$verbose));
my @output; # [2]
for @ints.combinations(3).sort.unique(:with(&[eqv])) -> @comb # [3]
{
my @perms = @comb.permutations>>.join; # [4]
my @even3 = @perms.grep({ $_.substr(0,1) ne "0"
&& $_.substr(2,1) %% 2 }).unique; # [5]
say ": Comb: @comb[] -> Perms: @perms[] -> Even3: @even3[]" if $verbose;
@output.append: @even3; # [6]
}
say "({ @output.sort.squish.join(", ")})"; # [7]
[1] At least two elements, all of which are single digits (including zero) only.
[2] The result will end up here.
[3]
Iterate over all the three element combinations (the
(3 argument), sorted (as we want to play nice with verbose mode),
and without duplicates. Note the funny argument to unique, telling it
to do object value comparison with the eqv operator.
See docs.raku.org/routine/combinations for more information about combinations.
See docs.raku.org/routine/unique for more information about unique.
See docs.raku.org/routine/eqv for more information about eqv.
[4] Get the different sort orderings with permutations,
and join each of them together as strings.
See docs.raku.org/routine/permutations for more information about permutations.
[5] Use grep to get rid of values starting with a zero, or
ending with en odd digit, and get rid of duplicates here as well.
See docs.raku.org/routine/grep for more information about grep.
[6] Add the values to the result.
[7]
Pretty print the result, ordered and without dupliacate values. We can use
squish (instead of unique) to get rid of duplicates, as the values are ordered.
See docs.raku.org/routine/squish for more information about squish.
See docs.raku.org/routine/unique for more information about unique.
Note that squish will not work in [5], as those values are not sorted.
See the verbose mode output from the second example for an example.
Running it:
$ ./3-digits-even 2 1 3 0
(102, 120, 130, 132, 210, 230, 302, 310, 312, 320)
$ ./3-digits-even 2 2 8 8 2
(222, 228, 282, 288, 822, 828, 882)
Looking good.
With verbose mode:
$ ./3-digits-even -v 2 1 3 0
: Comb: 1 3 0 -> Perms: 130 103 310 301 013 031 -> Even3: 130 310
: Comb: 2 1 0 -> Perms: 210 201 120 102 021 012 -> Even3: 210 120 102
: Comb: 2 1 3 -> Perms: 213 231 123 132 321 312 -> Even3: 132 312
: Comb: 2 3 0 -> Perms: 230 203 320 302 023 032 -> Even3: 230 320 302
(102, 120, 130, 132, 210, 230, 302, 310, 312, 320)
$ ./3-digits-even -v 2 2 8 8 2
: Comb: 2 2 2 -> Perms: 222 222 222 222 222 222 -> Even3: 222
: Comb: 2 2 8 -> Perms: 228 282 228 282 822 822 -> Even3: 228 282 822
: Comb: 2 8 2 -> Perms: 282 228 822 822 228 282 -> Even3: 282 228 822
: Comb: 2 8 8 -> Perms: 288 288 828 882 828 882 -> Even3: 288 828 882
: Comb: 8 8 2 -> Perms: 882 828 882 828 288 288 -> Even3: 882 828 288
(222, 228, 282, 288, 822, 828, 882)
@ints.
ints[i] and delete it to earn ints[i] points.
Afterwards, you must delete every element equal to ints[i] - 1
and every element equal to ints[i] + 1.
Input: @ints = (3, 4, 2)
Output: 6
Delete 4 to earn 4 points, consequently, 3 is also deleted.
Finally delete 2 to earn 2 points.
Input: @ints = (2, 2, 3, 3, 3, 4)
Output: 9
Delete a 3 to earn 3 points. All 2's and 4's are also deleted too.
Delete a 3 again to earn 3 points.
Delete a 3 once more to earn 3 points.
#! /usr/bin/env raku
subset PosInt of Int where * >= 1; # [1a]
unit sub MAIN (*@ints where @ints.elems > 0 && all(@ints) ~~ PosInt, " # [1]
:v(:$verbose));
my %freq = @ints.Bag; # [2]
say ": Initial Status:\n", %freq.keys.sort.map({ ": - value $_ -> count "
~ %freq{$_} }).join("\n") if $verbose;
my $points = 0; # [3]
for %freq.keys.sort({ %freq{$_} * $_ }).reverse -> $current # [4]
{
next unless %freq{$current}; # [5]
my $prev = $current -1; # [6]
my $next = $current +1; # [7]
$points += $current * %freq{$current}; # [8]
if $verbose
{
say ": Deleted value $current (count %freq{$current}) -> Points: $points";
say ": - Deleted neighbour $prev" if %freq{$prev};
say ": - Deleted neighbour $next" if %freq{$prev};
}
%freq{$current} :delete; # [9]
%freq{$prev} :delete if defined %freq{$prev}; # [10]
%freq{$next} :delete if defined %freq{$next}; # [11]
}
say $points; # [12]
[1] Ensure at least one element, all of which must be positive integers. I have chosen to allow positive values only.
[2] The order of the values is irrelevant, so we get the frequenices by
coercing the input into a Bag. Then we coerce that into a hash by assigning
it to a hash variable.
[3] The number of points will end up here.
[4] Iterate over the unique values (courtesy of the hash), sorted by value multiplied with frequency - highest value first. This order gives us the values that will add the most to the total number of points up front.
[5] Skip the value if we have deleted it (in [10] or [11]), as a neighbour.
[6] The neighbour to the left.
[7] The neighbour to the right.
[8] Add the points we get by removing all the instances of the current value.
[9] Remove the value itself with :delete, which will remove the
hash entry. Just setting it to zero will not remove it.
See https://docs.raku.org/type/Hash#:delete
for more information about :delete.
[10] Remove the neighbour to the left, if it exists.
[11] Remove the neighbour to the right, if it exists.
[12] Print the result.
Running it:
$ ./delete-and-earn-1pass 3 4 2
6
$ ./delete-and-earn-1pass 2 2 3 3 3 4
9
Looking good.
With verbose mode:
$ ./delete-and-earn-1pass -v 3 4 2
: Initial Status:
: - value 2 -> count 1
: - value 3 -> count 1
: - value 4 -> count 1
: Deleted value 4 (count 1) -> Points: 4
: - Deleted neighbour 3
: - Deleted neighbour 5
: Deleted value 2 (count 1) -> Points: 6
6
$ ./delete-and-earn-1pass -v 2 2 3 3 3 4
: Initial Status:
: - value 2 -> count 2
: - value 3 -> count 3
: - value 4 -> count 1
: Deleted value 3 (count 3) -> Points: 9
: - Deleted neighbour 2
: - Deleted neighbour 4
9
Note that this approach works for the given examples. But it is easy to trip it up:
$ ./delete-and-earn-1pass -v 1 1 1 1 1 1 1 2 2 2 2 3 3
: Initial Status:
: - value 1 -> count 7
: - value 2 -> count 4
: - value 3 -> count 2
: Deleted value 2 (count 4) -> Points: 8
: - Deleted neighbour 1
: - Deleted neighbour 3
8
The correct answer is 13. And it should have strated by deleting either 1 or 3.
I believe the only way to fix this is to try all possible orders of deletion. This can be optimised if we get rid of values without neighbors first, and then do the rest as permutations.
File: 3-digits-even-multipass
#! /usr/bin/env raku
subset PosInt of Int where * >= 0;
unit sub MAIN (*@ints where @ints.elems > 0 && all(@ints) ~~ PosInt,
:v(:$verbose));
my %freq = @ints.BagHash;
say ": Initial Status:\n", %freq.keys.sort.map({ ": - value $_ -> count "
~ %freq{$_} }).join("\n") if $verbose;
my $base-points = 0; # [1]
for %freq.keys.sort -> $current
{
my $prev = $current -1;
my $next = $current +1;
next if %freq{$prev}; # [2]
next if %freq{$next}; # [2a]
$base-points += $current * %freq{$current};
say ": Deleted neighbourless value $current (count %freq{$current}) \
-> Points: $base-points" if $verbose;
%freq{$current} :delete;
}
say ": ------------------------------------------\n: Status after removing \
neighbourless values:\n",
%freq.keys.sort.map({ ": - value $_ -> count " ~ %freq{$_} }).join("\n")
if $verbose;
my $max = 0; # [3]
for %freq.keys.permutations -> @perm # [4]
{
say ": ------------------------------------------\n: Trying order @perm[]"
if $verbose;
my $points = resolve(%freq, @perm); # [5]
if $points > $max # [6]
{
$max = $points; # [6]
say ": + New max: { $base-points + $max }" if $verbose;
}
elsif $verbose
{
say ": - Not a new max: $points (max: { $base-points + $max })";
}
}
say $base-points + $max; # [7]
sub resolve (%freq is copy, @perm) # [8]
{
my $points = 0;
for @perm -> $current # [9]
{
next unless %freq{$current};
my $prev = $current -1;
my $next = $current +1;
$points += $current * %freq{$current};
if $verbose
{
say ": Deleted value $current (count %freq{$current}) -> \
Points: $points";
say ": Deleted neighbour $prev" if %freq{$prev};
say ": Deleted neighbour $next" if %freq{$prev};
}
%freq{$current} :delete;
%freq{$prev} :delete if defined %freq{$prev};
%freq{$next} :delete if defined %freq{$next};
}
return $points; # [10]
}
[1] This variable will hold the points after removing neighbourless values, if any.
[2] Skip this valute if it has a left or right [2a] neighbour.
[3] The current maximum of the permutations, initially zero.
[4] Get the remianing values (after removing neighbourless ones), and iterate over the
permutations (sort order). Note that i Did not sort the keys, so the order will
not be the same each time the program is run.
[5] Get the points for this permutation.
[6] Set as new maximum, if it is a new maximum.
[7] Print the result; the maximum in addition to the points from the neighbourless values.
[8] Note the is copy trait, so that we can change the hash in our local
copy.
See docs.raku.org/type/Parameter#method_copy for more information about is copy.
[9] Iterate over the given permutation.
[10] Return the result.
Running it, with verbose mode:
$ ./delete-and-earn-multipass -v 3 4 2
: Initial Status:
: - value 2 -> count 1
: - value 3 -> count 1
: - value 4 -> count 1
: ------------------------------------------
: Status after removing neighbourless values:
: - value 2 -> count 1
: - value 3 -> count 1
: - value 4 -> count 1
: ------------------------------------------
: Trying order 3 2 4
: Deleted value 3 (count 1) -> Points: 3
: Deleted neighbour 2
: Deleted neighbour 4
: + New max: 3
: ------------------------------------------
: Trying order 3 4 2
: Deleted value 3 (count 1) -> Points: 3
: Deleted neighbour 2
: Deleted neighbour 4
: - Not a new max: 3 (max: 3)
: ------------------------------------------
: Trying order 2 3 4
: Deleted value 2 (count 1) -> Points: 2
: Deleted value 4 (count 1) -> Points: 6
: + New max: 6
: ------------------------------------------
: Trying order 2 4 3
: Deleted value 2 (count 1) -> Points: 2
: Deleted value 4 (count 1) -> Points: 6
: - Not a new max: 6 (max: 6)
: ------------------------------------------
: Trying order 4 3 2
: Deleted value 4 (count 1) -> Points: 4
: Deleted neighbour 3
: Deleted neighbour 5
: Deleted value 2 (count 1) -> Points: 6
: - Not a new max: 6 (max: 6)
: ------------------------------------------
: Trying order 4 2 3
: Deleted value 4 (count 1) -> Points: 4
: Deleted neighbour 3
: Deleted neighbour 5
: Deleted value 2 (count 1) -> Points: 6
: - Not a new max: 6 (max: 6)
6
$ ./delete-and-earn-multipass -v 2 2 3 3 3 4
: Initial Status:
: - value 2 -> count 2
: - value 3 -> count 3
: - value 4 -> count 1
: ------------------------------------------
: Status after removing neighbourless values:
: - value 2 -> count 2
: - value 3 -> count 3
: - value 4 -> count 1
: ------------------------------------------
: Trying order 2 4 3
: Deleted value 2 (count 2) -> Points: 4
: Deleted value 4 (count 1) -> Points: 8
: + New max: 8
: ------------------------------------------
: Trying order 2 3 4
: Deleted value 2 (count 2) -> Points: 4
: Deleted value 4 (count 1) -> Points: 8
: - Not a new max: 8 (max: 8)
: ------------------------------------------
: Trying order 4 2 3
: Deleted value 4 (count 1) -> Points: 4
: Deleted neighbour 3
: Deleted neighbour 5
: Deleted value 2 (count 2) -> Points: 8
: - Not a new max: 8 (max: 8)
: ------------------------------------------
: Trying order 4 3 2
: Deleted value 4 (count 1) -> Points: 4
: Deleted neighbour 3
: Deleted neighbour 5
: Deleted value 2 (count 2) -> Points: 8
: - Not a new max: 8 (max: 8)
: ------------------------------------------
: Trying order 3 2 4
: Deleted value 3 (count 3) -> Points: 9
: Deleted neighbour 2
: Deleted neighbour 4
: + New max: 9
: ------------------------------------------
: Trying order 3 4 2
: Deleted value 3 (count 3) -> Points: 9
: Deleted neighbour 2
: Deleted neighbour 4
: - Not a new max: 9 (max: 9)
9
$ ./delete-and-earn-multipass -v 1 1 1 1 1 1 1 2 2 2 2 3 3
: Initial Status:
: - value 1 -> count 7
: - value 2 -> count 4
: - value 3 -> count 2
: ------------------------------------------
: Status after removing neighbourless values:
: - value 1 -> count 7
: - value 2 -> count 4
: - value 3 -> count 2
: ------------------------------------------
: Trying order 2 3 1
: Deleted value 2 (count 4) -> Points: 8
: Deleted neighbour 1
: Deleted neighbour 3
: + New max: 8
: ------------------------------------------
: Trying order 2 1 3
: Deleted value 2 (count 4) -> Points: 8
: Deleted neighbour 1
: Deleted neighbour 3
: - Not a new max: 8 (max: 8)
: ------------------------------------------
: Trying order 3 2 1
: Deleted value 3 (count 2) -> Points: 6
: Deleted neighbour 2
: Deleted neighbour 4
: Deleted value 1 (count 7) -> Points: 13
: + New max: 13
: ------------------------------------------
: Trying order 3 1 2
: Deleted value 3 (count 2) -> Points: 6
: Deleted neighbour 2
: Deleted neighbour 4
: Deleted value 1 (count 7) -> Points: 13
: - Not a new max: 13 (max: 13)
: ------------------------------------------
: Trying order 1 2 3
: Deleted value 1 (count 7) -> Points: 7
: Deleted value 3 (count 2) -> Points: 13
: - Not a new max: 13 (max: 13)
: ------------------------------------------
: Trying order 1 3 2
: Deleted value 1 (count 7) -> Points: 7
: Deleted value 3 (count 2) -> Points: 13
: - Not a new max: 13 (max: 13)
13
Looking good.
But permutations are time consuming. Can we optimize this?
The reverse order may lead to the same deletions?
1 2 3 4 5 vs 5 4 3 2 1 will both delete 1, 3 and 5.
(2 and 4 are deleted as neighbours.)
But 1 2 3 4 vs 4 3 2 1 will not; 1 and 3 vs 4 and 2.
So this works only if we have an odd number of elements. And only if all the values are neighbours...
So we have to check if all the values are neighbours for idea 1 to work. But then it would be better to do that initially, and split up the values into separate lists of neighbours and permute each one separately.
And that gives us this program, where we could remove the get rid of neighbourless values part.
File: delete-and-earn
#! /usr/bin/env raku
subset PosInt of Int where * >= 0;
unit sub MAIN (*@ints where @ints.elems > 0 && all(@ints) ~~ PosInt,
:v(:$verbose));
my %freq = @ints.BagHash;
say ": Initial Status:\n", %freq.keys.sort.map({ ": - value $_ -> count "
~ %freq{$_} }).join("\n") if $verbose;
my $points = 0; # [1]
my @sorted = %freq.keys.sort; # [2]
my @current = (@sorted.shift,); # [3]
while @sorted || @current # [4]
{
my $next = @sorted.elems ?? @sorted.shift !! Nil; # [5]
if !$next || @current.tail +1 != $next # [6]
{
my $add = resolve-wrap(@current); # [7]
$points += $add; # [8]
if $verbose
{
say ": ------------------------------------------";
say ": Adding $add points -> $points from ({ @current.join(",") })";
}
@current = (); # [9]
}
@current.push: $next if $next; # [10]
}
say $points; # [11]
sub resolve-wrap (@current where [<] @current) # [12]
{
my $max = 0; # [13]
say ": ------------------------------------------" if $verbose;
for @current.permutations -> @perm # [14]
{
say ": ------------------------------------------" if $verbose;
if @perm.elems % 2 && @perm.head > @perm.tail # [15]
{
say ": Skipped order @perm[] and onwards as the reverse has been done"
if $verbose;
last; # [15a]
}
say ": Trying order @perm[]" if $verbose;
my $points-add = resolve(%freq, @perm); # [16]
if $points-add > $max # [17]
{
$max = $points-add; # [17a]
say ": + New max: { $max }" if $verbose;
}
elsif $verbose
{
say ": - Not a new max: $points-add (current max: $max)";
}
}
%freq{$_} :delete for @current; # [18]
return $max; # [19]
}
sub resolve (%freq is copy, @perm)
{
my $points = 0;
for @perm -> $current
{
next unless %freq{$current};
my $prev = $current -1;
my $next = $current +1;
$points += $current * %freq{$current};
if $verbose
{
say ": Deleted value $current (count %freq{$current}) -> \
Points: $points";
say ": Deleted neighbour $prev" if %freq{$prev};
say ": Deleted neighbour $next" if %freq{$prev};
}
%freq{$current} :delete;
%freq{$prev} :delete if defined %freq{$prev};
%freq{$next} :delete if defined %freq{$next};
}
return $points;
}
[1] We are adding to the (global) points as we work along with the input, one block (as in «neighbours») at a time.
[2] The unique values, sorted.
[3] The current neighbours, starting with the first value.
[4] As long as there is more to do (more values, or something in @current, so that
we do not have to repeat [7-9] after the loop to process the last one.
[5] Get the next element, or Nil if there isn't any.
[6] If the next value is not a neighbour (or there isn't a next value at all),
[7] • Get the number of points from the current list.
[8] • Add that number to the total.
[9] • Clear the buffer.
[10] Add the next value to the buffer, if it exists. This is either the first value, or a new neighbour added to existing values.
[11] Print the result.
[12] This wrapper procedure will try all the
permutations of the input, and return the maximum number of points. The input must be
sorted for this (see [15]) to work, so we enforce that with the where clause and
the Reduction Metaoperator [] in combination with < (a normal
«less than»).
See
docs.raku.org/language/operators#Reduction_metaoperators for more
information about the Reduction Metaoperator [].
[13] Zero points is the initial maximum.
[14] Iterate over all the permutations.
[15] head
tail Skip the rest of the permutations ([15a]) if the number of values is odd,
and the first value (head) is larger than the last one (tail).
See docs.raku.org/routine/head for more information about head.
See docs.raku.org/routine/tail for more information about tail.
[16] Get the number of points from this sort order.
[17] A new maximum? If so, update it [17a].
[18] Remove the values treated this time, so that future iteration know about the changes.
[19] Return the result.
Running it gives the expected result, here with verbose mode:
$ ./delete-and-earn -v 3 4 2
: Initial Status:
: - value 2 -> count 1
: - value 3 -> count 1
: - value 4 -> count 1
: ------------------------------------------
: ------------------------------------------
: Trying order 2 3 4
: Deleted value 2 (count 1) -> Points: 2
: Deleted value 4 (count 1) -> Points: 6
: + New max: 6
: ------------------------------------------
: Trying order 2 4 3
: Deleted value 2 (count 1) -> Points: 2
: Deleted value 4 (count 1) -> Points: 6
: - Not a new max: 6 (current max: 6)
: ------------------------------------------
: Trying order 3 2 4
: Deleted value 3 (count 1) -> Points: 3
: Deleted neighbour 2
: Deleted neighbour 4
: - Not a new max: 3 (current max: 6)
: ------------------------------------------
: Skipped order 3 4 2 and onwards as the reverse has been done
: ------------------------------------------
: Adding 6 points -> 6 from (2,3,4)
6
$ ./delete-and-earn -v 2 2 3 3 3 4
: Initial Status:
: - value 2 -> count 2
: - value 3 -> count 3
: - value 4 -> count 1
: ------------------------------------------
: ------------------------------------------
: Trying order 2 3 4
: Deleted value 2 (count 2) -> Points: 4
: Deleted value 4 (count 1) -> Points: 8
: + New max: 8
: ------------------------------------------
: Trying order 2 4 3
: Deleted value 2 (count 2) -> Points: 4
: Deleted value 4 (count 1) -> Points: 8
: - Not a new max: 8 (current max: 8)
: ------------------------------------------
: Trying order 3 2 4
: Deleted value 3 (count 3) -> Points: 9
: Deleted neighbour 2
: Deleted neighbour 4
: + New max: 9
: ------------------------------------------
: Skipped order 3 4 2 and onwards as the reverse has been done
: ------------------------------------------
: Adding 9 points -> 9 from (2,3,4)
9
$ ./delete-and-earn -v 1 1 1 1 1 1 1 2 2 2 2 3 3
: Initial Status:
: - value 1 -> count 7
: - value 2 -> count 4
: - value 3 -> count 2
: ------------------------------------------
: ------------------------------------------
: Trying order 1 2 3
: Deleted value 1 (count 7) -> Points: 7
: Deleted value 3 (count 2) -> Points: 13
: + New max: 13
: ------------------------------------------
: Trying order 1 3 2
: Deleted value 1 (count 7) -> Points: 7
: Deleted value 3 (count 2) -> Points: 13
: - Not a new max: 13 (current max: 13)
: ------------------------------------------
: Trying order 2 1 3
: Deleted value 2 (count 4) -> Points: 8
: Deleted neighbour 1
: Deleted neighbour 3
: - Not a new max: 8 (current max: 13)
: ------------------------------------------
: Skipped order 2 3 1 and onwards as the reverse has been done
: ------------------------------------------
: Adding 13 points -> 13 from (1,2,3)
13
And that's it.