Perl Weekly Challenge 159.

My solutions (task 1 and task 2 ) to the The Weekly Challenge - 159.

Task 1: Farey Sequence

Submitted by: Mohammad S Anwar
You are given a positive number, $n.

Write a script to compute Farey Sequence of the order $n.

Example 1:
Input: $n = 5
Output: 0/1, 1/5, 1/4, 1/3, 2/5, 1/2, 3/5, 2/3, 3/4, 4/5,
        1/1.
Example 2:
Input: $n = 7
Output: 0/1, 1/7, 1/6, 1/5, 1/4, 2/7, 1/3, 2/5, 3/7, 1/2, 4/7,
        3/5, 2/3, 5/7, 3/4, 4/5, 5/6, 6/7, 1/1.
Example 3:
Input: $n = 4
Output: 0/1, 1/4, 1/3, 1/2, 2/3, 3/4, 1/1.

The Farey sequence of order N consists of all rational numbers between 0 and 1 with denominator not larger than N when reduced so that there is no common factor in numerator and denominator in ascending order.

A straightforward solution is to generate all rational numbers between 0 and 1 with denominator and numerator not larger than N, filter out those numerators and denominator pairs that are not relative primes, sort and print. This solution may be one-lined:

perl -E 'for(@ARGV){say "Input: $_\nOutput: ", join ", ", map {"$_->[0]/$_->[1]"}
sort {($w,$x,$y,$z)=(@$a, @$b); $w*$z <=>$x*$y} map {$d=$_; map {[$_,$d]}
grep{gcd($_,$d)==1} (0..$d) } (1..$_);} sub gcd{my ($a, $b)=@_;$b&&gcd($b,$a%$b)||$a}
   ' `seq 10`

The greatest common divisor gcd($a,$b) above is tricky. If $b is not zero, it is gcd($b, $a%$b), but if $b==0 it is $a. This was coded with the short-circuit logical operators. To sort the fractions I used that w/x<y/z if w z<x y.

Results:

Input: 1
Output: 0/1, 1/1
Input: 2
Output: 0/1, 1/2, 1/1
Input: 3
Output: 0/1, 1/3, 1/2, 2/3, 1/1
Input: 4
Output: 0/1, 1/4, 1/3, 1/2, 2/3, 3/4, 1/1
Input: 5
Output: 0/1, 1/5, 1/4, 1/3, 2/5, 1/2, 3/5, 2/3, 3/4, 4/5, 1/1
Input: 6
Output: 0/1, 1/6, 1/5, 1/4, 1/3, 2/5, 1/2, 3/5, 2/3, 3/4, 4/5,
        5/6, 1/1
Input: 7
Output: 0/1, 1/7, 1/6, 1/5, 1/4, 2/7, 1/3, 2/5, 3/7, 1/2, 4/7,
        3/5, 2/3, 5/7, 3/4, 4/5, 5/6, 6/7, 1/1
Input: 8
Output: 0/1, 1/8, 1/7, 1/6, 1/5, 1/4, 2/7, 1/3, 3/8, 2/5, 3/7,
        1/2, 4/7, 3/5, 5/8, 2/3, 5/7, 3/4, 4/5, 5/6, 6/7, 7/8,
        1/1
Input: 9
Output: 0/1, 1/9, 1/8, 1/7, 1/6, 1/5, 2/9, 1/4, 2/7, 1/3, 3/8,
        2/5, 3/7, 4/9, 1/2, 5/9, 4/7, 3/5, 5/8, 2/3, 5/7, 3/4,
        7/9, 4/5, 5/6, 6/7, 7/8, 8/9, 1/1
Input: 10
Output: 0/1, 1/10, 1/9, 1/8, 1/7, 1/6, 1/5, 2/9, 1/4, 2/7, 3/10,
        1/3, 3/8, 2/5, 3/7, 4/9, 1/2, 5/9, 4/7, 3/5, 5/8, 2/3,
        7/10, 5/7, 3/4, 7/9, 4/5, 5/6, 6/7, 7/8, 8/9, 9/10, 1/1

Nevertheless, there is a smarter way of generating the Farey numbers in order without having to throw away non-primitive fractions and without having to sort them. This is based on a the nice mediant property: any three consecutive Farey numbers a/b, c/d, and e/f obey c/d=(a+e)/(b+f). This means that a+e=kc and b+f=kd for some common factor k. Therefore, given two consecutive Farey numbers, a/b and c/d, the next one is e/f=(kc-a)/(kd-b). As the denominator kc-a may not be larger than the order N of the sequence, k=⌊(N+b)/d⌋, where ⌊⌋ denote the /floor function, the largest integer not beyond its argument. Thus, an alternative oneliner is

