Week 214

2 files changed, 104 insertions, 0 deletions

diff --git a/challenge-214/cheok-yin-fung/perl/ch-1.pl b/challenge-214/cheok-yin-fung/perl/ch-1.pl
new file mode 100644
index 0000000000..44d03e954f
--- /dev/null
+++ b/challenge-214/cheok-yin-fung/perl/ch-1.pl
@@ -0,0 +1,40 @@
+# The Weekly Challenge 214
+# Task 1 Rank Score
+use v5.30.0;
+use warnings;
+
+
+sub rs {
+    my @scores = @_; 
+    my @mscores = sort {$b<=>$a} @scores;
+
+    my @mrank = (1);
+    my %s_r;
+    my $i = 1;
+    my $acc = 0;
+    $s_r{$mscores[0]} = 1;
+    for my $s (1..$#mscores) {
+        if ($mscores[$s-1] == $mscores[$s]) {
+            $acc++;
+        } else {
+            $i = $i + $acc + 1;
+            $acc = 0;
+        }
+        push @mrank, $i;
+    }
+    $s_r{$mscores[$_]} = $mrank[$_] for (0..$#scores);
+    my @numeric_rank = map { $s_r{$_} } @scores;
+    my @rank = map { $_ == 1 ? "G"
+                   : $_ == 2 ? "S"
+                   : $_ == 3 ? "B"
+                   : $_ } @numeric_rank;
+    return @rank;
+}
+
+use Test::More tests=>4;
+use Test::Deep;
+cmp_deeply [rs(1,2,4,3,5)], [5,4,"S","B","G"];
+cmp_deeply [rs(8,5,6,7,4)], ["G",4,"B","S",5];
+cmp_deeply [rs(3,5,4,2)], ["B","G","S",4];
+cmp_deeply [rs(2,5,2,1,7,5,1)], [4,"S",4,6,"G","S",6];
+
diff --git a/challenge-214/cheok-yin-fung/perl/ch-2.pl b/challenge-214/cheok-yin-fung/perl/ch-2.pl
new file mode 100644
index 0000000000..42fe9b10ac
--- /dev/null
+++ b/challenge-214/cheok-yin-fung/perl/ch-2.pl
@@ -0,0 +1,64 @@
+# The Weekly Challenge 214
+# Task 2 Collect Points
+# a slow but workable method
+use v5.30.0;
+use warnings;
+use List::Util qw/max/;
+
+my %s;
+my %n;
+my %cnt;
+my %end;
+
+sub cp {
+    my @numbers = @_;
+    $n{""} = [@numbers];
+    $s{""} = 0;
+    my @to_be_calc = ("");
+    while (scalar @to_be_calc != 0) {
+        nxt_stage($_) for @to_be_calc;
+        @to_be_calc = grep {!$cnt{$_} && !$end{$_}} keys %n;
+    }
+    my @cand = grep {$end{$_}} keys %n;
+    my $ans = max map {$s{$_}} @cand;
+    return $ans;
+}
+
+sub nxt_stage {
+    my $inp = $_[0];
+    my $pre_rmseq = $inp;
+    my @numbers = $n{$inp}->@*;
+    my $pre_score = $s{$inp};
+    $cnt{$inp} = 1;
+    for my $i (0..$#numbers) {
+        my ($rmseq, $sc, @ns)
+        = removal_and_score([@numbers], $i, $pre_rmseq, $pre_score);
+        $s{$rmseq} = $sc;
+        $n{$rmseq} = [@ns];
+        $end{$rmseq} = (scalar @ns == 0) ? 1 : 0;
+    }
+}
+
+sub removal_and_score {
+    my @numbers = $_[0]->@*;
+    my $i = $_[1];
+    my $pre_rmseq = $_[2];
+    my $pre_score = $_[3];
+    my $si = 0;
+    until ($si > $i || $numbers[$i] != $numbers[$i-$si]) {
+        $si++;
+    }
+    $si--;
+    my $ti = 0;
+    until ($i+$ti > $#numbers || $numbers[$i] != $numbers[$i+$ti]) {
+        $ti++;
+    } 
+    $ti--;
+    my $N = $ti+$si+1;
+    my $rmseq = ($pre_rmseq ? $pre_rmseq . "," : "") . $i;
+    my $score = $pre_score + $N*$N;
+    splice(@numbers, $i-$si, $ti+$si+1);
+    return ($rmseq, $score, @numbers);
+}
+
+say cp(2,4,3,3,3,4,5,4,2);  # 23