1st commit on 101_perl

2 files changed, 51 insertions, 0 deletions

diff --git a/challenge-101/stuart-little/perl/ch-1.pl b/challenge-101/stuart-little/perl/ch-1.pl
new file mode 100755
index 0000000000..d12f9e03bb
--- /dev/null
+++ b/challenge-101/stuart-little/perl/ch-1.pl
@@ -0,0 +1,35 @@
+#!/usr/bin/perl
+use warnings;
+use v5.12;
+
+# run <script> <space-separated array entries>
+
+use feature qw(signatures);
+no warnings qw(experimental::signatures);
+
+use List::AllUtils qw(min_by);
+
+sub rtcc($m) {
+    my @res;
+    for my $ix (0..scalar @{$m->[0]}-1) {
+	my @col = map {$_->[$ix]} @{$m};
+	push @res, (\@col,);
+    }
+    return [reverse @res];
+}
+
+sub pck($rows,$cols,$a) {
+    $rows == 1 && return [$a,];
+    $cols == 1 && return [map {[$_,]} reverse @{$a}];
+    my $rot = rtcc(pck($cols,$rows-1,[$a->@[$cols..scalar @{$a}-1]]));    
+    return [@$rot,[$a->@[0..$cols-1]]];
+}
+
+my $els = scalar @ARGV;
+my $rows = min_by { abs($_ - $els/$_) } grep {$els % $_ == 0} (1..int($els/2));
+my $cols = int($els/$rows);
+
+for (@{pck($rows,$cols,[map {sprintf("%5s", $_)} @ARGV])}) {
+    say "@$_";
+}
+
diff --git a/challenge-101/stuart-little/perl/ch-2.pl b/challenge-101/stuart-little/perl/ch-2.pl
new file mode 100755
index 0000000000..360e963584
--- /dev/null
+++ b/challenge-101/stuart-little/perl/ch-2.pl
@@ -0,0 +1,16 @@
+#!/usr/bin/perl
+use warnings;
+use v5.12;
+
+# run <script> <x1 y1 x2 y2 x3 y3>
+
+use feature qw(signatures);
+no warnings qw(experimental::signatures);
+
+sub areaTr2($x1,$y1,$x2,$y2,$x3,$y3) {
+    abs(($y3-$y1)*($x2-$x1) - ($y2-$y1)*($x3-$x1))
+}
+
+my ($x1,$y1,$x2,$y2,$x3,$y3) = @ARGV[0..5];
+
+say 0+(areaTr2(0,0,$x1,$y1,$x2,$y2) + areaTr2(0,0,$x2,$y2,$x3,$y3) + areaTr2(0,0,$x3,$y3,$x1,$y1) == areaTr2($x1,$y1,$x2,$y2,$x3,$y3));