Add files via upload

2 files changed, 160 insertions, 0 deletions

diff --git a/challenge-065/cheok-yin-fung/perl/ch-1a.pl b/challenge-065/cheok-yin-fung/perl/ch-1a.pl
new file mode 100644
index 0000000000..a92567cffd
--- /dev/null
+++ b/challenge-065/cheok-yin-fung/perl/ch-1a.pl
@@ -0,0 +1,47 @@
+#!/usr/bin/perl
+use strict;
+
+my $N;
+my $S;
+
+if ($ARGV[0] and $ARGV[1]) {
+    $N = $ARGV[0];
+    $S = $ARGV[1];
+}
+else {  #example
+    $N = 2;   
+    $S = 4;
+}
+
+sub boofoo {
+    my $dSum = $_[0];
+    my $dNumber = $_[1];
+    my $start = $_[2];    #  $start = 1 if $tf == 1
+    my $tf = $_[3];
+    my @ans = ();
+    if ($dNumber > 1) {
+        my $end = ($dSum >= 9 ? 9 : $dSum );
+        for my $lfs ($start..$end) {  # lfs , shorthand for largest sig fig
+            for my $baby 
+              (boofoo($dSum-$lfs, $dNumber-1, int ($dSum-$lfs-1)/9, 0)){ 
+                                                     # -1 is the key
+                push @ans, $lfs.$baby;
+            }
+        }
+    } 
+    else {
+        push @ans, ($dSum != 0 ? $dSum : "0");
+    }
+    
+    return @ans;
+}
+
+
+if ($N*9 < $S ) {
+    print "\n";
+} 
+else {
+    my @result = boofoo($S,$N,1, 1);
+    print join "\n", @result;
+    print "\n";
+}
diff --git a/challenge-065/cheok-yin-fung/perl/ch-2.pl b/challenge-065/cheok-yin-fung/perl/ch-2.pl
new file mode 100644
index 0000000000..ab3d24fd87
--- /dev/null
+++ b/challenge-065/cheok-yin-fung/perl/ch-2.pl
@@ -0,0 +1,113 @@
+#!/usr/bin/perl
+use strict;
+
+#Usage: ch-2.pl STRING
+
+sub is_pali {
+    my $w = $_[0];           #word
+    if (length $w == 1) {return 0;} #single not counted
+    my $mid = (int (length $w) / 2) - 1 ;
+    my @c = split //, $w;    #characters
+    my @stack = map {$c[$_]} (0..$mid);
+    my $pointer;
+    if ( (length $w) % 2 == 1) {        
+        $pointer = $mid+2;     #e.g.  length $w = 3, $mid = 0, $pointer = 2 
+    }
+    else {
+        $pointer = $mid+1;     #e.g.  length $w = 6, $mid = 2, $pointer = 3
+    }
+    while ($c[$pointer] eq $stack[$#stack]) {
+        pop @stack;
+        $pointer++;
+        last if @stack == ();
+    }
+    if (@stack == ()) {
+        return 1;
+    }
+    else {
+        return 0;
+    }
+}
+
+
+my $S = "abaaba";   #default setting
+$S = $ARGV[0] if $ARGV[0];
+
+
+sub part_func {         #partitions, generated by binary strings 
+    my $word = $_[0];
+    my $bstring = sprintf "%b", $_[1];
+    my @warray = split //, $word;
+    my @b = split //, $bstring;
+    my @ans = ();
+    my $temp = "";
+    for my $k (0..$#warray) {
+        if ($b[$k] == 1) {
+            $temp .= $warray[$k];
+       } else {
+            push @ans,$temp;
+            $temp = $warray[$k];
+        }
+    }
+    push @ans, $temp;
+    return @ans;
+}
+
+my %hresult;
+my $n = length $S;
+
+for my $seperator (2**($n-1)+1..2**$n) {
+    my @p = grep {is_pali $_} part_func($S, $seperator);
+    my $r = join ",", @p unless @p == ();
+    $hresult{$r} = 1;
+}
+
+
+sub need_to_remove_subsequence {
+    if (
+      index($_[0], ",".$_[1]) == -1
+        and
+      index($_[0], $_[1].",") == -1
+    ) {
+        return 0;
+    }
+    else {
+        return 1;
+    }
+}
+
+
+#remove_subsequence
+my @aresult = keys %hresult;
+for my $peter (@aresult) {
+    for my $pierre (@aresult) {
+        unless ($peter eq $pierre or $peter eq $S) {
+            if (need_to_remove_subsequence($peter,$pierre)) {
+                delete $hresult{$pierre};
+            }
+        }
+    }
+}
+
+#print answer
+
+print "string: ", $S,"\n\n";
+print join "\n", sort keys %hresult;
+print "\n";
+
+#
+# abaaba -> 
+# aa
+# baab
+# aba, aba
+# abaaba
+#
+# aabaab -> #Example 1
+# aabaa
+## aa, baab
+# aba
+#
+# abbaba -> #Example 2
+# abba
+# bb, aba
+# bab