perl -MPOSIX=floor -E 'for(@ARGV){@f=([0,1],[1,$_]);while($f[-1][1]!=1){
($a,$b,$c,$d)=(@{$f[-2]}, @{$f[-1]}); $k=floor(($_+$b)/$d); push @f, [$k*$c-$a, $k*$d-$b]}
say "Input: $_\nOutput: ", join ", ", map {"$_->[0]/$_->[1]"} @f;}' `seq 10`

Results:

Input: 1
Output: 0/1, 1/1
Input: 2
Output: 0/1, 1/2, 1/1
Input: 3
Output: 0/1, 1/3, 1/2, 2/3, 1/1
Input: 4
Output: 0/1, 1/4, 1/3, 1/2, 2/3, 3/4, 1/1
Input: 5
Output: 0/1, 1/5, 1/4, 1/3, 2/5, 1/2, 3/5, 2/3, 3/4, 4/5, 1/1
Input: 6
Output: 0/1, 1/6, 1/5, 1/4, 1/3, 2/5, 1/2, 3/5, 2/3, 3/4, 4/5, 5/6, 1/1
Input: 7
Output: 0/1, 1/7, 1/6, 1/5, 1/4, 2/7, 1/3, 2/5, 3/7, 1/2, 4/7, 3/5, 2/3, 5/7, 3/4, 4/5, 5/6, 6/7, 1/1
Input: 8
Output: 0/1, 1/8, 1/7, 1/6, 1/5, 1/4, 2/7, 1/3, 3/8, 2/5, 3/7, 1/2, 4/7, 3/5, 5/8, 2/3, 5/7, 3/4, 4/5, 5/6, 6/7, 7/8, 1/1
Input: 9
Output: 0/1, 1/9, 1/8, 1/7, 1/6, 1/5, 2/9, 1/4, 2/7, 1/3, 3/8, 2/5, 3/7, 4/9, 1/2, 5/9, 4/7, 3/5, 5/8, 2/3, 5/7, 3/4, 7/9, 4/5, 5/6, 6/7, 7/8, 8/9, 1/1
Input: 10
Output: 0/1, 1/10, 1/9, 1/8, 1/7, 1/6, 1/5, 2/9, 1/4, 2/7, 3/10, 1/3, 3/8, 2/5, 3/7, 4/9, 1/2, 5/9, 4/7, 3/5, 5/8, 2/3, 7/10, 5/7, 3/4, 7/9, 4/5, 5/6, 6/7, 7/8, 8/9, 9/10, 1/1

A full version is

 1  # Perl weekly challenge 159
 2  # Task 1: Farey sequence
 3  #
 4  # See https://wlmb.github.io/2022/04/05/PWC159/#task-1-farey-sequence
 5  use v5.12;
 6  use warnings;
 7  use POSIX qw(floor);
 8  use Text::Wrap qw(wrap $columns $break);
 9  die "Usage: ./ch-1.pl N1 [N2... ]\n to print Farey sequences of order N1, N2..." unless @ARGV;
10  for(@ARGV){
11      my @farey=([0,1],[1,$_]);
12      while($farey[-1][1]!=1){
13          my ($a,$b,$c,$d)=(@{$farey[-2]}, @{$farey[-1]});
14          my $k=floor(($_+$b)/$d);
15  	push @farey, [$k*$c-$a, $k*$d-$b];
16      }
17      $columns=62; $break=qr/\s/;
18      say "Input: $_\n",wrap("", "        ", "Output: ",
19  	join ", ",
20  	map {"$_->[0]/$_->[1]"} @farey);
21  }

./ch-1.pl `seq 10`

Results:

Input: 1
Output: 0/1, 1/1
Input: 2
Output: 0/1, 1/2, 1/1
Input: 3
Output: 0/1, 1/3, 1/2, 2/3, 1/1
Input: 4
Output: 0/1, 1/4, 1/3, 1/2, 2/3, 3/4, 1/1
Input: 5
Output: 0/1, 1/5, 1/4, 1/3, 2/5, 1/2, 3/5, 2/3, 3/4, 4/5, 1/1
Input: 6
Output: 0/1, 1/6, 1/5, 1/4, 1/3, 2/5, 1/2, 3/5, 2/3, 3/4,
	4/5, 5/6, 1/1
