Distribute Positions with Raku
[290] Published 26. May 2024.This is my response to The Weekly Challenge #270.
Challenge #270.1: Special Positions
m x n binary matrix.
Write a script to return the number of special positions in the given binary matrix.
A position (i, j) is called special if $matrix[i][j] == 1 and all other elements in the row i and column j are 0.
Example 1:
Input: $matrix = [ [1, 0, 0],
[0, 0, 1],
[1, 0, 0],
]
Output: 1
There is only one special position (1, 2) as $matrix[1][2] == 1
and all other elements in row 1 and column 2 are 0.
Input: $matrix = [ [1, 0, 0],
[0, 1, 0],
[0, 0, 1],
]
Output: 3
Special positions are (0,0), (1, 1) and (2,2).
#! /usr/bin/env raku
unit sub MAIN ($string = "1 0 0 | 0 0 1 | 1 0 0", # [1]
:v(:$verbose));
my $matrix = $string.split("|")>>.words>>.Int>>.Array; # [2]
die "The rows must have the same size" unless [==] $matrix>>.elems; # [3]
die "Must contain 0s and 1s only" unless all($matrix[*;*]) ~~ one(0,1); # [4]
my $rows = $matrix.elems; # [5]
my $cols = $matrix[0].elems; # [6]
my $count = 0; # [7]
say ": matrix: $matrix" if $verbose;
for ^$rows -> $row # [8]
{
for ^$cols -> $col # [9]
{
my $val = $matrix[$row][$col]; # [10]
my $row_sum = $matrix[$row;*].sum; # [11]
my $col_sum = $matrix[*;$col].sum; # [12]
say ": r: $row c: $col v: $val row: $matrix[$row;*] -> \
$row_sum col: $matrix[*;$col] -> $col_sum" if $verbose;
next unless $val == 1; # [13]
next unless $row_sum == 1; # [14]
next unless $col_sum == 1; # [15]
$count++; # [16]
say ": - is Special #$count" if $verbose;
}
}
say $count; # [17]
[1] A default matrix.
[2] Turn the given «matrix as a string» into a two dimentional array.
Note the coercion of the IntStr values we get from words into Int,
as this will make verbose mode look nicer.
[3] Ensure that all the rows ($matrix>>.elems) in the matrix
have the same length ([==]).
[4] We pick all the values from the matrix (as a one dimentional array)
with $matrix[*;*] and ensures that all the values are either 0 or 1.
[5] The number of rows.
[6] The number of columns.
[7] The result will end up here.
[8] Iterate over all the row indices.
[9] Iterate over all the column indices.
[10] Get the value at the current position.
[11] Get the sum of the current row. Note the handy $matrix[$row;*]
syntax to get the row values.
[12] Get the sum of the current column.
[13] Skip the current position if the value is not 1.
[14] Skip the current position if the row sum is not 1. I.e. that the value itself is 1, and the rest of the row is filled with zeroes.
[15] Ditto for the column.
[16] We have found a special position.
[17] Print the number of special positions found.
Running it:
$ ./special-positions
1
$ ./special-positions "1 0 0 | 0 1 0 | 0 0 1"
3
Looking good.
With verbose mode:
$ ./special-positions -v
: matrix: 1 0 0 0 0 1 1 0 0
: r: 0 c: 0 v: 1 row: 1 0 0 -> 1 col: 1 0 1 -> 2
: r: 0 c: 1 v: 0 row: 1 0 0 -> 1 col: 0 0 0 -> 0
: r: 0 c: 2 v: 0 row: 1 0 0 -> 1 col: 0 1 0 -> 1
: r: 1 c: 0 v: 0 row: 0 0 1 -> 1 col: 1 0 1 -> 2
: r: 1 c: 1 v: 0 row: 0 0 1 -> 1 col: 0 0 0 -> 0
: r: 1 c: 2 v: 1 row: 0 0 1 -> 1 col: 0 1 0 -> 1
: - is Special #1
: r: 2 c: 0 v: 1 row: 1 0 0 -> 1 col: 1 0 1 -> 2
: r: 2 c: 1 v: 0 row: 1 0 0 -> 1 col: 0 0 0 -> 0
: r: 2 c: 2 v: 0 row: 1 0 0 -> 1 col: 0 1 0 -> 1
1
$ ./special-positions -v "1 0 0 | 0 1 0 | 0 0 1"
: matrix: 1 0 0 0 1 0 0 0 1
: r: 0 c: 0 v: 1 row: 1 0 0 -> 1 col: 1 0 0 -> 1
: - is Special #1
: r: 0 c: 1 v: 0 row: 1 0 0 -> 1 col: 0 1 0 -> 1
: r: 0 c: 2 v: 0 row: 1 0 0 -> 1 col: 0 0 1 -> 1
: r: 1 c: 0 v: 0 row: 0 1 0 -> 1 col: 1 0 0 -> 1
: r: 1 c: 1 v: 1 row: 0 1 0 -> 1 col: 0 1 0 -> 1
: - is Special #2
: r: 1 c: 2 v: 0 row: 0 1 0 -> 1 col: 0 0 1 -> 1
: r: 2 c: 0 v: 0 row: 0 0 1 -> 1 col: 1 0 0 -> 1
: r: 2 c: 1 v: 0 row: 0 0 1 -> 1 col: 0 1 0 -> 1
: r: 2 c: 2 v: 1 row: 0 0 1 -> 1 col: 0 0 1 -> 1
: - is Special #3
3
Challenge #270.2: Distribute Elements
@ints and two integers, $x and
$y.
Write a script to execute one of the two options:
- Level 1
- Pick an index i of the given array and do $ints[i] += 1
- Level 2
- Pick two different indices i,j and do $ints[i] +=1 and $ints[j] += 1
$x and $y for Level 2.
In the end return the minimum cost to get the work done.
Example 1:
Input: @ints = (4, 1), $x = 3 and $y = 2
Output: 9
Level 1: i=1, so $ints[1] += 1.
@ints = (4, 2)
Level 1: i=1, so $ints[1] += 1.
@ints = (4, 3)
Level 1: i=1, so $ints[1] += 1.
@ints = (4, 4)
We perforned operation Level 1, 3 times.
So the total cost would be 3 x $x => 3 x 3 => 9
Input: @ints = (2, 3, 3, 3, 5), $x = 2 and $y = 1
Output: 6
Level 2: i=0, j=1, so $ints[0] += 1 and $ints[1] += 1
@ints = (3, 4, 3, 3, 5)
Level 2: i=0, j=2, so $ints[0] += 1 and $ints[2] += 1
@ints = (4, 4, 4, 3, 5)
Level 2: i=0, j=3, so $ints[0] += 1 and $ints[3] += 1
@ints = (5, 4, 4, 4, 5)
Level 2: i=1, j=2, so $ints[1] += 1 and $ints[2] += 1
@ints = (5, 5, 5, 4, 5)
Level 1: i=3, so $ints[3] += 1
@ints = (5, 5, 5, 5, 5)
We perforned operation Level 1, 1 time and Level 2, 4 times.
So the total cost would be (1 x $x) + (4 x $y) => (1 x 2) + (4 x 1) => 6
The challenge is only interested in cost, so the number of operations does not matter. One «Level 2» operation has the same effect on the array as two «Level 1» operations, so we should use the former only if the cost is lower than two «Level 1» operations.
The challenge does not state that the integers should be non-negative, but I have decided to do so. The costs should be positive only, as I do not think zero would be appropriate.
The restriction on different indices in the «Level 2» operation are a cause of some headache, so we will have to pick them with some care. An example of why this is important:
Here we have a seemingly random array, and a «Level 2» operation (cost:3) is cheaper than two «Level 1» operations (2x cost:2). In the «Ad Hoch approach» we pick two non-target numbers from the left, until we have run out of «Level 2» operation possibilities. Then we do the rest with «Level 1» operations.
The «Smart approach» shows that we will get a lower total cost if we do a smarter index picking. (We can just pick the two currently lowest values in the array each time.)
Let us start with a very short program, where we ignore the restriction on different values for the two indices in the «Level 2» operation. Then we can actually ignore the indices alltogether, and just inspect the values - or rather the differences to the target value.
File: distribute-elements-same
#! /usr/bin/env raku
unit sub MAIN (UInt :$x where $x > 0 = 2, # [1]
UInt :$y where $y > 0 = 3, # [1a]
*@ints, # [2]
:v(:$verbose));
die "Non-negative integers only" unless all(@ints) ~~ UInt; # [3]
my $target = @ints.max; # [4]
my $cost = 0; # [5]
my $delta = @ints.map( $target - * ).sum; # [6]
say ": Delta: $delta" if $verbose;
if $x + $x > $y # [7]
{
my $operations = $delta div 2; # [7a]
$cost = $operations * $y; # [7b]
$delta -= $operations * 2; # [7c]
}
$cost += $delta * $x if $delta; # [8]
say $cost; # [9]
[1] Named arguments for the «x» and «y» values, as positive integers.
[2] A slurpy array for the integers.
[3] Ensure that the array contains non-negative integers only.
[4] The target value is the highest value in the array.
[5] The total cost wil lend up here.
[6] We use map to transform each value into the number
of steps needed to reach the target. Then we add them all together with
sum, giving us the number of additions needed to reach the goal,
here called delta.
See docs.raku.org/routine/map for more information about map.
[7] Is the «Level 2» operation cheaper than doing two «Level 1»
operations? If so, calculate the number of «Level 2» operations (half the
delta), and note the integer division with div - as we need two indices
for each operation [7a]. Set the cost [7b], and adjust the delta [7c].
See docs.raku.org/routine/div for more information about div.
[8] Add «Level 1» operations to fix the rest.
[9] print the result.
Running it gives a result that is wrong, as the two indices for each of the 50 «Level 2» operations are the same:
$ ./distribute-elements-same -v 100
: Delta: 100
150
(The correct answer is 200.)
Let us try to answer the question, whilst still cutting corners. I.e. ignoring the indices. Actually rendering them irrelevant by shuffling the values around willy-nilly.
File: distribute-elements
#! /usr/bin/env raku
unit sub MAIN (UInt :$x where $x > 0 = 2,
UInt :$y where $y > 0 = 3,
*@ints,
:v(:$verbose));
die "Non-negative integers only" unless all(@ints) ~~ UInt;
my @todo = @ints.sort; # [1]
say ": Sorted: @todo[]" if $verbose;
my $target = @todo.pop; # [2]
my $cost = 0; # [3]
say ": Target: $target" if $verbose;
if $x + $x > $y # [4]
{
loop # [5]
{
last unless @todo.elems >= 2; # [6]
my $first = @todo.shift; # [7]
next if $first == $target; # [8]
my $second = @todo.shift; # [9]
if $second == $target # [10]
{
@todo.push: $first; # [10a]
last; # [10b]
}
$cost += $y; # [11]
say ": Level 2: Add cost: $y for bringing $first to { $first + 1 } \
and $second to { $second +1 } -> todo: @todo[]" if $verbose;
$first++; # [12]
$second++; # [12a]
@todo.push: $first unless $first == $target; # [13]
@todo.push: $second unless $second == $target; # [13a]
@todo .= sort; # [14]
}
}
for @todo -> $candidate # [15]
{
my $delta = $target - $candidate; # [16]
$cost += $delta * $x; # [17]
say ": Level 1: Add cost: { $delta * $x } ($delta * $x) for bringing \
$candidate to $target" if $verbose;
}
say $cost; # [18]
[1] This variable will contain the unfinished values (i.e. those that have not reached the target), in sorted order.
[2] Get the target, by removing it from the end of the array
with pop.
See docs.raku.org/routine/pop for more information about pop.
[3] The total cost will end up here.
[4] is it chreaper to perform one «Level 2» operation than two «Level 1» operations?
[5] An eternal loop.
[6] Exit the loop if we do not have enough values to do a «Level 2» operation.
[7] Get the lowest value.
[8] Exit the loop if the lowest value has reached the target. This means that the array consist of target values only.
[9] Get a second lowest value.
[10] Is the second value at the target? If so, push the non-target first value back onto the array [10a] and exit the loop [10b].
[11] We can do a «Level 2» operation now; add the cost.
[12] Increase the two values.
[13] Push the values back onto the array if they have not reached the target.
[14] Sort the array again.
[15] We have finished with the «Level 2» operations (if any), Now we do the «Level 1» operations. We iterate over the values.
[16] Get the delta, the difference between the value and the target.
[17] Add the cost of those operations.
[18] Print the result.
Running it:
$ ./distribute-elements -x=3 -y=2 4 1
9
$ ./distribute-elements -x=2 -y=1 2 3 3 3 5
6
Looking good.
With verbose mode:
$ ./distribute-elements -v -x=3 -y=2 4 1
: Sorted: 1 4
: Target: 4
: Add cost: 9 (3 * 3) for bringing 1 to 4
9
$ ./distribute-elements -v -x=2 -y=1 2 3 3 3 5
: Sorted: 2 3 3 3 5
: Target: 5
: Level 2: Add cost: 1 for bringing 2 to 3 and 3 to 4 -> todo: 3 3
: Level 2: Add cost: 1 for bringing 3 to 4 and 3 to 4 -> todo: 3 4
: Level 2: Add cost: 1 for bringing 3 to 4 and 4 to 5 -> todo: 4 4
: Level 2: Add cost: 1 for bringing 4 to 5 and 4 to 5 -> todo: 4
: Level 1: Add cost: 2 (1 * 2) for bringing 4 to 5
6
Let us uncut the corners, and work with indices:
File: distribute-elements-index
#! /usr/bin/env raku
unit sub MAIN (UInt :$x where $x > 0 = 2,
UInt :$y where $y > 0 = 3,
*@ints is copy,
:v(:$verbose));
die "Non-negative integers only" unless all(@ints) ~~ UInt;
my $target = @ints.max;
my $cost = 0;
say ": Target: $target" if $verbose;
if $x + $x > $y
{
loop
{
last if all(@ints) == $target; # [1]
last if @ints.grep( * eq $target ).elems == @ints.elems -1; # [2]
say ": Ints: @ints[]" if $verbose;
my @pairs = @ints.pairs.sort({ $^a.value <=> $^b.value }); # [3]
my $first_idx = @pairs[0].key; # [4]
my $second_idx = @pairs[1].key; # [4a]
say ": Level 2: Add cost: $y for bringing \@ints[$first_idx] from \
{ @ints[$first_idx] } to { @ints[$first_idx] +1 } and \
@ints[$second_idx] from { @ints[$second_idx] } to \
{ @ints[$second_idx] +1 }" if $verbose;
$cost += $y;
@ints[$first_idx]++; # [5]
@ints[$second_idx]++; # [5a]
}
}
say ": Ints after level 2: @ints[]" if $verbose;
for ^@ints.elems -> $index # [6]
{
my $delta = $target - @ints[$index];
next unless $delta;
$cost += $delta * $x;
say ": Level 1: Add cost: { $delta * $x } ($delta times $x) for \
bringing \@ints[$index] from { $target - $delta } to $target" if $verbose;
}
say $cost;
[1] We are not removing values from the array this time, so the goal is to end up with target values only.
[2] Do have a single non-target value? If so, exit the loop and leave the rest to Level 1.
[3] Applying pairs on an array gives us pair objects,
where the key is the original index, and the value is the original value. We
sort them by the values.
See docs.raku.org/routine/pairs for more information about pairs.
[4] Get the index of the lowest value, and the next one [4a].
[5] Update the values, in the original array.
[6] Iterate over the indices.
Running it:
$ ./distribute-elements-index -x=3 -y=2 4 1
9
$ ./distribute-elements-index -x=2 -y=1 2 3 3 3 5
6
Looking good.
With verbose mode:
$ ./distribute-elements-index -x=3 -y=2 -v 4 1
: Target: 4
: Ints after level 2: 4 1
: Level 1: Add cost: 9 (3 times 3) for bringing @ints[1] from 1 to 4
9
$ ./distribute-elements-index -v -x=2 -y=1 2 3 3 3 5
: Target: 5
: Ints: 2 3 3 3 5
: Level 2: Add cost: 1 for bringing @ints[0] from 2 to 3 and @ints[1] from 3 to 4
: Ints: 3 4 3 3 5
: Level 2: Add cost: 1 for bringing @ints[0] from 3 to 4 and @ints[2] from 3 to 4
: Ints: 4 4 4 3 5
: Level 2: Add cost: 1 for bringing @ints[3] from 3 to 4 and @ints[0] from 4 to 5
: Ints: 5 4 4 4 5
: Level 2: Add cost: 1 for bringing @ints[1] from 4 to 5 and @ints[2] from 4 to 5
: Ints after level 2: 5 5 5 4 5
: Level 1: Add cost: 2 (1 times 2) for bringing @ints[3] from 4 to 5
6
And that's it.