aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJörg Sommrey <28217714+jo-37@users.noreply.github.com>2023-05-01 22:11:11 +0200
committerJörg Sommrey <28217714+jo-37@users.noreply.github.com>2023-05-01 22:11:11 +0200
commit494087c9511fb60e2f084ddc16287ada9c594cd8 (patch)
treed67ad04e4de1e8044a96414705a80c7623adb801
parent6cc2e38f43011f65d7deaf1e03cf55e4306a53e5 (diff)
parent24fbfdf83065251a1280a215b98ee37703c0c9a0 (diff)
downloadperlweeklychallenge-club-494087c9511fb60e2f084ddc16287ada9c594cd8.tar.gz
perlweeklychallenge-club-494087c9511fb60e2f084ddc16287ada9c594cd8.tar.bz2
perlweeklychallenge-club-494087c9511fb60e2f084ddc16287ada9c594cd8.zip
some more solutions
-rwxr-xr-xchallenge-145/jo-37/perl/ch-1.pl55
-rwxr-xr-xchallenge-146/jo-37/perl/ch-2.pl69
-rwxr-xr-xchallenge-147/jo-37/perl/ch-1.pl70
3 files changed, 194 insertions, 0 deletions
diff --git a/challenge-145/jo-37/perl/ch-1.pl b/challenge-145/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..220093fa67
--- /dev/null
+++ b/challenge-145/jo-37/perl/ch-1.pl
@@ -0,0 +1,55 @@
+#!/usr/bin/perl -s
+
+use v5.24;
+use Test2::V0 '!float';
+use PDL;
+use experimental 'signatures';
+
+our ($tests, $examples);
+
+run_tests() if $tests || $examples; # does not return
+
+die <<EOS unless @ARGV == 2;
+usage: $0 [-examples] [-tests] [X Y]
+
+-examples
+ run the examples from the challenge
+
+-tests
+ run some tests
+
+X Y
+ two vectors in any representation as accepted by the PDL
+ constructor, e.g. x1,x2,...
+
+EOS
+
+
+### Input and Output
+
+say dot_product(@ARGV);
+
+
+### Implementation
+
+sub dot_product ($x, $y) {
+ (pdl($x) x pdl($y)->dummy(0))->sclr;
+}
+
+
+### Examples and tests
+
+sub run_tests {
+ SKIP: {
+ skip "examples" unless $examples;
+
+ is dot_product([1, 2, 3], [4, 5, 6]), 32, 'example';
+ }
+
+ SKIP: {
+ skip "tests" unless $tests;
+ }
+
+ done_testing;
+ exit;
+}
diff --git a/challenge-146/jo-37/perl/ch-2.pl b/challenge-146/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..aedafe7fdd
--- /dev/null
+++ b/challenge-146/jo-37/perl/ch-2.pl
@@ -0,0 +1,69 @@
+#!/usr/bin/perl -s
+
+use v5.24;
+use Test2::V0;
+use experimental 'signatures';
+
+our ($tests, $examples);
+
+run_tests() if $tests || $examples; # does not return
+
+die <<EOS unless @ARGV == 1;
+usage: $0 [-examples] [-tests] [D/N]
+
+-examples
+ run the examples from the challenge
+
+-tests
+ run some tests
+
+D/N
+ fraction
+
+EOS
+
+
+### Input and Output
+
+main: {
+ my @parents;
+ push @parents, curious_parent(split m{/}, shift, 2);
+ push @parents, curious_parent($parents[-1]->@*);
+ local $, = ' ';
+ say map {join '/', @$_} @parents;
+}
+
+
+### Implementation
+
+# The child nodes are made from the parent's
+# - numerator and numerator + denominator
+# - numerator + denominator and denominator
+# In reverse, the parent depends on the order of the child's denominator
+# and numerator and may be reconstructed easily.
+sub curious_parent ($d, $n) {
+ $d < $n ? [$d, $n - $d] : [$d - $n, $n];
+}
+
+
+### Examples and tests
+
+sub run_tests {
+ SKIP: {
+ skip "examples" unless $examples;
+ my $parent = curious_parent(3, 5);
+ is $parent, [3, 2], 'example 1 parent';
+ is curious_parent(@$parent), [1, 2], 'example 1 grandparent';
+
+ $parent = curious_parent(4, 3);
+ is $parent, [1, 3], 'example 2 parent';
+ is curious_parent(@$parent), [1, 2], 'example 2 grandparent';
+ }
+
+ SKIP: {
+ skip "tests" unless $tests;
+ }
+
+ done_testing;
+ exit;
+}
diff --git a/challenge-147/jo-37/perl/ch-1.pl b/challenge-147/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..bef3fd8a26
--- /dev/null
+++ b/challenge-147/jo-37/perl/ch-1.pl
@@ -0,0 +1,70 @@
+#!/usr/bin/perl -s
+
+use v5.24;
+use Test2::V0;
+use warnings FATAL => 'all';
+use Math::Prime::Util qw(fromdigits todigits is_prime);
+use Data::Dump qw(dd pp);
+use experimental 'signatures';
+
+our ($tests, $examples, $base);
+$base ||= 10;
+
+run_tests() if $tests || $examples; # does not return
+
+die <<EOS unless @ARGV;
+usage: $0 [-examples] [-tests] [-base=B] [N]
+
+-examples
+ run the examples from the challenge
+
+-tests
+ run some tests
+
+-base=B
+ use base B. Default: 10
+
+N
+ check if N is a left-truncatable prime in base B
+
+EOS
+
+
+### Input and Output
+
+say 0 + !!is_truncatable_prime(shift, $base);
+
+
+### Implementation
+
+sub is_truncatable_prime ($p, $b) {
+ my @p = todigits($p, $b);
+ while (@p) {
+ $p = fromdigits([@p], $b);
+ return unless is_prime($p);
+ shift @p;
+ }
+ 1;
+}
+
+
+### Examples and tests
+
+sub run_tests {
+ SKIP: {
+ skip "examples" unless $examples;
+
+ ok is_truncatable_prime(9137, 10), 'example';
+ }
+
+ SKIP: {
+ skip "tests" unless $tests;
+
+ ok !is_truncatable_prime(15, 10), '15';
+ ok is_truncatable_prime(17, 10), '17';
+ ok !is_truncatable_prime(19, 10), '19';
+ }
+
+ done_testing;
+ exit;
+}