Perl Weekly Challenge 213.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 213.
Task 1: Fun Sort
Submitted by: Mohammad S Anwar
You are given a list of positive integers.
Write a script to sort the all even integers first then all odds in ascending order.
Example 1
Input: @list = (1,2,3,4,5,6)
Output: (2,4,6,1,3,5)
Example 2
Input: @list = (1,2)
Output: (2,1)
Example 3
Input: @list = (1)
Output: (1)
This is very easily solved using the shortcut || operator. I do a
simple sort on the residues after dividing by two (even less than odd)
and if necessary (both odd or both even) I sort on their numerical
value. The result is an honest one-liner:
perl -E 'say join " ", @ARGV, "->", sort {$a%2 <=> $b%2 || $a<=>$b} @ARGV' 1 2 3 4 5 6
perl -E 'say join " ", @ARGV, "->", sort {$a%2 <=> $b%2 || $a<=>$b} @ARGV' 1 2
perl -E 'say join " ", @ARGV, "->", sort {$a%2 <=> $b%2 || $a<=>$b} @ARGV' 1
Results:
1 2 3 4 5 6 -> 2 4 6 1 3 5
1 2 -> 2 1
1 -> 1
The full code is identical, except for a couple of checks:
1 # Perl weekly challenge 213
2 # Task 1: Fun Sort
3 #
4 # See https://wlmb.github.io/2023/04/17/PWC213/#task-1-fun-sort
5 use v5.36;
6 use POSIX qw(floor);
7 use List::Util qw(all);
8
9 die <<~"FIN" unless @ARGV;
10 Usage: $0 N1 [N2...]
11 to fun-sort the integers N1 N2...
12 FIN
13 die "Input should be non-negative integers" unless all {floor($_)==$_ && $_>=0} @ARGV;
14 say join " ", @ARGV, "->", sort {$a%2 <=> $b%2 || $a<=>$b} @ARGV;
Examples:
./ch-1.pl 1 2 3 4 5 6
./ch-1.pl 1 2
./ch-1.pl 1
Task 2: Shortest Route
Submitted by: Mohammad S Anwar
You are given a list of bidirectional routes defining a network of nodes,
as well as source and destination node numbers.
Write a script to find the route from source to destination that passes through
fewest nodes.
Example 1:
Input: @routes = ([1,2,6], [5,6,7])
$source = 1
$destination = 7
Output: (1,2,6,7)
Source (1) is part of route [1,2,6] so the journey looks like 1 -> 2 -> 6
then jump to route [5,6,7] and takes the route 6 -> 7.
So the final route is (1,2,6,7)
Example 2:
Input: @routes = ([1,2,3], [4,5,6])
$source = 2
$destination = 5
Output: -1
Example 3:
Input: @routes = ([1,2,3], [4,5,6], [3,8,9], [7,8])
$source = 1
$destination = 7
Output: (1,2,3,8,7)
Source (1) is part of route [1,2,3] so the journey looks like 1 -> 2 -> 3
then jump to route [3,8,9] and takes the route 3 -> 8
then jump to route [7,8] and takes the route 8 -> 7
So the final route is (1,2,3,8,7)
The task may be solved in steps. First, determine the neighbors of each node. Then assign a number to each node, starting from the destination (0) according to its distance to the destination, i.e., one more than the shortest distance from its neighbors. Finally, from the starting node chose iteratively the neighbor with the shortest distance. I assume the input is the starting node, the ending node and a list strings with space separated node labels. If the distance from the starting node is not defined, then there is no route to the destination.
1 # Perl weekly challenge 213
2 # Task 2: Shortest Route
3 #
4 # See https://wlmb.github.io/2023/04/17/PWC213/#task-2-shortest-route
5 use v5.36;
6 use List::UtilsBy qw(min_by);
7 die <<~"FIN" unless @ARGV >= 3;
8 Usage: $0 start dest R1 [R2...]
9 to find shortest route from start to dest following the routes R1 R2...
10 Each route is specified as a space separated string of node labels
11 FIN
12 my $start=shift;
13 my $dest=shift;
14 my @routes=map {[split " "]} @ARGV;
15 my %neighbors;
16 for my $r(@routes){ # set table of neighbors
17 $neighbors{$r->[$_]}{$r->[$_+1]}=$neighbors{$r->[$_+1]}{$r->[$_]}=1 for 0..@$r-2;
18 }
19 my %distance_from;
20 my @nodes=([$dest,0]);
21 while(my $n=shift @nodes){
22 my ($current, $distance)=@$n;
23 $distance_from{$current}=$distance;
24 push @nodes, map {[$_, $distance+1]}
25 grep {not defined $distance_from{$_}}
26 keys %{$neighbors{$current}};
27 }
28 my @shortest;
29 push @shortest, my $current=$start if defined $distance_from{$start};
30 push @shortest, $current=min_by {$distance_from{$_}} grep {defined $distance_from{$_}}
31 keys %{$neighbors{$current}} while(defined $current && $current!=$dest);
32 say @shortest?(join " ", @shortest):"No solution";
33
Example 1:
./ch-2.pl 1 7 "1 2 6" "5 6 7"
Results:
1 2 6 7
Example 2 :
./ch-2.pl 2 5 "1 2 3" "4 5 6"
Results:
No solution
Example 3:
./ch-2.pl 1 7 "1 2 3" "4 5 6" "3 8 9" "7 8"
Results:
1 2 3 8 7
Just for fun, the code can be crammed into a 4.5liner, but with some subtle errors and not too pretty,
Example 1:
perl -MList::UtilsBy=min_by -E '$s=shift;$d=shift;@r=map {[split " "]} @ARGV;for my $r(@r){
$n{$r->[$_]}{$r->[$_+1]}=$n{$r->[$_+1]}{$r->[$_]}=1 for 0..@$r-2;} @n=([$d,0]);while($n=shift @n){
($c, $l)=@$n; $d{$c}=$l; push @n, map {[$_, $l+1]} grep {!defined $d{$_}} keys %{$n{$c}};}
push @s, my $c=$s if $d{$s};push @s, $c=min_by {$d{$_}} grep {defined $d{$_}} keys %{$n{$c}}
while($c && $c!=$d); say @s?(join " ", @s):-1;
' 1 7 "1 2 6" "5 6 7"
Results:
1 2 6 7
Example 2:
perl -MList::UtilsBy=min_by -E '$s=shift;$d=shift;@r=map {[split " "]} @ARGV;for my $r(@r){
$n{$r->[$_]}{$r->[$_+1]}=$n{$r->[$_+1]}{$r->[$_]}=1 for 0..@$r-2;} @n=([$d,0]);while($n=shift @n){
($c, $l)=@$n; $d{$c}=$l; push @n, map {[$_, $l+1]} grep {!defined $d{$_}} keys %{$n{$c}};}
push @s, my $c=$s if $d{$s};push @s, $c=min_by {$d{$_}} grep {defined $d{$_}} keys %{$n{$c}}
while($c && $c!=$d); say @s?(join " ", @s):-1;
' 2 5 "1 2 3" "4 5 6"
Results:
-1
Example 3:
perl -MList::UtilsBy=min_by -E '$s=shift;$d=shift;@r=map {[split " "]} @ARGV;for my $r(@r){
$n{$r->[$_]}{$r->[$_+1]}=$n{$r->[$_+1]}{$r->[$_]}=1 for 0..@$r-2;} @n=([$d,0]);while($n=shift @n){
($c, $l)=@$n; $d{$c}=$l; push @n, map {[$_, $l+1]} grep {!defined $d{$_}} keys %{$n{$c}};}
push @s, my $c=$s if $d{$s};push @s, $c=min_by {$d{$_}} grep {defined $d{$_}} keys %{$n{$c}}
while($c && $c!=$d); say @s?(join " ", @s):-1;
' 1 7 "1 2 3" "4 5 6" "3 8 9" "7 8"
Results:
1 2 3 8 7
Written on April 17, 2023