Merge pull request #4603 from stuart-little/stuart-little_123_perl

1st commit on 123_perl

2 files changed, 57 insertions, 0 deletions

diff --git a/challenge-123/stuart-little/perl/ch-1.pl b/challenge-123/stuart-little/perl/ch-1.pl
new file mode 100755
index 0000000000..11ab4cf035
--- /dev/null
+++ b/challenge-123/stuart-little/perl/ch-1.pl
@@ -0,0 +1,27 @@
+#!/usr/bin/env perl
+use warnings;
+use v5.12;
+
+# run as <script> <number $n> to return the first $n ugly numbers
+
+use feature qw(signatures);
+no warnings qw(experimental::signatures);
+
+use List::Util qw(first);
+
+my %memo = map { $_ => 1 } (1,2,3,5);
+
+sub smth5p($n) {
+    $memo{$n} && return 1;
+    my $den = first {$n % $_ ==0} (2,3,5);
+    return ($den ? ($memo{int($n/$den)} && ($memo{$n}=1)) : 0)
+}
+
+my ($count,$nr)=(0,0);
+while ($count < $ARGV[0]) {
+    $nr+=1;
+    (smth5p($nr)) && do {
+	say $nr;
+	$count+=1;
+    };    
+}
diff --git a/challenge-123/stuart-little/perl/ch-2.pl b/challenge-123/stuart-little/perl/ch-2.pl
new file mode 100755
index 0000000000..92845bec74
--- /dev/null
+++ b/challenge-123/stuart-little/perl/ch-2.pl
@@ -0,0 +1,30 @@
+#!/usr/bin/env perl
+use warnings;
+use v5.12;
+
+# run <script> <x1 y1 x2 y2 ..>
+
+use feature qw(signatures);
+no warnings qw(experimental::signatures);
+
+sub sqDist($x1, $y1, $x2, $y2) {
+    return ($x2-$x1)**2 + ($y2-$y1)**2;
+}
+
+sub sqDistHash($coords) {
+    my %h;
+    for my $i (0..2) {
+	for my $j ($i+1..3) {
+	    $h{sqDist($coords->[2*$i],$coords->[2*$i+1],$coords->[2*$j],$coords->[2*$j+1])}++;
+	}
+    }
+    return \%h;
+}
+
+sub isSq($coords) {
+    my @distCounts = values %{sqDistHash($coords)};
+    return(((grep {$_==2} @distCounts) && (grep {$_==4} @distCounts)) ? (1) : (0));
+}
+
+my @coords=@ARGV[0..7];
+say isSq(\@coords);