aboutsummaryrefslogtreecommitdiff
path: root/challenge-097
diff options
context:
space:
mode:
authorMohammad S Anwar <Mohammad.Anwar@yahoo.com>2021-01-25 19:34:18 +0000
committerGitHub <noreply@github.com>2021-01-25 19:34:18 +0000
commit180d0ad76576c4dcf8a5bf70301c717eed7d38aa (patch)
tree1052571bd82768cc3a2b6bf6f3e8182c17d05f17 /challenge-097
parent6779a1e8fe843ffeb0e2678c75b93ac0bfa63106 (diff)
parent32d19796c475f97e8e5f4553d8f3dc3dc80d45eb (diff)
downloadperlweeklychallenge-club-180d0ad76576c4dcf8a5bf70301c717eed7d38aa.tar.gz
perlweeklychallenge-club-180d0ad76576c4dcf8a5bf70301c717eed7d38aa.tar.bz2
perlweeklychallenge-club-180d0ad76576c4dcf8a5bf70301c717eed7d38aa.zip
Merge pull request #3377 from stuart-little/stuart-little_097_perl
1st commit on 097_perl
Diffstat (limited to 'challenge-097')
-rwxr-xr-xchallenge-097/stuart-little/perl/ch-1.pl15
-rwxr-xr-xchallenge-097/stuart-little/perl/ch-2.pl40
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)}}|;