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
Written on August 15, 2022