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 258

PWC 258 Last week (#257) I finished challenge 2 and my blog post for challenge 257 late last week, so had only submitted challenge 1. Here is my blog post for PWC 257 , including the full code for my challenge 2 solution. This week, I have done both challenges in perl 4.019 on DOSBOX. Both scripts also work fine on the latest Perl 5.38. I also did the challenges in Raku, where they are one-liners.  Challenge 1 (Count Even Digits Number) We are given a list of integers, and asked to count the number of elements whose base-10 representation has an even number of digits. In Raku , this is a one-liner. Here it is: raku -e 'say +@*ARGS.grep({$_.chars %% 2})' $@ It could be a one-liner in Perl 4 too, but since I run it on DOSBOX, my script would not be a bash shell script. Here is the short subroutine that does the job.  sub count_even_digits {  scalar( grep( ((length($_) % 2) == 0), @_) ); } The full code is here . Challenge 2 (Sum of values) We are given an integer k  an...
Read more

PWC 253

PWC 253 I do both challenges this week using old software on DOSBOX: perl 4.019, and for comparison, also python 1.4 beta. My solutions also work on the current versions of Perl 5 (5.38) and Python 2 (2.7.18) respectively. Challenge 1 (Split Strings) Links to code: perl4.019 python1.4b We are given a list of strings, and a single character say sep . We are asked to return the list, with the strings split into component substrings using sep as a separator. We should not include any empty strings in the output. In perl 4, I first stick a backslash in front of the separator character, so that it is escaped if entered in a regex. This is because the perl split function takes a regex as its first argument indicating the separator. If we have a character like '$' or ',', we want to escape it so that it is read literally when parsing the regex. Here is the key subroutine:   sub split_strings {  local ($separator, @words)=@_;  local (@retval)=(); #array to be returned  # ...
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 %_) &&...
Read more