Merge pull request #417 from andrezgz/challenge-018

challenge-018 andrezgz solution

2 files changed, 121 insertions, 0 deletions

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;
+}