2 Perl scripts

2 files changed, 181 insertions, 0 deletions

diff --git a/challenge-092/cheok-yin-fung/perl/ch-1.pl b/challenge-092/cheok-yin-fung/perl/ch-1.pl
new file mode 100644
index 0000000000..308c210bdf
--- /dev/null
+++ b/challenge-092/cheok-yin-fung/perl/ch-1.pl
@@ -0,0 +1,67 @@
+#!/usr/bin/perl
+# The Weekly Challenge 092
+# Task 1 
+# main idea: hash of arrays 
+use strict;
+use warnings;
+use Data::Dumper;
+
+sub learn_pattern {
+    my %pattern;
+    my $word = $_[0];
+    my @alphabet = split //, $word;
+    my %hash;
+    my $num_of_diff_symbols = 0;
+    for (0..$#alphabet) {
+        if (exists $hash{$alphabet[$_]}) {
+            push @{$pattern{$hash{$alphabet[$_]}}}, $_;
+        } else {
+            $hash{$alphabet[$_]} = $num_of_diff_symbols;
+            $pattern{$num_of_diff_symbols} = [ $_ ] ;
+            $num_of_diff_symbols++;
+
+        }
+    }
+    return %pattern;
+}
+
+sub verify_pattern {
+    my %pattern = %{$_[0]};
+    my $word = $_[1];
+    my @alphabet = split //, $word;
+    my @char = (undef) x length $word;
+    my @symbol;
+    my %ehash;
+    my $num_of_diff_symbols = 0;
+    for my $alpha (@alphabet) {
+        if (!exists $ehash{$alpha}) {
+            $ehash{$alpha} = 1;
+            $symbol[$num_of_diff_symbols] = $alpha;
+            $num_of_diff_symbols++;
+        }
+    }
+
+
+    for my $order (sort {$a <=> $b} keys %pattern) {
+        my @p = @{$pattern{$order}};
+        for (@p) {
+            $char[$_] = $symbol[$order];
+        }
+    }
+
+    my $word_two = join "", @char;
+
+    return ($word eq $word_two);
+}
+
+my %h = learn_pattern($ARGV[0]);
+if (verify_pattern(\%h,$ARGV[1])) {
+    print 1;
+} else {
+    print 0;
+}
+print "\n";
+
+
+
+
diff --git a/challenge-092/cheok-yin-fung/perl/ch-2.pl b/challenge-092/cheok-yin-fung/perl/ch-2.pl
new file mode 100644
index 0000000000..c5a47700bf
--- /dev/null
+++ b/challenge-092/cheok-yin-fung/perl/ch-2.pl
@@ -0,0 +1,114 @@
+#!/usr/bin/perl
+# The Weekly Challenge 092
+# Task 2 Insert Interval
+use strict;
+use warnings;
+use Test::More tests => 3;
+use Test::Deep;
+
+my $MAXLIM =  10000;
+my $MINLIM = -10000;
+
+my @input = ([1,5], [7,9]);
+my $new_intv = [ shift @ARGV, shift @ARGV ] ;
+my @result = @{insert_interval(\@input, $new_intv)};
+
+print "before insertion: " ; print_couples(@input);
+print "after insertion : " ; print_couples(@result);
+
+
+sub insert_interval {
+    my @S = @{$_[0]};
+    my @result;
+    my $N = $_[1];
+
+    unshift @S, [$MINLIM, $S[0]->[0] - 1 ];
+    push @S, [$S[-1]->[1] + 1 , $MAXLIM];
+
+    my $i = -1;
+    my $j;
+
+    do { $i++; } while ( $i <= $#S-1 && 
+            $N->[0] >= $S[$i+1]->[0] );
+    if ($N->[0] > $S[$i]->[1]) {$i++;}
+
+    $j = $i-1;
+
+    do { $j++; } while ( $j <= $#S-1 && 
+           $N->[1] >= $S[$j+1]->[1]);
+
+    if ($j < $#S && $N->[1] >= $S[$j+1]->[0]) {$j++;}
+
+    #    print "$i   $j\n";  #testing line 
+
+    if ($i == 0 and $j == $#S) {
+        push @result, $N;
+    }
+    elsif ($i == $j and $j == 0) {
+        shift @S;
+        unshift @S, $N; 
+        pop @S;
+        @result = @S;
+    } elsif ($i == 0 and $j <= $#S-1) {
+        push @result, [
+            $N->[0], 
+            ($N->[1] > $S[$j]->[1]) ? $N->[1] : $S[$j]->[1] 
+        ];
+        for my $k ($j+1..$#S-1) {
+            push @result, $S[$k];
+        }
+    } elsif ($i > 0 and $j <= $#S-1) {
+        for my $k (1..$i-1) {
+            push @result, $S[$k];
+        }
+        push @result, [
+            ($N->[0] < $S[$i]->[0]) ? $N->[0] : $S[$i]->[0] ,
+            ($N->[1] > $S[$j]->[1]) ? $N->[1] : $S[$j]->[1] ];
+        for my $k ($j+1..$#S-1) {
+            push @result, $S[$k];
+        }
+    } elsif ($i < $#S and $j == $#S) {
+        for my $k (1..$i-1) {
+            push @result,  $S[$k]  ;
+        }
+        push @result, [ 
+            ($N->[0] < $S[$i]->[0]) ? $N->[0] : $S[$i]->[0] ,
+             $N->[1]
+         ];
+
+    } elsif ($i == $j and $j == $#S) {
+        shift @S;
+        pop @S;
+        push @S, $N;
+        @result = @S;
+    }
+
+
+    return \@result;
+}
+
+sub print_couples {
+    my @r = @_;
+    my $a = pop @r; 
+    for (@r) {
+        print "(", $_->[0], "," ,$_->[1], "), ";
+    }
+    print "(", $a->[0],"," ,$a->[1], ")", "\n";
+}
+
+
+cmp_deeply( 
+    insert_interval([([1,4], [8,10])], [2,6]), 
+    [[1,6],[8,10]] , 
+    "Example 1" 
+);
+cmp_deeply( 
+    insert_interval([[1,2], [3,7], [8,10]], [5,8]),
+    [[1,2],[3,10]] ,
+    "Example 2"
+);
+cmp_deeply(
+    insert_interval([[1,5], [7,9]], [10,11]),
+    [[1,5],[7,9],[10,11]],
+    "Example 3"
+);