Merge pull request #427 from dmanto/branch-for-challenge-018

my proposed solutions for challenge-018, p5 1 & 2

2 files changed, 170 insertions, 0 deletions

diff --git a/challenge-018/daniel-mantovani/perl5/ch-1.pl b/challenge-018/daniel-mantovani/perl5/ch-1.pl
new file mode 100644
index 0000000000..9f363730fb
--- /dev/null
+++ b/challenge-018/daniel-mantovani/perl5/ch-1.pl
@@ -0,0 +1,73 @@
+# 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 v5.10;
+use utf8;
+use open qw(:std :utf8);
+use FindBin;
+use Encode 'decode_utf8';    # ¡Porque hay otros idiomas! :)
+
+# we start by writing a function that gives all possible substrings of size
+# $n from a given string
+
+sub substrings {
+    my ( $s, $n ) = @_;
+    my @r;    # array of all subrstrings
+    for my $i ( 0 .. length($s) - $n ) {
+
+        # will end up pushing all possible $n char substrings
+        push @r, substr $s, $i, $n;
+    }
+    return @r;
+}
+
+# we will use first input string as a reference, because it should
+# always exist
+
+my ( $ref, @others ) = @ARGV;
+
+die "Usage: perl $0 <string1> <string2> ... <stringn>" unless defined $ref;
+
+# now we will start with length($ref) chars, and go back to 1 char, checking
+# if any substring from $ref exists in other strings
+
+for my $i ( reverse 1 .. length($ref) ) {
+
+   # we now construct a hash with all substrings of $n chars of $ref, like this:
+    my %ref_substrings = map { $_ => 0 } substrings( $ref, $i );
+
+    # 0 means it didn't match any other substring yet
+    for my $oth (@others) {
+        for my $oth_sstr ( substrings( $oth, $i ) ) {
+            next unless exists $ref_substrings{$oth_sstr};
+            $ref_substrings{$oth_sstr} = 1;
+        }
+
+        # everytime after matching other strings, delete all non-matched
+        # and prepare %ref_substrings for next string
+        for my $k ( keys %ref_substrings ) {
+            if ( $ref_substrings{$k} ) {
+
+                # keep this one, but mark as not matched for next string check
+                $ref_substrings{$k} = 0;
+            }
+            else {
+                # delete this one, not matched
+                delete $ref_substrings{$k};
+            }
+        }
+    }
+
+    # after looking on all @others, any remaining match is the correct answer!
+    for my $m ( keys %ref_substrings ) {
+        say "Found substring $m with $i chars in all strings";
+    }
+    last
+      if %ref_substrings;    # and don't look any further
+                             # (would get shorter matches)
+}
diff --git a/challenge-018/daniel-mantovani/perl5/ch-2.pl b/challenge-018/daniel-mantovani/perl5/ch-2.pl
new file mode 100644
index 0000000000..652e6ecf90
--- /dev/null
+++ b/challenge-018/daniel-mantovani/perl5/ch-2.pl
@@ -0,0 +1,97 @@
+# 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.
+
+use strict;
+use warnings;
+use v5.10;
+
+# For the porpouse of the challenge, we will go for a "naive" implementation,
+# not using any external modules.
+# However note that if performance is an issue,  a more recommended approach
+# would be to use a Heap::xx perl module.
+# That would allow us to use partially ordered lists, obtaining a much better
+# performance in real life situations
+#
+# Now back to the challenge.
+# First we will need a "max" function, (in practice it would be much better
+# just to use PEVANS' List::Utils module)
+
+sub max {    # numerical max
+    my $max = shift;    # initialices with first element
+    map { $max = $_ if $_ > $max } @_;    # max algorithm
+    return $max;
+}
+
+# we define our queues as hash references, with priorities
+# as keys and array of elements on each value;
+# elements could be regular strings or any perl valid scalar
+# i.e. hash or array references
+
+#
+# For example, a queue array at a particular moment could be
+# something like:
+#
+# {1 => ['element x', 'element y'], 7 => ['element z']}
+
+# checking if a queue is empty. Will return 1 or '' (false)
+sub is_empty {
+    my $q = shift;
+    return !%$q;
+}
+
+# insert with priority will insert an element and return the new
+# queue:
+
+sub insert_with_priority {
+    my ( $q, $e, $p ) = @_;    # current queue, element and priority
+    push @{ $q->{$p} }, $e;    # so we have an array for every priority
+    return $q;                 # returns new queue
+}
+
+# To pull highest priority element is probably the slowest part, as we
+# will need to sweep all our queue priorities to find highest one,
+# and also delete priority altogether when corresponding array ends
+# empty
+
+sub pull_highest_priority_element {
+    my $q   = shift;                    # current queue
+    my $max = max( keys %$q );          # find max numeric priority (O(n)) :(
+    my $e   = shift @{ $q->{$max} };    # get oldest element for this priority
+    delete $q->{$max}
+      unless @{ $q->{$max} };           # check if there are remaining elements
+    return ( $e, $q );                  # will return element and new queue
+}
+
+# an example, using all defined functions, could be:
+
+my $queue = {};                         # empty initial queue
+$queue = insert_with_priority $queue, 'el 1, highest priority',     10;
+$queue = insert_with_priority $queue, 'el 2, pri 2, (1st element)', 2;
+$queue = insert_with_priority $queue, 'el 3, pri 2, (2nd element)', 2;
+$queue = insert_with_priority $queue, 'el 4, pri = 4',              4;
+$queue = insert_with_priority $queue, 'el 5, pri 2, (3rd element)', 2;
+$queue = insert_with_priority $queue, 'el 6, lowest priority',      1;
+$queue = insert_with_priority $queue, 'el 7, pri 2, (4th element)', 2;
+$queue = insert_with_priority $queue, 'el 8, pri 2, (5th element)', 2;
+
+# now we will be retrieving element by element, highest priority first
+
+my $i = 1;
+my $el;
+( $el, $queue ) = pull_highest_priority_element($queue),
+  printf "#%d element: %s\n", $i++, $el
+  while !is_empty($queue);
+
+# resulting element order should be elements 1, 4, 2, 3, 5, 7, 8 and 6