Perl Weekly Challenge 178.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 178.
Task 1: Quater-imaginary Base
Submitted by: Mohammad S Anwar
Write a script to convert a given number (base 10) to
quater-imaginary base number and vice-versa. For more informations,
please checkout wiki page.
For example,
$number_base_10 = 4
$number_quater_imaginary_base = 10300
I was unaware till this morning about negative and imaginary bases for expressing numbers, but, why not. Interestingly, you can express any complex number Z as the sum Z=∑n dn (2i)n, where the powers n run through all the integers, the digits dn take the values 0, 1, 2 or 3 and i is imaginary unit. For complex integers, only positive powers n appear in the sum. For ordinary integers N, only positive even powers appear N=∑n>0 d2n (-4)n. A magical algorithm by Schroeppel for obtaining the coefficients d2n is the following: Consider the number S with binary representation 1100110011001100…=0xCCCCC…. Then d2n are the base-4 digits of (N+S) ^ S, with ^ the bitwise exclusive or of its operands.
To understand this, consider, as an example, the number 54. In base four it is given by 54=3124=3×42+1×4+2. Consider now the same number in base -4. We first write 54=3×(-4)2-1×(-4)+2, so the digits could be 3, -1, 2, i.e., we change the signs of the digits corresponding to odd positions. However, all digits ought to be positive. We can fix this by adding and subtracting 16=1×(-4)2=(-4)×(-4), i.e., 54=3×(-4)2+1×(-4)2+4×(-4)-1×(-4)+2=4×(-4)2+3×(-4)+2, so the digits could be 432. But all digits should be smaller than 0. Thus we add and subtract 64=-1×(-4)3=4×(-4)2, 54 = -1×(-4)3-4×(-4)2+4×(-4)2+3×(-4)+2 = -1×(-4)3+0×(-4)2+3×(-4)+2, yielding the digits -1,0,3,2. But, as -1 is not a valid digit, we add and subtract 128 = 1×(-4)4 = -4×(-4)3, 54 = 1×(-4)4+4×(-4)3-1×(-4)3+0×(-4)2+3×(-4)+2 = 1×(-4)4+3×(-4)3+0×(-4)2+3×(-4)+2, so that finally we get the digits 1,3,0,3,2, i.e., 54 = 13032-4.
Generalizing, to obtain a representation of a number in base -4, we can represent it in base 4 (binary grouped by 2’s). Then, we change the sign of all odd digits. Finally, we add 4 to the negative digits and compensate by adding 1 to the next digit. Similarly, we subtract 4 from those digits exceeding 4 and compensate by adding 1 to the next higher digit. This is what Schroeppel algorithm does. Adding a binary number to 0xCCC… generates the carries from odd to even digits, and taking the exclusive or generates the complements of the non-zero odd-placed digits.
For integer numbers a oneliner solution may be built.
perl -MList::Util=pairmap -E '$S=0xCCCCCCCCCCCCCCCC; @b=split "", sprintf "%b", ($S+shift)^$S;
@b=@b%2?(0,@b):@b; say join "0", pairmap{2*$a+$b} @b;
' 4
Results:
10300
Within the pairmap, $a
and $b
are the left and right binary digits of the
quaternary digits d2n of the result, they are converted to a
single quaternary digit and interspersed with
the digits 0 corresponding to the imaginary parts and printed. The
result of the example states that
1×(2i)4+0×(2i)3+3×(2i)2+0×(2i)1+0×(2i)0=1×16-0×8i-3×4+0×2i+0×1=16-12=4.
I test another number.
perl -MList::Util=pairmap -E '$S=0xCCCCCCCCCCCCCCCC; @b=split "", sprintf "%b", ($S+shift)^$S;
@b=@b%2?(0,@b):@b; say join "0", pairmap{2*$a+$b} @b;
' 234
Results:
101030202
We can verify it is correct, as 101030202(base 2i)= 1×(2i)8+0×(2i)7+1×(2i)6+0×(2i)5+3×(2i)4+0×(2i)3+2×(2i)2+0×(2i)1+2×(2i)0 =1×256-0×128i-1×64+0×32i+3×16-0×8i-2×4+0×2i+2×1 =256-64+48-8+2=234
The full code is
1 # Perl weekly challenge 178
2 # Task 1: Quater imaginary base
3 #
4 # See https://wlmb.github.io/2022/08/15/PWC178/#task-1-quater-imaginary-base
5 use v5.36;
6 use experimental qw(try);
7 use List::Util qw(pairmap);
8 sub st_to_reim($string){ # Parse string as X+Yi (with small variations)
9 my $orig=$string;
10 my $re= $string=~s/^(\s*([+-]?\d+))\s*(?!(\d|i))//?$2:0;
11 my $im= $string=~s/^(\s*([+-]?\d+)\s*i\s*)$//?$2:0;
12 die("$orig has the wrong format\n") unless $string=~/^$/;
13 die("$orig is too big\n") unless abs($re)<= 1e5 and abs($im) <= 1e5; # to be safe
14 return ($re, $im);
15 }
16 sub re_to_qi($X){ # convert a real integer number to base 2i
17 state $S=0xCCCCCCCC; # Schroeppel number, enough for upto 32 bits.
18 my @bits=split "", sprintf "%b", ($S+$X)^$S;
19 unshift @bits,0 if @bits%2; # make length even
20 join "0", pairmap {2*$a+$b} (@bits);
21 }
22 sub cmplx_to_qi($X, $Y){ # convert a complex integer number X+Yi to base 2i
23 my $re=re_to_qi($X); # convert real part
24 my $im=re_to_qi(-2*$Y); # convert 2i*Yi=-2Y, with Y imaginary part
25 substr $im,-2,1,''; # delete last digit
26 $re+$im; # mix both parts together
27 }
28
29 die "Usage: $0 Z1 [Z2...]\nto convert the complex integers Zn=Xn+Yni (no space) to base 2i\n"
30 unless @ARGV;
31 foreach (@ARGV){
32 say "$_(base ten)= ",
33 cmplx_to_qi(do{try {st_to_reim($_);} catch($m){say $m; next;}}),
34 "(base 2i)";
35 }
36
Example:
./ch-1.pl 10 20i 10+20i
Results:
10(base ten)= 10202(base 2i)
20i(base ten)= 102020(base 2i)
10+20i(base ten)= 112222(base 2i)
This program has a couple of problems. It can’t deal with fractional numbers. This could be solved by a more straightforward approach, calculating quaternary digits one by one by making divisions and taking remainders, instead of using Schroeppel’s trick. Furthermore, I used only a 32 bit Schroeppel number though my Perl handles 64 bit integers, to avoid a warning about non-portability. Finally, it doesn’t allow very large inputs as it treated the long strings of resulting quaternary digits as integers variables on which it applies arithmetic operations (namely, an addition), but the resulting numbers might have too many digits. Thus I limited the input to real and imaginary parts less than 1e5, for which I checked it behaved.
Task 2: Business Date
Submitted by: Mohammad S Anwar
You are given $timestamp (date with time) and $duration in hours.
Write a script to find the time that occurs $duration business hours
after $timestamp. For the sake of this task, let us assume the
working hours is 9am to 6pm, Monday to Friday. Please ignore
timezone too.
For example,
Suppose the given timestamp is 2022-08-01 10:30 and the duration is
4 hours. Then the next business date would be 2022-08-01 14:30.
Similar if the given timestamp is 2022-08-01 17:00 and the duration
is 3.5 hours.
Then the next business date would be 2022-08-02 11:30.
Date calculations always confuse me. The difficulty in this case is
that a job started one day may be finished on the next day, or
several days ahead, and that not every hour is a working hour nor
everyday a working day. I solve this challenge with the
help of the DateTime
modules, to parse the timestamp, to make
operations on the time and to stringify the result. I assume no
vacation time and no lunch time, so from 9:00 to 18:00 means 9
working hours every day. I solve the problem by steps. First I move
towards the end of the day, then towards the end of the week, then
by full weeks (in case the number of business hours is very large),
then by full days, and finally by the remaining minutes, if any,
stopping when running out of time.
# Perl weekly challenge 178
# Task 2: Business date
#
# See https://wlmb.github.io/2022/08/15/PWC178/#task-2-business-date
use v5.36;
use DateTime;
use DateTime::Format::DateParse;
use List::Util qw(min);
use POSIX qw(floor);
use experimental qw(try for_list);
my $minutes_per_hour=60;
my $opening_time=9;
my $closing_time=18;
my $minutes_per_day=($closing_time-$opening_time)*$minutes_per_hour;
my $days_per_week=5;
my $minutes_per_week=$days_per_week*$minutes_per_day;
die "Usage: $0 timestamp hours\nto find the next available time\n" unless @ARGV>=2 && @ARGV%2==0;
for my ($ts, $duration)(@ARGV){
try { say "$ts plus $duration hours->", next_available($ts, $duration)}
catch($m){say $m}
}
sub next_available($ts, $hours){
my $minutes=$hours*$minutes_per_hour;
my $initial=DateTime::Format::DateParse->parse_datetime($ts)->truncate(to=>"minute");
die "Wrong timestamp" unless $initial->day_of_week <=5 and $initial->hour>=$opening_time
and $initial->hour < $closing_time;
# Advance towards end of day
my $target=$initial->clone;
my $closing=$target->clone->set(hour=>$closing_time, minute=>0);
my $minutes_to_close=$closing->subtract_datetime($target)->in_units("minutes");
my $actual_minutes=min($minutes, $minutes_to_close);
$target->add(minutes=>$actual_minutes);
$minutes-=$actual_minutes;
return $target->datetime(" ") unless $minutes>0;
# Advance towards end of week
my $days_to_weekend=$days_per_week-$target->day_of_week;
my $actual_days=min($days_to_weekend, floor($minutes/$minutes_per_day));
$target->add(days=>$actual_days);
$minutes-=$actual_days*$minutes_per_day;
return $target->datetime(" ") unless $minutes>0;
# Advance to next working morning
$target->add(days=>1)->set(hour=>$opening_time, minute=>0); # next morning
$target->add(days=>2) if $target->day_of_week==6; # skip weekend
# Advance full weeks
my $weeks=floor($minutes/$minutes_per_week);
$target->add(weeks=>$weeks);
$minutes-=$weeks*$minutes_per_week;
return $target->datetime(" ") unless $minutes>0;
#Advance full days
my $days=floor($minutes/$minutes_per_day);
$target->add(days=>$days);
$minutes-=$days*$minutes_per_day;
return $target->datetime(" ") unless $minutes>0;
#Advance remaining time
$target->add(minutes=>$minutes);
#$minutes=0
return $target->datetime(" ");
}
Test with the given examples:
./ch-2.pl "2022-08-01 10:30" 4 "2022-08-01 17:00" 3.5
Results:
2022-08-01 10:30 plus 4 hours->2022-08-01 14:30:00
2022-08-01 17:00 plus 3.5 hours->2022-08-02 11:30:00
Skip across a weekend:
./ch-2.pl "2022-08-19 17:00" 3.5
Results:
2022-08-19 17:00 plus 3.5 hours->2022-08-22 11:30:00
Test with a lengthy activity that requires 13 full working days, starting on a Thrusday afternoon:
./ch-2.pl "2022-08-18 17:00" 108
Results:
2022-08-18 17:00 plus 108 hours->2022-09-05 17:00:00