Input: 7
Output: 0/1, 1/7, 1/6, 1/5, 1/4, 2/7, 1/3, 2/5, 3/7, 1/2,
	4/7, 3/5, 2/3, 5/7, 3/4, 4/5, 5/6, 6/7, 1/1
Input: 8
Output: 0/1, 1/8, 1/7, 1/6, 1/5, 1/4, 2/7, 1/3, 3/8, 2/5,
	3/7, 1/2, 4/7, 3/5, 5/8, 2/3, 5/7, 3/4, 4/5, 5/6,
	6/7, 7/8, 1/1
Input: 9
Output: 0/1, 1/9, 1/8, 1/7, 1/6, 1/5, 2/9, 1/4, 2/7, 1/3,
	3/8, 2/5, 3/7, 4/9, 1/2, 5/9, 4/7, 3/5, 5/8, 2/3,
	5/7, 3/4, 7/9, 4/5, 5/6, 6/7, 7/8, 8/9, 1/1
Input: 10
Output: 0/1, 1/10, 1/9, 1/8, 1/7, 1/6, 1/5, 2/9, 1/4, 2/7,
	3/10, 1/3, 3/8, 2/5, 3/7, 4/9, 1/2, 5/9, 4/7, 3/5,
	5/8, 2/3, 7/10, 5/7, 3/4, 7/9, 4/5, 5/6, 6/7, 7/8,
	8/9, 9/10, 1/1

Task 2: Moebius Number

Submitted by: Mohammad S Anwar
You are given a positive number $n.

Write a script to generate the Moebius Number for the given
number. Please refer to wikipedia page for more informations.

Example 1:
Input: $n = 5
Output: -1
Example 2:
Input: $n = 10
Output: 1
Example 3:
Input: $n = 20
Output: 0

The Moebius number μ(n) of a number n is 0 if it is divisible by the square of a prime. Otherwise, it is μ(n)=(-1)f, where f is the number of (non-repeating) prime factors. The package Math::Prime::Util contains a routine moebius, so that, taking advantage of the work of others, a oneliner solution is

perl -MMath::Prime::Util=moebius -E 'say "Input: $_ Output: ", moebius($_) for(@ARGV)' 5 10 20

Results:

Input: 5 Output: -1
Input: 10 Output: 1
Input: 20 Output: 0

Now I write a oneliner that starts from scratch but uses the Perl Data Language (PDL) to first obtain a list of primes, then filter it to get a list of factors, and multiplies them (each distinct factor once) and compares the result to the original number. A mismatch means the number has squared prime factors and μ(n)=0. Otherwise, the parity of the number of factors determines the sign of μ(n)=±1.

perl -MPDL -MPDL::NiceSlice -E 'for(@ARGV){$f=ones($_+1); $f(0:1).=0;
$f($_**2:-1:$_).=0 for(2..sqrt($_)); $p=$f->xvals->where($f); $g=$p->where($_%$p==0);
$h=$g->prodover; say "Input: $_ Output: ", $h==$_?$g->nelem%2?-1:1:0;}' 5 10 20

Results:

Input: 5 Output: -1
Input: 10 Output: 1
Input: 20 Output: 0

The full version of this solution follows:

 1  # Perl weekly challenge 159
 2  # Task 2: Moebius number
 3  #
 4  # See https://wlmb.github.io/2022/04/05/PWC159/#task-2-moebius-number
 5  use v5.12;
 6  use warnings;
 7  use PDL;
 8  use PDL::NiceSlice;
 9  die "Usage: ./ch-2.pl N1 [N2... ]\n to find the Moebius numbers of N1, N2..." unless @ARGV;
10  for(@ARGV){
11      my $sieve=ones($_+1); # Eratosthenes sieve
12      $sieve(0:1).=0;
13      $sieve($_**2:-1:$_).=0 for(2..sqrt($_)); # 1=prime, 0=nonprime
14      my $primes=$sieve->xvals->where($sieve); # primes
15      my $factors=$primes->where($_%$primes==0); # prime factors
16      my $prod=$factors->prodover; # product of factors, once each
17      my $square_free=$prod==$_;
18      my $parity=$factors->nelem%2?-1:1;
19      say "Input: $_ Output: ", $square_free?$parity:0;
20  }

./ch-2.pl 5 10 20

Results:

Input: 5 Output: -1
Input: 10 Output: 1
Input: 20 Output: 0
Written on April 5, 2022