diff options
| -rw-r--r-- | challenge-162/ryan-thompson/README.md | 25 | ||||
| -rwxr-xr-x | challenge-162/ryan-thompson/perl/ch-1.pl | 39 | ||||
| -rwxr-xr-x | challenge-162/ryan-thompson/perl/ch-2.pl | 88 |
3 files changed, 132 insertions, 20 deletions
diff --git a/challenge-162/ryan-thompson/README.md b/challenge-162/ryan-thompson/README.md index 499e779053..fe9fd08778 100644 --- a/challenge-162/ryan-thompson/README.md +++ b/challenge-162/ryan-thompson/README.md @@ -1,31 +1,16 @@ # Ryan Thompson -## Week 161 Solutions +## Week 162 Solutions -### Task 1 › Abecedarian Words +### Task 1 › ISBN-13 * [Perl](perl/ch-1.pl) - #### Synopsis - - ./ch-1.pl [--dict=path/to/dict.txt --benchmark --test] - - * `--benchmark` - Runs benchmarking on every different solution - * `--test` - Unit tests showing all solutions produce equal results - * `--dict=file` - Alternate dictionary file to use (uses `../../../data/dictionary.txt` by default) - -### Task 2 › Pangrams +### Task 2 › Wheatstone–Playfair Cipher * [Perl](perl/ch-2.pl) -#### Usage - - ./ch-2.pl [--dict=path/to/dict.txt --min=length] - - * `--dict=file` - Alternate dictionary file to use (default: `../../../data/dictionary.txt`) - * `--min=length` - Minimum word length (default: 4) - ## Blogs - * [Abecedarian Words](https://ry.ca/2022/04/abecedarian-words) - * [Pangrams](https://ry.ca/2022/04/pangrams) + * [ISBN-13](https://ry.ca/2022/04/isbn-13) + * [Wheatstone–Playfair Cipher](https://ry.ca/2022/04/playfair-cipher) diff --git a/challenge-162/ryan-thompson/perl/ch-1.pl b/challenge-162/ryan-thompson/perl/ch-1.pl new file mode 100755 index 0000000000..48b75b63f1 --- /dev/null +++ b/challenge-162/ryan-thompson/perl/ch-1.pl @@ -0,0 +1,39 @@ +#!/usr/bin/env perl +# +# ch-1.pl - ISBN 13 Check +# +# 2022 Ryan Thompson <rjt@cpan.org> + +use 5.010; +use warnings; +use strict; +no warnings 'uninitialized'; +use Carp qw< croak carp >; +use List::Util qw< sum pairs pairmap >; + +use Test::More; +use Test::Exception; + +ok valid_isbn13('978-0-306-40615-7'); +ok valid_isbn13('978-1-56619-909-4'); +ok !valid_isbn13('123-4-56789-012-3'); +dies_ok { valid_isbn13('invalid isbn') } 'Not an ISBN at all'; +dies_ok { valid_isbn13('978-0-306-40615') } 'Too short'; +dies_ok { valid_isbn13('978-0-306-40615-71') } 'Too long'; +dies_ok { valid_isbn13('978-0-306-4B615-7') } 'Non-digit'; + +done_testing; + +# We use a relaxed interpretation of an ISBN 13 here, because the parts are +# not fixed lengths, so as long as we have 13 digits, we don't care where (or +# if) the dashes are placed. +sub valid_isbn13 { + local $_ = shift; + croak "Invalid ISBN" unless /^[0-9-]+$/; + my @digits = grep { /\d/ } split //; + croak "Only 13 digit ISBNs are supported" if @digits != 13; + my $check = pop @digits; + + # Sum of every odd number plus 3 x every even number + 10 - (sum pairmap { $a + 3*$b } @digits) % 10 == $check; +} diff --git a/challenge-162/ryan-thompson/perl/ch-2.pl b/challenge-162/ryan-thompson/perl/ch-2.pl new file mode 100755 index 0000000000..2a25a11191 --- /dev/null +++ b/challenge-162/ryan-thompson/perl/ch-2.pl @@ -0,0 +1,88 @@ +#!/usr/bin/env perl +# +# ch-2.pl - Playfair Cipher +# +# 2022 Ryan Thompson <rjt@cpan.org> + +use 5.010; +use warnings; +use strict; +no warnings 'uninitialized'; +use Test::More; +use List::Util qw< pairmap >; + +use constant { + playfair_encrypt => +1, + playfair_decrypt => -1, +}; + +is encrypt("playfair example", "hide the gold in the tree stump"), + "bmodzbxdnabekudmuixmmouvif"; + +is decrypt("perl and raku", "siderwrdulfipaarkcrw"), + "thewexeklychallengex"; + +done_testing; + +# Encryption and decryption functions +sub encrypt { __playfair($_[0], $_[1], playfair_encrypt) } +sub decrypt { __playfair($_[0], $_[1], playfair_decrypt) } + +# Main Playfair encrypt/decrypt. Supply key and plaintext, and $ed +# is one of the playfair_encrypt or playfair_decrypt constants. +# End users should not call this function directly +sub __playfair { + my ($key, $plaintext, $ed) = @_; + + my @sq = __gen_square($key, 'j'); + + my %coords; # Coordinates of each letter within @sq + for my $x (0..4) { + $coords{$sq[$_][$x]} = [$x, $_] for 0..4; + } + + # Munge $plaintext into only letters, and insert x between repeated chars + $plaintext =~ s/[^a-z]//g; + $plaintext =~ s/^((?:..)*?)(\w)\2/$1$2x$2/g; + $plaintext .= 'x' if length($plaintext) % 2; # Enforce even length + + return join '', pairmap { + my ($xa, $ya) = @{$coords{$a} // $coords{i}}; + my ($xb, $yb) = @{$coords{$b} // $coords{i}}; + + ($xa, $ya, $xb, $yb) = + $xa == $xb ? ( $xa, ($ya+$ed)%5,$xb, ($yb+$ed)%5) + : $ya == $yb ? (($xa+$ed)%5,$ya, ($xb+$ed)%5,$yb ) + : ( $xb, $ya, $xa, $yb ); + + $sq[$ya][$xa] . $sq[$yb][$xb]; + } split //, $plaintext; +} + +# Generate the 5x5 square with the keyphrase +# $key - Keyphrase +# $int - Interchangeable letter (usually J or Q), will be removed +sub __gen_square { + my ($key, $int) = @_; + + my %left = map { $_ => 1 } 'a'..'z'; + delete $left{$int}; + my @rows = ([]); + + # We'll need this twice, so make it a sub + my $push = sub { + push @rows, [] if @{$rows[-1]} == 5; + push @{$rows[-1]}, $_[0]; + }; + + for (split //, $key) { + next unless $left{$_}; + delete $left{$_}; + $push->($_); + } + + $push->($_) for sort keys %left; + + @rows; +} + |