Perl Weekly Challenge: Week 124
Challenge 1:
Happy Women Day
Write a script to print the Venus Symbol, international gender symbol for women. Please feel free to use any character.
^^^^^
^ ^
^ ^
^ ^
^ ^
^ ^
^ ^
^ ^
^ ^
^ ^
^^^^^
^
^
^
^^^^^
^
^
This was a very interesting problem though I fear I have done a very hacky job of solving it. There was a lot of jiggling "magic numbers" and while I did end up with something looking close to the desired result (on my terminal atleast) I'm not sure if it will look proper on anyone elses.
There are two parts to the symbol, the circle and the cross. I drew both of these in separate functions.
the circle() function in Raku takes two parameters, the radius of the circle we wish to draw and the character to draw it with.
Note $c doesn't have a type. That's because apparently there isn't a character type in Raku. That doesn't sound right to me
and I should investigate further but at that momenet I didn't.
sub circle(Int $radius, $c) {
The next line introduces a scaling factor for the width of the circle. Without it, it just came out looking oval. I arrived at the number 6 just by playing about until I found something that made the circle look goood.
my $widthScale = 6;
The width of the circle has to be atleast twice the radius and then some. As I said, the scale factor was not all derived scientifically. The 0.5 was added to deal with radii of odd length. This entire number will be rounded to an integer via the .Int() method. Finally 3 is added to the width just so the circle is not printed flush against the left edge of the screen.
my $width = 3 + (0.5 + $widthScale * $radius).Int;
We are also going to need the value of the radius squared so it is calculated on this next line.
my $radius2 = $radius ** 2;
Now the actual width of the circle (opposing points on the circumference) are going to range from -$radius (far left) to $radius
(far right.) We express this, naturally, with a range.
for -$radius .. ($radius) -> $y {
Now we have the y-coordinate, we can derive the x-coordinate by subtracting the square of $y from the square of the radius and taking the square root of the result. There is some added complication due to scaling and the whole thing has to be converted to an integer so the value of $x we get will only be an approximation.
my $x = (0.5 + ($widthScale * ($radius2 - $y ** 2)) ** 0.5).Int;
Now we can print out a line of the circle. First we print some blank spaces. Again, I just messed with the formula until the
result look good. We only want to print the circumference so one $c character is printed, then blank spaces in the interior of the circle and then another $c for the other side.
say ' ' x (($width div 2) - $x), $c, ' ' x (2 * $x - 4), $c;
}
}
The cross function is much simpler. Once again we take two parameters, the height of the cross, and the printing character.
sub cross(Int $height, $c) {
Also as in circle() we need a scaling factor for the width.
my $widthScale = 6;
The width is calculated based on the heght and uses the same formula as in circle().
my $width = 3 + (0.5 + $widthScale * $height).Int;
Now I am not sure I really need this value.
my $height2 = $height ** 2;
for 0 .. $height -> $y {
We want the vertical bar of the cross to appear about 2/3 of the way down its height.
if $y == ($height * 2 / 3).Int {
But this calculation of its width is probably way more complicated than it needs to be.
my $x = (0.5 + ($widthScale * ($height2 - $y ** 2)) ** 0.5).Int;
say ' ' x $width div 3 - 2, $c x (3 * $x / 2).Int;
If we are not doing the vertical bar, it's easy. Just skip some spaces and print a single $c character. But even here I think
I should have shunted it one space to the left now that I look at the result.
} else {
say ' ' x ($width div 2), $c;
}
}
}
So there you have it. I do have a result that is mostly ok but God knows this is not code I'll be showcasing anywhere.
These are the Perl versions of the two functions above.
sub circle {
my ($radius, $c) = @_;
my $widthScale = 6;
my $width = 3 + int(0.5 + $widthScale * $radius);
my $radius2 = $radius ** 2;
for my $y (-$radius .. $radius) {
my $x = (0.5 + ($widthScale * int($radius2 - $y ** 2)) ** 0.5);
The only comment I have is after my initial translation from Raku, I got the warning Negative repeat count does nothing two times
which is very unsightly if nothing else. I fixed it by adding the following three lines.
if ($x < 2) {
$x = 2;
}
say ' ' x (($width / 2) - $x), $c, ' ' x (2 * $x - 4), $c;
}
}
sub cross {
my ($height, $c) = @_;
my $widthScale = 6;
my $width = 3 + int(0.5 + $widthScale * $height);
my $height2 = $height ** 2;
for my $y (0 .. $height) {
if ($y == int ($height * 2 / 3)) {
my $x = (0.5 + ($widthScale * int($height2 - $y ** 2)) ** 0.5);
say ' ' x ($width / 3 - 2), $c x int(3 * $x / 2);
} else {
say ' ' x ($width / 2), $c;
}
}
}
Challenge 2:
Tug of War
You are given a set of
$nintegers (n1, n2, n3, ….).Write a script to divide the set in two subsets of n/2 sizes each so that the difference of the sum of two subsets is the least. If $n is even then each subset must be of size $n/2 each. In case $n is odd then one subset must be ($n-1)/2 and other must be ($n+1)/2.
Example
Input: Set = (10, 20, 30, 40, 50, 60, 70, 80, 90, 100)
Output: Subset 1 = (30, 40, 60, 70, 80)
Subset 2 = (10, 20, 50, 90, 100)
Input: Set = (10, -15, 20, 30, -25, 0, 5, 40, -5)
Subset 1 = (30, 0, 5, -5)
Subset 2 = (10, -15, 20, -25, 40)
According to my Google research there are more elegant ways of solving this challenge but I chickened out and went with a brute-force approach. It works well enough for the examples but it would probably be too inefficient for very large input.
Anyway, I start by calculating the lengths of the two subsets. If the length of @n is even, these two parts will be equal in
length. If it is odd, the second part will be one element larger than the the first.
my $part1 = @n.elems div 2;
my $part2 = @n.elems - $part1;
I also setup some variables for tracking which is the best solution we have gotten so far.
my (@best1, @best2);
my $bestdiff = Inf;
Then we find all the permutations of @n.
for @n.permutations -> @perm {
Each permutation is split into two subsets based on the lengths already calculated as $part1 and $part2.
my @subset1 = @perm[0 .. $part1 - 1];
my @subset2 = @perm[$part2 - 1 .. *];
The elements of each subset are totalled up using one of my favorite raku features the [+] operator.
my $total1 = [+] @subset1;
my $total2 = [+] @subset2;
The difference between the two totals is calculated.
my $diff = abs($total1 - $total2);
And if the difference is smaller than the best we have seen so far, it becomes the new best and the two subsets are also saved.
if $diff < $bestdiff {
$bestdiff = $diff;
@best1 = @subset1;
@best2 = @subset2;
If the $bestdiff is 0, we can't do any better so we may as well stop. (Though there can be multiple best permutations.)
if $bestdiff == 0 {
last;
}
}
}
When we have our answer, it is printed out in the format suggested by the spec.
say "Subset 1 = (", @best1.sort.join(q{, }), q{)};
say "Subset 2 = (", @best2.sort.join(q{, }), q{)};
This is the Perl version. It uses the permute() function from perlfaq4 I have used so many times in the past. It also uses a sum() function I wrote to replace the use of [+].
my $part1 = scalar @n / 2;
my (@best1, @best2);
my $bestdiff = 'inf';
my @permutations;
permute { push @permutations, \@_; } @n;
for my $perm (@permutations) {
While "zen slices" of arrays can be used in Perl as well as Raku I chose to use the splice() function here instead. It removes
elements from an array so as a result, an explicit $part2 variable isn't needed.
my @subset1 = splice @{$perm}, 0, $part1;
my @subset2 = @{$perm};
my $total1 = sum \@subset1;
my $total2 = sum \@subset2;
my $diff = abs($total1 - $total2);
if ($diff < $bestdiff) {
$bestdiff = $diff;
@best1 = @subset1;
@best2 = @subset2;
if ($bestdiff == 0) {
last;
}
}
}
say "Subset 1 = (", ( join q{, }, sort { $a <=> $b } @best1) , q{)};
say "Subset 2 = (", ( join q{, }, sort { $a <=> $b } @best2 ), q{)};