Perl Weekly Challenge 142.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 142.
Task 1: Divisor Last Digit
Submitted by: Mohammad S Anwar
You are given positive integers, $m and $n.
Write a script to find total count of divisors of $m having
last digit $n.
Example 1:
Input: $m = 24, $n = 2
Output: 2
The divisors of 24 are 1, 2, 3, 4, 6, 8 and 12.
There are only 2 divisors having last digit 2 are 2 and 12.
Example 2:
Input: $m = 30, $n = 5
Output: 2
The divisors of 30 are 1, 2, 3, 5, 6, 10 and 15.
There are only 2 divisors having last digit 5 are 5 and 15.
A simple solution is to find pairs of divisors of $m by
testing all numbers up to sqrt($m). I believe the examples
above are not quite correct: If 1 is considered a divisor of $m, then $m itself
should be considered a divisor, as $m=1×$m. Nevertheless,
I’ll follow the examples in the following and exclude $m
itself as a divisor. If
$p(<sqrt($m)) divides $m, then $m/$p(>sqrt($m))~ is also a divisor.
Thus, divisors come in pairs, except $p=1, as we
exclude (arbitrarily) $m from the list of divisors, and
sqrt($m), in case it is also a divisor, as $m/sqrt($m)=sqrt($m)
is not a new divisor.
perl -E '($m,$n)=@ARGV; $q=sqrt($m); say "Input: m=$m n=$n, Output: ",
scalar grep {$_=~/$n$/} map {1<$_<$q?($_, $m/$_):$_} grep {$m%$_==0}(1..$q)' 24 2
perl -E '($m,$n)=@ARGV; $q=sqrt($m); say "Input: m=$m n=$n, Output: ",
scalar grep {$_=~/$n$/} map {1<$_<$q?($_, $m/$_):$_} grep {$m%$_==0}(1..$q)' 30 5
Results:
Input: m=24 n=2, Output: 2
Input: m=30 n=5, Output: 2
I tested above the last digit with a regular expression. This allows testing for more than one digit. For example,
perl -E '($m,$n)=@ARGV; $q=sqrt($m); say "Input: m=$m n=$n, Output: ",
scalar grep {$_=~/$n$/} map {1<$_<$q?($_, $m/$_):$_} grep {$m%$_==0}(1..$q)' 1024 56
Results:
Input: m=1024 n=56, Output: 1
as 256 divides 1024 and ends in 56.
An somewhat shorter alternative can be built using PDL.
perl -MPDL -E '($m,$n)=@ARGV; $s=sequence($m-1)+1;say "Input: m=$m, n=$n, Output: ",
$s->where($m%$s==0&$s%10==$n)->nelem;' 24 2
perl -MPDL -E '($m,$n)=@ARGV; $s=sequence($m-1)+1;say "Input: m=$m, n=$n, Output: ",
$s->where($m%$s==0&$s%10==$n)->nelem;' 30 5
perl -MPDL -E '($m,$n)=@ARGV; $s=sequence($m-1)+1;say "Input: m=$m, n=$n, Output: ",
$s->where($m%$s==0&$s%10==$n)->nelem;' 1024 56
Results:
Input: m=24, n=2, Output: 2
Input: m=30, n=5, Output: 2
Input: m=1024, n=56, Output: 0
The trick for the two las digits digits didn’t work this time as I’m testing the last digit with congruences modulo 10.
The full code for the first solution is
1 # Perl weekly challenge 142
2 # Task 1: divisor last digit
3 #
4 # See https://wlmb.github.io/2021/12/09/PWC142/#task-1-divisor-last-digit
5 use v5.12;
6 use warnings;
7
8 say("Usage: ./ch-1.pl m n\nto count divisors of m ending in n"), exit unless @ARGV==2;
9 my ($m,$n)=@ARGV;
10 my $q=sqrt($m);
11 my @divisors_ending_in_n=grep {$_=~/$n$/}
12 my @divisors=sort {$a<=>$b} map {1<$_<$q?($_, $m/$_):$_} grep {$m%$_==0}(1..$q);
13 say "Input: m=$m n=$n,\nOutput: ", scalar(@divisors_ending_in_n),
14 "\nas the divisors of $m are: ", join(" ", @divisors),
15 "\nand those ending in $n are: ", join(" ", @divisors_ending_in_n), "\n";
Examples:
./ch-1.pl 24 2
./ch-1.pl 30 5
./ch-1.pl 1024 56
./ch-1.pl 100 3
Results:
Input: m=24 n=2,
Output: 2
as the divisors of 24 are: 1 2 3 4 6 8 12
and those ending in 2 are: 2 12
Input: m=30 n=5,
Output: 2
as the divisors of 30 are: 1 2 3 5 6 10 15
and those ending in 5 are: 5 15
Input: m=1024 n=56,
Output: 1
as the divisors of 1024 are: 1 2 4 8 16 32 64 128 256 512
and those ending in 56 are: 256
Input: m=100 n=3,
Output: 0
as the divisors of 100 are: 1 2 4 5 10 20 25 50
and those ending in 3 are:
Task 2: Sleep Sort
Submitted by: Adam Russell
Another joke sort similar to JortSort suggested by champion
Adam Russell.
You are given a list of numbers.
Write a script to implement Sleep Sort. For more information,
please checkout this post.
A straightforward implementation of the sleep sort would be:
perl -E 'foreach(@ARGV){$pid=fork;
if($pid==0){sleep $_; say $_; exit}}' 5 4 3 2 1
The parent spawns one child for each number. The children sleeps the given amount of seconds and then prints the given number. Results:
1
2
3
4
5
It works! However, it doesn’t work on fractional numbers.
perl -E 'foreach(@ARGV){$pid=fork;
if($pid==0){sleep $_; say $_; exit}}' .5 .4 .3 .2 .1
Results (wrong):
.5
.4
.3
.2
.1
Maybe the parent should take charge of printing the results, waiting for its kids to finish. A high resolution timer may also be helpful. Thus, the full solution is
1 # Perl weekly challenge 142
2 # Task 2: sleep sort
3 #
4 # See https://wlmb.github.io/2021/12/09/PWC142/#task-2-sleep-sort
5 use v5.12;
6 use warnings;
7 use Time::HiRes qw(sleep time);
8 use POSIX ":sys_wait_h";
9 my %value_for_kid;
10 my @ordered;
11 say("Usage: ./ch-2.pl scale a b c...\nto sort the numbers a b c...\n".
12 " Uses sleep sort. Sleep time is scale*number seconds"),
13 exit if @ARGV<=1;
14 my $scale=shift @ARGV;
15 foreach(@ARGV){
16 my $pid=fork;
17 die "couldn't fork" unless defined $pid;
18 if($pid==0){
19 sleep($scale*$_);
20 exit 0;
21 }
22 $value_for_kid{$pid}=$_;
23 }
24
25 while ((my $pid = waitpid(-1, 0))>0){
26 push @ordered, $value_for_kid{$pid};
27 }
28
29 say "\nInput: ", join ", ", @ARGV;
30 say "Scale: $scale";
31 say "Output: ", join ", ", @ordered;
Examples:
./ch-2.pl 1e-3 5 4 3 2 1
Results:
Input: 5, 4, 3, 2, 1
Scale: 1e-3
Output: 1, 2, 3, 4, 5
I added a scale factor as the first argument, so that the
numbers to sort may be
interpreted as fractions (or multiples) of a second.
If $scale is too large, the sleep sort takes a long time, but if
it is too small, the sort fails due to timing
uncertainties. The appropriate scale depends on the input.
./ch-2.pl 1.e-3 .5 .4 .3 .2 .1
./ch-2.pl 1e-2 .5 .4 .3 .2 .1
./ch-2.pl 1e-3 5.5 5.4 5.3 5.2 5.1 5.0
./ch-2.pl 1e-2 5.5 5.4 5.3 5.2 5.1 5.0
Results:
Input: .5, .4, .3, .2, .1
Scale: 1.e-3
Output: .5, .4, .3, .2, .1 # wrong
Input: .5, .4, .3, .2, .1
Scale: 1e-2
Output: .1, .2, .3, .4, .5 # correct
Input: 5.5, 5.4, 5.3, 5.2, 5.1, 5.0
Scale: 1e-3
Output: 5.4, 5.5, 5.3, 5.2, 5.0, 5.1 # wrong
Input: 5.5, 5.4, 5.3, 5.2, 5.1, 5.0
Scale: 1e-2
Output: 5.0, 5.1, 5.2, 5.3, 5.4, 5.5 #correct
I tried to compensate for the launch time by subtracting the delay
my $start=time;
foreach(@ARGV){
my $pid=fork;
die "couldn't fork" unless defined $pid;
if($pid==0){
usleep($scale*$_+$start-time);
exit 0;
}
$value_for_kid{$pid}=$_;
}
but it was not of much help.
Thus, the user should experiment with the appropriate scale, different for each input list. It is not impossible that this sorting algorithm turns out not to be a very robust one.
:)