From cd4d6cdee8376715f0f48252e42f6c16fd73a3bc Mon Sep 17 00:00:00 2001
From: Alexander <39702500+threadless-screw@users.noreply.github.com>
Date: Wed, 24 Jul 2019 06:35:57 +0000
Subject: Create ch-2b.p6

---
 challenge-018/ozzy/perl6/ch-2b.p6 | 25 +++++++++++++++++++++++++
 1 file changed, 25 insertions(+)
 create mode 100644 challenge-018/ozzy/perl6/ch-2b.p6

(limited to 'challenge-018')

diff --git a/challenge-018/ozzy/perl6/ch-2b.p6 b/challenge-018/ozzy/perl6/ch-2b.p6
new file mode 100644
index 0000000000..45fa31e654
--- /dev/null
+++ b/challenge-018/ozzy/perl6/ch-2b.p6
@@ -0,0 +1,25 @@
+#!/usr/bin/env perl6
+# Find longest common substring(s) for 2+ cmdline specified strings.
+# Set+sort solution inspired by Rosetta code solution.
+
+sub MAIN (*@strings) {
+
+    if @strings.elems < 2 { say "Usage: cmd <string1> <string2> [stringx]..."; exit 1 }
+
+    my @substrings;
+    for 0..@strings.elems-1 -> $i {                                         #  $i = string index into @strings
+        my $l = @strings[$i].chars;                                         #  $l = string length
+        for 0..$l-1 -> $j {                                                 #  $j = start index into string
+            for $j..$l-1 -> $k {                                            #  $k = end index of string
+                @substrings[$i].push: @strings[$i].substr($j, ($k-$j+1));   #  Generate all substrings from string
+            }                                                               #+ in form of 2D-array; 1st dim. is string
+        }                                                                   #+ index, 2nd dim. is substring index.
+    }
+    my @cs = ([∩] @substrings).keys.sort({$^b.chars <=> $^a.chars});        #  Length-sorted intersection of substrings
+    if @cs.elems != 0 {
+        say "List of longest common substrings: ";                          #  Output lcs if we found any.
+        my $i=0; while @cs[$i].chars == @cs[0].chars { say @cs[$i++] };
+    } else {
+        say "No common substring found";
+    }
+}
-- 
cgit 


From 8a0772dd5ca30448de0a2f06ab75677c38aad880 Mon Sep 17 00:00:00 2001
From: Mohammad S Anwar <mohammad.anwar@yahoo.com>
Date: Wed, 24 Jul 2019 16:29:37 +0100
Subject: - Added solutions by Ozzy.

---
 challenge-018/ozzy/perl6/ch-2.p6  | 20 ++++++++++++++++++++
 challenge-018/ozzy/perl6/ch-2a.p6 | 25 +++++++++++++++++++++++++
 challenge-018/ozzy/perl6/ch-2b.p6 | 25 -------------------------
 3 files changed, 45 insertions(+), 25 deletions(-)
 create mode 100644 challenge-018/ozzy/perl6/ch-2.p6
 create mode 100644 challenge-018/ozzy/perl6/ch-2a.p6
 delete mode 100644 challenge-018/ozzy/perl6/ch-2b.p6

(limited to 'challenge-018')

diff --git a/challenge-018/ozzy/perl6/ch-2.p6 b/challenge-018/ozzy/perl6/ch-2.p6
new file mode 100644
index 0000000000..92f61119e1
--- /dev/null
+++ b/challenge-018/ozzy/perl6/ch-2.p6
@@ -0,0 +1,20 @@
+#!/usr/bin/env perl6
+# Find single longest common substring for just 2 cmdline specified strings.
+# This was a first attempt; the low-level approach seems somewhat difficult to generalize to multiple lcs in 2+ strings.
+
+sub MAIN (Str $string1 , Str $string2) {
+
+    my @string1     = $string1.comb;
+    my @string2     = $string2.comb;
+    my ($l1, $l2)   = (@string1.elems, @string2.elems);
+    my ($x,$z)      = (0,0);                                # $x is lcs-index into @string1, $z is length of lcs
+
+    for 0..$l1-1 -> $i {
+        for 0..$l2-1 -> $j {
+            my $k=0; 
+            $k++ while ($i+$k < $l1) && ($j+$k < $l2) && (@string1[$i+$k] eq @string2[$j+$k]);
+            if $k > $z { ($x, $z) = ($i, $k) };
+        }
+    }
+    say "LCS  = { $string1.substr($x, $z) }";
+}
diff --git a/challenge-018/ozzy/perl6/ch-2a.p6 b/challenge-018/ozzy/perl6/ch-2a.p6
new file mode 100644
index 0000000000..45fa31e654
--- /dev/null
+++ b/challenge-018/ozzy/perl6/ch-2a.p6
@@ -0,0 +1,25 @@
+#!/usr/bin/env perl6
+# Find longest common substring(s) for 2+ cmdline specified strings.
+# Set+sort solution inspired by Rosetta code solution.
+
+sub MAIN (*@strings) {
+
+    if @strings.elems < 2 { say "Usage: cmd <string1> <string2> [stringx]..."; exit 1 }
+
+    my @substrings;
+    for 0..@strings.elems-1 -> $i {                                         #  $i = string index into @strings
+        my $l = @strings[$i].chars;                                         #  $l = string length
+        for 0..$l-1 -> $j {                                                 #  $j = start index into string
+            for $j..$l-1 -> $k {                                            #  $k = end index of string
+                @substrings[$i].push: @strings[$i].substr($j, ($k-$j+1));   #  Generate all substrings from string
+            }                                                               #+ in form of 2D-array; 1st dim. is string
+        }                                                                   #+ index, 2nd dim. is substring index.
+    }
+    my @cs = ([∩] @substrings).keys.sort({$^b.chars <=> $^a.chars});        #  Length-sorted intersection of substrings
+    if @cs.elems != 0 {
+        say "List of longest common substrings: ";                          #  Output lcs if we found any.
+        my $i=0; while @cs[$i].chars == @cs[0].chars { say @cs[$i++] };
+    } else {
+        say "No common substring found";
+    }
+}
diff --git a/challenge-018/ozzy/perl6/ch-2b.p6 b/challenge-018/ozzy/perl6/ch-2b.p6
deleted file mode 100644
index 45fa31e654..0000000000
--- a/challenge-018/ozzy/perl6/ch-2b.p6
+++ /dev/null
@@ -1,25 +0,0 @@
-#!/usr/bin/env perl6
-# Find longest common substring(s) for 2+ cmdline specified strings.
-# Set+sort solution inspired by Rosetta code solution.
-
-sub MAIN (*@strings) {
-
-    if @strings.elems < 2 { say "Usage: cmd <string1> <string2> [stringx]..."; exit 1 }
-
-    my @substrings;
-    for 0..@strings.elems-1 -> $i {                                         #  $i = string index into @strings
-        my $l = @strings[$i].chars;                                         #  $l = string length
-        for 0..$l-1 -> $j {                                                 #  $j = start index into string
-            for $j..$l-1 -> $k {                                            #  $k = end index of string
-                @substrings[$i].push: @strings[$i].substr($j, ($k-$j+1));   #  Generate all substrings from string
-            }                                                               #+ in form of 2D-array; 1st dim. is string
-        }                                                                   #+ index, 2nd dim. is substring index.
-    }
-    my @cs = ([∩] @substrings).keys.sort({$^b.chars <=> $^a.chars});        #  Length-sorted intersection of substrings
-    if @cs.elems != 0 {
-        say "List of longest common substrings: ";                          #  Output lcs if we found any.
-        my $i=0; while @cs[$i].chars == @cs[0].chars { say @cs[$i++] };
-    } else {
-        say "No common substring found";
-    }
-}
-- 
cgit 


From dc4def61ef2eb1ebf2c6df0698ad8691a4ad384d Mon Sep 17 00:00:00 2001
From: Steven Wilson <steven1170@zoho.eu>
Date: Wed, 24 Jul 2019 17:27:29 +0100
Subject: add task 1 solution

---
 challenge-018/steven-wilson/perl5/ch-1.pl | 65 +++++++++++++++++++++++++++++++
 1 file changed, 65 insertions(+)
 create mode 100644 challenge-018/steven-wilson/perl5/ch-1.pl

(limited to 'challenge-018')

