From da4ecc7a88b78fd27d877290e202ec1c51dc7d2c Mon Sep 17 00:00:00 2001
From: "E. Choroba" <choroba@matfyz.cz>
Date: Mon, 25 Jan 2021 23:42:52 +0100
Subject: Solve 097: Caesar Cipher & Binary Substrings by E. Choroba

---
 challenge-097/e-choroba/perl/ch-1.pl | 22 +++++++++++++
 challenge-097/e-choroba/perl/ch-2.pl | 64 ++++++++++++++++++++++++++++++++++++
 2 files changed, 86 insertions(+)
 create mode 100755 challenge-097/e-choroba/perl/ch-1.pl
 create mode 100755 challenge-097/e-choroba/perl/ch-2.pl

(limited to 'challenge-097')

diff --git a/challenge-097/e-choroba/perl/ch-1.pl b/challenge-097/e-choroba/perl/ch-1.pl
new file mode 100755
index 0000000000..39e7eefd4e
--- /dev/null
+++ b/challenge-097/e-choroba/perl/ch-1.pl
@@ -0,0 +1,22 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+my $ALPHABET = join "", 'A' .. 'Z';
+sub caesar_cipher {
+    my ($s, $n) = @_;
+    $n %= 26;
+    my $key = $ALPHABET;
+    substr $key, 0, 0, substr $key, -$n, $n, "";
+    eval "\$s =~ tr/$ALPHABET/$key/";
+    return $s
+}
+
+use Test::More tests => 3;
+
+is caesar_cipher('THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG', 3),
+    'QEB NRFZH YOLTK CLU GRJMP LSBO QEB IXWV ALD',
+    'Example';
+
+is caesar_cipher('ZABC', 54), 'XYZA', 'N>26';
+is caesar_cipher('YZAB', -1), 'ZABC', 'N<0';
diff --git a/challenge-097/e-choroba/perl/ch-2.pl b/challenge-097/e-choroba/perl/ch-2.pl
new file mode 100755
index 0000000000..d54fb97539
--- /dev/null
+++ b/challenge-097/e-choroba/perl/ch-2.pl
@@ -0,0 +1,64 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+use List::Util qw{ sum };
+
+sub brute_force {
+    my ($binary, $size) = @_;
+    my @strings = $binary =~ /(.{$size})/g;
+    die "Can't split evenly" unless @strings * $size == length $binary;
+
+    my $same = 0 x $size;
+    my $best = $size * @strings;
+    until ($size < length $same) {
+        my $flips = sum(map { ($_ ^ $same) =~ tr/\x01// } @strings);
+        $best = $flips if $flips < $best;
+        $same = sprintf "%0${size}b", 1 + oct "b$same";
+    }
+    return $best
+}
+
+sub by_pos {
+    my ($binary, $size) = @_;
+    my @strings = $binary =~ /(.{$size})/g;
+    die "Can't split evenly" unless @strings * $size == length $binary;
+
+    my $sum = 0;
+    for my $pos (0 .. $size - 1) {
+        my $ones += grep { substr $_, $pos, 1 } @strings;
+        $sum += $ones > @strings / 2 ? @strings - $ones : $ones;
+    }
+    return $sum
+}
+
+use Test::More;
+
+for my $example (['101100101', 3, 1],
+                 ['10110111', 4, 2],
+                 ['0000000101101011', 2, 6],
+                 ['000000101010111000110011001111110101', 6, 16],
+                 ['000111111', 3, 3],
+                 ['00000001001001001000', 4, 4],
+                 ['0000100011101010', 4, 4]
+){
+    is by_pos(@$example[0, 1]), $example->[-1];
+    is by_pos(@$example), brute_force(@$example);
+}
+
+my $long = '101010101000100010010010111100010010101010101101001010100010101';
+is brute_force($long, 3), by_pos($long, 3);
+
+done_testing();
+
+use Benchmark qw{ cmpthese };
+
+cmpthese(-3, {
+    brute_force => sub { brute_force($long, 3) },
+    by_pos      => sub { by_pos($long, 3) },
+});
+
+__END__
+               Rate brute_force      by_pos
+brute_force 24884/s          --        -69%
+by_pos      80637/s        224%          --
-- 
cgit