From 76b126f0f4f572e051ee7d51d004c22163d83a86 Mon Sep 17 00:00:00 2001 From: Julien Fiegehenn Date: Mon, 25 Apr 2022 11:59:38 +0100 Subject: week 162, task 1 in Perl --- challenge-162/julien-fiegehenn/perl/1.pl | 46 ++++++++++++++++++++++++++++++++ 1 file changed, 46 insertions(+) create mode 100644 challenge-162/julien-fiegehenn/perl/1.pl diff --git a/challenge-162/julien-fiegehenn/perl/1.pl b/challenge-162/julien-fiegehenn/perl/1.pl new file mode 100644 index 0000000000..615f3f75c2 --- /dev/null +++ b/challenge-162/julien-fiegehenn/perl/1.pl @@ -0,0 +1,46 @@ +#!/usr/bin/env perl +use strict; +use warnings; + +use feature 'say'; +use List::Util 'sum'; + +# Write a script to generate the check digit of given ISBN-13 code. Please refer wikipedia for more information. + +# Example +# ISBN-13 check digit for '978-0-306-40615-7' is 7. + +# https://en.wikipedia.org/wiki/ISBN#ISBN-13_check_digit_calculation + +sub isbn_13 { + my $number = shift; + + die 'Input required' unless $number; + + # clean up the number + $number =~ s/\D//g; + + # we need to do maths on each digit + my @digits = split //, $number; + + # discard the check digit + pop @digits if @digits == 13; + + # do we have the right amount of digits? + die 'This does not look like an ISBN-13' unless @digits == 12; + + # tripple all the even digits + $_ *= 3 for @digits[1, 3, 5, 7, 9, 11]; + + # and do the maths + return 10 - sum(@digits) % 10; +} + +say isbn_13(shift); + +__END__ +use Test::More; + +is isbn_13('978-0-306-40615-7'), 7; + +done_testing; \ No newline at end of file -- cgit From 17c58341c3d547bf624632821dfb7001bee4fe8f Mon Sep 17 00:00:00 2001 From: Julien Fiegehenn Date: Tue, 26 Apr 2022 09:23:27 +0100 Subject: week 162, task 2 in Perl --- challenge-162/julien-fiegehenn/perl/2.pl | 199 +++++++++++++++++++++++++++++++ 1 file changed, 199 insertions(+) create mode 100644 challenge-162/julien-fiegehenn/perl/2.pl diff --git a/challenge-162/julien-fiegehenn/perl/2.pl b/challenge-162/julien-fiegehenn/perl/2.pl new file mode 100644 index 0000000000..ee3dc3206f --- /dev/null +++ b/challenge-162/julien-fiegehenn/perl/2.pl @@ -0,0 +1,199 @@ +#!/usr/bin/env perl +use strict; +use warnings; + +use feature 'say'; + +use constant {ROW => 0, COL => 1}; + +# Implement encryption and decryption using the Wheatstone-Playfair cipher. +# +# Examples: +# (These combine I and J, and use X as padding.) +# +# encrypt("playfair example", "hide the gold in the tree stump") = "bmodzbxdnabekudmuixmmouvif" +# +# decrypt("perl and raku", "siderwrdulfipaarkcrw") = "thewexeklychallengex" + +# Comments based on example in https://de.wikipedia.org/wiki/Playfair. + +# Turn on debugging with the DEBUG=0 environment variable. + +say encrypt('playfaire example', 'hide the gold in the tree stump'); +say decrypt("perl and raku", "siderwrdulfipaarkcrw"); + +sub debug($) { + print @_ if $ENV{DEBUG}; +} + +sub generate_table { + my $key = shift; + + my @letters = grep /[A-IK-Z]/, split //, uc $key; + push @letters, 'A' .. 'I', 'K' .. 'Z'; + + my ($table, $seen); + + for my $row (0 .. 4) { + for my $col (0 .. 4) { + while (@letters) { + my $letter = shift @letters; + + # skip the ones we've seen + redo if $seen->{$letter}; + + $table->[$row]->[$col] = $letter; + $seen->{$letter} = [$row, $col]; + last; + } + debug "$table->[$row]->[$col] "; + } + debug "\n"; + } + debug "\n"; + + return ($table, $seen); +} + +sub encrypt { + my ($key, $string) = @_; + + my ($table, $lookup) = generate_table($key); + + my $encrypted = q{}; + + my @letters = grep /[A-Z]/, split //, uc $string; + while (my ($first, $second) = splice @letters, 0, 2) { + + # pad to create a pair if we only have one letter left + $second ||= 'X'; + + # handle repeated letters + if ($first eq $second) { + unshift @letters, $second; + $second = 'X'; + } + + debug "$first$second "; + + # 1. The pair HI forms a rectangle, replace it with BM + if ( $lookup->{$first}->[ROW] != $lookup->{$second}->[ROW] + && $lookup->{$first}->[COL] != $lookup->{$second}->[COL]) + { + ($first, $second) = ( + $table->[$lookup->{$first}->[ROW]]->[$lookup->{$second}->[COL]], + $table->[$lookup->{$second}->[ROW]]->[$lookup->{$first}->[COL]], + ); + } + + # 2. The pair DE is in a column, replace it with OD + elsif ($lookup->{$first}->[ROW] != $lookup->{$second}->[ROW] + && $lookup->{$first}->[COL] == $lookup->{$second}->[COL]) + { + ($first, $second) = ( + $table->[wrap_number($lookup->{$first}->[ROW] + 1)] + ->[$lookup->{$first}->[COL]], + $table->[wrap_number($lookup->{$second}->[ROW] + 1)] + ->[$lookup->{$second}->[COL]], + ); + } + + # 10. The pair EX (X inserted to split EE) is in a row, replace it with XM + elsif ($lookup->{$first}->[ROW] == $lookup->{$second}->[ROW] + && $lookup->{$first}->[COL] != $lookup->{$second}->[COL]) + { + ($first, $second) = ( + $table->[$lookup->{$first}->[ROW]] + ->[wrap_number($lookup->{$first}->[COL] + 1)], + $table->[$lookup->{$second}->[ROW]] + ->[wrap_number($lookup->{$second}->[COL] + 1)], + ); + } + debug " -> $first$second\n"; + + $encrypted .= $first . $second; + } + debug "\n"; + + return $encrypted; +} + +sub decrypt { + my ($key, $string) = @_; + + my ($table, $lookup) = generate_table($key); + + my $encrypted = q{}; + + my @letters = grep /[A-Z]/, split //, uc $string; + while (my ($first, $second) = splice @letters, 0, 2) { + + # pad to create a pair if we only have one letter left + $second ||= 'X'; + + # handle repeated letters + if ($first eq $second) { + unshift @letters, $second; + $second = 'X'; + } + + debug "$first$second "; + + # 1. The pair HI forms a rectangle, replace it with BM + if ( $lookup->{$first}->[ROW] != $lookup->{$second}->[ROW] + && $lookup->{$first}->[COL] != $lookup->{$second}->[COL]) + { + ($first, $second) = ( + $table->[$lookup->{$first}->[ROW]]->[$lookup->{$second}->[COL]], + $table->[$lookup->{$second}->[ROW]]->[$lookup->{$first}->[COL]], + ); + } + + # 2. The pair DE is in a column, replace it with OD + elsif ($lookup->{$first}->[ROW] != $lookup->{$second}->[ROW] + && $lookup->{$first}->[COL] == $lookup->{$second}->[COL]) + { + ($first, $second) = ( + $table->[wrap_number($lookup->{$first}->[ROW] - 1)] + ->[$lookup->{$first}->[COL]], + $table->[wrap_number($lookup->{$second}->[ROW] - 1)] + ->[$lookup->{$second}->[COL]], + ); + } + + # 10. The pair EX (X inserted to split EE) is in a row, replace it with XM + elsif ($lookup->{$first}->[ROW] == $lookup->{$second}->[ROW] + && $lookup->{$first}->[COL] != $lookup->{$second}->[COL]) + { + ($first, $second) = ( + $table->[$lookup->{$first}->[ROW]] + ->[wrap_number($lookup->{$first}->[COL] - 1)], + $table->[$lookup->{$second}->[ROW]] + ->[wrap_number($lookup->{$second}->[COL] - 1)], + ); + } + debug " -> $first$second\n"; + + $encrypted .= $first . $second; + } + debug "\n"; + + return $encrypted; +} + +sub wrap_number { + my $number = shift; + + return 4 - $number if $number > 4; + return $number; +} + +__END__ + +use Test::More; + +is lc encrypt("playfair example", "hide the gold in the tree stump"), + "bmodzbxdnabekudmuixmmouvif"; +is lc decrypt("perl and raku", "siderwrdulfipaarkcrw"), "thewexeklychallengex"; + +done_testing; \ No newline at end of file -- cgit