diff --git a/challenge-018/steven-wilson/perl5/ch-1.pl b/challenge-018/steven-wilson/perl5/ch-1.pl
new file mode 100644
index 0000000000..f8d86eadd2
--- /dev/null
+++ b/challenge-018/steven-wilson/perl5/ch-1.pl
@@ -0,0 +1,65 @@
+#!/usr/bin/env perl
+# Author: Steven Wilson
+# Date: 2019-07-22
+# Week: 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.
+
+use strict;
+use warnings;
+use feature qw/ say /;
+
+# my @input_strings = @ARGV;
+# print_longest_common_string(@input_strings);
+
+my @input_strings = qw/ ABABC BABCA ABCBA /;
+print_longest_common_string(@input_strings);
+
+sub print_longest_common_string {
+    my @strings = @_;
+
+    # longest strings first
+    my @sorted_strings = sort { length $b <=> length $a } @strings;
+
+    my %longest_common_substrings
+        = map { $_ => 1 } all_substrings( shift @sorted_strings );
+
+    while (@sorted_strings) {
+        %longest_common_substrings = map { $_ => 1 }
+            grep { exists $longest_common_substrings{$_} }
+            all_substrings( shift @sorted_strings );
+    }
+
+    my @sorted_common_strings
+        = sort { length $b <=> length $a } keys %longest_common_substrings;
+
+    if (@sorted_common_strings) {
+        my $longest_common_substring_length
+            = length $sorted_common_strings[0];
+        say "Longest common substring(s): " . join " ",
+            grep { length $_ == $longest_common_substring_length }
+            @sorted_common_strings;
+    }
+    else {
+        say "No common substrings exist";
+    }
+    return;
+}
+
+sub all_substrings {
+    my $string        = shift;
+    my $string_length = length $string;
+    my %substrings;
+    for ( my $i = 0; $i <= $string_length - 1; $i++ ) {
+        for ( my $j = ($string_length) - ($i); $j > 0; $j-- ) {
+            $substrings{ substr $string, $i, $j } = 1;
+        }
+    }
+    my @sorted_substrings = sort { length $b <=> length $a } keys %substrings;
+    return @sorted_substrings;
+}
-- 
cgit 


From 1bef788c588649b2f3ae0fef3db49224acc97033 Mon Sep 17 00:00:00 2001
From: andrezgz <andrezgz@gmail.com>
Date: Wed, 24 Jul 2019 20:30:21 -0300
Subject: challenge-018 andrezgz solution

---
 challenge-018/andrezgz/perl5/ch-1.pl | 61 ++++++++++++++++++++++++++++++++++++
 challenge-018/andrezgz/perl5/ch-2.pl | 60 +++++++++++++++++++++++++++++++++++
 2 files changed, 121 insertions(+)
 create mode 100644 challenge-018/andrezgz/perl5/ch-1.pl
 create mode 100644 challenge-018/andrezgz/perl5/ch-2.pl

(limited to 'challenge-018')

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/challenge-018/andrezgz/perl5/ch-2.pl
@@ -0,0 +1,60 @@
+#!/usr/bin/perl
+
+# https://perlweeklychallenge.org/blog/perl-weekly-challenge-018/
+# Task #2
+# Write a script to implement Priority Queue. It is like regular queue except
+# each element has a priority associated with it.
+# In a priority queue, an element with high priority is served before an element
+# with low priority. Please check this wiki page for more informations.
+# https://en.wikipedia.org/wiki/Priority_queue
+#
+# It should serve the following operations:
+# 1) is_empty: check whether the queue has no elements.
+# 2) insert_with_priority: add an element to the queue with an associated priority.
+# 3) pull_highest_priority_element: remove the element from the queue that has
+#     the highest priority, and return it. If two elements have the same priority,
+#     then return element added first.
+#
+
+use strict;
+use warnings;
+
+my $queue = {};
+
+print "Add elements to the queue: ELEMENT,PRIORITY\n";
+print "(priority 1 is the highest, 9 is the lowest)\n";
+while (<STDIN>) {
+    chomp;
+    my ($element, $priority) = split ',';
+    last unless (defined $priority && $priority =~ /^[1-9]$/);
+    insert_with_priority($queue, $element, $priority);
+    print ".Added: $element => $priority\n";
+}
+
+print "Processing queue by priority ...\n";
+print ".Serving: $_\n" while (local $_ = pull_highest_priority_element($queue));
+print "Queue is empty\n";
+
+sub is_empty {
+    my ($queue) = @_;
+    return (keys %$queue ? 0 : 1);
+}
+
+sub insert_with_priority {
+    my ($queue, $element, $priority) = @_;
+    push @{ $queue->{$priority} }, $element;
+    return;
+}
+
+sub pull_highest_priority_element {
+    my ($queue) = @_;
+    return if is_empty($queue);
+
+    my ($k) = sort keys %$queue; # highest priority key
+    my $e = shift @{ $queue->{$k} }; # first element of the highest priority
+
+    # if there are no more elements, remove priority key from the queue
+    delete $queue->{$k} unless @{ $queue->{$k} };
+
+    return $e;
+}
-- 
cgit 


From bf92bc382792fac6f958e3854bc2806d67d8d258 Mon Sep 17 00:00:00 2001
From: Mohammad S Anwar <mohammad.anwar@yahoo.com>
Date: Thu, 25 Jul 2019 12:22:47 +0100
Subject: - Added solutions by Laurent Rosenfeld.

---
 challenge-018/laurent-rosenfeld/blog.txt       |  1 +
 challenge-018/laurent-rosenfeld/perl5/ch-1.pl  | 49 ++++++++++++++++++++++++++
 challenge-018/laurent-rosenfeld/perl5/ch-1a.pl | 24 +++++++++++++
 challenge-018/laurent-rosenfeld/perl5/ch-2.pl  | 43 ++++++++++++++++++++++
 challenge-018/laurent-rosenfeld/perl6/ch-1.p6  | 25 +++++++++++++
 5 files changed, 142 insertions(+)
 create mode 100644 challenge-018/laurent-rosenfeld/blog.txt
 create mode 100644 challenge-018/laurent-rosenfeld/perl5/ch-1.pl
 create mode 100644 challenge-018/laurent-rosenfeld/perl5/ch-1a.pl
 create mode 100644 challenge-018/laurent-rosenfeld/perl5/ch-2.pl
 create mode 100644 challenge-018/laurent-rosenfeld/perl6/ch-1.p6

(limited to 'challenge-018')

