Can't Think of a Pithy Title: Perl Weekly Challenge #124
TASK #1 › Happy Women Day
Submitted by: Mohammad S Anwar Write a script to print the Venus Symbol, international gender symbol for women. Please feel free to use any character.
^^^^^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^^^^^ ^ ^ ^ ^^^^^ ^ ^
Want to draw a circle? That’s 360 degrees, but many things in math are easier to handle in radians, so we convert to radians. Decide the radius, and you can use the radians and the radius to draw the whole thing. I’m putting this into a two-dimensional array, so we’ll int everything. There’s no such thing as $x[0.2342346], right?
Once we’ve got that done, we draw the tail, but that’s easy. A problem is that text characters are taller than wide, so I add a space to make ‘em look less drawn out, like a Cinemascope movie projected with the wrong lens.
(What I graph as X and Y are a bit off of what plotting software think of, but if the circles are rough.)
After that, it’s simple math to draw the tail, as long as you know where the center and the lowest point are.
Show Me The Code!
#!/usr/bin/env perl
use feature qw{say state signatures};
use strict;
use warnings;
use utf8;
no warnings qw{ experimental };
use constant pi => 3.14159;
my $clear = ' ';
my $filled = ' #';
my @venus;
for my $i ( 0 .. 50 ) {
for my $j ( 0 .. 40 ) {
$venus[$i][$j] = $clear;
}
}
my $maxx = 0;
for my $d ( 0 .. 360 ) {
my $r = deg2rad($d);
my $len = 11;
my $x = 19 + int xPos( $len, $r );
my $y = 19 - int yPos( $len, $r );
$venus[$x][$y] = $filled;
$maxx = $x > $maxx ? $x : $maxx;
}
for my $i ( 0 .. 10 ) {
$venus[ $maxx + $i ][19] = $filled;
$venus[ $maxx + 5 ][ 24 - $i ] = $filled;
}
for my $row (@venus) {
say join '', $row->@*;
}
sub deg2rad ($degrees) {
return ( $degrees / 180 ) * pi;
}
sub xPos ( $len = 10, $rad = 0 ) {
return $len * sin $rad;
}
sub yPos ( $len = 10, $rad = 0 ) {
return $len * cos $rad;
}
# # # # # # # # #
# # # # # #
# # # #
# # # #
# # # #
# #
# # # #
# #
# #
# #
# # #
# #
# #
# #
# # # #
# #
# # # #
# # # #
# # # #
# # # # # #
# # # # # # # # #
#
#
#
#
# # # # # # # # # # #
#
#
#
#
#
TASK #2 › Tug of War
Submitted by: Mohammad S Anwar
You are given a set of$nintegers (n1, n2, n3, ….).Write a script to divide the set in two subsets of
n/2sizes each so that the difference of the sum of two subsets is the least. If$nis even then each subset must be of size$n/2each. In case$nis odd then one subset must be($n-1)/2and other must be($n+1)/2.
This looks like a job … for Algorithm::Permute. With reservations.
Permute is a common go-to module for me, because what it does is so useful for these challenges. Give it an arrayref and it gives you every possible variation. Given A B C, for example, you get
C B A
B C A
B A C
C A B
A C B
A B C
With (10, 20, 30, 40, 50, 60, 70, 80, 90, 100) as a set, the first split is going to be (10, 20, 30, 40, 50), (60, 70, 80, 90, 100).
Except that it could also be (10, 20, 30, 40, 50), (60, 70, 80, 100, 90). It could also be (20, 10, 30, 40, 50), (60, 70, 80, 90, 100). So, whether or not this is a good split (it is not), it doesn’t deserve to be handled twice. My answer? Sort, stringify, put into a hash and go next if that hash key exists.
We store the sets based on whether the current diff of sums is less than the stored diff of sums, which we start absurdly high.
Even when blocking identical sets, you can still have multiple sets that math out correctly.
Show Me The Code!
#!/usr/bin/env perl
use feature qw{say state signatures};
use strict;
use warnings;
use utf8;
no warnings qw{ experimental };
use Algorithm::Permute;
use List::Util qw{sum};
my @sets;
push @sets, [ 10, -15, 20, 30, -25, 0, 5, 40, -5 ];
push @sets, [ 10, 20, 30, 40, 50, 60, 70, 80, 90, 100 ];
for my $set (@sets) {
my ( $s1, $s2 ) = tug_of_war( $set->@* );
my $sum1 = sum $s1->@*;
my $sum2 = sum $s2->@*;
say join ' ', 'Set = ', $set->@*;
say join ' ', 'Sub1 = ', $s1->@*;
say "Sum1 = $sum1";
say join ' ', 'Sub2 = ', $s2->@*;
say "Sum2 = $sum2";
say 'DIFF = ' . abs( $sum1 - $sum2 );
say '';
}
sub tug_of_war (@set) {
my $set->@* = @set;
my %done;
my $mdiff = 2 * sum $set->@*;
my $max = scalar $set->@*;
my $center = int( $max / 2 );
my ( $set1, $set2 );
my $p = Algorithm::Permute->new($set);
while ( my @res = $p->next ) {
my @sub1;
my @sub2;
for my $i ( 0 .. -1 + $max ) {
my $n = $res[$i];
if ( $i < $center ) {
push @sub1, $n;
}
else {
push @sub2, $n;
}
}
my $comp = join ' ', ( sort { $a <=> $b } @sub1 ), '|',
( sort { $a <=> $b } @sub2 );
next if $done{$comp}++;
my $sub1 = sum @sub1;
my $sub2 = sum @sub2;
my $diff = abs( $sub1 - $sub2 );
if ( $diff < $mdiff ) {
$mdiff = $diff;
$set1->@* = sort { $a <=> $b } @sub1;
$set2->@* = sort { $a <=> $b } @sub2;
}
else { next }
}
return ( $set1, $set2 );
}
Set = 10 -15 20 30 -25 0 5 40 -5
Sub1 = -25 5 20 30
Sum1 = 30
Sub2 = -15 -5 0 10 40
Sum2 = 30
DIFF = 0
Set = 10 20 30 40 50 60 70 80 90 100
Sub1 = 30 40 50 60 90
Sum1 = 270
Sub2 = 10 20 70 80 100
Sum2 = 280
DIFF = 10