Week 277 - two perl solutions, 1 Lisp solution for Task 2

3 files changed, 69 insertions, 0 deletions

diff --git a/challenge-277/cheok-yin-fung/lisp/ch-2.lsp b/challenge-277/cheok-yin-fung/lisp/ch-2.lsp
new file mode 100755
index 0000000000..34d9344cc1
--- /dev/null
+++ b/challenge-277/cheok-yin-fung/lisp/ch-2.lsp
@@ -0,0 +1,22 @@
+; The Weekly Challenge 277
+; Task 2 Strong Pair
+
+(defun strong-pair (lst-a &aux result)
+  (dolist (x (remove-duplicates lst-a) result)
+    (dolist (y (remove-duplicates lst-a))
+      (when (and (< 0 (- y x)) (not (equal x y)) (< (- y x) (min x y)))
+        (push (list x y) result)))))
+
+(defun strong-pair-cnt (lst-a)
+  (length (strong-pair lst-a)))
+
+; > (strong-pair (list 1 2 3 4 5))
+; ((4 5) (3 5) (3 4) (2 3))
+; > (strong-pair-cnt (list 1 2 3 4 5))
+; 4
+
+; > (strong-pair (list 5 7 1 7 ))
+; ((5 7))
+; > (strong-pair-cnt (list 5 7 1 7 ))
+; 1
+
diff --git a/challenge-277/cheok-yin-fung/perl/ch-1.pl b/challenge-277/cheok-yin-fung/perl/ch-1.pl
new file mode 100755
index 0000000000..d049e5943f
--- /dev/null
+++ b/challenge-277/cheok-yin-fung/perl/ch-1.pl
@@ -0,0 +1,26 @@
+# The Weekly Challenge 277
+# Task 1 Count Common
+use v5.30.0;
+use warnings;
+use List::MoreUtils qw/singleton duplicates/;
+
+sub cc {
+    my @words1 = $_[0]->@*;
+    my @words2 = $_[1]->@*;
+    my @commons = duplicates ((singleton @words1),(singleton @words2));
+    return scalar @commons;
+}
+
+use Test::More tests=>3;
+ok cc(
+    ["Perl", "is", "my", "friend"],
+    ["Perl", "and", "Raku", "are", "friend"]
+  ) == 2;
+ok cc(
+    ["Perl", "and", "Python", "are", "very", "similar"],
+    ["Python", "is", "top", "in", "guest", "languages"]
+  ) == 1;
+ok cc(
+    ["Perl", "is", "imperative", "Lisp", "is", "functional"],
+    ["Crystal", "is", "similar", "to", "Ruby"]
+  ) == 0;
diff --git a/challenge-277/cheok-yin-fung/perl/ch-2.pl b/challenge-277/cheok-yin-fung/perl/ch-2.pl
new file mode 100755
index 0000000000..008dc01c87
--- /dev/null
+++ b/challenge-277/cheok-yin-fung/perl/ch-2.pl
@@ -0,0 +1,21 @@
+# The Weekly Challenge 277
+# Task 2 Strong Pair
+use v5.30.0;
+use warnings;
+use List::Util qw/uniqnum min/;
+
+sub sp {
+    my @ints = $_[0]->@*;
+    my @nums = uniqnum @ints;
+    my $ans = 0;
+    for my $i (0..$#nums-1) {
+        for my $j ($i+1..$#nums) {
+            $ans++ if abs($nums[$i]-$nums[$j]) < min($nums[$i], $nums[$j]);
+        }
+    }
+    return $ans;
+}
+
+use Test::More tests=>2;
+ok sp([1,2,3,4,5]) == 4;
+ok sp([5,7,1,7]) == 1;