Merge pull request #4661 from jacoby/master

Venus And Mars

3 files changed, 115 insertions, 0 deletions

diff --git a/challenge-124/dave-jacoby/blog.txt b/challenge-124/dave-jacoby/blog.txt
new file mode 100644
index 0000000000..e7702f41d1
--- /dev/null
+++ b/challenge-124/dave-jacoby/blog.txt
@@ -0,0 +1 @@
+https://jacoby.github.io/2021/08/03/cant-think-of-a-pithy-title-perl-weekly-challenge-124.html
\ No newline at end of file
diff --git a/challenge-124/dave-jacoby/perl/ch-1.pl b/challenge-124/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..8bf9ce154c
--- /dev/null
+++ b/challenge-124/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,50 @@
+#!/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;
+}
diff --git a/challenge-124/dave-jacoby/perl/ch-2.pl b/challenge-124/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..ad0beb14f9
--- /dev/null
+++ b/challenge-124/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,64 @@
+#!/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 );
+}