diff --git a/challenge-018/laurent-rosenfeld/blog.txt b/challenge-018/laurent-rosenfeld/blog.txt
new file mode 100644
index 0000000000..297c793b9e
--- /dev/null
+++ b/challenge-018/laurent-rosenfeld/blog.txt
@@ -0,0 +1 @@
+http://blogs.perl.org/users/laurent_r/2019/07/perl-weekly-challenge-18-longest-common-substrings-priority-queues-and-a-functional-object-system.html
diff --git a/challenge-018/laurent-rosenfeld/perl5/ch-1.pl b/challenge-018/laurent-rosenfeld/perl5/ch-1.pl
new file mode 100644
index 0000000000..51d3313938
--- /dev/null
+++ b/challenge-018/laurent-rosenfeld/perl5/ch-1.pl
@@ -0,0 +1,49 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use feature qw/say/;
+
+sub compare2str {
+    my ($str1, $str2) = @_;
+    my @st1 = split //, $str1;
+    my @st2 = split //, $str2;
+    my %result;
+    my $common = '';
+    my ($i, $j) = (0, 0);
+    while ($i <= $#st1) {
+        while ($j <= $#st2) {
+            if ($st1[$i] eq $st2[$j]) {
+                $common .= $st1[$i];
+                $result{$common} = 1;
+                my ($k, $l) = ($i, $j);
+                while (1) {
+                    $k++; $l++;
+                    if ($k <= $#st1 and $l<= $#st2
+                        and $st1[$k] eq $st2[$l]) {
+                            $common .= $st1[$k];
+                            $result{$common} = 1;;
+                    } else {
+                        $common = '';
+                        last;
+                    }
+                }
+            }
+            $j++;
+        }
+        $j = 0;
+        $i++;
+    }
+    return keys %result;
+}
+
+die "Must supply at least two strings\n" unless @ARGV >= 2;
+my %common = map { $_ => 1 } compare2str shift, $ARGV[0];
+while (@ARGV > 1) {
+    %common = map { $_ => 1 } grep $common{$_},
+        compare2str shift, $ARGV[0];
+}
+my $max = "";
+for (keys %common) {
+    $max = $_ if length $_ > length $max;
+}
+say "Largest common substring: $max";
diff --git a/challenge-018/laurent-rosenfeld/perl5/ch-1a.pl b/challenge-018/laurent-rosenfeld/perl5/ch-1a.pl
new file mode 100644
index 0000000000..25d691c8aa
--- /dev/null
+++ b/challenge-018/laurent-rosenfeld/perl5/ch-1a.pl
@@ -0,0 +1,24 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use feature qw/say/;
+
+sub substrings {
+    my @chars = split //, shift;
+    my %substr; # using a hash to remove duplicates
+    for my $i (0..$#chars) {
+        for my $j ($i..$#chars) {
+            $substr{ join '', @chars[$i..$j] } = 1;
+        }
+    }
+    return keys %substr;
+}
+my %result = map { $_ => 1} substrings shift;
+for my $word (@ARGV) {
+    %result = map {$_ => 1} grep $result{$_}, substrings $word;
+}
+my $max = 0;
+for (keys %result) {
+    $max = $_ if length $_ > length $max;
+}
+say "Largest common substring: $max";
diff --git a/challenge-018/laurent-rosenfeld/perl5/ch-2.pl b/challenge-018/laurent-rosenfeld/perl5/ch-2.pl
new file mode 100644
index 0000000000..e053afca80
--- /dev/null
+++ b/challenge-018/laurent-rosenfeld/perl5/ch-2.pl
@@ -0,0 +1,43 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use feature qw/say/;
+
+
+sub new_queue {
+    my @queue;  # an AoA
+    my $is_empty = sub {
+        for my $item (@queue) {
+            next unless defined $item;
+            return 0 if @$item > 0;
+        }
+        return 1;
+    };
+    my $insert_with_prio = sub {
+        my ($item, $prio) = @_;
+        push @{$queue[$prio]}, $item;
+    };
+    my $pull_highest_prio = sub {
+        for my $item (reverse @queue) {
+            next unless defined $item;
+            return shift @$item if @$item > 0;
+        }
+    };
+    return $is_empty, $insert_with_prio, $pull_highest_prio;
+}
+
+my ($is_empty, $insert, $pull_prio) = new_queue;
+for my $num (1..20) {   # inserting 20 items into the queue
+    $insert->($num,
+        $num % 10 == 0 ? 10 :
+        $num % 5  == 0 ? 5  :
+        $num % 3  == 0 ? 3  :
+        $num % 2  == 0 ? 2  :
+        1);
+}
+for my $num (1..20) {
+    say $pull_prio->();
+}
+say "Empty queue" if $is_empty->();
+
+
diff --git a/challenge-018/laurent-rosenfeld/perl6/ch-1.p6 b/challenge-018/laurent-rosenfeld/perl6/ch-1.p6
new file mode 100644
index 0000000000..e9de2d89c9
--- /dev/null
+++ b/challenge-018/laurent-rosenfeld/perl6/ch-1.p6
@@ -0,0 +1,25 @@
+use v6;
+use Test;
+
+sub substrings (Str $in) {
+    my @result = $in.comb;
+    append @result,  map { .join('') }, $in.comb.rotor: $_ => 1-$_ for 2..$in.chars;
+    return set @result;
+}
+sub largest-substring (@words) {
+    my Set $intersection = substrings shift @words;
+    while (my $word = shift @words) {
+        $intersection ∩= substrings $word;
+    }
+    return $intersection.keys.max({.chars});
+}
+multi MAIN (*@words where *.elems > 1) {
+    say largest-substring @words;
+}
+multi MAIN () {
+    plan 2;
+    my @words = <ABABC BABCA ABCBA>;
+    cmp-ok largest-substring(@words), 'eq', 'ABC', "Testing 3 strings";
+    @words = 'abcde' xx 5;
+    cmp-ok largest-substring(@words), 'eq', 'abcde', "Testing identical strings";
+}
-- 
cgit 


From 2ee369e38b70d3761f52440afab44f517628be14 Mon Sep 17 00:00:00 2001
From: Adam Russell <ac.russell@live.com>
Date: Thu, 25 Jul 2019 10:26:35 -0400
Subject: initial commit

---
 challenge-018/adam-russell/blog.txt             |  0
 challenge-018/adam-russell/perl5/SuffixArray.pm | 16 ++++++++++++++++
 challenge-018/adam-russell/perl5/ch-1.pl        |  0
 challenge-018/adam-russell/perl5/ch-2.pl        |  0
 challenge-018/adam-russell/perl5/ch-3.pl        |  0
 5 files changed, 16 insertions(+)
 create mode 100644 challenge-018/adam-russell/blog.txt
 create mode 100644 challenge-018/adam-russell/perl5/SuffixArray.pm
 create mode 100644 challenge-018/adam-russell/perl5/ch-1.pl
 create mode 100644 challenge-018/adam-russell/perl5/ch-2.pl
 create mode 100644 challenge-018/adam-russell/perl5/ch-3.pl

(limited to 'challenge-018')

