Merge pull request #7990 from polettix/polettix/pwc214

Add polettix's solution to challenge-214

6 files changed, 182 insertions, 0 deletions

diff --git a/challenge-214/polettix/blog.txt b/challenge-214/polettix/blog.txt
new file mode 100644
index 0000000000..d1981d196c
--- /dev/null
+++ b/challenge-214/polettix/blog.txt
@@ -0,0 +1 @@
+https://etoobusy.polettix.it/2023/04/27/pwc214-rank-score/
diff --git a/challenge-214/polettix/blog1.txt b/challenge-214/polettix/blog1.txt
new file mode 100644
index 0000000000..23262b1878
--- /dev/null
+++ b/challenge-214/polettix/blog1.txt
@@ -0,0 +1 @@
+ihttps://etoobusy.polettix.it/2023/04/28/pwc214-collect-points/
diff --git a/challenge-214/polettix/perl/ch-1.pl b/challenge-214/polettix/perl/ch-1.pl
new file mode 100644
index 0000000000..675ef0ded5
--- /dev/null
+++ b/challenge-214/polettix/perl/ch-1.pl
@@ -0,0 +1,22 @@
+#!/usr/bin/env perl
+use v5.24;
+use warnings;
+use experimental 'signatures';
+
+my @rs = rank_score(@ARGV ? @ARGV : (2, 5, 2, 1, 7, 5, 1));
+say '(', join(',', @rs), ')';
+
+sub rank_score (@scores) {
+   state $lower = [ qw< X G S B > ];
+   my @retval = (0) x @scores;
+   my $n = 0;
+   my @pairs = reverse sort { $a->[0] <=> $b->[0] }
+      map { [$scores[$_], $_] }
+      0 .. $#scores;
+   for my $i (0 .. $#pairs) {
+      my ($v, $k) = $pairs[$i]->@*;
+      $n = $i + 1 if $i == 0 || $pairs[$i - 1][0] > $v;
+      $retval[$k] = $n < 4 ? $lower->[$n] : $n;
+   }
+   return @retval;
+}
diff --git a/challenge-214/polettix/perl/ch-2.pl b/challenge-214/polettix/perl/ch-2.pl
new file mode 100644
index 0000000000..8da60ba616
--- /dev/null
+++ b/challenge-214/polettix/perl/ch-2.pl
@@ -0,0 +1,75 @@
+#!/usr/bin/env perl
+use v5.24;
+use warnings;
+use experimental 'signatures';
+use Memoize 'memoize';
+use Data::Dumper;
+
+say collect_points(@ARGV ? @ARGV : (2, 4, 4, 3, 4, 4, 3, 3, 3, 3, 5, 3));
+
+sub collect_points (@numbers) {
+   return 0 unless @numbers;
+   my @slots = ($numbers[0], 1);
+   for my $i (1 .. $#numbers) {
+      if ($numbers[$i - 1] == $numbers[$i]) {
+         $slots[-1]++;
+      }
+      else {
+         push @slots, $numbers[$i], 1;
+      }
+   }
+   return collect_points_wh(@slots);
+}
+
+sub remove_slot ($i, @slots) {
+   splice(@slots, $i, 2);
+
+   # check for merge
+   if ($i > 0 && $i < @slots && $slots[$i - 2] == $slots[$i]) {
+      $slots[$i - 1] += $slots[$i + 1];
+      splice(@slots, $i, 2);
+   }
+
+   return @slots;
+}
+
+sub collect_points_wh (@slots) {
+   my $score = 0;
+
+   while ('necessary') {
+      my %count_for;
+
+      my $i = 0;
+      while ($i < @slots) {
+         ($count_for{$slots[$i]} //= 0)++;
+         $i += 2;
+      }
+
+      my %is_single = map { $_ => 1 }
+         grep { $count_for{$_} == 1 } keys %count_for;
+      last unless scalar keys %is_single;
+
+      $i = 0;
+      while ($i < @slots) {
+         if ($is_single{$slots[$i]}) {
+            $score += $slots[$i + 1] ** 2;
+            @slots = remove_slot($i, @slots);
+         }
+         else {
+            $i += 2;
+         }
+      }
+   }
+
+   my $i = 0;
+   my $best_sub_score = 0;
+   while ($i < @slots) {
+      my @sub_slots = remove_slot($i, @slots);
+      my $sub_score = collect_points_wh(@sub_slots);
+      $best_sub_score = $sub_score if $best_sub_score < $sub_score;
+      $i += 2;
+   }
+
+   $score += $best_sub_score;
+   return $score;
+}
diff --git a/challenge-214/polettix/raku/ch-1.raku b/challenge-214/polettix/raku/ch-1.raku
new file mode 100644
index 0000000000..4580531f13
--- /dev/null
+++ b/challenge-214/polettix/raku/ch-1.raku
@@ -0,0 +1,16 @@
+#!/usr/bin/env raku
+use v6;
+sub MAIN (*@scores) { say rank-score(@scores) }
+
+sub rank-score (@scores) {
+   state @lower = <X G S B>;
+   my @retval = 0 xx @scores;
+   my $n = 0;
+   my @pairs = (@scores Z (0 ... *)).sort({ $^a[0] <=> $^b[0] }).reverse;
+   for ^@pairs -> $i {
+      my ($v, $k) = @pairs[$i].Slip;
+      $n = $i + 1 if $i == 0 || @pairs[$i - 1][0] > $v;
+      @retval[$k] = $n < 4 ?? @lower[$n] !! $n;
+   }
+   return @retval;
+}
diff --git a/challenge-214/polettix/raku/ch-2.raku b/challenge-214/polettix/raku/ch-2.raku
new file mode 100644
index 0000000000..d60483781d
--- /dev/null
+++ b/challenge-214/polettix/raku/ch-2.raku
@@ -0,0 +1,67 @@
+#!/usr/bin/env raku
+use v6;
+sub MAIN (*@args) { put collect-points(@args) }
+
+sub collect-points (@numbers) {
+   return 0 unless @numbers;
+   my @slots = @numbers[0], 1;
+   for 1 ..^ @numbers -> $i {
+      if @numbers[$i - 1] == @numbers[$i] {
+         @slots[*-1]++;
+      }
+      else {
+         @slots.push: @numbers[$i], 1;
+      }
+   }
+   return collect-points-wh(@slots);
+}
+
+sub collect-points-wh (@slots) {
+   my $score = 0;
+
+   loop {
+      my %count-for;
+
+      my $i = 0;
+      while $i < @slots {
+         (%count-for{@slots[$i]} //= 0)++;
+         $i += 2;
+      }
+
+      my %is-single = %count-for.keys.grep({ %count-for{$_} == 1 })
+         .map({ $_ => True });
+      last unless %is-single.elems;
+
+      $i = 0;
+      while $i < @slots {
+         if %is-single{@slots[$i]} {
+            $score += @slots[$i + 1] ** 2;
+            @slots = remove-slot($i, @slots);
+         }
+         else {
+            $i += 2;
+         }
+      }
+   }
+
+   my $i = 0;
+   my $best-sub-score = 0;
+   while $i < @slots {
+      my @sub-slots = remove-slot($i, @slots);
+      my $sub-score = collect-points-wh(@sub-slots);
+      $best-sub-score = $sub-score if $best-sub-score < $sub-score;
+      $i += 2;
+   }
+
+   $score += $best-sub-score;
+   return $score;
+}
+
+sub remove-slot ($i, @slots is copy) {
+   @slots.splice($i, 2);
+   if $i > 0 && $i < @slots && @slots[$i - 2] == @slots[$i] {
+      @slots[$i - 1] += @slots[$i + 1];
+      @slots.splice($i, 2);
+   }
+   return @slots;
+}