initial commit

3 files changed, 134 insertions, 0 deletions

diff --git a/challenge-155/adam-russell/blog.txt b/challenge-155/adam-russell/blog.txt
new file mode 100644
index 0000000000..a3022d3ba0
--- /dev/null
+++ b/challenge-155/adam-russell/blog.txt
@@ -0,0 +1 @@
+http://www.rabbitfarm.com/cgi-bin/blosxom/perl/2022/03/13
diff --git a/challenge-155/adam-russell/perl/ch-1.pl b/challenge-155/adam-russell/perl/ch-1.pl
new file mode 100644
index 0000000000..d785c65464
--- /dev/null
+++ b/challenge-155/adam-russell/perl/ch-1.pl
@@ -0,0 +1,85 @@
+use strict;
+use warnings;
+##
+# Write a script to produce the first eight Fortunate Numbers (unique and sorted).
+##
+use boolean;
+use Math::Primality qw/is_prime/;
+
+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 first_n_fortunate{
+    my($n) = @_;
+    my @primes = sieve_atkin(N);
+    my @fortunates;
+    my $x = 1;
+    do{
+        my @first_n_primes = @primes[0 .. $x - 1];
+        my $product_first_n_primes = 1;
+        map {$product_first_n_primes *= $_} @first_n_primes;
+        my $m = 1;
+        do{
+            $m++;
+        }while(!is_prime($product_first_n_primes + $m));
+        if(!grep {$m == $_} @fortunates){
+             unshift @fortunates, $m;
+        }
+        $x++;
+    }while(@fortunates != $n);
+    return sort {$a <=> $b} @fortunates;
+}
+
+MAIN:{
+    print join(", ", first_n_fortunate(8)) . "\n";
+}
\ No newline at end of file
diff --git a/challenge-155/adam-russell/perl/ch-2.pl b/challenge-155/adam-russell/perl/ch-2.pl
new file mode 100644
index 0000000000..978a5645e6
--- /dev/null
+++ b/challenge-155/adam-russell/perl/ch-2.pl
@@ -0,0 +1,48 @@
+use strict;
+use warnings;
+##
+# Write a script to find the period of the third Pisano Period.
+##
+use constant N => 1_000_000_000; 
+
+sub fibonacci_below_n{
+    my($n, $fibonaccis) = @_;
+    $fibonaccis = [1, 1] if !$fibonaccis;
+    my $f = $fibonaccis->[@{$fibonaccis} - 2] + $fibonaccis->[@{$fibonaccis} - 1];
+    if($f < $n){
+        push @{$fibonaccis}, $f;
+        fibonacci_below_n($n, $fibonaccis);
+    }
+    else{
+        return $fibonaccis;
+    }
+}
+
+sub multiplicative_order{
+    my($a, $n) = @_;
+    my $k = 1;
+    my $result = 1;
+    while($k < $n){
+        $result = ($result * $a) % $n;
+        return $k if $result == 1;
+        $k++;
+    }
+    return -1 ;
+}
+
+sub fibonacci_period_mod_n{
+    my($n) = @_;
+    my $fibonaccis = fibonacci_below_n(N);
+    my $k = 1;
+    for my $f (@{$fibonaccis}){
+        if($f % $n == 0){
+            return $k * multiplicative_order($fibonaccis->[$k+1], $n);
+        }
+        $k++;
+    }
+    return -1;
+}
+
+MAIN:{
+    print fibonacci_period_mod_n(3) . "\n";
+}
\ No newline at end of file