PWC 246

PWC 246

For both challenges, I adopt conservative syntax and a procedural programming style mostly skewing towards the Perl 4.036 specification in Programming Perl 1e (pink camel). This is not Perl 4 though, as I take advantage of the map statement and the Perl 5 enhanced grep syntax and also some useful CPAN libraries.

Challenge 1 (6 out of 49)

We are asked to generate 6 random integers between 1 and 49 with no repetitions. This is inspired by a German lottery.

In Perl 5, this can be done by creating a 49-element array of random numbers, say @rnd, and sorting their indices (plus one) based on the order of the random number at that index. We can then just peel off the first 6 indices from the sorted list of indices.

(sort {$rnd[$a-1] <=> $rnd[$b-1]} 1..49)  [0..5]

Here is the full subroutine:

local *six_out_of_49 = sub {
    local @six_out_of_49 = map {rand} 0 .. 48;
    return (sort {$six_out_of_49[$a-1] <=> $six_out_of_49[$b-1]} 1 .. 49) [0 .. 5];
};

Challenge 2 (Linear recurrence of order 2)

We are given a list of 5 integers, say @a. We are asked to test if these form a linear recurrence of order 2. This is defined as follows:

There exist 2 integers p and q such that for all n from 0 to 2:

p.a[n]+q.a[n+1]=a[n+2].

As usual, indices start from 0, so the last element of @a is indexed 4.

I can think of two ways to approach this. One: the task is designed to test a series of lists that have not been purposely created to meet the condition. In that case, we would expect most of the inputs to not satisfy the condition, and we would look for an algorithm that quickly rejects non-conforming inputs. Second: the task is designed to spot non-compliant lists in a series of lists that have been purposely created to satisfy the condition by another program, probably as part of testing and debugging that program. In that case, we would expect most cases to pass, and we would look to quickly accept conforming inputs.

I adopt the first approach.

I first do simple input validation, ensuring that the input is 5 integers:

     #-- input validation (vector of 5 integers)
    
    (@_ == 5) || return "linear_recurrence_2: Input must have 5 elements.";
    
    (sum( map {&is_int($_)} @_ )==5) || return "linear_recurrence_2: Input must be integers."; 
 

I use a nested subroutine &is_int to check that an item is an integer.

 local *is_int = sub {
       ($_[0] =~ /^[-]?[0-9]+$/ ) || (return 0);
       ($_[0] - int($_[0])) == 0;
 };
 

As the test examples hint, if the first two elements of @a have a common divisor say x, for the condition to hold, we need all remaining elements of @a to be also divisible by x. We can therefore find the highest common factor (aka greatest common divisor) of the first two elements (calling the hcf routine from Math::Utils) and immediately return 0 if it fails to be a divisor of any of the remaining elements:

   
    #-- if hcf of 1st 2 elements does not divide into all others, reject
    if (($_[0] != 0) && ($_[1] != 0)){
        local $hcf=hcf( $_[0],$_[1] );
        ( grep { ($_ % $hcf) != 0 } @_[2..4] ) && (return 0);
    }

The core of my algorithm is to get p and q by solving the following pair of simultaneous equations (let me label this pair of equations [1] to refer to later):

p.a[0]+q.a[1]=a[2].
p.a[1]+q.a[2]=a[3].

If we have no issues with division by zero, the solution is given by: (my Perl 5 code with @_ as the vector a in [1])

    else {
        $q= ($_[2]/$_[0]-$_[3]/$_[1]) /
            ($_[1]/$_[0]-$_[2]/$_[1]);
    
        $p=($_[2]/$_[1]-$_[3]/$_[2]) /
            ($_[0]/$_[1]-$_[1]/$_[2]);

    }

We can then proceed to check whether this p and q also satisfies the remaining equation:

p.a[2]+q.a[3]=a[4].

The "else" is because this default solution for p and q depends on no division by zero, so we first use if statements to solve  various special cases where a[0], a[1] and/or a[2] are zero, or where the denominators in the expressions above evaluate to zero. For example if a[1] is zero while a[0] and a[2] are non-zero, we get from [1]:

p=a[2]/a[0].
q=a[3]/a[2].

In the special case where any two consecutive elements are zero, while the succeeding element is non-zero, there is no solution for p and q and we can return 0 (False). p.0+q.0 cannot be non-zero for any integer p and q. It follows from this that the only list with consecutive zero elements that will pass the test is one where every element after the consecutive zeros is zero too. This admits (0,0,0,0,0) where any integer choice of p and q works, and also (x,0,0,0,0), with non-zero x, where we can choose p=q=0.

In the special case where a[1]/a[0] equals a[2]/a[1] equals y say where both  a[0] and a[1] are non-zero, the equation [1] is equivalent to:

p.a[0]+q.a[1]=a[2].
p.a[0].y+q.a[1].y=a[3].

These equations will only have a solution if a[3]=a[2].y. If this is true, then extending the logic to the succeeding set of equations:

p.a[1]+q.a[2]=a[3].
p.a[1].y+q.a[2].y=a[4].

We need a[4]=a[3].y for a solution to exist. If this is true, then the input list satisfies the linear recurrence condition (we can choose for example p=0, q=y if y is an integer). Otherwise, it fails.

