Perl Weekly Challenge 157.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 157.
Task 1: Pythagorean Means
Submitted by: Mohammad S Anwar
You are given a set of integers.
Write a script to compute all three Pythagorean Means i.e
Arithmetic Mean, Geometric Mean and Harmonic Mean of the given
set of integers. Please refer to wikipedia page for more
informations.
Example 1:
Input: @n = (1,3,5,6,9)
Output: AM = 4.8, GM = 3.9, HM = 2.8
Example 2:
Input: @n = (2,4,6,8,10)
Output: AM = 6.0, GM = 5.2, HM = 4.4
Example 3:
Input: @n = (1,2,3,4,5)
Output: AM = 3.0, GM = 2.6, HM = 2.2
I just apply the definitions. The arithmetic mean of a sequence of N numbers is their sum divided by N, their geometric mean is the N-th root of their product, and their harmonic mean is the inverse of the arithmetic mean of their inverses. That yields a simple oneliner. .
perl -MList::Util=sum0,product -E 'say "In: ", join ", ", @ARGV; say sprintf
"AM=%.2f GM=%.2f HM=%.2f", sum0(@ARGV)/@ARGV, product(@ARGV)**(1/@ARGV),
@ARGV/sum0(map {1/$_} (@ARGV));
' 1 3 5 6 9
perl -MList::Util=sum0,product -E 'say "In: ", join ", ", @ARGV;
say sprintf "AM=%.2f GM=%.2f HM=%.2f", sum0(@ARGV)/@ARGV, product(@ARGV)**(1/@ARGV),
@ARGV/sum0(map {1/$_} (@ARGV));
' 2 4 6 8 10
perl -MList::Util=sum0,product -E 'say "In: ", join ", ", @ARGV;
say sprintf "AM=%.2f GM=%.2f HM=%.2f", sum0(@ARGV)/@ARGV, product(@ARGV)**(1/@ARGV),
@ARGV/sum0(map {1/$_} (@ARGV));
' 1 2 3 4 5
Results:
In: 1, 3, 5, 6, 9
AM=4.80 GM=3.82 HM=2.76
In: 2, 4, 6, 8, 10
AM=6.00 GM=5.21 HM=4.38
In: 1, 2, 3, 4, 5
AM=3.00 GM=2.61 HM=2.19
My first geometric mean disagrees in the first example with that in the problem statement; I guess it is a typo.
The full version is almost identical. I add a few checks.
1 # Perl weekly challenge 157
2 # Task 1: Pythagorean means
3 #
4 # See https://wlmb.github.io/2022/03/21/PWC157/#task-1-pythagorean-means
5 use v5.12;
6 use warnings;
7 use List::Util qw(sum0 product any);
8 die "Usage: ./ch-1.pl N1 N2 N3 ... to get the means of the numbers Ni..." unless @ARGV;
9 say "In: ", join ", ", @ARGV;
10 my $AM= sprintf "%.2f", sum0(@ARGV)/@ARGV; # arithmetic mean
11 my $product=product(@ARGV);
12 my $GM=($product<0 && @ARGV%2==0)? "Undefined":sprintf "%.2f", $product**(1/@ARGV);
13 my $HM=(any{$_==0} (@ARGV))?"Undefined":sprintf "%.2f", @ARGV/sum0(map {1/$_} (@ARGV));
14 say sprintf "AM=$AM GM=$GM HM=$HM";
Examples:
./ch-1.pl 1 3 5 6 9
./ch-1.pl 2 4 6 8 10
./ch-1.pl 1 2 3 4 5
Results:
In: 1, 3, 5, 6, 9
AM=4.80 GM=3.82 HM=2.76
In: 2, 4, 6, 8, 10
AM=6.00 GM=5.21 HM=4.38
In: 1, 2, 3, 4, 5
AM=3.00 GM=2.61 HM=2.19
Examples with errors:
./ch-1.pl 0 1 2 3
./ch-1.pl 1 2 3 -4
Results:
In: 0, 1, 2, 3
AM=1.50 GM=0.00 HM=Undefined
In: 1, 2, 3, -4
AM=0.50 GM=Undefined HM=2.53
Task 2: Brazilian Number
Submitted by: Mohammad S Anwar
You are given a number $n > 3.
Write a script to find out if the given number is a Brazilian
Number.
A positive integer number N has at least one natural number B
where 1 < B < N-1 where the representation of N in base B has
same digits.
Example 1:
Input: $n = 7
Output: 1
Since 7 in base 2 is 111.
Example 2:
Input: $n = 6
Output: 0
Since 6 in base 2 is 110,
6 in base 3 is 30 and
6 in base 4 is 12.
Example 3:
Input: $n = 8
Output: 1
Since 8 in base 3 is 22.
A Brazilian number in base B with M repeated digits D is of the form N=DDDD..DDD=D BM-1 + D BM-2+…+D B1+D B0=D(BM-1)/(B-1) after factorizing D and simplifying the geometric sum. As the largest value of D is B-1, N is smaller than BM. Thus, for a given base, B, I can find M as the smallest integer larger than log(N)/log(B). From M, I can obtain D=N*(B-1)/(D**{M}-1). Therefore, a number N is Brazilian if for some base between 2 and N-2, the number D obtained above is an integer. This yields the simple one liner:
perl -MPOSIX=ceil,floor -E 'N:for $n(@ARGV){for $b(2..$n-2){$m=ceil(log($n)/log($b));
$d=floor($n*($b-1)/($b**$m-1)); say("$n=", (($d)x$m)," in base $b is Brazilian"), next N
if $d*($b**$m-1)/($b-1)==$n} say "$n is not Brazilian"} ' `seq 30`
Results:
1 is not Brazilian
2 is not Brazilian
3 is not Brazilian
4 is not Brazilian
5 is not Brazilian
6 is not Brazilian
7=111 in base 2 is Brazilian
8=22 in base 3 is Brazilian
9 is not Brazilian
10=22 in base 4 is Brazilian
11 is not Brazilian
12=22 in base 5 is Brazilian
13=111 in base 3 is Brazilian
14=22 in base 6 is Brazilian
15=1111 in base 2 is Brazilian
16=22 in base 7 is Brazilian
17 is not Brazilian
18=33 in base 5 is Brazilian
19 is not Brazilian
20=22 in base 9 is Brazilian
21=111 in base 4 is Brazilian
22=22 in base 10 is Brazilian
23 is not Brazilian
24=44 in base 5 is Brazilian
25 is not Brazilian
26=222 in base 3 is Brazilian
27=33 in base 8 is Brazilian
28=44 in base 6 is Brazilian
29 is not Brazilian
30=33 in base 9 is Brazilian
The full code is:
1 # Perl weekly challenge 157
2 # Task 2: Brazilian number
3 #
4 # See https://wlmb.github.io/2022/03/21/PWC157/#task-2-brazilian-number
5 use v5.12;
6 use warnings;
7 use POSIX qw(ceil floor);
8 N:
9 for my $n(@ARGV){
10 for my $b(2..$n-2){
11 my $m=ceil(log($n)/log($b));
12 my $d=floor($n*($b-1)/($b**$m-1));
13 say("$n=", (($d)x$m)," in base $b is Brazilian"), next N
14 if $d*($b**$m-1)/($b-1)==$n
15 }
16 say "$n is not Brazilian"
17 }
./ch-2.pl `seq 30`
Results:
1 is not Brazilian
2 is not Brazilian
3 is not Brazilian
4 is not Brazilian
5 is not Brazilian
6 is not Brazilian
7=111 in base 2 is Brazilian
8=22 in base 3 is Brazilian
9 is not Brazilian
10=22 in base 4 is Brazilian
11 is not Brazilian
12=22 in base 5 is Brazilian
13=111 in base 3 is Brazilian
14=22 in base 6 is Brazilian
15=1111 in base 2 is Brazilian
16=22 in base 7 is Brazilian
17 is not Brazilian
18=33 in base 5 is Brazilian
19 is not Brazilian
20=22 in base 9 is Brazilian
21=111 in base 4 is Brazilian
22=22 in base 10 is Brazilian
23 is not Brazilian
24=44 in base 5 is Brazilian
25 is not Brazilian
26=222 in base 3 is Brazilian
27=33 in base 8 is Brazilian
28=44 in base 6 is Brazilian
29 is not Brazilian
30=33 in base 9 is Brazilian
Written on March 21, 2022