RabbitFarm

The examples used here are from The Weekly Challenge problem statement and demonstrate the working solution.

Part 1

Write a script to produce the first eight Fortunate Numbers (unique and sorted).

Solution

use strict;
use warnings;

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";
}

Sample Run

$ perl perl/ch-1.pl
3, 5, 7, 13, 17, 19, 23, 37

Notes

Yet another re-use of my Sieve of Adkin code! Here the sieve is used to generate primes for us to compute primorials, the product of the first n prime numbers. A Fortunate Number is a sequence in which each kth term is the number m such that for the primorial of the first k primes summed with the smallest m,m > 1 such that the sum is prime. It is an unproven conjecture in Number Theory that all terms of the Fortunate Numbers sequence are prime.

Here the code follows pretty directly from the definition with the added restrictions that we must eliminate duplicates and sort the results.

Part 2

Write a script to find the period of the third Pisano Period.

Solution

use strict;
use warnings;

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";
}

Sample Run

$ perl perl/ch-2.pl
8

Notes

It is possible to compute the Pisano period in a fairly direct way. First you must determine the smallest Fibonacci Number evenly divisible by the modulus. Record the index of this term in the sequence, call it k. Compute the multiplicative order M of the k+1st term with the given modulus. The Pisano period is then k * M.

The above code implements that procedure fairly directly. One possible change would be to not pre-compute Fibonacci terms as done here, but for this small problem it hardly matters. Take care if trying this out on very large terms, however.

References

Challenge 155

Fortunate Prime

Multiplicative Order

Pisano Period