diff options
| -rw-r--r-- | challenge-213/wlmb/blog.txt | 2 | ||||
| -rwxr-xr-x | challenge-213/wlmb/perl/ch-1.pl | 15 | ||||
| -rwxr-xr-x | challenge-213/wlmb/perl/ch-2.pl | 33 |
3 files changed, 50 insertions, 0 deletions
diff --git a/challenge-213/wlmb/blog.txt b/challenge-213/wlmb/blog.txt new file mode 100644 index 0000000000..5468e199f6 --- /dev/null +++ b/challenge-213/wlmb/blog.txt @@ -0,0 +1,2 @@ +https://wlmb.github.io/2023/04/17/PWC213/ + diff --git a/challenge-213/wlmb/perl/ch-1.pl b/challenge-213/wlmb/perl/ch-1.pl new file mode 100755 index 0000000000..71f15d4c8a --- /dev/null +++ b/challenge-213/wlmb/perl/ch-1.pl @@ -0,0 +1,15 @@ +#!/usr/bin/env perl +# Perl weekly challenge 213 +# Task 1: Fun Sort +# +# See https://wlmb.github.io/2023/04/17/PWC213/#task-1-fun-sort +use v5.36; +use POSIX qw(floor); +use List::Util qw(all); + +die <<~"FIN" unless @ARGV; + Usage: $0 N1 [N2...] + to fun-sort the integers N1 N2... + FIN +die "Input should be non-negative integers" unless all {floor($_)==$_ && $_>=0} @ARGV; +say join " ", @ARGV, "->", sort {$a%2 <=> $b%2 || $a<=>$b} @ARGV; diff --git a/challenge-213/wlmb/perl/ch-2.pl b/challenge-213/wlmb/perl/ch-2.pl new file mode 100755 index 0000000000..383fb0dedf --- /dev/null +++ b/challenge-213/wlmb/perl/ch-2.pl @@ -0,0 +1,33 @@ +#!/usr/bin/env perl +# Perl weekly challenge 213 +# Task 2: Shortest Route +# +# See https://wlmb.github.io/2023/04/17/PWC213/#task-2-shortest-route +use v5.36; +use List::UtilsBy qw(min_by); +die <<~"FIN" unless @ARGV >= 3; + Usage: $0 start dest R1 [R2...] + to find shortest route from start to dest following the routes R1 R2... + Each route is specified as a space separated string of node labels + FIN +my $start=shift; +my $dest=shift; +my @routes=map {[split " "]} @ARGV; +my %neighbors; +for my $r(@routes){ # set table of neighbors + $neighbors{$r->[$_]}{$r->[$_+1]}=$neighbors{$r->[$_+1]}{$r->[$_]}=1 for 0..@$r-2; +} +my %distance_from; +my @nodes=([$dest,0]); +while(my $n=shift @nodes){ + my ($current, $distance)=@$n; + $distance_from{$current}=$distance; + push @nodes, map {[$_, $distance+1]} + grep {not defined $distance_from{$_}} + keys %{$neighbors{$current}}; +} +my @shortest; +push @shortest, my $current=$start if defined $distance_from{$start}; +push @shortest, $current=min_by {$distance_from{$_}} grep {defined $distance_from{$_}} + keys %{$neighbors{$current}} while(defined $current && $current!=$dest); +say @shortest?(join " ", @shortest):"No solution"; |