Add polettix's solution to challenge-213

6 files changed, 281 insertions, 0 deletions

diff --git a/challenge-213/polettix/blog.txt b/challenge-213/polettix/blog.txt
new file mode 100644
index 0000000000..c1b54f7995
--- /dev/null
+++ b/challenge-213/polettix/blog.txt
@@ -0,0 +1 @@
+https://etoobusy.polettix.it/2023/04/20/pwc213-fun-sort/
diff --git a/challenge-213/polettix/blog1.txt b/challenge-213/polettix/blog1.txt
new file mode 100644
index 0000000000..34a8a7bb57
--- /dev/null
+++ b/challenge-213/polettix/blog1.txt
@@ -0,0 +1 @@
+https://etoobusy.polettix.it/2023/04/21/pwc213-shortest-route/
diff --git a/challenge-213/polettix/perl/ch-1.pl b/challenge-213/polettix/perl/ch-1.pl
new file mode 100644
index 0000000000..7dddae9527
--- /dev/null
+++ b/challenge-213/polettix/perl/ch-1.pl
@@ -0,0 +1,22 @@
+#!/usr/bin/env perl
+use v5.24;
+use warnings;
+use experimental 'signatures';
+
+say '(', join(',', fun_sort(@ARGV ? @ARGV : (1 .. 6))), ')';
+
+sub fun_sort (@input) {
+   @input = sort { $a <=> $b } @input;
+   my $start = 0;
+   my $stop = $#input;
+   while ($start <= $stop) {
+      if ($input[$start] % 2) { # move odds at the end
+         push @input, splice @input, $start, 1;
+         --$stop;
+      }
+      else {
+         ++$start;
+      }
+   }
+   return @input;
+}
diff --git a/challenge-213/polettix/perl/ch-2.pl b/challenge-213/polettix/perl/ch-2.pl
new file mode 100644
index 0000000000..69cfad8178
--- /dev/null
+++ b/challenge-213/polettix/perl/ch-2.pl
@@ -0,0 +1,100 @@
+#!/usr/bin/env perl
+use v5.24;
+use warnings;
+use experimental 'signatures';
+
+use Data::Dumper;
+
+my @routes = ([1,2,3], [4,5,6], [3,8,9], [7,8]);
+my $source = 1;
+my $destination = 7;
+my $route = shortest_route(\@routes, $source, $destination) // [];
+{ local $" = ','; say $route->@* ? "($route->@*)" : -1 }
+
+sub shortest_route ($routes, $src, $dst) {
+   my $graph = routes_to_graph($routes);
+   return scalar astar(
+      start => $src,
+      goal  => $dst,
+      distance => sub { return 1 },
+      successors => sub ($v) { keys $graph->{$v}->%* },
+      identifier => sub ($v) { $v },
+   );
+}
+
+sub routes_to_graph ($routes) {
+   my %adjacents_for;
+   for my $route ($routes->@*) {
+      my $prev = $route->[0];
+      for my $i (1 .. $route->$#*) {
+         my $curr = $route->[$i];
+         $adjacents_for{$prev}{$curr} = $adjacents_for{$curr}{$prev} = 1;
+         $prev = $curr;
+      }
+   }
+   return \%adjacents_for;
+}
+
+sub astar {
+   my %args = (@_ && ref($_[0])) ? %{$_[0]} : @_;
+   my @reqs = qw< start goal distance successors >;
+   exists($args{$_}) || die "missing parameter '$_'" for @reqs;
+   my ($start, $goal, $dist, $succs) = @args{@reqs};
+   my $h     = $args{heuristic}  || $dist;
+   my $id_of = $args{identifier} || sub { return "$_[0]" };
+
+   my ($id, $gid) = ($id_of->($start), $id_of->($goal));
+   my %node_for = ($id => {value => $start, g => 0});
+   my $queue = bless ['-', {id => $id, f => 0}], __PACKAGE__;
+
+   while (!$queue->_is_empty) {
+      my $cid = $queue->_dequeue->{id};
+      my $cx  = $node_for{$cid};
+      next if $cx->{visited}++;
+
+      my $cv = $cx->{value};
+      return __unroll($cx, \%node_for) if $cid eq $gid;
+
+      for my $sv ($succs->($cv)) {
+         my $sid = $id_of->($sv);
+         my $sx = $node_for{$sid} ||= {value => $sv};
+         next if $sx->{visited};
+         my $g = $cx->{g} + $dist->($cv, $sv);
+         next if defined($sx->{g}) && ($g >= $sx->{g});
+         @{$sx}{qw< p g >} = ($cid, $g);    # p: id of best "previous"
+         $queue->_enqueue({id => $sid, f => $g + $h->($sv, $goal)});
+      } ## end for my $sv ($succs->($cv...))
+   } ## end while (!$queue->_is_empty)
+
+   return;
+} ## end sub astar
+
+sub _dequeue {                              # includes "sink"
+   my ($k, $self) = (1, @_);
+   my $r = ($#$self > 1) ? (splice @$self, 1, 1, pop @$self) : pop @$self;
+   while ((my $j = $k * 2) <= $#$self) {
+      ++$j if ($j < $#$self) && ($self->[$j + 1]{f} < $self->[$j]{f});
+      last if $self->[$k]{f} < $self->[$j]{f};
+      (@{$self}[$j, $k], $k) = (@{$self}[$k, $j], $j);
+   }
+   return $r;
+} ## end sub _dequeue
+
+sub _enqueue {                              # includes "swim"
+   my ($self, $node) = @_;
+   push @$self, $node;
+   my $k = $#$self;
+   (@{$self}[$k / 2, $k], $k) = (@{$self}[$k, $k / 2], int($k / 2))
+     while ($k > 1) && ($self->[$k]{f} < $self->[$k / 2]{f});
+} ## end sub _enqueue
+
+sub _is_empty { return !$#{$_[0]} }
+
+sub __unroll {    # unroll the path from start to goal
+   my ($node, $node_for, @path) = ($_[0], $_[1], $_[0]{value});
+   while (defined(my $p = $node->{p})) {
+      $node = $node_for->{$p};
+      unshift @path, $node->{value};
+   }
+   return wantarray ? @path : \@path;
+} ## end sub __unroll
diff --git a/challenge-213/polettix/raku/ch-1.raku b/challenge-213/polettix/raku/ch-1.raku
new file mode 100644
index 0000000000..842bc3343c
--- /dev/null
+++ b/challenge-213/polettix/raku/ch-1.raku
@@ -0,0 +1,12 @@
+#!/usr/bin/env raku
+use v6;
+sub MAIN (*@args) { say fun-sort(@args ?? @args !! [1 .. 6]) }
+
+sub fun-sort (@input) {
+   my (@even, @odd);
+   for @input -> $v {
+      if $v %% 2 { @even.push: $v.Int }
+      else       { @odd.push: $v.Int  }
+   }
+   return (@even.sort, @odd.sort).flat;
+}
diff --git a/challenge-213/polettix/raku/ch-2.raku b/challenge-213/polettix/raku/ch-2.raku
new file mode 100644
index 0000000000..cd41a1735e
--- /dev/null
+++ b/challenge-213/polettix/raku/ch-2.raku
@@ -0,0 +1,145 @@
+#!/usr/bin/env raku
+use v6;
+
+sub MAIN {
+   my @routes = [1,2,3], [4,5,6], [3,8,9], [7,8];
+   my $source = 1;
+   my $destination = 6;
+   my $route = shortest-route(@routes, $source, $destination) // -1;
+   say $route;
+}
+
+class Dijkstra { ... }
+class PriorityQueue { ... }
+
+sub shortest-route (@routes, $src, $dst) {
+   my $graph = routes-to-graph(@routes);
+   my $d = Dijkstra.new(
+      distance => { $graph{$^a}{$^b} },
+      successors => { $graph{$^a}.keys },
+      start => $src,
+      goals => [ $dst ],
+   );
+   return $d.path-to($dst);
+}
+
+sub routes-to-graph (@routes) {
+   my %adjacents_for;
+   for @routes -> $route {
+      my $prev = $route[0];
+      for (1 ..^ @$route) -> $i {
+         my $curr = $route[$i];
+         %adjacents_for{$prev}{$curr} = %adjacents_for{$curr}{$prev} = 1;
+         $prev = $curr;
+      }
+   }
+   return %adjacents_for;
+}
+
+class Dijkstra {
+   has %!thread-to is built; # thread to a destination
+   has $!start     is built;     # starting node
+   has &!id-of     is built;     # turn a node into an identifier
+
+   method new (:&distance!, :&successors!, :$start!, :@goals,
+         :$more-goals is copy, :&id-of = -> $n { $n.Str }) {
+      my %is-goal = @goals.map: { &id-of($_) => 1 };
+      $more-goals //= (sub ($id) { %is-goal{$id}:delete; %is-goal.elems })
+         if %is-goal.elems;
+      my $id = &id-of($start);
+      my $queue = PriorityQueue.new(
+         before => sub ($a, $b) { $a<d> < $b<d> },
+         id-of  => sub ($n) { $n<id> },
+         items  => [{v => $start, id => $id, d => 0},],
+      );
+      my %thr-to = $id => {d => 0, p => Nil, pid => $id};
+      while ! $queue.is-empty {
+         my ($ug, $uid, $ud) = $queue.dequeue<v id d>;
+         for &successors($ug) -> $vg {
+            my ($vid, $alt) = &id-of($vg), $ud + &distance($ug, $vg);
+            next if ($queue.contains-id($vid)
+               ?? ($alt >= (%thr-to{$vid}<d> //= $alt + 1))
+               !! (%thr-to{$vid}:exists));
+            $queue.enqueue({v => $vg, id => $vid, d => $alt});
+            %thr-to{$vid} = {d => $alt, p => $ug, pid => $uid};
+         }
+      }
+      self.bless(thread-to => %thr-to, :&id-of, :$start);
+   }
+
+   method path-to ($v is copy) {
+      my $vid = &!id-of($v);
+      my $thr = %!thread-to{$vid} or return;
+      my @retval;
+      while defined $v {
+         @retval.unshift: $v;
+         ($v, $vid) = $thr<p pid>;
+         $thr = %!thread-to{$vid};
+      }
+      return @retval;
+   }
+   method distance-to ($v) { (%!thread-to{&!id-of($v)} // {})<d> }
+}
+
+class PriorityQueue {
+   has @!items;
+   has %!pos-of;
+   has %!item-of;
+   has &!before;
+   has &!id-of;
+
+   submethod BUILD (
+      :&!before = {$^a < $^b},
+      :&!id-of  = {~$^a},
+      :@items
+   ) {
+      @!items = '-';
+      self.enqueue($_) for @items;
+   }
+
+   method contains ($obj --> Bool) { self.contains-id(&!id-of($obj)) }
+   method contains-id ($id --> Bool) { %!item-of{$id}:exists }
+   method dequeue { self!remove-kth(1) }
+   method elems { @!items.end }
+   # method enqueue ($obj) <-- see below
+   method is-empty { @!items.elems == 1 }
+   method item-of ($id) { %!item-of{$id}:exists ?? %!item-of{$id} !! Any }
+   method remove ($obj) { self.remove-id(&!id-of($obj)) }
+   method remove-id ($id) { self!remove-kth(%!pos-of{$id}) }
+   method size  { @!items.end }
+   method top { @!items.end ?? @!items[1] !! Any }
+   method top-id { @!items.end ?? &!id-of(@!items[1]) !! Any }
+
+   method enqueue ($obj) {
+      my $id = &!id-of($obj);
+      %!item-of{$id} = $obj; # keep track of this item
+      @!items[my $k = %!pos-of{$id} ||= @!items.end + 1] = $obj;
+      self!adjust($k);
+      return $id;
+   }
+   method !adjust ($k is copy) { # assumption: $k <= @!items.end
+      $k = self!swap(($k / 2).Int, $k)
+         while ($k > 1) && &!before(@!items[$k], @!items[$k / 2]);
+      while (my $j = $k * 2) <= @!items.end {
+         ++$j if ($j < @!items.end) && &!before(@!items[$j+1], @!items[$j]);
+         last if &!before(@!items[$k], @!items[$j]); # parent is OK
+         $k = self!swap($j, $k);
+      }
+      return self;
+   }
+   method !remove-kth (Int:D $k where 0 < $k <= @!items.end) {
+      self!swap($k, @!items.end);
+      my $r = @!items.pop;
+      self!adjust($k) if $k <= @!items.end; # no adjust for last element
+      my $id = &!id-of($r);
+      %!item-of{$id}:delete;
+      %!pos-of{$id}:delete;
+      return $r;
+   }
+   method !swap ($i, $j) {
+      my ($I, $J) = @!items[$i, $j] = @!items[$j, $i];
+      %!pos-of{&!id-of($I)} = $i;
+      %!pos-of{&!id-of($J)} = $j;
+      return $i;
+   }
+}