Merge pull request #9319 from E7-87-83/newt

Week 249

2 files changed, 77 insertions, 0 deletions

diff --git a/challenge-249/cheok-yin-fung/perl/ch-1.pl b/challenge-249/cheok-yin-fung/perl/ch-1.pl
new file mode 100755
index 0000000000..1c5b945915
--- /dev/null
+++ b/challenge-249/cheok-yin-fung/perl/ch-1.pl
@@ -0,0 +1,32 @@
+# The Weekly Challenge 249
+# Task 1 Equal Pairs
+use v5.30.0;
+use warnings;
+
+use Data::Printer;
+
+sub equal_pairs {
+    my @arr = @_;
+    # p @arr;
+    @arr = sort {$a<=>$b} @arr;
+    # p @arr;
+    my @ans;
+    for my $i (0..$#arr) {
+        next unless !($i % 2);
+        push @ans, [$arr[$i], $arr[$i+1]] if $arr[$i] == $arr[$i+1];
+    }
+    return [@ans];
+}
+
+use Test::More tests=>2;
+use Test::Deep;
+
+cmp_deeply 
+           [[2, 2], [2, 2], [3, 3]],
+           equal_pairs 3, 2, 3, 2, 2, 2 
+;
+    #      [(2, 2), (3, 3), (2, 2)] equals to [2,2,3,3,2,2];
+cmp_deeply [], equal_pairs 1,2,3,4;
+
+
+
diff --git a/challenge-249/cheok-yin-fung/perl/ch-2.pl b/challenge-249/cheok-yin-fung/perl/ch-2.pl
new file mode 100644
index 0000000000..b83086dd75
--- /dev/null
+++ b/challenge-249/cheok-yin-fung/perl/ch-2.pl
@@ -0,0 +1,45 @@
+# The Weekly Challenge 249
+# Task 2 DI String Match
+use v5.30.0;
+use warnings;
+use List::Util qw/first/;
+
+sub check_DI {
+    my $str = $_[0];
+    my @perm = $_[1]->@*;
+    return 0 unless (join ",", sort {$a<=>$b} @perm) 
+                            eq 
+                    (join ",", 0..length $str);
+    for (0..$#perm-1) {
+        next if substr($str, $_, 1) eq "I" && $perm[$_] < $perm[$_+1];
+        next if substr($str, $_, 1) eq "D" && $perm[$_] > $perm[$_+1];
+        return 0;
+    }
+    return 1;
+}
+
+sub generate {
+    my $str = $_[0];
+    my @bin = map {1 << $_} 1..length $str;
+    my @asst = (0);
+    for (1..length $str) {
+        if (substr($str, $_-1, 1) eq "I") {
+            $asst[$_] = $asst[$_-1]+$bin[$_-1];
+        } elsif (substr($str, $_-1, 1) eq "D") {
+            $asst[$_] = $asst[$_-1]-$bin[$_-1];
+        } else {
+            die "Error\n";
+        }
+    }
+    my @bsst = sort {$a<=>$b} @asst;
+    my @arr;
+    for my $i (0..length $str) {
+        push @arr, first {$bsst[$_] == $asst[$i]} 0..length $str;
+    }
+    say "String $str, generate '@arr'";
+    return [@arr];
+}
+use Test::More tests=>3;
+ok check_DI("IDID",generate("IDID"));
+ok check_DI("III",generate("III"));
+ok check_DI("DDI",generate("DDI"));