1st commit on 097_perl

2 files changed, 55 insertions, 0 deletions

diff --git a/challenge-097/stuart-little/perl/ch-1.pl b/challenge-097/stuart-little/perl/ch-1.pl
new file mode 100755
index 0000000000..93cdfe4377
--- /dev/null
+++ b/challenge-097/stuart-little/perl/ch-1.pl
@@ -0,0 +1,15 @@
+#!/usr/bin/perl
+use warnings;
+use v5.12;
+
+# run <script> <quoted string> <number>
+
+use feature qw(signatures);
+no warnings qw(experimental::signatures);
+
+sub rot($nr,$c) {
+    return (ord $c >= 65 && ord $c <= 90) ? (chr(ord('A') + (ord($c) - ord('A') - ($nr % 26)) % 26)) : $c
+}
+
+my ($str,$nr) = @ARGV;
+say join "", map {rot($nr,$_)} (split //, $str);
diff --git a/challenge-097/stuart-little/perl/ch-2.pl b/challenge-097/stuart-little/perl/ch-2.pl
new file mode 100755
index 0000000000..bb6f89c40a
--- /dev/null
+++ b/challenge-097/stuart-little/perl/ch-2.pl
@@ -0,0 +1,40 @@
+#!/usr/bin/perl
+use warnings;
+use v5.12;
+
+# run <script> <binary string> <number>
+
+use feature qw(signatures);
+no warnings qw(experimental::signatures);
+
+use List::MoreUtils qw(each_arrayref part);
+
+sub toflip($tgt,$strs) {
+    my $sum=0;
+    for (@{$strs}) {
+	$sum += length (($tgt ^ $_) =~ s/\0//gr)
+    }
+    return $sum;
+}
+
+sub mostfreqchar($str) {
+    my %freqs;
+    my $chr;
+    for (split //, $str) {	
+	$freqs{$_}++;
+	((! $chr) || ($freqs{$chr} < $freqs{$_})) && do {$chr=$_};
+    }
+    return $chr;
+}
+
+my ($bin,$nr) = @ARGV;
+my @bins = unpack("(A$nr)*",$bin);
+
+my $i=0;
+my @crossbins = map {join '', @{$_}} (part { $i++ % $nr } (split //, $bin));
+
+my $tgt = join "", (map {mostfreqchar $_} @crossbins);
+
+say qq|Initial strings:\n${\ do {join "\n", @bins}}\n|;
+say qq|Target string: $tgt\n|;
+say qq|Have to flip: ${\ do {toflip($tgt,\@bins)}}|;