Merge pull request #2807 from E7-87-83/master

Cheok Yin's submission for challenge 087

4 files changed, 236 insertions, 0 deletions

diff --git a/challenge-087/cheok-yin-fung/blog.txt b/challenge-087/cheok-yin-fung/blog.txt
new file mode 100644
index 0000000000..d42f21f2a4
--- /dev/null
+++ b/challenge-087/cheok-yin-fung/blog.txt
@@ -0,0 +1 @@
+http://blogs.perl.org/users/c_y_fung/2020/11/cys-take-on-pwc087.html
diff --git a/challenge-087/cheok-yin-fung/common-lisp/ch-1.lsp b/challenge-087/cheok-yin-fung/common-lisp/ch-1.lsp
new file mode 100644
index 0000000000..232dc71c31
--- /dev/null
+++ b/challenge-087/cheok-yin-fung/common-lisp/ch-1.lsp
@@ -0,0 +1,51 @@
+; The Weekly Challenge - Perl & Raku #087 
+; Task 1: Longest Consecutive Sequence
+; Common Lisp script
+
+(setf *ans* '(10000))
+
+(defun add1 (mynumber)
+  (+ 1 mynumber))
+
+
+(defun seperate-list ()
+  (if (not (zerop (length *mylist*))) (progn (progn
+    (if (= (add1 (car *mylist*)) (car (car *newlist*)))
+      (push (car *mylist*) (car *newlist*))
+      (push (nreverse (list (car *mylist*))) *newlist*))
+    (setf *mylist* (cdr *mylist*))
+    (print *mylist*)
+    (print *newlist*)
+    (seperate-list)))))
+
+(defun extract-longest ()
+  (if (>=  (length *mylist*) 1 ) (progn
+    (if (> (length (car *mylist*)) (length *ans*))
+      (setq *ans* (car *mylist*)))
+    (setq *mylist* (cdr *mylist*))
+    (extract-longest))))
+
+; ================================================
+; main procedures
+
+;example; (setf *mylist* '(50 48 301 4 51 3 2 49 29 300))
+(setf *mylist* '(50 48 301 4 51 3 2 49 29 300))
+(sort *mylist* #'>)
+; (example)  *mylist* is (2 3 4 29 48 49 50 51 300 301)
+
+(setf *newlist* (list (list (car *mylist*))))
+(setf *mylist* (cdr *mylist*))
+(seperate-list)
+(setf *mylist* *newlist*)
+; (example) *mylist is ((2 3 4) (29) (48 49 50 51) (300 301))
+
+(extract-longest)
+
+(if (= (length *ans*) 1) 
+  (print 0) 
+  (progn 
+    (format t "~%") 
+    (format t "Answer:") 
+    (print *ans*)))
+
+
diff --git a/challenge-087/cheok-yin-fung/perl/ch-1.pl b/challenge-087/cheok-yin-fung/perl/ch-1.pl
new file mode 100644
index 0000000000..4a935d20db
--- /dev/null
+++ b/challenge-087/cheok-yin-fung/perl/ch-1.pl
@@ -0,0 +1,51 @@
+#!/usr/bin/perl
+# The Weekly Challenge - Perl & Raku - 087
+# Task: Longest Consecutive Sequence
+# Usage: ch-1.pl @N
+
+use strict;
+use warnings;
+use Test::More tests => 3;
+use Test::Deep;
+
+sub long_consec{
+    my @list = sort {$a<=>$b} @_;
+    my $max_len = 1;
+    my @max_opp;
+
+    my @potential_max_opp = ($list[0]);
+    for (1..$#list) { 
+        if ($list[$_-1] == $list[$_]-1) {
+            push @potential_max_opp, $list[$_];
+        } else
+        {
+            if (scalar @potential_max_opp > $max_len) {
+                $max_len = scalar @potential_max_opp;
+                @max_opp = @potential_max_opp;
+            }
+            @potential_max_opp = ($list[$_]);
+        }
+    }
+
+    return \@max_opp;
+}
+
+my @temp_arr;
+
+if ($ARGV[0]) {
+    @temp_arr = @{long_consec(@ARGV)};
+}
+if (@temp_arr) {
+    print "("; 
+    print join ", ", @temp_arr;
+    print ")";
+} else
+{
+    print 0;
+}
+
+print "\n";
+
+cmp_deeply ( long_consec(100, 4, 50, 3, 2) , [2, 3, 4], "example 1");
+cmp_deeply( long_consec(10, 30, 20, 50, 40) , [], "example 2");
+cmp_deeply( long_consec(20, 19, 9, 11, 10) , [9,10,11], "example 3");
diff --git a/challenge-087/cheok-yin-fung/perl/ch-2.pl b/challenge-087/cheok-yin-fung/perl/ch-2.pl
new file mode 100644
index 0000000000..04a2ecff9e
--- /dev/null
+++ b/challenge-087/cheok-yin-fung/perl/ch-2.pl
@@ -0,0 +1,133 @@
+#!/usr/bin/perl
+# very similar to #084 Find Squares Task
+use strict;
+use warnings;
+#use Test::More tests => 8;
+#Usage: ch-2.pl [matrix height] [matrix width] [matrix entries]
+#Example: 
+#input: ch-2.pl  10 6 0 1 1 1 0 0 0 0 1 1 0 0 0 0 1 0 1 1 0 1 1 0 0 1 1 1 0 0 0 0 0 0 1 0 0 1 1 1 1 0 1 0 1 0 1 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 
+
+#output: 2x3 matrix with every entry 1
+
+sub print_matrix {
+    my @mat = @{$_[0]};  
+    my $M = scalar @mat;
+    my $N = scalar @{$mat[0]};
+    for my $j (0..$M-1) {
+        print "[", join(", ", @{$mat[$j]}), "]" ;
+        print "\n";
+    }
+}
+
+sub find_rect {
+    my @mat = @{$_[0]};  
+    my $nsq = 0;
+    my $M = scalar @mat;
+    my $N = scalar @{$mat[0]};
+    my $largest_area = 0;
+    my $rect_width;
+    my $rect_height;
+
+    for my $i (0..$N-2) {
+        for my $j (0..$M-2) {
+            for my $k (reverse $i+1..$N-1) {
+                if (all_ones(\@mat,$i,$k,$j)) {
+                    for my $l (reverse $j+1..$M-1) {
+                        if (($k-$i+1)*($l-$j+1) > $largest_area) {
+                            my $count = $l;
+                            my $bool;
+                            do {
+                                $bool = all_ones(\@mat, $i, $k, $count);
+                                $count = $count-1;
+                            } while ($count > $j && $bool);
+                            if ($bool and $count==$j) {
+                                $largest_area = ($k-$i+1)*($l-$j+1);
+                                $rect_width = $k-$i+1;
+                                $rect_height = $l-$j+1;
+                            }
+                        }
+                    }
+                }
+            }     
+        }
+    }
+
+    if ($largest_area > 0) {
+        print "\n\n";
+        for my $j (1..$rect_height) {
+            print "[";
+            for my $i (1..$rect_width-1) {
+                print "1 "
+            }
+            print "1]\n";
+        } 
+        print "area:", $largest_area, "\n"; # Testing Lines
+    }
+
+    return $largest_area;
+}
+
+sub all_ones {
+    my @mat = @{$_[0]};
+    my $start_col = $_[1];
+    my $end_col = $_[2];
+    my $row = $_[3];
+    my $count = $start_col;
+    while ( $count <= $end_col && ${$mat[$row]}[$count]) {
+        $count++;
+    }
+    if ($count==$end_col+1) { 
+        return 1;
+    } else 
+    {
+       return undef;
+    } 
+}
+
+if ($ARGV[0]) {
+    my @f = @ARGV;
+    my $M = shift @f;
+    my $N = shift @f;
+    my @matrix = ();
+    die "Input Parameters Error" unless scalar @f == $M*$N;
+    for my $j (0..$M-1) {
+        push @matrix , [ @f[$N*$j..$N*$j+$N-1] ]; 
+    }
+    print_matrix([@matrix]);
+    print 0, "\n" if !(find_rect([@matrix]));
+}
+
+
+=pod
+ok(find_rect([[ 0,1,0,1 ], [ 0, 0, 1,0 ], [ 1, 1 ,0 ,1],[1, 0, 0, 1 ]] )== 0,
+    "Test Case 1");
+ok(find_rect([[ 1 ,1, 0, 1 ], [ 1, 1 ,0 ,0 ],  [ 0, 1, 1 ,1 ],  [ 1, 0, 1, 1 ]]
+    )== 4,  "Test Case 2");
+ok(find_rect([[ 0 ,1 ,0 ,1 ], [ 1, 0 ,1 ,0 ], [ 0 ,1 ,0 ,0 ], [ 1, 0 ,0 ,1 ]]
+    ) == 0,  "Test case 3");
+ok(find_rect([[1,1,1,1],[1,1,1,1],[1,1,1,1],[1,1,1,1]]
+    ) == 16, "a 4x4 matrix with every entry being 1");
+
+ok(find_rect([[1,1,1,1,1],[1,1,1,1,1],[1,1,1,1,1]]
+    ) == 15, "a 3x5 matrix with every entry being 1");
+
+ok(find_rect([
+    [ 0,0,0,1,0,0,],
+    [ 1,1,1,0,0,0,],
+    [ 0,0,1,0,0,1,],
+    [ 1,1,1,1,1,0,],
+    [ 1,1,1,1,1,0,]]) == 10, "Example 1");
+
+ok(find_rect([
+    [ 1,0,1,0,1,0,],
+    [ 0,1,0,1,0,1,],
+    [ 1,0,1,0,1,0,],
+    [ 0,1,0,1,0,1,]]) == 0, "Example 2");
+
+ok(find_rect([
+    [ 0,0,0,1,1,1],
+    [ 1,1,1,1,1,1],
+    [ 0,0,1,0,0,1],
+    [ 0,0,1,1,1,1],
+    [ 0,0,1,1,1,1]]) == 8, "Example 3");
+=cut