Here is the relevant code (I have not been very careful with checking inequality after floating point divisions, but != seems to work fine.):

    elsif ( abs($_[1]/$_[0] - $_[2]/$_[1]) < 0.000001 ) {
        local $ratio = $_[1]/$_[0];
        ($_[3]/$_[2] != $ratio) && return 0;
        ($_[4]/$_[3] != $ratio) ? (return 0) : (return 1);
    }

By itself, this condition is not sufficient. For example, it would admit 81,54,36,24,16 (where y=2/3) where no integer solution for p and q is possible. But this would be ruled out earlier by the HCF test.

I conjecture that any all-integer sequence of the form a[n]=a[0].pow(y,n) (a geometric progression) that is not a linear recurrence of order 2 would fail the HCF test. 

I have not attempted to prove this conjecture rigorously, but as a sketch, if y=c/d, with c,d integers that have no common factors except 1, we would need a[0] to be divisible by d^4, and a[1] by d^3 to ensure an all-integer a[0..4]. This gives the HCF of the first two elements as at least d^3, which would not be a divisor of the later elements. (If we construct the list so that the last element a[4] is divisible by d^3, then we need a[0] to be divisible by d^7, and a[1] to be divisible by  d^6, leading to a similar failure of later elements to be divisible by the HCF of the first two elements). I use the operator "^" here to refer to powers, equivalent to Perl "**".

To test my program, I construct 1,000,000 random sets of 5 integers between -9 and +9 (I use a variation of the Challenge 1 program). This gave around 400 linear recurrences out of 1,000,000 trials and ran in around 23 seconds on my hardware. Here is the code:

local *test_lr2 = sub {
#-- Test &linear_recurrence_2 further:
#-- create 1 million 5-element integer vectors
#-- with elements between -9 and 9
#-- and print out those that are linear recurrences of order 2
    local *rand_seq = sub {    
        local @rand_seq = map {rand} -9 .. 9;
        return (sort {$rand_seq[$a+9] <=> $rand_seq[$b+9]} -9 .. 9) [0 .. 4];
    };
 
    my $ctr=0;
    for (1 .. 1_000_000)  {
        local @test_lr2 = &rand_seq;
        if (&linear_recurrence_2(@test_lr2)) {
            print "@test_lr2"; $ctr++;
        }
    }
    print "--------\nNUMBER OF LINEAR RECURRENCES SECOND ORDER (out of 1,000,000): ",$ctr;  
};

&test_lr2; 

I also tried this with the more general random list generator  

map {-9 + int rand 18} 0 .. 4

which allows repeated elements. This gave around 1500 linear recurrences out of 1,000,000 trials and ran in around 11 seconds on my hardware.

Comments

Post a Comment

Popular posts from this blog

PWC 227

PWC 227 Challenge 1 (Friday 13th) This challenge requires us to count the number of times Friday 13th occurs in a particular year. I use Date::Manip. This module probably has easier ways to do this using a Date Range, but my approach is easy enough. My &friday_13th subroutine takes the year as input, throws an exception if it is outside the specified range (1753 to 9999), and then cycles through the 13th of each month, counting the Fridays. use Date::Manip; my $dateobj=Date::Manip::Date->new(); sub friday_13th {     my ($year)=@_;     my $retval=0;     ( ($year > 9999) || ($year < 1753) ) &&         die "Year should be between 1753 and 9999";     map {         ( ($dateobj->new_date("$year-$_-13")->printf('%w') ) == 5 ) &&             $retval++;     }     1 .. 12;          $retval; }   Challenge 2 (Roman Maths) This challenge requires us to implement a calculator that parses infix math operations using roman numerals.  There
Read more

PWC 234

PWC 234 I tried to restrict to Perl 4 syntax for both challenges this week, as documented in Rex Swain's Perl 4 reference or the 1st edition of Programming perl. I do use nested subroutines, which I am not sure would actually work in Perl 4, though they comply with the syntax. My programs are tested on Perl 5.38. (The -l in the shebang line works only in Perl 5. The Perl 4 equivalent was -L012 in Unix, which is no longer available.) As I have mentioned before, my aims in using the old syntax are just mild nostalgia plus to add a bit of additional challenge to the task. I know that this is not the most efficient or idiomatic way to do things today. But I should observe that it is really cool that I am able to write code using 30-year old syntax, and run it unmodified on the latest Perl 5.38. You cannot do this with Python 3 for example. This very deep backward compatibility is one of those unsung underappreciated beauties of Perl 5. In my opinion, it is a very cool thing in
Read more

PWC 249

PWC 249 Challenge 1 (Equal pairs) We are given a list of integers with an even number of elements. We are asked to check if the list can be completely divided into sub-lists of size 2 with each sub-list containing the same integer repeated, like say (2,2). If so, we are asked to return the list of such sub-lists. This is straightforward in Perl 5. I use modern conveniences this time, though it could be done using only primitive Perl 4 syntax. Here is my subroutine. It returns a list of array references. local *equal_pairs = sub {     #-- return () if input is of odd length     ((scalar(@_) % 2) > 0) && (return ());          #-- count number of occurrences of each element using a hash     local %_ = ();     map {$_{$_}++} @_;          #-- if any element occurs an odd number of times, return ()     (grep {($_{$_} % 2) > 0} keys %_) && (return ());          #-- loop thru %_ keys, returning pairs of such keys     map {         my $k=$_;         my $num_pairs=( ($_{$k}
Read more