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