Merge pull request #6202 from E7-87-83/newt

Week 167

2 files changed, 201 insertions, 0 deletions

diff --git a/challenge-167/cheok-yin-fung/perl/ch-1.pl b/challenge-167/cheok-yin-fung/perl/ch-1.pl
new file mode 100644
index 0000000000..8f13197b81
--- /dev/null
+++ b/challenge-167/cheok-yin-fung/perl/ch-1.pl
@@ -0,0 +1,106 @@
+#!/usr/bin/perl
+# The Weekly Challenge 167
+# Task 1 Circular Prime
+
+# Array @c_prime Indexing following OEIS:A068652; 
+#    thus set $c_prime[0] as -1
+use v5.24.0;
+use warnings;
+use List::Util qw/min reduce pairmap any all/;
+
+
+
+my @c_prime = ("-1", 2, 3, 5, 7, 11, 13, 17, 31, 37, 71, 73, 79, 97);
+my @circular_prime = (2, 3, 5, 7, 11, 13, 17, 37, 79);
+
+my $num = 10 + scalar @circular_prime;
+
+
+
+while ( scalar @circular_prime < $num ) {
+    my $candidate = reduce {$a . $b} my_permute();
+
+    if (prime_test($candidate)) {
+        my $younger_self = min_self($candidate);
+        if ($younger_self != $candidate) {
+            push @c_prime, $candidate
+                if any {$_ == $younger_self} @circular_prime; 
+        }
+        elsif (all { prime_test($_) } cyclic($candidate)->@*) {
+            push @c_prime, $candidate;
+            push @circular_prime, $candidate;
+        }
+    }
+}
+
+
+
+sub my_permute {
+
+    state $permuted = 1;
+    state $len = 3;
+    state $ordered = 0;
+
+    my @digits = (1, 3, 7, 9);
+    my @a_base4num;
+
+    my $bin = sprintf("%b", $ordered);
+    # generate bit string here
+    $bin = ( "0" x ($len*2 - length $bin) ) . $bin;
+    # convert bit string to base-4 integer representation
+    @a_base4num = pairmap { $a*2 + $b } split("", $bin);
+
+    $permuted = join "", map { $digits[$_] }  @a_base4num;
+
+    if ($permuted =~ /^9+$/) {
+        $len++;
+        $ordered = 0;
+    }
+    else {
+        $ordered++;
+    }
+
+    return $permuted;
+}
+
+
+
+sub prime_test {
+    my $n = $_[0];
+    return 0 if $n % 3 == 0;
+    my $k = 1;
+    while ( 6*$k <= sqrt($n) ) {
+        return 0 if $n % (6*$k-1) == 0;
+        return 0 if $n % (6*$k+1) == 0;
+        $k++;
+    }
+    return 1;
+}
+
+
+
+sub cyclic {
+    my $w = $_[0];
+    my $ans = [$w];
+    my @arr = split "", $w;
+    for (1..(length $w) - 1) {
+        push $ans->@*, substr($w, $_). substr($w, 0, $_)
+    }
+    return $ans;
+}
+
+
+
+sub min_self {
+    return min(cyclic($_[0])->@*);
+}
+
+
+
+
+use Test::More tests => 2;
+my $task_requirement = join ", ", @circular_prime[9..9+9];
+ok 
+    $task_requirement eq
+      "113, 197, 199, 337, 1193, 3779, 11939, 19937, 193939, 199933";
+ok $c_prime[30] == 7793;
diff --git a/challenge-167/cheok-yin-fung/perl/ch-2.pl b/challenge-167/cheok-yin-fung/perl/ch-2.pl
new file mode 100644
index 0000000000..93bc6aec76
--- /dev/null
+++ b/challenge-167/cheok-yin-fung/perl/ch-2.pl
@@ -0,0 +1,95 @@
+#!/usr/bin/perl
+# The Weekly Challenge 167
+# Task 2 Gamma Function
+# simplified "translation" from Maxima code: 
+#     https://mrob.com/pub/ries/lanczos-gamma.html
+use v5.24.0;
+use warnings;
+
+say l_gamma($ARGV[0]) if defined($ARGV[0]);
+
+
+
+sub lanczos_log_gamma {
+    my $pi = 4*atan2(1,1);
+
+    my $ln_sqrt_2_pi = log sqrt (2*$pi);
+
+    my $LG_g = 5;
+    # (from mrob.com) set of parameters from: Takusagawa, Press, Borgelt
+    my @lct = (
+         1.000000000190015,
+        76.18009172947146,
+       -86.50532032941677,
+        24.01409824083091,
+        -1.231739572450155,
+         0.1208650973866179e-2,
+        -0.5395239384953e-5
+    );
+
+=pod Another Set of Paramaters (also from mrob.com)
+   # which in turn is from from Mihai Preda and/or Paul Godfrey  
+    
+    my $LG_g = 4.7421875;
+    my @lct = qw{
+        0.99999999999999709182
+        57.156235665862923517
+        -59.597960355475491248
+        14.136097974741747174
+        -0.49191381609762019978
+        .33994649984811888699e-4
+        .46523628927048575665e-4
+        -.98374475304879564677e-4
+        .15808870322491248884e-3
+        -.21026444172410488319e-3
+        .21743961811521264320e-3
+        -.16431810653676389022e-3
+        .84418223983852743293e-4
+        -.26190838401581408670e-4
+        .36899182659531622704e-5 };
+=cut
+
+    my $z = $_[0];
+    $z = $z-1;
+    my $base = $z + $LG_g + 0.5;
+    my $sum = 0;
+    for (reverse (1 .. $#lct)) {
+        $sum += $lct[$_] / ($z + $_);
+    }
+    $sum += $lct[0];
+    return (($ln_sqrt_2_pi + log($sum)) - $base) + log($base)*($z+0.5);
+}
+
+
+
+sub l_gamma {
+    my $z = $_[0];
+    die "This simple script not supported real number smaller than 0.5.\n" 
+        if $z <= 0.5;
+
+    return exp(lanczos_log_gamma($z));
+}
+
+
+
+use Test::More tests => 10;
+# ref: https://en.wikipedia.org/wiki/Gamma_function#Particular_values
+
+sub accept_test {
+    my $parameter = $_[0];
+    my $part_val = $_[1];
+    my $acceptable_error = 1e-5;
+    ok abs( l_gamma($parameter) - $part_val ) < $acceptable_error;
+}
+
+accept_test(1, 1);
+accept_test(1.5, 0.88622_69254_52758_01364);
+accept_test(2, 1);
+accept_test(2.5, 1.32934_03881_79137_02047);
+accept_test(3, 2);
+accept_test(3.5, 3.32335_09704_47842_55118);
+accept_test(4, 6);
+accept_test(5, 24);
+accept_test(7, 720);
+accept_test(11, 3628800);
+