diff --git a/challenge-018/adam-russell/blog.txt b/challenge-018/adam-russell/blog.txt
new file mode 100644
index 0000000000..e69de29bb2
diff --git a/challenge-018/adam-russell/perl5/SuffixArray.pm b/challenge-018/adam-russell/perl5/SuffixArray.pm
new file mode 100644
index 0000000000..a6d37104a9
--- /dev/null
+++ b/challenge-018/adam-russell/perl5/SuffixArray.pm
@@ -0,0 +1,16 @@
+package SuffixArray{
+    use boolean;  
+    use Class::Struct;
+    struct(
+
+
+    );
+
+
+
+
+
+
+
+    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..e69de29bb2
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..e69de29bb2
diff --git a/challenge-018/adam-russell/perl5/ch-3.pl b/challenge-018/adam-russell/perl5/ch-3.pl
new file mode 100644
index 0000000000..e69de29bb2
-- 
cgit 


From 4d1a5e75514d48d0dd0583d2e94e702ec4355361 Mon Sep 17 00:00:00 2001
From: "E. Choroba" <choroba@matfyz.cz>
Date: Fri, 26 Jul 2019 00:20:01 +0200
Subject: Add solutions to 018 by E. Choroba

There are two different files for the first task, one of them searches
the longest common substring naively, the second one uses a suffix
tree.

The priority queue is also implemented in two different ways, but in
one file only: using an array or a heap.
---
 challenge-018/e-choroba/perl5/ch-1a.pl |  24 +++++
 challenge-018/e-choroba/perl5/ch-1b.pl | 181 +++++++++++++++++++++++++++++++++
 challenge-018/e-choroba/perl5/ch-2.pl  |  91 +++++++++++++++++
 3 files changed, 296 insertions(+)
 create mode 100755 challenge-018/e-choroba/perl5/ch-1a.pl
 create mode 100755 challenge-018/e-choroba/perl5/ch-1b.pl
 create mode 100755 challenge-018/e-choroba/perl5/ch-2.pl

(limited to 'challenge-018')

diff --git a/challenge-018/e-choroba/perl5/ch-1a.pl b/challenge-018/e-choroba/perl5/ch-1a.pl
new file mode 100755
index 0000000000..3bb93311c7
--- /dev/null
+++ b/challenge-018/e-choroba/perl5/ch-1a.pl
@@ -0,0 +1,24 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use feature qw{ say };
+
+my @longest = ("");
+my $string  = shift;
+for my $pos (1 .. length $string) {
+    for my $length (1 .. 1 - $pos + length $string) {
+        next if $length < length $longest[0];
+
+        my $substr = substr $string, $pos - 1, $length;
+        my $found = 0;
+        -1 != index $_, $substr and ++$found for @ARGV;
+        if ($found == @ARGV) {
+            if ($length == length $longest[0]) {
+                push @longest, $substr;
+            } else {
+                @longest = $substr;
+            }
+        }
+    }
+}
+say "<$_>" for @longest;
diff --git a/challenge-018/e-choroba/perl5/ch-1b.pl b/challenge-018/e-choroba/perl5/ch-1b.pl
new file mode 100755
index 0000000000..fcbdfc0972
--- /dev/null
+++ b/challenge-018/e-choroba/perl5/ch-1b.pl
@@ -0,0 +1,181 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use feature qw{ say };
+
+{   package My::Node;
+    sub new { bless { start => $_[1], end => $_[2] }, $_[0] }
+    sub edge_length {
+        my ($self, $position) = @_;
+        ($self->{end} < $position + 1
+            ? $self->{end}
+            : $position + 1
+        ) - $self->{start}
+    }
+}
+
+{   package My::Suffix::Tree;
+
+    sub new {
+        my ($class) = @_;
+        bless my $self = {position => -1,
+                          text => "",
+                          active_edge => 0,
+                          active_length => 0,
+                          current_node => -1,
+        }, $class;
+        $self->{root} = $self->new_node(-1, -1);
+        $self->{active_node} = $self->{root};
+        return $self
+    }
+
+    sub add_numbers {
+        my ($self, $node_index) = @_;
+        my $node = $self->{nodes}[$node_index];
+        for my $next_index (values %{ $node->{next} }) {
+            undef $node->{numbers}{$_} for $self->add_numbers($next_index);
+        }
+        return $node->{number} // () unless exists $node->{numbers};
+
+        return keys %{ $self->{numbers} }
+    }
+
+    sub add_words {
+        my ($self, @words) = @_;
+        $self->{number_of_words} = @ARGV;
+        for my $word_index (0 .. $#words) {
+            $self->add_char($_)
+                for split //, "$words[$word_index]<$word_index>";
+        }
+        my $text_length = length $self->{text};
+        for my $node (@{ $self->{nodes} }) {
+            next if $node->{start} < 0;
+            my $text = $node->{end} > $text_length
+                     ? substr $self->{text}, $node->{start}
+                     : substr $self->{text}, $node->{start},
+                           $node->{end} - $node->{start};
+            $node->{text} = $text;
+            if (my ($number) =  $text =~ /<([0-9]+)>/) {
+                $node->{number} = $number;
+            }
+        }
+        $self->add_numbers(0);
+    }
+
+    sub _add_suffix_link {
+        my ($self, $node) = @_;
+        $self->{nodes}[ $self->{need_suffix_link} ]{link} = $node
+            if $self->{need_suffix_link} > 0;
+        $self->{need_suffix_link} = $node;
+    }
+
+    sub active_edge { substr $_[0]{text}, $_[0]{active_edge}, 1 }
+
+    sub walk_down {
+        my ($self, $next) = @_;
+        $next //= 0;
+        my $position = $self->{position};
+        if ($self->{active_length}
+            >= $self->{nodes}[$next]->edge_length($position)
+        ) {
+            $self->{active_edge}
+                += $self->{nodes}[$next]->edge_length($position);
+            $self->{active_length}
+                -= $self->{nodes}[$next]->edge_length($position);
+            $self->{active_node} = $next;
+            return 1
+        }
+        return
+    }
+
+    sub new_node {
+        my ($self, $start, $end) = @_;
+        $self->{nodes}[ ++$self->{current_node} ]
+            = 'My::Node'->new($start, $end);
+        $self->{current_node}
+    }
+
+    sub add_char {
+        my ($self, $char) = @_;
+        substr $self->{text}, ++$self->{position}, 1, $char;
+        $self->{need_suffix_link} = -1;
+        ++$self->{remainder};
+        while ($self->{remainder} > 0) {
+            $self->{active_edge} = $self->{position}
+                unless $self->{active_length};
+            if (! exists
+                $self->{nodes}[ $self->{active_node} ]{next}{ $self->active_edge }
+            ) {
+                $self->{nodes}[ $self->{active_node} ]
+                    {next}{ $self->active_edge }
+                    = $self->new_node($self->{position}, 'INF');
+                $self->_add_suffix_link($self->{active_node});  # Rule 2.
+            } else {
+                my $next = $self->{nodes}[ $self->{active_node} ]
+                    {next}{ $self->active_edge };
+                next if $self->walk_down($next);  # Observation 2.
+
+                # Observation 2.
+                if ($char eq substr $self->{text},
+                        $self->{nodes}[$next]{start} + $self->{active_length}, 1
+                ) {
+                    ++$self->{active_length};
+                    $self->_add_suffix_link($self->{active_node});  # Observation 3.
+                    last
+                }
+                my $split = $self->new_node($self->{nodes}[$next]{start},
+                    $self->{nodes}[$next]{start} + $self->{active_length});
+                $self->{nodes}[ $self->{active_node} ]{next}
+                    { $self->active_edge } = $split;
+                my $leaf = $self->new_node($self->{position}, 'INF');
+                $self->{nodes}[$split]{next}{$char} = $leaf;
+                $self->{nodes}[$next]{start} += $self->{active_length};
+                $self->{nodes}[$split]{next}{ substr $self->{text},
+                    $self->{nodes}[$next]{start}, 1 } = $next;
+                $self->_add_suffix_link($split);  # Rule 2.
+            }
+            -- $self->{remainder};
+
+            if ($self->{active_node} == $self->{root}
+                && $self->{active_length} > 0  # Rule 1.
+            ) {
+                --$self->{active_length};
+                $self->{active_edge}
+                    = $self->{position} - $self->{remainder} + 1;
+            } else {
+                $self->{nodes}[ $self->{active_node} ]{link} //= 0;
+                $self->{active_node}
+                    = $self->{nodes}[ $self->{active_node} ]{link} > 0
+                    ? $self->{nodes}[ $self->{active_node} ]{link}
+                    : $self->{root};  # Rule 3.
+            }
+        }
+    }
+
+    my @lcs;
+    sub longest_common_substring {
+        my ($self, $node_index, $string) = @_;
+        @lcs = ("") unless $node_index;
+        my $node = $self->{nodes}[$node_index];
+
+        if ($self->{number_of_words} == keys %{ $node->{numbers} }) {
+            my $compare_lengths = length $string <=> length $lcs[0];
+            push @lcs, $string if $compare_lengths == 0;
+            @lcs = ($string) if $compare_lengths == 1;
+        }
+
+        for my $next_char (keys %{ $node->{next} }) {
+            my $next_index = $node->{next}{$next_char};
+            my $next = $self->{nodes}[$next_index];
+            $self->longest_common_substring(
+                $next_index,
+                "$string$next->{text}");
+        }
+        return @lcs
+    }
+}
+
+my $o = 'My::Suffix::Tree'->new;
+$o->add_words(@ARGV);
+
+say "<$_>" for $o->longest_common_substring(0, "");
diff --git a/challenge-018/e-choroba/perl5/ch-2.pl b/challenge-018/e-choroba/perl5/ch-2.pl
new file mode 100755
index 0000000000..79c11f00a0
--- /dev/null
+++ b/challenge-018/e-choroba/perl5/ch-2.pl
@@ -0,0 +1,91 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+{   package My::Queue::Priority::Array;
+
+    sub new { bless [], shift }
+
+    sub is_empty { ! grep @{ $_ // [] }, @{ $_[0] } }
+
+    sub insert_with_priority {
+        my ($self, $element, $priority) = @_;
+        push @{ $self->[$priority] }, $element;
+    }
+
+    sub pull_highest_priority_element {
+        my ($self) = @_;
+        my ($i) = grep @{ $self->[$_] || [] }, reverse 0 .. $#$self;
+        shift @{ $self->[$i] }
+    }
+}
+
+{   package My::Queue::Priority::Heap;
+    use enum qw( ELEMENT PRIORITY );
+
+    sub new { bless [], shift }
+
+    sub is_empty { ! @{ $_[0] } }
+
+    sub insert_with_priority {
+        my ($self, $element, $priority) = @_;
+        push @$self, [$element, $priority];
+        my $i = $#$self;
+        my $p = int(($i - 1) / 2);
+        while ($p >= 0 && $self->[$p][PRIORITY] < $self->[$i][PRIORITY]) {
+            @$self[$i, $p] = @$self[$p, $i];
+            $i = $p;
+            $p = int(($i - 1) / 2);
+        }
+    }
+
+    sub pull_highest_priority_element {
+        my ($self) = @_;
+        my $element = shift(@$self)->[ELEMENT];
+        my $new = ref($self)->new;
+        $new->insert_with_priority(@$_) for reverse @$self;
+        $_[0] = $new;
+        return $element
+    }
+}
+
+use Test::More tests => 2 * 14;
+
+for my $class (qw(My::Queue::Priority::Array My::Queue::Priority::Heap)) {
+    my $q = $class->new();
+    ok $q->is_empty;
+
+    $q->insert_with_priority(@$_)
+        for [a => 10], [b => 4], [c => 2], [d=>8], [e => 4], [f => 3];
+    ok ! $q->is_empty;
+
+    is $q->pull_highest_priority_element, 'a';
+    ok ! $q->is_empty;
+    is $q->pull_highest_priority_element, 'd';
+    ok ! $q->is_empty;
+    is $q->pull_highest_priority_element, 'b';
+    ok ! $q->is_empty;
+    is $q->pull_highest_priority_element, 'e';
+    ok ! $q->is_empty;
+    is $q->pull_highest_priority_element, 'f';
+    ok ! $q->is_empty;
+    is $q->pull_highest_priority_element, 'c';
+    ok $q->is_empty;
+}
+
+use Benchmark qw{ cmpthese };
+cmpthese(-3, {
+    heap => sub {
+        my $q = My::Queue::Priority::Heap->new;
+        $q->insert_with_priority(@$_)
+            for [a => 10], [b => 4], [c => 2], [d=>8], [e => 4], [f => 3];
+        $q->pull_highest_priority_element for 1 .. 6;
+    },
+    array => sub {
+        my $q = My::Queue::Priority::Array->new;
+        $q->insert_with_priority(@$_)
+            for [a => 10], [b => 4], [c => 2], [d=>8], [e => 4], [f => 3];
+        $q->pull_highest_priority_element for 1 .. 6;
+    }
+
+});
-- 
cgit 


From 8b31784d9239d87e9f76e1f3dffba03c885b0b4e Mon Sep 17 00:00:00 2001
From: Mohammad S Anwar <mohammad.anwar@yahoo.com>
Date: Thu, 25 Jul 2019 23:48:14 +0100
Subject: - Added solutions by E. Choroba.

---
 challenge-018/e-choroba/perl5/ch-1.pl  |  24 +++++
 challenge-018/e-choroba/perl5/ch-1a.pl | 185 ++++++++++++++++++++++++++++++---
 challenge-018/e-choroba/perl5/ch-1b.pl | 181 --------------------------------
 3 files changed, 195 insertions(+), 195 deletions(-)
 create mode 100755 challenge-018/e-choroba/perl5/ch-1.pl
 delete mode 100755 challenge-018/e-choroba/perl5/ch-1b.pl

(limited to 'challenge-018')

diff --git a/challenge-018/e-choroba/perl5/ch-1.pl b/challenge-018/e-choroba/perl5/ch-1.pl
new file mode 100755
index 0000000000..3bb93311c7
--- /dev/null
+++ b/challenge-018/e-choroba/perl5/ch-1.pl
@@ -0,0 +1,24 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use feature qw{ say };
+
+my @longest = ("");
+my $string  = shift;
+for my $pos (1 .. length $string) {
+    for my $length (1 .. 1 - $pos + length $string) {
+        next if $length < length $longest[0];
+
+        my $substr = substr $string, $pos - 1, $length;
+        my $found = 0;
+        -1 != index $_, $substr and ++$found for @ARGV;
+        if ($found == @ARGV) {
+            if ($length == length $longest[0]) {
+                push @longest, $substr;
+            } else {
+                @longest = $substr;
+            }
+        }
+    }
+}
+say "<$_>" for @longest;
diff --git a/challenge-018/e-choroba/perl5/ch-1a.pl b/challenge-018/e-choroba/perl5/ch-1a.pl
index 3bb93311c7..fcbdfc0972 100755
--- a/challenge-018/e-choroba/perl5/ch-1a.pl
+++ b/challenge-018/e-choroba/perl5/ch-1a.pl
@@ -3,22 +3,179 @@ use warnings;
 use strict;
 use feature qw{ say };
 
-my @longest = ("");
-my $string  = shift;
-for my $pos (1 .. length $string) {
-    for my $length (1 .. 1 - $pos + length $string) {
-        next if $length < length $longest[0];
-
-        my $substr = substr $string, $pos - 1, $length;
-        my $found = 0;
-        -1 != index $_, $substr and ++$found for @ARGV;
-        if ($found == @ARGV) {
-            if ($length == length $longest[0]) {
-                push @longest, $substr;
+{   package My::Node;
+    sub new { bless { start => $_[1], end => $_[2] }, $_[0] }
+    sub edge_length {
+        my ($self, $position) = @_;
+        ($self->{end} < $position + 1
+            ? $self->{end}
+            : $position + 1
+        ) - $self->{start}
+    }
+}
+
+{   package My::Suffix::Tree;
+
+    sub new {
+        my ($class) = @_;
+        bless my $self = {position => -1,
+                          text => "",
+                          active_edge => 0,
+                          active_length => 0,
+                          current_node => -1,
+        }, $class;
+        $self->{root} = $self->new_node(-1, -1);
+        $self->{active_node} = $self->{root};
+        return $self
+    }
+
+    sub add_numbers {
+        my ($self, $node_index) = @_;
+        my $node = $self->{nodes}[$node_index];
+        for my $next_index (values %{ $node->{next} }) {
+            undef $node->{numbers}{$_} for $self->add_numbers($next_index);
+        }
+        return $node->{number} // () unless exists $node->{numbers};
+
+        return keys %{ $self->{numbers} }
+    }
+
+    sub add_words {
+        my ($self, @words) = @_;
+        $self->{number_of_words} = @ARGV;
+        for my $word_index (0 .. $#words) {
+            $self->add_char($_)
+                for split //, "$words[$word_index]<$word_index>";
+        }
+        my $text_length = length $self->{text};
+        for my $node (@{ $self->{nodes} }) {
+            next if $node->{start} < 0;
+            my $text = $node->{end} > $text_length
+                     ? substr $self->{text}, $node->{start}
+                     : substr $self->{text}, $node->{start},
+                           $node->{end} - $node->{start};
+            $node->{text} = $text;
+            if (my ($number) =  $text =~ /<([0-9]+)>/) {
+                $node->{number} = $number;
+            }
+        }
+        $self->add_numbers(0);
+    }
+
+    sub _add_suffix_link {
+        my ($self, $node) = @_;
+        $self->{nodes}[ $self->{need_suffix_link} ]{link} = $node
+            if $self->{need_suffix_link} > 0;
+        $self->{need_suffix_link} = $node;
+    }
+
+    sub active_edge { substr $_[0]{text}, $_[0]{active_edge}, 1 }
+
+    sub walk_down {
+        my ($self, $next) = @_;
+        $next //= 0;
+        my $position = $self->{position};
+        if ($self->{active_length}
+            >= $self->{nodes}[$next]->edge_length($position)
+        ) {
+            $self->{active_edge}
+                += $self->{nodes}[$next]->edge_length($position);
+            $self->{active_length}
+                -= $self->{nodes}[$next]->edge_length($position);
+            $self->{active_node} = $next;
+            return 1
+        }
+        return
+    }
+
+    sub new_node {
+        my ($self, $start, $end) = @_;
+        $self->{nodes}[ ++$self->{current_node} ]
+            = 'My::Node'->new($start, $end);
+        $self->{current_node}
+    }
+
+    sub add_char {
+        my ($self, $char) = @_;
+        substr $self->{text}, ++$self->{position}, 1, $char;
+        $self->{need_suffix_link} = -1;
+        ++$self->{remainder};
+        while ($self->{remainder} > 0) {
+            $self->{active_edge} = $self->{position}
+                unless $self->{active_length};
+            if (! exists
+                $self->{nodes}[ $self->{active_node} ]{next}{ $self->active_edge }
+            ) {
+                $self->{nodes}[ $self->{active_node} ]
+                    {next}{ $self->active_edge }
+                    = $self->new_node($self->{position}, 'INF');
+                $self->_add_suffix_link($self->{active_node});  # Rule 2.
+            } else {
+                my $next = $self->{nodes}[ $self->{active_node} ]
+                    {next}{ $self->active_edge };
+                next if $self->walk_down($next);  # Observation 2.
+
+                # Observation 2.
+                if ($char eq substr $self->{text},
+                        $self->{nodes}[$next]{start} + $self->{active_length}, 1
+                ) {
+                    ++$self->{active_length};
+                    $self->_add_suffix_link($self->{active_node});  # Observation 3.
+                    last
+                }
+                my $split = $self->new_node($self->{nodes}[$next]{start},
+                    $self->{nodes}[$next]{start} + $self->{active_length});
+                $self->{nodes}[ $self->{active_node} ]{next}
+                    { $self->active_edge } = $split;
+                my $leaf = $self->new_node($self->{position}, 'INF');
+                $self->{nodes}[$split]{next}{$char} = $leaf;
+                $self->{nodes}[$next]{start} += $self->{active_length};
+                $self->{nodes}[$split]{next}{ substr $self->{text},
+                    $self->{nodes}[$next]{start}, 1 } = $next;
+                $self->_add_suffix_link($split);  # Rule 2.
+            }
+            -- $self->{remainder};
+
+            if ($self->{active_node} == $self->{root}
+                && $self->{active_length} > 0  # Rule 1.
+            ) {
+                --$self->{active_length};
+                $self->{active_edge}
+                    = $self->{position} - $self->{remainder} + 1;
             } else {
-                @longest = $substr;
+                $self->{nodes}[ $self->{active_node} ]{link} //= 0;
+                $self->{active_node}
+                    = $self->{nodes}[ $self->{active_node} ]{link} > 0
+                    ? $self->{nodes}[ $self->{active_node} ]{link}
+                    : $self->{root};  # Rule 3.
             }
         }
     }
+
+    my @lcs;
+    sub longest_common_substring {
+        my ($self, $node_index, $string) = @_;
+        @lcs = ("") unless $node_index;
+        my $node = $self->{nodes}[$node_index];
+
+        if ($self->{number_of_words} == keys %{ $node->{numbers} }) {
+            my $compare_lengths = length $string <=> length $lcs[0];
+            push @lcs, $string if $compare_lengths == 0;
+            @lcs = ($string) if $compare_lengths == 1;
+        }
+
+        for my $next_char (keys %{ $node->{next} }) {
+            my $next_index = $node->{next}{$next_char};
+            my $next = $self->{nodes}[$next_index];
+            $self->longest_common_substring(
+                $next_index,
+                "$string$next->{text}");
+        }
+        return @lcs
+    }
 }
-say "<$_>" for @longest;
+
+my $o = 'My::Suffix::Tree'->new;
+$o->add_words(@ARGV);
+
+say "<$_>" for $o->longest_common_substring(0, "");
diff --git a/challenge-018/e-choroba/perl5/ch-1b.pl b/challenge-018/e-choroba/perl5/ch-1b.pl
deleted file mode 100755
index fcbdfc0972..0000000000
--- a/challenge-018/e-choroba/perl5/ch-1b.pl
+++ /dev/null
@@ -1,181 +0,0 @@
-#!/usr/bin/perl
-use warnings;
-use strict;
-use feature qw{ say };
-
-{   package My::Node;
-    sub new { bless { start => $_[1], end => $_[2] }, $_[0] }
-    sub edge_length {
-        my ($self, $position) = @_;
-        ($self->{end} < $position + 1
-            ? $self->{end}
-            : $position + 1
-        ) - $self->{start}
-    }
-}
-
-{   package My::Suffix::Tree;
-
-    sub new {
-        my ($class) = @_;
-        bless my $self = {position => -1,
-                          text => "",
-                          active_edge => 0,
-                          active_length => 0,
-                          current_node => -1,
-        }, $class;
-        $self->{root} = $self->new_node(-1, -1);
-        $self->{active_node} = $self->{root};
-        return $self
-    }
-
-    sub add_numbers {
-        my ($self, $node_index) = @_;
-        my $node = $self->{nodes}[$node_index];
-        for my $next_index (values %{ $node->{next} }) {
-            undef $node->{numbers}{$_} for $self->add_numbers($next_index);
-        }
-        return $node->{number} // () unless exists $node->{numbers};
-
-        return keys %{ $self->{numbers} }
-    }
-
-    sub add_words {
-        my ($self, @words) = @_;
-        $self->{number_of_words} = @ARGV;
-        for my $word_index (0 .. $#words) {
-            $self->add_char($_)
-                for split //, "$words[$word_index]<$word_index>";
-        }
-        my $text_length = length $self->{text};
-        for my $node (@{ $self->{nodes} }) {
-            next if $node->{start} < 0;
-            my $text = $node->{end} > $text_length
-                     ? substr $self->{text}, $node->{start}
-                     : substr $self->{text}, $node->{start},
-                           $node->{end} - $node->{start};
-            $node->{text} = $text;
-            if (my ($number) =  $text =~ /<([0-9]+)>/) {
-                $node->{number} = $number;
-            }
-        }
-        $self->add_numbers(0);
-    }
-
-    sub _add_suffix_link {
-        my ($self, $node) = @_;
-        $self->{nodes}[ $self->{need_suffix_link} ]{link} = $node
-            if $self->{need_suffix_link} > 0;
-        $self->{need_suffix_link} = $node;
-    }
-
-    sub active_edge { substr $_[0]{text}, $_[0]{active_edge}, 1 }
-
-    sub walk_down {
-        my ($self, $next) = @_;
-        $next //= 0;
-        my $position = $self->{position};
-        if ($self->{active_length}
-            >= $self->{nodes}[$next]->edge_length($position)
-        ) {
-            $self->{active_edge}
-                += $self->{nodes}[$next]->edge_length($position);
-            $self->{active_length}
-                -= $self->{nodes}[$next]->edge_length($position);
-            $self->{active_node} = $next;
-            return 1
-        }
-        return
-    }
-
-    sub new_node {
-        my ($self, $start, $end) = @_;
-        $self->{nodes}[ ++$self->{current_node} ]
-            = 'My::Node'->new($start, $end);
-        $self->{current_node}
-    }
-
-    sub add_char {
-        my ($self, $char) = @_;
-        substr $self->{text}, ++$self->{position}, 1, $char;
-        $self->{need_suffix_link} = -1;
-        ++$self->{remainder};
-        while ($self->{remainder} > 0) {
-            $self->{active_edge} = $self->{position}
-                unless $self->{active_length};
-            if (! exists
-                $self->{nodes}[ $self->{active_node} ]{next}{ $self->active_edge }
-            ) {
-                $self->{nodes}[ $self->{active_node} ]
-                    {next}{ $self->active_edge }
-                    = $self->new_node($self->{position}, 'INF');
-                $self->_add_suffix_link($self->{active_node});  # Rule 2.
-            } else {
-                my $next = $self->{nodes}[ $self->{active_node} ]
-                    {next}{ $self->active_edge };
-                next if $self->walk_down($next);  # Observation 2.
-
-                # Observation 2.
-                if ($char eq substr $self->{text},
-                        $self->{nodes}[$next]{start} + $self->{active_length}, 1
-                ) {
-                    ++$self->{active_length};
-                    $self->_add_suffix_link($self->{active_node});  # Observation 3.
-                    last
-                }
-                my $split = $self->new_node($self->{nodes}[$next]{start},
-                    $self->{nodes}[$next]{start} + $self->{active_length});
-                $self->{nodes}[ $self->{active_node} ]{next}
-                    { $self->active_edge } = $split;
-                my $leaf = $self->new_node($self->{position}, 'INF');
-                $self->{nodes}[$split]{next}{$char} = $leaf;
-                $self->{nodes}[$next]{start} += $self->{active_length};
-                $self->{nodes}[$split]{next}{ substr $self->{text},
-                    $self->{nodes}[$next]{start}, 1 } = $next;
-                $self->_add_suffix_link($split);  # Rule 2.
-            }
-            -- $self->{remainder};
-
-            if ($self->{active_node} == $self->{root}
-                && $self->{active_length} > 0  # Rule 1.
-            ) {
-                --$self->{active_length};
-                $self->{active_edge}
-                    = $self->{position} - $self->{remainder} + 1;
-            } else {
-                $self->{nodes}[ $self->{active_node} ]{link} //= 0;
-                $self->{active_node}
-                    = $self->{nodes}[ $self->{active_node} ]{link} > 0
-                    ? $self->{nodes}[ $self->{active_node} ]{link}
-                    : $self->{root};  # Rule 3.
-            }
-        }
-    }
-
-    my @lcs;
-    sub longest_common_substring {
-        my ($self, $node_index, $string) = @_;
-        @lcs = ("") unless $node_index;
-        my $node = $self->{nodes}[$node_index];
-
-        if ($self->{number_of_words} == keys %{ $node->{numbers} }) {
-            my $compare_lengths = length $string <=> length $lcs[0];
-            push @lcs, $string if $compare_lengths == 0;
-            @lcs = ($string) if $compare_lengths == 1;
-        }
-
-        for my $next_char (keys %{ $node->{next} }) {
-            my $next_index = $node->{next}{$next_char};
-            my $next = $self->{nodes}[$next_index];
-            $self->longest_common_substring(
-                $next_index,
-                "$string$next->{text}");
-        }
-        return @lcs
-    }
-}
-
-my $o = 'My::Suffix::Tree'->new;
-$o->add_words(@ARGV);
-
-say "<$_>" for $o->longest_common_substring(0, "");
-- 
cgit 


From a4c5b39677d5d58c1800accb8c55284c9b3318be Mon Sep 17 00:00:00 2001
From: Lubos Kolouch <lubos@kolouch.net>
Date: Fri, 26 Jul 2019 12:48:01 +0200
Subject: Challenge 018 LK

---
 challenge-018/lubos-kolouch/perl5/ch-1.pl | 117 ++++++++++++++++++++++++++++++
 challenge-018/lubos-kolouch/perl5/ch-2.pl | 115 +++++++++++++++++++++++++++++
 2 files changed, 232 insertions(+)
 create mode 100644 challenge-018/lubos-kolouch/perl5/ch-1.pl
 create mode 100644 challenge-018/lubos-kolouch/perl5/ch-2.pl

(limited to 'challenge-018')

diff --git a/challenge-018/lubos-kolouch/perl5/ch-1.pl b/challenge-018/lubos-kolouch/perl5/ch-1.pl
new file mode 100644
index 0000000000..fef4d9155e
--- /dev/null
+++ b/challenge-018/lubos-kolouch/perl5/ch-1.pl
@@ -0,0 +1,117 @@
+#!/usr/bin/perl 
+#===============================================================================
+#
+#         FILE: ch-1.pl
+#
+#        USAGE: ./ch-1.pl
+#
+#  DESCRIPTION: 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.
+#
+#
+#      OPTIONS: ---
+# REQUIREMENTS: ---
+#         BUGS: ---
+#        NOTES: ---
+#       AUTHOR: Lubos Kolouch,
+# ORGANIZATION:
+#      VERSION: 1.0
+#      CREATED: 07/24/2019 08:48:27 PM
+#     REVISION: ---
+#===============================================================================
+
+use strict;
+use warnings;
+use feature qw{ say };
+use Data::Dumper;
+
+my %all_strings;
+my $max_count = 0;
+
+# ignore substrings 
+my $seen_first;
+
+sub insert_to_all_strings {
+    my $str = shift;
+
+    my %seen_str;
+
+    my $length = length($str);
+
+    for my $pos ( 0 .. $length - 1 ) {
+        for my $length_remain ( 1 .. $length - $pos ) {
+            my $sub_string = substr( $str, $pos, $length_remain );
+
+            # skip if this substring is not present in the first word
+            next if $seen_first and not defined $all_strings{length($sub_string)}{$sub_string};
+
+            # skip if the string was already present in the current letter
+            next if $seen_str{$sub_string};
+
+            # remember we have already seen the letter
+            $seen_str{$sub_string} = 1;
+
+            my $current_count = $all_strings{$sub_string} // 0;
+            $current_count++;
+
+            # We have seen the substring one more time
+            $max_count = $current_count if $current_count > $max_count;
+
+            # Let us remember it
+            $all_strings{ length($sub_string) }{$sub_string}++;
+        }
+
+    }
+
+    $seen_first = 1;
+
+    return 1;
+}
+
+sub longest_str {
+    my @strings = @_;
+
+    my $found_solution;
+
+    # fill in all the common strings and their count
+    insert_to_all_strings($_) for (@strings);
+
+    # print the longest one
+
+    foreach my $str_length ( sort { $b <=> $a } keys %all_strings ) {
+
+        foreach my $string ( keys %{ $all_strings{$str_length} } ) {
+            if ( $all_strings{$str_length}{$string} == scalar @strings ) {
+
+                # we found a substring that is in all strings
+                say "Common string $string";
+                $found_solution = $string;
+            }
+        }
+
+        last if $found_solution;
+    }
+
+    say 'No common string found' unless $found_solution;
+    return $found_solution;
+
+}
+
+###### MAIN ######
+
+my @strings = @ARGV or die 'Usage: script string1 string2 stringN';
+die 'Usage: script string1 string2 stringN' unless @strings >= 2;
+
+longest_str(@strings);
+
+###### TESTS ######
+
+use Test::More;
+
+say 'TESTS:';
+%all_strings = ();
+$seen_first = 0;
+is( longest_str( 'ABABC', 'BABCA', 'ABCBA' ), 'ABC', 'Test 1' );
+
+done_testing;
diff --git a/challenge-018/lubos-kolouch/perl5/ch-2.pl b/challenge-018/lubos-kolouch/perl5/ch-2.pl
new file mode 100644
index 0000000000..5a3dd95865
--- /dev/null
+++ b/challenge-018/lubos-kolouch/perl5/ch-2.pl
@@ -0,0 +1,115 @@
+#!/usr/bin/perl 
+#===============================================================================
+#
+#         FILE: ch-2.pl
+#
+#        USAGE: ./ch-2.pl
+#
+#  DESCRIPTION: Task #2
+#
+#
+#    Write a script to implement Priority Queue. It is like regular queue except each element has a priority associated with it. In a priority queue, an element with high priority is served before an element with low priority. Please check this wiki page for more informations. It should serve the following operations:
+#
+#        1) is_empty: check whether the queue has no elements.
+#
+#        2) insert_with_priority: add an element to the queue with an associated priority.
+#
+#        3) pull_highest_priority_element: remove the element from the queue that has the highest priority, and return it. If two elements have the same priority, then return element added first.
+#
+#
+#      OPTIONS: ---
+# REQUIREMENTS: ---
+#         BUGS: ---
+#        NOTES: ---
+#       AUTHOR: Lubos Kolouch,
+# ORGANIZATION:
+#      VERSION: 1.0
+#      CREATED: 07/24/2019 08:48:27 PM
+#     REVISION: ---
+#===============================================================================
+
+use strict;
+use warnings;
+use feature qw{ say };
+
+sub is_empty {
+    my $hash_ref = shift;
+
+    return %{$hash_ref} ? 0 : 1;
+
+}
+
+sub insert_with_priority {
+    my ( $hash_ref, $priority, $element ) = @_;
+
+    my %queue = %{$hash_ref};
+
+    push @{ $queue{$priority} }, $element;
+
+    return %queue;
+}
+
+sub pull_highest_priority_element {
+    my $hash_ref = shift;
+
+    foreach my $priority ( sort { $b <=> $a } keys %$hash_ref ) {
+
+        my $element = shift @{ %${hash_ref}{$priority} };
+
+        # destroy the queue if not neede
+
+        delete $$hash_ref{$priority} unless scalar @{ %${hash_ref}{$priority} };
+
+        return $element;
+    }
+
+    return 1;
+}
+
+###### MAIN ######
+
+###### TESTS ######
+
+use Test::More;
+
+say 'TESTS:';
+my %empty;
+my %not_empty = ( '1' => 'a' );
+
+is( is_empty( \%empty ),     1, 'Testing empty queue' );
+is( is_empty( \%not_empty ), 0, 'Testing not empty queue' );
+
+my %queue = insert_with_priority( \%empty, '1', 'aaa' );
+
+is( $queue{1}[0], 'aaa', 'Testing added string equal to aaa' );
+isnt( $queue{1}[0], 'aab', 'Testing added string not equal to bbb' );
+
+is( pull_highest_priority_element( \%queue ), 'aaa', 'is highest priority aaa' );
+is( is_empty( \%queue ),                      1,     'is the queue empty now' );
+
+%queue = insert_with_priority( \%queue, '2', 'aaa' );
+is( $queue{2}[0], 'aaa', 'Insert priority 2 element aaa' );
+
+%queue = insert_with_priority( \%queue, '3', 'bbb' );
+is( $queue{2}[0], 'aaa', 'Is still priority 2 element aaa' );
+is( $queue{3}[0], 'bbb', 'Insert priority 3 element bbb' );
+
+%queue = insert_with_priority( \%queue, '1', 'xxx' );
+is( $queue{2}[0], 'aaa', 'Is still priority 2 element aaa' );
+is( $queue{3}[0], 'bbb', 'Is still priority 3 element bbb' );
+is( $queue{1}[0], 'xxx', 'Is still priority 1 element xxx' );
+isnt( $queue{1}[0], 'aaa', 'Is priority 1 element not  aaa' );
+
+%queue = insert_with_priority( \%queue, '3', 'ccc' );
+is( $queue{2}[0], 'aaa', 'Is still priority 2 element aaa' );
+is( $queue{3}[0], 'bbb', 'Is still priority 3 element bbb' );
+is( $queue{1}[0], 'xxx', 'Is still priority 1 element xxx' );
+is( $queue{3}[1], 'ccc', 'Is now second priority 3 element ccc' );
+
+is( pull_highest_priority_element( \%queue ), 'bbb', 'bbb correctly pulled' );
+is( pull_highest_priority_element( \%queue ), 'ccc', 'ccc correctly pulled' );
+is( pull_highest_priority_element( \%queue ), 'aaa', 'aaa correctly pulled' );
+is( pull_highest_priority_element( \%queue ), 'xxx', 'xxx correctly pulled' );
+
+is( is_empty( \%queue ), 1, 'is the queue empty now' );
+done_testing;
-- 
cgit 


From d1adf5e81990dc94b7322e8d464e2352833f0267 Mon Sep 17 00:00:00 2001
From: Mohammad S Anwar <mohammad.anwar@yahoo.com>
Date: Fri, 26 Jul 2019 12:44:41 +0100
Subject: - Added solutions by Laurent Rosenfeld.

---
 challenge-018/laurent-rosenfeld/blog1.txt     |  1 +
 challenge-018/laurent-rosenfeld/perl6/ch-2.p6 | 76 +++++++++++++++++++++++++++
 2 files changed, 77 insertions(+)
 create mode 100644 challenge-018/laurent-rosenfeld/blog1.txt
 create mode 100644 challenge-018/laurent-rosenfeld/perl6/ch-2.p6

(limited to 'challenge-018')

diff --git a/challenge-018/laurent-rosenfeld/blog1.txt b/challenge-018/laurent-rosenfeld/blog1.txt
new file mode 100644
index 0000000000..073057274a
--- /dev/null
+++ b/challenge-018/laurent-rosenfeld/blog1.txt
@@ -0,0 +1 @@
+http://blogs.perl.org/users/laurent_r/2019/07/perl-weekly-challenge-18-priority-queues-and-binary-heaps-in-perl-6.html
diff --git a/challenge-018/laurent-rosenfeld/perl6/ch-2.p6 b/challenge-018/laurent-rosenfeld/perl6/ch-2.p6
new file mode 100644
index 0000000000..044584572f
--- /dev/null
+++ b/challenge-018/laurent-rosenfeld/perl6/ch-2.p6
@@ -0,0 +1,76 @@
+use v6;
+sub new-queue {
+    my @queue;  # an AoA
+    sub is_empty {
+        @queue.elems == 0;
+    }
+    sub insert_with_prio ($item, Int $prio) {
+        my $index = first {@queue[$_][0] == $prio}, @queue.keys;
+        if (defined $index) {
+            push @queue[$index][1], $item;
+        } else {
+            push @queue, [$prio, [$item]];
+            my $idx = @queue.end;
+            add-to-queue($idx);
+        }
+    }
+    sub pull_highest_prio {
+        return Nil if is-empty;
+        my $result = shift @queue[0][1];
+        take-from-heap if @queue[0][1].elems == 0;
+        return $result;
+    }
+    sub add-to-queue ($index is rw) {
+        my $index-val = @queue[$index];
+        while ($index) {
+            my $parent-idx = Int( ($index - 1) /2);
+            my $parent-val = @queue[$parent-idx];
+            last if $parent-val[0] > $index-val[0];
+            @queue[$index] = $parent-val;
+            $index = $parent-idx;
+        }
+        @queue[$index] = $index-val;
+    }
+    sub take-from-heap {
+        my $index = 0;
+        loop {
+            my $left-index = 2 * $index + 1;
+                # right-index is $left-index + 1
+            unless (defined @queue[$left-index] or
+                defined @queue[$left-index + 1]) {
+                    @queue.splice($index, 1);
+                    last;
+            }
+            unless defined @queue[$left-index + 1] {
+                @queue[$index] = @queue[$left-index]:delete;
+                last;
+            }
+            unless defined @queue[$left-index] {
+                @queue[$index] = @queue[$left-index + 1]:delete;
+                last;
+            }
+            # both children are defined if we get here
+            my $next-index = ($left-index,
+                $left-index + 1).max({@queue[$_][0]});
+            @queue[$index] = @queue[$next-index];
+            $index = $next-index;
+        }
+    }
+
+    return &is_empty, &insert_with_prio, &pull_highest_prio;
+}
+my (&is-empty, &insert, &pull-prio) = new-queue;
+# Testing the above code: 20 insertions and then trying 30 deletions
+for 1..20 -> $num {
+    insert($num,
+        $num %% 10 ?? 10 !!
+        $num %% 5  ?? 5  !!
+        $num %% 3  ?? 3  !!
+        $num %% 2  ?? 2  !!
+        1);
+}
+for 1..30 -> $num {
+    last if is-empty;
+    say pull-prio;
+}
+say "Empty queue" if is-empty();
-- 
cgit 


From 88ae6df6667f3fd82c543ab157cd02d948dd4d51 Mon Sep 17 00:00:00 2001
From: "E. Choroba" <choroba@matfyz.cz>
Date: Fri, 26 Jul 2019 17:15:46 +0200
Subject: Fix solutions to 018 by E. Choroba, add a blog post (part 1)

- small errors in the code translated from Java
- use a counter instead of a float priority
---
 challenge-018/e-choroba/blogs.txt      |  1 +
 challenge-018/e-choroba/perl5/ch-1a.pl | 16 +++++----
 challenge-018/e-choroba/perl5/ch-2.pl  | 63 ++++++++++++++++++++++------------
 3 files changed, 51 insertions(+), 29 deletions(-)
 create mode 100644 challenge-018/e-choroba/blogs.txt

(limited to 'challenge-018')

diff --git a/challenge-018/e-choroba/blogs.txt b/challenge-018/e-choroba/blogs.txt
new file mode 100644
index 0000000000..b5581348b2
--- /dev/null
+++ b/challenge-018/e-choroba/blogs.txt
@@ -0,0 +1 @@
+http://blogs.perl.org/users/e_choroba/2019/07/perl-weekly-challenge-0181-longest-common-substring.html
diff --git a/challenge-018/e-choroba/perl5/ch-1a.pl b/challenge-018/e-choroba/perl5/ch-1a.pl
index fcbdfc0972..d4fe7bba84 100755
--- a/challenge-018/e-choroba/perl5/ch-1a.pl
+++ b/challenge-018/e-choroba/perl5/ch-1a.pl
@@ -18,11 +18,11 @@ use feature qw{ say };
 
     sub new {
         my ($class) = @_;
-        bless my $self = {position => -1,
-                          text => "",
-                          active_edge => 0,
+        bless my $self = {position      => -1,
+                          text          => "",
+                          active_edge   => 0,
                           active_length => 0,
-                          current_node => -1,
+                          current_node  => -1,
         }, $class;
         $self->{root} = $self->new_node(-1, -1);
         $self->{active_node} = $self->{root};
@@ -104,7 +104,8 @@ use feature qw{ say };
             $self->{active_edge} = $self->{position}
                 unless $self->{active_length};
             if (! exists
-                $self->{nodes}[ $self->{active_node} ]{next}{ $self->active_edge }
+                $self->{nodes}[ $self->{active_node} ]
+                    {next}{ $self->active_edge }
             ) {
                 $self->{nodes}[ $self->{active_node} ]
                     {next}{ $self->active_edge }
@@ -115,12 +116,13 @@ use feature qw{ say };
                     {next}{ $self->active_edge };
                 next if $self->walk_down($next);  # Observation 2.
 
-                # Observation 2.
+                # Observation 1.
                 if ($char eq substr $self->{text},
                         $self->{nodes}[$next]{start} + $self->{active_length}, 1
                 ) {
                     ++$self->{active_length};
-                    $self->_add_suffix_link($self->{active_node});  # Observation 3.
+                    # Observation 3.
+                    $self->_add_suffix_link($self->{active_node});
                     last
                 }
                 my $split = $self->new_node($self->{nodes}[$next]{start},
diff --git a/challenge-018/e-choroba/perl5/ch-2.pl b/challenge-018/e-choroba/perl5/ch-2.pl
index 79c11f00a0..dfa59b0bd6 100755
--- a/challenge-018/e-choroba/perl5/ch-2.pl
+++ b/challenge-018/e-choroba/perl5/ch-2.pl
@@ -1,6 +1,7 @@
 #!/usr/bin/perl
 use warnings;
 use strict;
+use feature qw{ say };
 
 {   package My::Queue::Priority::Array;
 
@@ -21,18 +22,23 @@ use strict;
 }
 
 {   package My::Queue::Priority::Heap;
-    use enum qw( ELEMENT PRIORITY );
+    use enum qw( ELEMENT PRIORITY COUNTER );
 
     sub new { bless [], shift }
 
     sub is_empty { ! @{ $_[0] } }
 
+    my $i = 1;
     sub insert_with_priority {
-        my ($self, $element, $priority) = @_;
-        push @$self, [$element, $priority];
+        my ($self, $element, $priority, $counter) = @_;
+        push @$self, [$element, $priority, ($counter // ++$i)];
         my $i = $#$self;
         my $p = int(($i - 1) / 2);
-        while ($p >= 0 && $self->[$p][PRIORITY] < $self->[$i][PRIORITY]) {
+        while ($p >= 0
+               && ($self->[$p][PRIORITY] < $self->[$i][PRIORITY]
+                   || ($self->[$p][PRIORITY] == $self->[$i][PRIORITY]
+                       && $self->[$p][COUNTER] > $self->[$i][COUNTER]))
+        ) {