Merge pull request #5525 from adamcrussell/challenge-147

initial commit

6 files changed, 179 insertions, 0 deletions

diff --git a/challenge-147/adam-russell/blog.txt b/challenge-147/adam-russell/blog.txt
new file mode 100644
index 0000000000..6ba83d955a
--- /dev/null
+++ b/challenge-147/adam-russell/blog.txt
@@ -0,0 +1 @@
+http://www.rabbitfarm.com/cgi-bin/blosxom/perl/2022/01/16
diff --git a/challenge-147/adam-russell/blog1.txt b/challenge-147/adam-russell/blog1.txt
new file mode 100644
index 0000000000..7b1bb684d3
--- /dev/null
+++ b/challenge-147/adam-russell/blog1.txt
@@ -0,0 +1 @@
+http://www.rabbitfarm.com/cgi-bin/blosxom/prolog/2022/01/16
diff --git a/challenge-147/adam-russell/perl/ch-1.pl b/challenge-147/adam-russell/perl/ch-1.pl
new file mode 100644
index 0000000000..3940e53d2e
--- /dev/null
+++ b/challenge-147/adam-russell/perl/ch-1.pl
@@ -0,0 +1,83 @@
+use strict;
+use warnings;
+##
+# Write a script to generate first 20 left-truncatable prime numbers in base 10.
+##
+use boolean;
+use constant N => 10_000; 
+
+sub sieve_atkin{
+    my($n) = @_;
+    my @primes = (2, 3, 5);
+    my $upper_bound = int($n * log($n) + $n * log(log($n)));
+    my @atkin = (false) x $upper_bound;    
+    my @sieve = (1, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 49, 53, 59);
+    for my $x (1 .. sqrt($upper_bound)){
+        for(my $y = 1; $y <= sqrt($upper_bound); $y+=2){
+            my $m = (4 * $x ** 2) + ($y ** 2);
+            my @remainders;  
+            @remainders = grep {$m % 60 == $_} (1, 13, 17, 29, 37, 41, 49, 53) if $m <= $upper_bound; 
+            $atkin[$m] = !$atkin[$m] if @remainders; 
+        }          
+    } 
+    for(my $x = 1; $x <= sqrt($upper_bound); $x += 2){
+        for(my $y = 2; $y <= sqrt($upper_bound); $y += 2){
+            my $m = (3 * $x ** 2) + ($y ** 2);
+            my @remainders;  
+            @remainders = grep {$m % 60 == $_} (7, 19, 31, 43) if $m <= $upper_bound; 
+            $atkin[$m] = !$atkin[$m] if @remainders; 
+        }          
+    }   
+    for(my $x = 2; $x <= sqrt($upper_bound); $x++){
+        for(my $y = $x - 1; $y >= 1; $y -= 2){
+            my $m = (3 * $x ** 2) - ($y ** 2);
+            my @remainders;  
+            @remainders = grep {$m % 60 == $_} (11, 23, 47, 59) if $m <= $upper_bound;
+            $atkin[$m] = !$atkin[$m] if @remainders; 
+        }          
+    } 
+    my @m;
+    for my $w (0 .. ($upper_bound / 60)){
+        for my $s (@sieve){
+            push @m, 60 * $w + $s;  
+        }
+    }
+    for my $m (@m){
+        last if $upper_bound < ($m ** 2);
+        my $mm = $m ** 2;
+        if($atkin[$m]){
+            for my $m2 (@m){
+                my $c = $mm * $m2;
+                last if $c > $upper_bound;
+                $atkin[$c] = false;
+            }
+        }
+    }
+    map{ push @primes, $_ if $atkin[$_] } 0 .. @atkin - 1;
+    return @primes; 
+}
+
+sub truncatable{
+    my($prime, $primes) = @_;
+    return false if $prime =~ m/0/;
+    my @truncatable = map { my $p = substr($prime, -1 * $_, $_); grep {$p == $_} @{$primes}} 1 .. length($prime);
+    return @truncatable == length($prime);
+}
+
+sub first_n_truncatable_primes{
+    my($n) = @_;
+    my @primes = sieve_atkin(N);
+    my @truncatable;
+    for my $prime (@primes){
+        push @truncatable, $prime if truncatable($prime, \@primes);
+        last if @truncatable == $n;
+    }
+    return @truncatable;
+}
+
+
+
+MAIN:{
+    print join(", ", first_n_truncatable_primes(20)) . "\n";
+
+}
\ No newline at end of file
diff --git a/challenge-147/adam-russell/perl/ch-2.pl b/challenge-147/adam-russell/perl/ch-2.pl
new file mode 100644
index 0000000000..0126f4a084
--- /dev/null
+++ b/challenge-147/adam-russell/perl/ch-2.pl
@@ -0,0 +1,49 @@
+use strict;
+use warnings;
+##
+# Write a sript to find the first pair of Pentagon Numbers 
+# whose sum and difference are also a Pentagon Number.
+##
+use constant N => 10_000;
+
+sub n_pentagon_numbers{
+    my($n) = @_;
+    my @pentagon_numbers;
+    my $x = 1;
+    my %h;
+    do{
+        my $pentagon = $x * (3 * $x - 1) / 2;
+        push @pentagon_numbers, $pentagon;
+        $h{"$pentagon"} = $x;
+        $x++;
+    }while(@pentagon_numbers < $n);
+    return (\@pentagon_numbers, \%h);
+}
+
+sub pairs_pentagon{
+    my($n) = @_;
+    my($pentagons, $lookup) = n_pentagon_numbers(N);
+    my @pairs;
+    for my $x (0 .. @{$pentagons} - 1){
+        for my $y (0 .. @{$pentagons} - 1){
+            unless($x == $y){
+                my($sum, $difference) = ($pentagons->[$x] + $pentagons->[$y], abs($pentagons->[$x] - $pentagons->[$y]));
+                 if($lookup->{$sum} && $lookup->{$difference}){
+                     my($s, $t) = ($x + 1, $y + 1);
+                     push @pairs, ["P($s)", "P($t)"]
+                 }
+            }
+            last if @pairs == $n;
+        }
+        last if @pairs == $n;
+    }
+    return @pairs;
+}
+
+sub first_pair_pentagon{
+    return [pairs_pentagon(1)];
+}
+
+MAIN:{
+    print join(", ", @{first_pair_pentagon()->[0]}) . "\n";
+}
\ No newline at end of file
diff --git a/challenge-147/adam-russell/prolog/ch-1.p b/challenge-147/adam-russell/prolog/ch-1.p
new file mode 100644
index 0000000000..25b6da4de0
--- /dev/null
+++ b/challenge-147/adam-russell/prolog/ch-1.p
@@ -0,0 +1,27 @@
+:-initialization(main).
+
+left_truncatable(X):-
+    fd_labeling(X),
+    number_codes(X, C),
+    \+ member(48, C),
+    length(C, L),
+    findall(Truncatable, (
+        between(1, L, N),
+        length(T, N),
+        append(_, T, C),
+        number_codes(Truncatable, T),
+        fd_prime(Truncatable)), Truncatables),
+     length(Truncatables, NumberTruncatable),   
+     L == NumberTruncatable.  
+
+first_twenty_left_truncatable(FirstTwenty):-
+    length(FirstTwenty, 20),
+    fd_domain(FirstTwenty, 1, 200),
+    fd_all_different(FirstTwenty),
+    maplist(left_truncatable, FirstTwenty), 
+    fd_labeling(FirstTwenty). 
+
+main:-
+    first_twenty_left_truncatable(FirstTwenty),
+    write(FirstTwenty), nl,
+    halt.
\ No newline at end of file
diff --git a/challenge-147/adam-russell/prolog/ch-2.p b/challenge-147/adam-russell/prolog/ch-2.p
new file mode 100644
index 0000000000..af3a3bf8ad
--- /dev/null
+++ b/challenge-147/adam-russell/prolog/ch-2.p
@@ -0,0 +1,18 @@
+n_pentagon_numbers(0, []).
+n_pentagon_numbers(N, [H|T]):-
+    H #= N * (3 * N - 1) / 2,
+    Next #= N - 1,
+    n_pentagon_numbers(Next, T).
+    
+first_pair_pentagon(FirstPair):-
+    n_pentagon_numbers(10000, Pentagons),
+    fd_domain([X, Y, Sum, AbsoluteDifference], Pentagons),
+    Sum #= X + Y,
+    Difference #= X - Y,
+    ((
+        Difference #< 0, 
+        AbsoluteDifference #= -1 * Difference
+    ); AbsoluteDifference #= Difference),
+    fd_labeling([X, Y]),
+    FirstPair = [X, Y].    
+    
\ No newline at end of file