Perl Weekly Challenge 183.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 183.
Task 1: Unique Array
Submitted by: Mohammad S Anwar
You are given list of arrayrefs.
Write a script to remove the duplicate arrayrefs from the given list.
Example 1
Input: @list = ([1,2], [3,4], [5,6], [1,2])
Output: ([1,2], [3,4], [5,6])
Example 2
Input: @list = ([9,1], [3,7], [2,5], [2,5])
Output: ([9, 1], [3,7], [2,5])
I use the magic of the Perl Data Language PDL to solve this task. I
construct the solution progressively below. First I input the array of
vectors as an 2d-array, one row for each vector, using PDL’s ability
to parse strings.
perl -MPDL -MPDL::NiceSlice -E '
$x=pdl shift; say $x;
' "[[1,2], [3,4], [5,6], [1,2]]"
Results:
[
[1 2]
[3 4]
[5 6]
[1 2]
]
I compare each row with each other row by introducing dummy
indices in the second and third positions and using andover to check
if all elements of the vectors coincide.
perl -MPDL -MPDL::NiceSlice -E '
$x=pdl shift; $a=($x->(:,:,*1)==$x(:,*1,:))->andover; say $a;
' "[[1,2], [3,4], [5,6], [1,2]]"
The result is a 2D matrix
[
[1 0 0 1]
[0 1 0 0]
[0 0 1 0]
[1 0 0 1]
]
that shows that in this example, row 3 is equal to row 0. Besides, each row is equal to itself.
I eliminate the trivial case and the redundant cases by comparing the
xvals and yvals of the matrix,
perl -MPDL -MPDL::NiceSlice -E '
$x=pdl shift; $a=($x->(:,:,*1)==$x(:,*1,:))->andover;
$w=$a&($a->xvals<$a->yvals); say +$w;
' "[[1,2], [3,4], [5,6], [1,2]]"
and orover the results
[
[0 0 0 0]
[0 0 0 0]
[0 0 0 0]
[1 0 0 0]
]
to get those rows that are duplicate of any other row:
perl -MPDL -MPDL::NiceSlice -E '
$x=pdl shift; $a=($x->(:,:,*1)==$x(:,*1,:))->andover;
$w=($a&($a->xvals<$a->yvals))->orover; say +$w;
' "[[1,2], [3,4], [5,6], [1,2]]"
The results
[0 0 0 1]
show that I must remove row-3. I invert the result find the rows that I have to keep and get their indices:
perl -MPDL -MPDL::NiceSlice -E '
$x=pdl shift; $a=($x->(:,:,*1)==$x(:,*1,:))->andover;
$w=which(!($a&($a->xvals<$a->yvals))->orover); say +$w;
' "[[1,2], [3,4], [5,6], [1,2]]"
which in this example are rows 0, 1 and 2. Results:
[0 1 2]
Finally, I use this as a vector of indices into the original array and print the results:
perl -MPDL -MPDL::NiceSlice -E '
$x=pdl shift; $a=($x->(:,:,*1)==$x(:,*1,:))->andover;
$w=which(!($a&($a->xvals<$a->yvals))->orover); say +$x->mv(-1,0)->index1d($w)->mv(0,-1);
' "[[1,2], [3,4], [5,6], [1,2]]"
Results:
[
[1 2]
[3 4]
[5 6]
]
I test the code with the second example
perl -MPDL -MPDL::NiceSlice -E '
$x=pdl shift; $a=($x->(:,:,*1)==$x(:,*1,:))->andover;
$w=which(!($a&($a->xvals<$a->yvals))->orover); say +$x->mv(-1,0)->index1d($w)->mv(0,-1);
' "[[9,1], [3,7], [2,5], [2,5]]"
Results:
[
[9 1]
[3 7]
[2 5]
]
With a very small modification I can make the code to work with
ndarrays of any dimension as input, by flattening them before doing
the comparisons with clump. Thus the complete code is
perl -MPDL -MPDL::NiceSlice -E '
$x=pdl shift; $f=$x->clump(-2); $a=($f->(:,:,*1)==$f(:,*1,:))->andover;
$w=which(!($a&($a->xvals<$a->yvals))->orover); say +$x->mv(-1,0)->index1d($w)->mv(0,-1);
' "[[1,2], [3,4], [5,6], [1,2]]"
Results:
[
[1 2]
[3 4]
[5 6]
]
Thus, the original example still works.
Example with matricial, instead of vectorial inputs
perl -MPDL -MPDL::NiceSlice -E '
$x=pdl shift; $f=$x->clump(-2); $a=($f->(:,:,*1)==$f(:,*1,:))->andover;
$w=which(!($a&($a->xvals<$a->yvals))->orover); say +$x->mv(-1,0)->index1d($w)->mv(0,-1);
' "[[[1,2],[3,4]],[[5,6],[7,8]], [[5,6],[7,8]], [[9,10],[11,12]]]"
Results:
[
[
[1 2]
[3 4]
]
[
[5 6]
[7 8]
]
[
[ 9 10]
[11 12]
]
]
Example with scalar instead of vectorial inputs:
perl -MPDL -MPDL::NiceSlice -E '
$x=pdl shift; $f=$x->clump(-2); $a=($f->(:,:,*1)==$f(:,*1,:))->andover;
$w=which(!($a&($a->xvals<$a->yvals))->orover); say +$x->mv(-1,0)->index1d($w)->mv(0,-1);
' "[0,1,0,2,3,0,2]"
Results:
[0 1 2 3]
The full code is
1 # Perl weekly challenge 183
2 # Task 1: Unique Array
3 #
4 # See https://wlmb.github.io/2022/09/20/PWC183/#task-1-unique-array
5 use v5.36;
6 use experimental qw(try);
7 use PDL;
8 use PDL::NiceSlice;
9 die <<EOF
10 Usage: $0 "[V1,V2...]" ...
11 to print the unique arrays among V1, V2...
12 Each V_i is an array [N1, N2...] of numbers N_j, or an array of arrays [W1,W2...] where
13 each Wj is an array of...
14 Admits multiple arguments.
15 EOF
16 unless @ARGV;
17 for(@ARGV){
18 try {
19 my $input=pdl $_;
20 my $flat=$input->clump(-2);
21 my $repetitions=($flat->(:,:,*1)==$flat(:,*1,:))->andover;
22 my $redundant=($repetitions&($repetitions->xvals < $repetitions->yvals))->orover;
23 my $keep_indices=which(!$redundant);
24 say +$input->mv(-1,0)->index1d($keep_indices)->mv(0,-1);
25 }
26 catch ($m) {
27 say "\n$m\nInvalid ndarray: $_";
28 }
29 }
30
Examples, including vectors, matrices, scalars and an error:
./ch-1.pl "[[1,2], [3,4], [5,6], [1,2]]" "[[9,1], [3,7], [2,5], [2,5]]" \
"[[[1,2],[3,4]],[[5,6],[7,8]], [[5,6],[7,8]], [[9,10],[11,12]]]" \
"[0,1,0,2,3,0,2]" "[1,a,3]"
Results:
[
[1 2]
[3 4]
[5 6]
]
[
[9 1]
[3 7]
[2 5]
]
[
[
[1 2]
[3 4]
]
[
[5 6]
[7 8]
]
[
[ 9 10]
[11 12]
]
]
[0 1 2 3]
PDL::Core::new_pdl_from_string: found disallowed character(s) 'a' in '[1,a,3]', value now: '[1,a,3]' at ./ch-1.pl line 21.
Invalid ndarray: [1,a,3]
Task 2: Date Difference
Submitted by: Mohammad S Anwar
You are given two dates, $date1 and $date2 in the format YYYY-MM-DD.
Write a script to find the difference between the given dates in terms on years and days only.
Example 1
Input: $date1 = '2019-02-10'
$date2 = '2022-11-01'
Output: 3 years 264 days
Example 2
Input: $date1 = '2020-09-15'
$date2 = '2022-03-29'
Output: 1 year 195 days
Example 3
Input: $date1 = '2019-12-31'
$date2 = '2020-01-01'
Output: 1 day
Example 4
Input: $date1 = '2019-12-01'
$date2 = '2019-12-31'
Output: 30 days
Example 5
Input: $date1 = '2019-12-31'
$date2 = '2020-12-31'
Output: 1 year
Example 6
Input: $date1 = '2019-12-31'
$date2 = '2021-12-31'
Output: 2 years
Example 7
Input: $date1 = '2020-09-15'
$date2 = '2021-09-16'
Output: 1 year 1 day
Example 8
Input: $date1 = '2019-09-15'
$date2 = '2021-09-16'
Output: 2 years 1 day
Manipulating dates is quite complex, so I rely on the DateTime and
Date::Parse packages. I’m not convinced my use is the best, but it
fits a 3-liner.
Example 1:
perl -MDateTime -MDate::Parse -E '
($d1,$d2)=map {DateTime->from_epoch($_)} sort {$a<=>$b} map {str2time($_)}@ARGV;
$y=$d2->subtract_datetime($d1)->years; $d2->subtract(years=>$y);
($d)=$d2->delta_days($d1)->in_units("days");say "$y years, $d days";
' 2019-02-10 2022-11-01
Result:
3 years, 264 days
Example 2:
perl -MDateTime -MDate::Parse -E '
($d1,$d2)=map {DateTime->from_epoch($_)} sort {$a<=>$b} map {str2time($_)}@ARGV;
$y=$d2->subtract_datetime($d1)->years; $d2->subtract(years=>$y);
($d)=$d2->delta_days($d1)->in_units("days");say "$y years, $d days";
' 2020-09-15 2022-03-29
Result:
1 years, 195 days
Example 3:
perl -MDateTime -MDate::Parse -E '
($d1,$d2)=map {DateTime->from_epoch($_)} sort {$a<=>$b} map {str2time($_)}@ARGV;
$y=$d2->subtract_datetime($d1)->years; $d2->subtract(years=>$y);
($d)=$d2->delta_days($d1)->in_units("days");say "$y years, $d days";
' 2019-12-31 2020-01-01
Result:
0 years, 1 days
Example 4:
perl -MDateTime -MDate::Parse -E '
($d1,$d2)=map {DateTime->from_epoch($_)} sort {$a<=>$b} map {str2time($_)}@ARGV;
$y=$d2->subtract_datetime($d1)->years; $d2->subtract(years=>$y);
($d)=$d2->delta_days($d1)->in_units("days");say "$y years, $d days";
' 2019-12-01 2019-12-31
Result:
0 years, 30 days
Example 5:
perl -MDateTime -MDate::Parse -E '
($d1,$d2)=map {DateTime->from_epoch($_)} sort {$a<=>$b} map {str2time($_)}@ARGV;
$y=$d2->subtract_datetime($d1)->years; $d2->subtract(years=>$y);
($d)=$d2->delta_days($d1)->in_units("days");say "$y years, $d days";
' 2019-12-31 2020-12-31
Result:
1 years, 0 days
Output: 1 year
Example 6:
perl -MDateTime -MDate::Parse -E '
($d1,$d2)=map {DateTime->from_epoch($_)} sort {$a<=>$b} map {str2time($_)}@ARGV;
$y=$d2->subtract_datetime($d1)->years; $d2->subtract(years=>$y);
($d)=$d2->delta_days($d1)->in_units("days");say "$y years, $d days";
' 2019-12-31 2021-12-31
Result:
2 years, 0 days
Example 7:
perl -MDateTime -MDate::Parse -E '
($d1,$d2)=map {DateTime->from_epoch($_)} sort {$a<=>$b} map {str2time($_)}@ARGV;
$y=$d2->subtract_datetime($d1)->years; $d2->subtract(years=>$y);
($d)=$d2->delta_days($d1)->in_units("days");say "$y years, $d days";
' 2020-09-15 2021-09-16
Result:
1 years, 1 days
Example 8:
perl -MDateTime -MDate::Parse -E '
($d1,$d2)=map {DateTime->from_epoch($_)} sort {$a<=>$b} map {str2time($_)}@ARGV;
$y=$d2->subtract_datetime($d1)->years; $d2->subtract(years=>$y);
($d)=$d2->delta_days($d1)->in_units("days");say "$y years, $d days";
' 2019-09-15 2021-09-16
Results:
2 years, 1 days
The code produced the expected results in all the given examples.
Thus, with more confidence I proceed to the full code.
1 # Perl weekly challenge 183
2 # Task 2: Date Difference
3 #
4 # See https://wlmb.github.io/2022/09/20/PWC183/#task-2-date-difference
5 use v5.36;
6 use experimental qw(try for_list);
7 use DateTime;
8 use Date::Parse;
9 die <<FIN unless @ARGV and @ARGV%2==0;
10 Usage: $0 D1 D2 ...
11 Print the date difference between dates D1 and D2, each in the format YYYY-MM-DD.
12 Additional pairs of dates may be added;
13 FIN
14
15 for my ($date1, $date2)(@ARGV){
16 try {
17 my ($dt1, $dt2)=map {DateTime->from_epoch($_)} # ordered datetimes
18 sort {$a<=>$b}
19 map {str2time($_)//die "Wrong date: $_"} ($date1, $date2);
20 my $years=$dt2->subtract_datetime($dt1)->years; # year difference
21 $dt2->subtract(years=>$years); # reduce difference to within a year
22 my $days=$dt2->delta_days($dt1)->in_units("days"); # remaining days
23 my $years_name=$years==1?"year":"years"; # singular or plural
24 my $days_name=$days==1?"day":"days";
25 say "The difference between $date1 and $date2 is $years $years_name and $days $days_name";
26 }
27 catch($m){
28 say "Failed with $date1 and $date2\n$m";
29 }
30 }
Examples:
./ch-2.pl 2019-02-10 2022-11-01 2020-09-15 2022-03-29 2019-12-31 2020-01-01 \
2019-12-01 2019-12-31 2019-12-31 2020-12-31 2019-12-31 2021-12-31 \
2020-09-15 2021-09-16 2019-09-15 2021-09-16
Results:
The difference between 2019-02-10 and 2022-11-01 is 3 years and 264 days
The difference between 2020-09-15 and 2022-03-29 is 1 year and 195 days
The difference between 2019-12-31 and 2020-01-01 is 0 years and 1 day
The difference between 2019-12-01 and 2019-12-31 is 0 years and 30 days
The difference between 2019-12-31 and 2020-12-31 is 1 year and 0 days
The difference between 2019-12-31 and 2021-12-31 is 2 years and 0 days
The difference between 2020-09-15 and 2021-09-16 is 1 year and 1 day
The difference between 2019-09-15 and 2021-09-16 is 2 years and 1 day
Written on September 20, 2022