aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--challenge-015/athanasius/perl5/ch-1.pl72
-rw-r--r--challenge-015/athanasius/perl5/ch-2.pl192
-rw-r--r--challenge-015/athanasius/perl5/ch-3.pl124
-rw-r--r--challenge-015/athanasius/perl6/ch-1.p674
-rw-r--r--challenge-015/athanasius/perl6/ch-2.p6166
-rw-r--r--challenge-015/athanasius/perl6/ch-3.p693
6 files changed, 721 insertions, 0 deletions
diff --git a/challenge-015/athanasius/perl5/ch-1.pl b/challenge-015/athanasius/perl5/ch-1.pl
new file mode 100644
index 0000000000..ff550c4732
--- /dev/null
+++ b/challenge-015/athanasius/perl5/ch-1.pl
@@ -0,0 +1,72 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 015
+=========================
+
+Task #1
+-------
+
+Write a script to generate first 10 strong and weak prime numbers.
+
+ For example, the nth prime number is represented by p(n).
+
+ p(1) = 1
+ p(2) = 3
+ p(3) = 5
+
+ Strong Prime number p(n) when p(n) > [ p(n-1) + p(n+1) ] / 2
+ Weak Prime number p(n) when p(n) < [ p(n-1) + p(n+1) ] / 2
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2019 PerlMonk Athanasius #
+#--------------------------------------#
+
+use strict;
+use warnings;
+use Const::Fast;
+use Math::Prime::Util qw( prime_iterator );
+
+const my $SERIES_LENGTH => 10;
+
+$| = 1;
+
+MAIN:
+{
+ my %primes = map { $_ => [] } qw( strong weak );
+ my $iterator = prime_iterator();
+ my $previous = $iterator->();
+ my $current = $iterator->();
+
+ while (scalar $primes{strong}->@* < $SERIES_LENGTH ||
+ scalar $primes{weak }->@* < $SERIES_LENGTH)
+ {
+ my $next = $iterator->();
+ my $mean = ($previous + $next) / 2;
+ my $type = ($current > $mean) ? 'strong' :
+ ($current < $mean) ? 'weak' : 'balanced';
+
+ if ($type ne 'balanced' && scalar $primes{$type}->@* < $SERIES_LENGTH)
+ {
+ push $primes{$type}->@*, $current;
+ }
+
+ ($previous, $current) = ($current, $next);
+ }
+
+ print "\n";
+
+ for my $type (qw( strong weak ))
+ {
+ printf "The first %d %-*s primes are: %s\n",
+ $SERIES_LENGTH, length('strong'), $type,
+ join(', ', map { sprintf '%2d', $_ } $primes{$type}->@*);
+ }
+}
+
+################################################################################
diff --git a/challenge-015/athanasius/perl5/ch-2.pl b/challenge-015/athanasius/perl5/ch-2.pl
new file mode 100644
index 0000000000..286aaaa36f
--- /dev/null
+++ b/challenge-015/athanasius/perl5/ch-2.pl
@@ -0,0 +1,192 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 015
+=========================
+
+Task #2
+-------
+
+Write a script to implement Vigenère cipher. The script should be able encode
+and decode. Checkout wiki [ https://en.wikipedia.org/wiki/Vigen%C3%A8re_cipher
+|page] for more information.
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2019 PerlMonk Athanasius #
+#--------------------------------------#
+
+use strict;
+use utf8;
+use warnings;
+use Const::Fast;
+use Getopt::Long;
+use POSIX qw( ceil );
+
+# The alphabet for both plaintext and ciphertext: characters must have
+# consecutive ordinal values within their character set
+
+# (1) The canonical alphabet: upper case only
+const my @ALPHABET => ('A' .. 'Z');
+
+# (2) Extended alphabet: allows messages and keys to be written in "CamelCase"
+#const my @ALPHABET => ('A' .. 'Z', '[', '\\', ']', '^', '_', '`', 'a' .. 'z');
+
+# (3) Full ASCII alphabet
+#const my @ALPHABET => map { chr $_ } 32 .. 126;
+
+# Ordinal value of the first character in the alphabet
+
+const my $ORD_BASE => ord $ALPHABET[0];
+
+# Regular expression to match non-alphabet characters (the first is captured)
+
+const my $NON_ALPHA => eval "qr{ ( [^$ALPHABET[0]-$ALPHABET[-1]] ) }x";
+
+# Default values (from the Wikipedia page)
+
+const my $KEY => 'LEMON';
+const my $PLAINTEXT => 'ATTACKATDAWN';
+
+# Usage message
+
+const my $USAGE => "\nUSAGE: perl $0 [--key <str>] [--plain|message <str>] " .
+ "[--cipher <str>]\n";
+$| = 1;
+
+MAIN:
+{
+ my ($key, $plaintext, $ciphertext) = read_command_line();
+
+ if (( $plaintext && $ciphertext) ||
+ (!$plaintext && !$ciphertext))
+ {
+ $plaintext //= $PLAINTEXT; # Allow empty string
+ my $cipher = encode($plaintext, $key);
+ my $decoded = decode($cipher, $key);
+
+ printf "\nWith key '%s', '%s' --> '%s' --> '%s': %s\n",
+ $key, $plaintext, $cipher, $decoded,
+ $decoded eq $plaintext ? 'Success' : 'Failure';
+ }
+ elsif ($plaintext) # Encode only
+ {
+ printf "\nWith key '%s', '%s' encodes to '%s'\n",
+ $key, $plaintext, encode($plaintext, $key);
+ }
+ else # Decode only
+ {
+ printf "\nWith key '%s', '%s' decodes to '%s'\n",
+ $key, $ciphertext, decode($ciphertext, $key);
+ }
+}
+
+sub read_command_line
+{
+ my ($help, $key, $plaintext, $ciphertext);
+
+ GetOptions
+ (
+ 'help' => \$help,
+ 'key:s' => \$key,
+ 'plain|message:s' => \$plaintext,
+ 'cipher:s' => \$ciphertext,
+
+ ) or die $USAGE;
+
+ die $USAGE if $help;
+
+ $key ||= $KEY; # Disallow empty string
+
+ return ($key, $plaintext, $ciphertext);
+}
+
+#-------------------------------------------------------------------------------
+=Wikipedia article "Vigenère cipher"
+
+Vigenère can also be described algebraically. If the letters A–Z are taken to be
+the numbers 0–25 ( A ≙ 0, B ≙ 1, etc.), and addition is performed modulo 26,
+Vigenère encryption E using the key K can be written as
+
+ C_i = E_K(M_i) = (M_i + K_i) mod 26
+
+and decryption D using the key K as
+
+ M_i = D_K(C_i) = (C_i - K_i) mod 26,
+
+in which M = M_1 ... M_n is the message,
+ C = C_1 ... C_n is the ciphertext and
+ K = K_1 ... K_n is the key obtained by repeating the keyword ⌈n/m⌉
+ times in which m is the keyword length.
+=cut
+#-------------------------------------------------------------------------------
+
+sub encode
+{
+ my ($plaintext, $key) = @_;
+
+ validate('plaintext', $plaintext, $key);
+
+ my @plain = str2num($plaintext);
+ my @key = (str2num($key)) x ceil(length($plaintext) / length($key));
+ my @cipher;
+
+ while (@plain)
+ {
+ my $m = shift @plain;
+ my $k = shift @key;
+
+ push @cipher, ($m + $k) % scalar @ALPHABET;
+ }
+
+ return num2str(@cipher);
+}
+
+sub decode
+{
+ my ($ciphertext, $key) = @_;
+
+ validate('ciphertext', $ciphertext, $key);
+
+ my @cipher = str2num($ciphertext);
+ my @key = (str2num($key)) x ceil(length($ciphertext) / length($key));
+ my @plain;
+
+ while (@cipher)
+ {
+ my $c = shift @cipher;
+ my $k = shift @key;
+
+ push @plain, ($c - $k) % scalar @ALPHABET;
+ }
+
+ return num2str(@plain);
+}
+
+sub validate
+{
+ my ($name, $text, $key) = @_;
+
+ die "Invalid character '$1' in $name\n" if $text =~ $NON_ALPHA;
+ die "Invalid character '$1' in key\n" if $key =~ $NON_ALPHA;
+}
+
+sub str2num
+{
+ my ($string) = @_;
+
+ return map { ord($_) - $ORD_BASE } split //, $string;
+}
+
+sub num2str
+{
+ my @nums = @_;
+
+ return join '', map { chr( $_ + $ORD_BASE ) } @nums;
+}
+
+################################################################################
diff --git a/challenge-015/athanasius/perl5/ch-3.pl b/challenge-015/athanasius/perl5/ch-3.pl
new file mode 100644
index 0000000000..1672fa5c2d
--- /dev/null
+++ b/challenge-015/athanasius/perl5/ch-3.pl
@@ -0,0 +1,124 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 015
+=========================
+
+Task #3
+-------
+
+Write a script to use Language Detection API. For more information about API,
+please visit [ https://detectlanguage.com/ |page]. The API task is *optional*
+but we would love to see your solution.
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2019 PerlMonk Athanasius #
+#--------------------------------------#
+
+use strict;
+use warnings;
+use Const::Fast;
+use Getopt::Long;
+use JSON;
+use LWP::UserAgent ();
+
+const my $API_KEY => '< redacted >';
+const my $MAX_TEXT => 66; # Max text length for 80-char console
+const my $TIMEOUT => 30; # seconds
+const my $URL_DETECT => 'https://ws.detectlanguage.com/0.2/detect';
+const my $URL_LANGS => 'https://ws.detectlanguage.com/0.2/languages';
+const my $USAGE => "USAGE: perl $0 --help | --text <string> | " .
+ "--file <filename>\n";
+
+$| = 1;
+
+MAIN:
+{
+ print "\n";
+
+ my $text = read_text();
+ my $response = get_lang_detection($text);
+ my $json = JSON->new;
+ my $lang_det = $json->decode($response)->{data}{detections}[0];
+ my $confidence = $lang_det->{confidence} // 'Unknown';
+ my $reliable = $lang_det->{isReliable} ? 'Yes' : 'No';
+ my $lang_code = $lang_det->{language} // 'Unknown';
+
+ printf "Text: %s\n", substr($text, 0, $MAX_TEXT);
+ printf "Language: %s = %s\n", $lang_code, get_lang_name($lang_code);
+ print "Is reliable: $reliable\n";
+ print "Confidence: $confidence\n";
+}
+
+sub read_text
+{
+ my ($help, $text, $file);
+
+ GetOptions
+ (
+ 'help' => \$help,
+ 'text:s' => \$text,
+ 'file:s' => \$file,
+
+ ) or die $USAGE;
+
+ die $USAGE if $help || ($text && $file) || (!$text && !$file);
+
+ if ($file)
+ {
+ open my $fh, '<', $file
+ or die "Cannot open file '$file' for reading, stopped";
+
+ local $/; # Slurp
+ $text = <$fh>;
+
+ close $fh
+ or die "Cannot close file '$file', stopped";
+ }
+
+ return ($text);
+}
+
+sub get_lang_detection
+{
+ my ($text) = @_;
+ my $ua = LWP::UserAgent->new(timeout => $TIMEOUT);
+ $ua->default_header('Authorization' => "Bearer $API_KEY");
+ my $response = $ua->post($URL_DETECT, Content => "q=$text");
+
+{
+ use Data::Dump;
+ dd $response;
+}
+ $response->is_success
+ or die $response->status_line . ', stopped';
+
+ return $response->decoded_content;
+}
+
+sub get_lang_name
+{
+ my ($lang_code) = @_;
+
+ return 'Unknown' if $lang_code eq 'Unknown';
+
+ my $ua = LWP::UserAgent->new(timeout => $TIMEOUT);
+ my $response = $ua->get($URL_LANGS);
+
+ $response->is_success
+ or die $response->status_line . ', stopped';
+
+ my $content = $response->decoded_content;
+ my $json = JSON->new;
+ my $languages = $json->decode($content);
+ my %languages = map { $_->{code} => $_->{name} } @$languages;
+
+ return $languages{$lang_code};
+}
+
+################################################################################
diff --git a/challenge-015/athanasius/perl6/ch-1.p6 b/challenge-015/athanasius/perl6/ch-1.p6
new file mode 100644
index 0000000000..6bdaa18650
--- /dev/null
+++ b/challenge-015/athanasius/perl6/ch-1.p6
@@ -0,0 +1,74 @@
+use v6;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 015
+=========================
+
+Task #1
+-------
+
+Write a script to generate first 10 strong and weak prime numbers.
+
+ For example, the nth prime number is represented by p(n).
+
+ p(1) = 1
+ p(2) = 3
+ p(3) = 5
+
+ Strong Prime number p(n) when p(n) > [ p(n-1) + p(n+1) ] / 2
+ Weak Prime number p(n) when p(n) < [ p(n-1) + p(n+1) ] / 2
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2019 PerlMonk Athanasius #
+#--------------------------------------#
+
+my UInt constant $SERIES-LENGTH = 10;
+my constant @PRIME-TYPES = < strong weak >;
+my UInt constant $TYPE-LENGTH = @PRIME-TYPES.map( { .chars } ).max;
+
+sub MAIN()
+{
+ my %primes = @PRIME-TYPES.map: { $_ => [] };
+ my UInt $previous = next-prime;
+ my UInt $current = next-prime;
+
+ while %primes{'strong'}.elems < $SERIES-LENGTH ||
+ %primes{'weak' }.elems < $SERIES-LENGTH
+ {
+ my Int $next = next-prime;
+ my Rat $mean = ($previous + $next) / 2;
+ my Str $type = ($current > $mean) ?? 'strong' !!
+ ($current < $mean) ?? 'weak' !! 'balanced';
+
+ if $type ∈ @PRIME-TYPES && %primes{$type}.elems < $SERIES-LENGTH
+ {
+ %primes{$type}.push: $current;
+ }
+
+ ($previous, $current) = ($current, $next);
+ }
+
+ say '';
+ say "The first $SERIES-LENGTH ", $_.fmt( "%-{ $TYPE-LENGTH }s" ),
+ ' primes are: ', %primes{$_}.map({ .fmt( '%2d' ) }).join(', ')
+ for @PRIME-TYPES;
+}
+
+sub next-prime(--> UInt)
+{
+ state UInt $p = 1;
+
+ repeat until $p.is-prime
+ {
+ ++$p;
+ }
+
+ return $p;
+}
+
+################################################################################
diff --git a/challenge-015/athanasius/perl6/ch-2.p6 b/challenge-015/athanasius/perl6/ch-2.p6
new file mode 100644
index 0000000000..51f109a534
--- /dev/null
+++ b/challenge-015/athanasius/perl6/ch-2.p6
@@ -0,0 +1,166 @@
+use v6;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 015
+=========================
+
+Task #2
+-------
+
+Write a script to implement Vigenère cipher. The script should be able encode
+and decode. Checkout wiki [ https://en.wikipedia.org/wiki/Vigen%C3%A8re_cipher
+|page] for more information.
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2019 PerlMonk Athanasius #
+#--------------------------------------#
+
+use MONKEY-SEE-NO-EVAL;
+
+# The alphabet for both plaintext and ciphertext: characters must have
+# consecutive ordinal values within their character set
+
+# (1) The canonical alphabet: upper case only
+my constant @ALPHABET = ('A' .. 'Z');
+
+# (2) Extended alphabet: allows messages and keys to be written in "CamelCase"
+#my constant @ALPHABET = ('A' .. 'Z', '[', '\\', ']', '^', '_', '`', 'a' .. 'z');
+
+# (3) Full ASCII alphabet
+#my constant @ALPHABET = (32 .. 126).map: { chr $_ };
+
+# Ordinal value of the first character in the alphabet
+
+my UInt constant $ORD-BASE = ord @ALPHABET[0];
+
+# Regular expression to match non-alphabet characters (the first is captured)
+
+my constant $NON-ALPHA = EVAL 'rx/ ( <-[' ~ @ALPHABET.join('') ~ ']> ) /';
+
+# Default values (from the Wikipedia page)
+
+my Str constant $KEY = 'LEMON';
+my Str constant $PLAINTEXT = 'ATTACKATDAWN';
+
+sub MAIN
+(
+ Bool :$help, #= this usage message
+ Str :$key = $KEY, #= key to encode and/or decode
+ Str :message(:$plain), #= plaintext to be encoded
+ Str :$cipher, #= ciphertext to be decoded
+)
+{
+ die 'Empty key' unless $key;
+
+ if ($help)
+ {
+ say "\n$*USAGE";
+ }
+ elsif (( $plain && $cipher) ||
+ (!$plain && !$cipher))
+ {
+ my $plaintext = $plain // $PLAINTEXT; # Allow empty string
+ my $ciphertext = encode($plaintext, $key);
+ my $decodedtext = decode($ciphertext, $key);
+
+ say "\nWith key '$key', '$plaintext' --> '$ciphertext' --> ",
+ "'$decodedtext': ",
+ $decodedtext eq $plaintext ?? 'Success' !! 'Failure';
+ }
+ elsif ($plain) # Encode only
+ {
+ say "\nWith key '$key', '$plain' encodes to ",
+ "'{ encode($plain, $key) }'";
+ }
+ else # Decode only
+ {
+ say "\nWith key '$key', '$cipher' decodes to ",
+ "'{ decode($cipher, $key) }'";
+ }
+}
+
+#-------------------------------------------------------------------------------
+=begin wp
+
+From the Wikipedia article "Vigenère cipher":
+
+Vigenère can also be described algebraically. If the letters A–Z are taken to be
+the numbers 0–25 ( A ≙ 0, B ≙ 1, etc.), and addition is performed modulo 26,
+Vigenère encryption E using the key K can be written as
+
+ C_i = E_K(M_i) = (M_i + K_i) mod 26
+
+and decryption D using the key K as
+
+ M_i = D_K(C_i) = (C_i - K_i) mod 26,
+
+in which M = M_1 ... M_n is the message,
+ C = C_1 ... C_n is the ciphertext and
+ K = K_1 ... K_n is the key obtained by repeating the keyword ⌈n/m⌉
+ times in which m is the keyword length.
+
+=end wp
+#-------------------------------------------------------------------------------
+
+sub encode(Str:D $plaintext, Str:D $key)
+{
+ validate('plaintext', $plaintext, $key);
+
+ my @plain = str2num($plaintext);
+ my UInt $mult = ceiling($plaintext.chars / $key.chars);
+ my @key = (str2num($key) xx $mult)[*;*]; # Flatten the list
+ my @cipher;
+
+ while @plain
+ {
+ my $m = @plain.shift;
+ my $k = @key.shift;
+
+ @cipher.push: ($m + $k) % @ALPHABET.elems;
+ }
+
+ return num2str(@cipher);
+}
+
+sub decode(Str:D $ciphertext, Str:D $key)
+{
+ validate('ciphertext', $ciphertext, $key);
+
+ my @cipher = str2num($ciphertext);
+ my UInt $mult = ceiling($ciphertext.chars / $key.chars);
+ my @key = (str2num($key) xx $mult)[*;*]; # Flatten the list
+ my @plain;
+
+ while @cipher
+ {
+ my $c = @cipher.shift;
+ my $k = @key.shift;
+
+ @plain.push: ($c - $k) % @ALPHABET.elems;
+ }
+
+ return num2str(@plain);
+}
+
+sub validate(Str:D $name, Str:D $text, Str:D $key)
+{
+ die "Invalid character '$0' in $name\n" if $text ~~ $NON-ALPHA;
+ die "Invalid character '$0' in key\n" if $key ~~ $NON-ALPHA;
+}
+
+sub str2num(Str:D $string)
+{
+ return $string.split('', :skip-empty).map: { ord($_) - $ORD-BASE };
+}
+
+sub num2str(@nums)
+{
+ return @nums.map( { chr( $_ + $ORD-BASE ) } ).join('');
+}
+
+################################################################################
diff --git a/challenge-015/athanasius/perl6/ch-3.p6 b/challenge-015/athanasius/perl6/ch-3.p6
new file mode 100644
index 0000000000..aa0bda8db0
--- /dev/null
+++ b/challenge-015/athanasius/perl6/ch-3.p6
@@ -0,0 +1,93 @@
+use v6;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 015
+=========================
+
+Task #3
+-------
+
+Write a script to use Language Detection API. For more information about API,
+please visit [ https://detectlanguage.com/ |page]. The API task is *optional*
+but we would love to see your solution.
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2019 PerlMonk Athanasius #
+#--------------------------------------#
+
+use JSON::Tiny;
+use LWP::UserAgent:from<Perl5> ();
+
+my Str constant $API-KEY = '< redacted >';
+my UInt constant $MAX-TEXT = 66; # max text length for 80-char console
+my UInt constant $TIMEOUT = 30; # seconds
+my Str constant $URL-DETECT = 'https://ws.detectlanguage.com/0.2/detect';
+my Str constant $URL-LANGS = 'https://ws.detectlanguage.com/0.2/languages';
+
+sub MAIN
+(
+ Bool :$help, #= this usage message
+ Str :$text, #= text with language to be detected
+ Str :$file, #= name of file containing text with language to be detected
+)
+{
+ say '';
+ die $*USAGE if $help || ($text && $file) || (!$text && !$file);
+
+ my utf8 $target = $file ?? $file.IO.slurp.encode('UTF-8')
+ !! $text.encode('UTF-8');
+ my Str $response = get-lang-detection($target);
+ my %lang-det = from-json($response){'data'}{'detections'}[0];
+ my Rat $confidence = %lang-det{'confidence'} // 'Unknown';
+ my Str $reliable = %lang-det{'isReliable'} ?? 'Yes' !! 'No';
+ my Str $lang-code = %lang-det{'language'} // 'Unknown';
+
+ say 'Text: ', $target.decode.substr(0, $MAX-TEXT);
+ say 'Language: ', $lang-code, ' = ', get-lang-name($lang-code);
+ say 'Is reliable: ', $reliable;
+ say 'Confidence: ', $confidence;
+
+ CATCH
+ {
+ default
+ {
+ .payload.say;
+ }
+ };
+}
+
+sub get-lang-detection(utf8:D $text --> Str)
+{
+ my $ua = LWP::UserAgent.new(timeout => $TIMEOUT);
+ $ua.default_header('Authorization' => "Bearer $API-KEY");
+ my $response = $ua.post($URL-DETECT, Content => "q=$text");
+
+ $response.is_success
+ or die $response.status_line ~ ', stopped';
+
+ return $response.decoded_content;
+}
+
+sub get-lang-name(Str:D $lang-code --> Str)
+{
+ return 'Unknown' if $lang-code eq 'Unknown';
+
+ my $ua = LWP::UserAgent.new(timeout => $TIMEOUT);
+ my $response = $ua.get($URL-LANGS);
+
+ $response.is_success
+ or die $response.status_line ~ ', stopped';
+
+ my $content = $response.decoded_content;
+ my $languages = from-json($content);
+ my %languages = $languages.map: { $_{'code'} => $_{'name'} };
+
+ return %languages{$lang-code};
+}
+
+################################################################################
generated by cgit (git 2.34.1) at 2026-05-22 19:31:19 +0000