Merge pull request #18 from manwar/master

Update for w19

79 files changed, 3980 insertions, 40 deletions

diff --git a/challenge-018/adam-russell/blog.txt b/challenge-018/adam-russell/blog.txt
new file mode 100644
index 0000000000..4a5c19a082
--- /dev/null
+++ b/challenge-018/adam-russell/blog.txt
@@ -0,0 +1 @@
+https://adamcrussell.livejournal.com/6109.html
diff --git a/challenge-018/adam-russell/perl5/PriorityQueue.pm b/challenge-018/adam-russell/perl5/PriorityQueue.pm
new file mode 100644
index 0000000000..e817fdc0e4
--- /dev/null
+++ b/challenge-018/adam-russell/perl5/PriorityQueue.pm
@@ -0,0 +1,74 @@
+use strict;
+use warnings;
+package PriorityQueue{
+    use boolean; 
+    use Class::Struct;
+    package Node{
+        use Class::Struct; 
+        struct(
+            priority => q/$/,
+            data => q/$/
+        ); 
+    }   
+    package Heap{
+        use Class::Struct;
+        struct(
+            nodes => q/@/,
+            length => q/$/
+        );  
+    } 
+    struct(
+        heap => q/Heap/,  
+        length => q/$/
+    ); 
+    sub initialize{
+        my($self) = @_;
+        my $heap = new Heap(
+            nodes => [],
+            length => 0
+        ); 
+        $self->heap($heap); 
+    } 
+    sub is_empty{
+        my($self) = @_;
+        return @{$self->heap()->nodes()}; 
+    } 
+    sub insert_with_priority{
+        my($self, $priority, $data) = @_;
+        my $i = $self->heap()->length() + 1;
+        my $j = int($i / 2);
+        while($i > 1 && $self->heap()->nodes()->[$j]->priority() > $priority){
+            $self->heap()->nodes->[$i] = $self->heap()->nodes()->[$j]; 
+            $i = $j;
+            $j = int($j / 2); 
+        }   
+        $self->heap()->nodes()->[$i] = new Node();
+        $self->heap()->nodes()->[$i]->priority($priority);
+        $self->heap()->nodes()->[$i]->data($data);
+        $self->heap()->length($self->heap()->length + 1); 
+    }        
+    sub pull_highest_priority_element{
+        my($self) = @_;
+        if(!$self->is_empty()){
+            return undef; 
+        }
+        my $data = $self->heap()->nodes()->[1]->data(); 
+        $self->heap()->nodes()->[1] = $self->heap()->nodes()->[@{$self->heap()->nodes()} + 1]; 
+        $self->heap()->length($self->heap()->length() - 1); 
+        my $i = 1;
+        while($i != $self->heap()->length() + 1){
+            my $k = $self->heap()->length + 1 ;
+            my $j = $i * 2;
+            if($j <= $self->heap()->length() && ($self->heap()->nodes()->[$j]->priority() < $self->heap()->nodes->[$k]->priority())){
+                $k = $j; 
+            }  
+            if($j + 1 <= $self->heap()->length() && ($self->heap()->nodes()->[$j + 1]->priority() < $self->heap()->nodes->[$k]->priority())){
+                $k = $j + 1; 
+            }  
+            $self->heap()->nodes()->[$i] = $self->heap()->nodes()->[$k]; 
+            $i = $k;  
+        }
+        return $data;  
+    } 
+    true; 
+}
diff --git a/challenge-018/adam-russell/perl5/SuffixArray.pm b/challenge-018/adam-russell/perl5/SuffixArray.pm
new file mode 100644
index 0000000000..c480d4517d
--- /dev/null
+++ b/challenge-018/adam-russell/perl5/SuffixArray.pm
@@ -0,0 +1,115 @@
+use strict;
+use warnings; 
+package SuffixArray{
+    use boolean;  
+    use Class::Struct;
+    struct(
+        suffixes => q/@/
+    );
+    sub create{
+        my($self, $text) = @_;
+        for my $n (0 .. (length($text) - 1)){
+            my @text_array = split(//, $text); 
+            my $suffix = new Suffix(
+                text => $text,
+                text_array => \@text_array,
+                index => $n                 
+            );  
+            $self->suffixes($n, $suffix); 
+        } 
+        my @a = sort {$a cmp $b} @{$self->suffixes()}; 
+        $self->suffixes(\@a); 
+    } 
+    sub length{
+        my($self) = @_;
+        return @{$self->[0]}; 
+    } 
+    sub index{
+        my($self, $i) = @_;  
+        return $self->suffixes()->[$i]->index(); 
+    }
+    sub lcp{
+        my($self, $i) = @_;  
+        return $self->lcp_suffix($self->suffixes()->[$i], $self->suffixes()->[$i - 1]);   
+    } 
+    sub lcp_suffix{
+        my($self, $a, $b) = @_;  
+        my $length_a = $a->length();   
+        my $length_b = $b->length();   
+        my $n = $length_a < $length_b ? $length_a : $length_b; 
+        for my $i (0..($n - 1)){
+            if($a->char_at($i) ne $b->char_at($i)){
+                return $i; 
+            } 
+        } 
+        return $n;  
+    }
+    sub select{
+        my($self, $i) = @_;  
+        return $self->suffixes()->[$i]->text();  
+    }    
+    sub rank{
+        my($self, $query) = @_;  
+        my $low = 0;
+        my $high = @{$self->[0]} - 1; 
+        while($low <= $high){
+            my $middle = int($low + ($high - $low) / 2); 
+            my $comparison = $self->compare_string($query, $self->suffixes()->[$middle]);
+            if($comparison < 0){
+                $high = $middle - 1;
+            }  
+            elsif($comparison > 0){
+                $low = $middle + 1;  
+            } 
+            else{
+                return $middle;  
+            }  
+        }
+        return $low;  
+    }
+    sub compare_string{
+        my($self, $query, $suffix) = @_;
+        return 0 if $query eq substr($suffix->text(), $suffix->index());  
+        my $length_query = CORE::length($query); 
+        my $length_suffix = CORE::length($suffix->text()); 
+        my $n = $length_query < $length_suffix ? $length_query : $length_suffix; 
+        my @q = split(//, $query); 
+        for my $i (0 .. ($n - 1)){
+            return -1 if($q[$i] lt $suffix->char_at($i)); 
+            return  1 if($q[$i] gt $suffix->char_at($i)); 
+        }  
+    }  
+
+    package Suffix{
+        use Class::Struct 
+            text => q/$/,
+            text_array => q/@/,
+            index => q/$/ 
+        ; 
+        use overload
+            '<=>' => \&compare,
+            'cmp' => \&compare;
+        use boolean;
+        sub compare{
+            my($a, $b) = @_;   
+            return 0 if substr($a->text(), $a->index()) eq substr($b->text(), $b->index());  
+            my $length_a = length(substr($a->text(), $a->index())); 
+            my $length_b = length(substr($b->text(), $b->index())); 
+            my $n = $length_a < $length_b ? $length_a : $length_b; 
+            for my $i (0 .. ($n - 1)){
+                return -1 if($a->char_at($i) lt $b->char_at($i)); 
+                return  1 if($a->char_at($i) gt $b->char_at($i)); 
+            }  
+        }  
+        sub length{
+            my($self) = @_;  
+            return length($self->text()) - $self->index();  
+        } 
+        sub char_at{
+            my($self, $i) = @_;  
+            return $self->text_array()->[$self->index() + $i];   
+        }  
+        true; 
+    }  
+    true; 
+} 
diff --git a/challenge-018/adam-russell/perl5/ch-1.pl b/challenge-018/adam-russell/perl5/ch-1.pl
new file mode 100644
index 0000000000..c96e37bedb
--- /dev/null
+++ b/challenge-018/adam-russell/perl5/ch-1.pl
@@ -0,0 +1,67 @@
+use strict;
+use warnings;
+##
+# Write a script that takes 2 or more strings as command line 
+# parameters and print the longest common substring.
+##
+use SuffixArray; 
+
+sub lcp{
+    my($s, $p, $t, $q) = @_;
+    my @s = split(//, $s); 
+    my @t = split(//, $t); 
+    my $n = length($s) - $p < length($t) - $q ? length($s) - $p : length($t) - $q;
+    for my $i (0 .. $n - 1){
+        if($s[$p + $i] ne $t[$q + $i]){
+            return substr($s, $p, $p + $i);  
+        } 
+    }  
+    return substr($s, $p, $p + $n);  
+} 
+
+sub compare{
+    my($s, $p, $t, $q) = @_;
+    my @s = split(//, $s); 
+    my @t = split(//, $t); 
+    my $n = length($s) - $p < length($t) - $q ? length($s) - $p : length($t) - $q;
+    for my $i (0 .. $n - 1){
+        if($s[$p + $i] ne $t[$q + $i]){
+            return ord($s[$p + $i]) - ord($t[$q + $i]);  
+        }
+    }
+    return -1 if(length($s) - $p < length($t) - $q);
+    return  1 if(length($s) - $p > length($t) - $q);
+    return 0; 
+}
+
+sub lcs{
+    my($s, $t) = @_;
+    my $suffix_array0 = new SuffixArray(); 
+    $suffix_array0->create($s); 
+    my $suffix_array1 = new SuffixArray(); 
+    $suffix_array1->create($t); 
+    my $lcs = "";
+    my($i, $j) = (0, 0);
+    while($i < length($s) && $j < length($t)){
+        my $p = $suffix_array0->index($i); 
+        my $q = $suffix_array1->index($j); 
+        my($x) = lcp($s, $p, $t, $q);
+        if(length($x) > length($lcs)){
+            $lcs = $x; 
+        } 
+        if(compare($s, $p, $t, $q) < 0){
+            $i++; 
+        } 
+        else{
+            $j++; 
+        } 
+    } 
+    return $lcs;  
+} 
+
+MAIN:{
+    my $string0 = $ARGV[0];
+    my $string1 = $ARGV[1];
+    my $lcs = lcs($string0, $string1);
+    print "$lcs\n"; 
+} 
diff --git a/challenge-018/adam-russell/perl5/ch-2.pl b/challenge-018/adam-russell/perl5/ch-2.pl
new file mode 100644
index 0000000000..b67cab8bf0
--- /dev/null
+++ b/challenge-018/adam-russell/perl5/ch-2.pl
@@ -0,0 +1,14 @@
+use PriorityQueue;
+my $pq = new PriorityQueue();
+$pq->initialize();
+$pq->insert_with_priority(7, "sleep");  
+$pq->insert_with_priority(4, "go to the gym");  
+$pq->insert_with_priority(3, "work on blog");  
+$pq->insert_with_priority(5, "drink water");  
+$pq->insert_with_priority(1, "eat pizza");  
+$pq->insert_with_priority(2, "work on perl weekly challenge");  
+$pq->insert_with_priority(6, "clean dishes");  
+for(0 .. 6){
+    my $data = $pq->pull_highest_priority_element();
+    printf("$data\n");
+}  
diff --git a/challenge-018/andrezgz/perl5/ch-1.pl b/challenge-018/andrezgz/perl5/ch-1.pl
new file mode 100644
index 0000000000..4d0503ac84
--- /dev/null
+++ b/challenge-018/andrezgz/perl5/ch-1.pl
@@ -0,0 +1,61 @@
+#!/usr/bin/perl
+
+# https://perlweeklychallenge.org/blog/perl-weekly-challenge-018/
+# Task #1
+# Write a script that takes 2 or more strings as command line parameters
+# and print the longest common substring.
+# For example, the longest common substring of the strings
+# "ABABC", "BABCA" and "ABCBA" is string "ABC" of length 3.
+# Other common substrings are "A", "AB", "B", "BA", "BC" and "C".
+# Please check this wiki page for details.
+# https://en.wikipedia.org/wiki/Longest_common_substring_problem
+
+use strict;
+use warnings;
+use English qw(-no_match_vars);
+
+die "Usage: $PROGRAM_NAME string1 string2 [stringN]" if (@ARGV < 2);
+
+my @strings = map {uc $_ }                    # case-insensitive comparing
+              sort {length $a <=> length $b}  # shortest first
+              @ARGV;
+
+# get all of the substrings from the shortest string
+my @shortest_subs = get_all_substr(shift @strings);
+
+my $l = 0;
+my @longest;
+
+SUB: foreach my $sub (@shortest_subs) {
+
+    # stop if the length of this substring is shorter than the previous one
+    # and matches were found
+    last if (length $sub < $l && @longest);
+    $l = length $sub;
+
+    # check if any of the other strings does not contain this substring
+    foreach my $str (@strings) {
+        next SUB if (index($str,$sub) == -1);
+    }
+
+    # the substring is common to all
+    push @longest, $sub;
+}
+
+print 'Longest common substring(s): '.join(',',@longest)."\n";
+
+# return all substrings for a certain string ordered by longest first
+sub get_all_substr {
+    my $s = shift;
+    my $l = length $s;
+    my @subs;
+
+    for ( my $from = 0; $from < $l; $from++ ) {
+        for ( my $to = 1; $to < $l - $from + 1; $to++) {
+            push @subs, substr $s, $from, $to;
+        }
+    }
+
+    my @subs_sorted = reverse sort {length $a <=> length $b} @subs;
+    return @subs_sorted;
+}
diff --git a/challenge-018/andrezgz/perl5/ch-2.pl b/challenge-018/andrezgz/perl5/ch-2.pl
new file mode 100644
index 0000000000..9936793213
--- /dev/null
+++ b/