Merge pull request #2003 from jo-37/contrib

Solutions for task 071

2 files changed, 102 insertions, 0 deletions

diff --git a/challenge-071/jo-37/perl/ch-1.pl b/challenge-071/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..c6a873d686
--- /dev/null
+++ b/challenge-071/jo-37/perl/ch-1.pl
@@ -0,0 +1,36 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use List::Util qw(shuffle);
+
+# map3 is some kind of mixture and extension of map and reduce:
+# It iterates over the elements of a list calling a code block,
+# locally setting
+# - $a to the previous element
+# - $_ to the current element
+# - $b to the next element
+# and returning the the results of each invocation of the code block.
+# The block is never called with $_ set to the first or last element
+# of the list.
+sub map3 (&@) {
+	my $code = shift;
+
+	my ($prev, $current, $next, $i);
+	map {
+		($prev, $current, $next) = ($current, $next, $_);
+		++$i > 2 ?
+			do {local ($a, $_, $b) = ($prev, $current, $next); $code->()} :
+			();
+	} @_;
+}
+
+my $N = 10;
+local $" = ', ';
+
+# Shuffle the deck and take the first N cards.
+my @rand = splice @{[shuffle 1 .. 50]}, 0, $N;
+print "Array: [@rand]\n";
+
+# Add zeroes around the array to detect "border peaks".
+print "Peak: [@{[map3 {$_ > $a && $_ > $b ? $_ : ()} 0, @rand, 0]}]\n";
diff --git a/challenge-071/jo-37/perl/ch-2.pl b/challenge-071/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..e999078810
--- /dev/null
+++ b/challenge-071/jo-37/perl/ch-2.pl
@@ -0,0 +1,66 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use LinkedList::Single;
+
+# Print the node data from a linked list.
+sub list_print {
+	my $list = shift;
+
+	for ($list->head; $list->has_next; $list->next) {
+		print $list->node_data->[0], " -> ";
+	}
+	print $list->node_data->[0], "\n"
+}
+
+# Remove n-th last element from the list.
+sub remove_from_end {
+	my ($list, $n) = @_;
+
+	# Create a new singly linked list that will hold at most $n
+	# "position pointers" into the original list.  'undef' is used
+	# as a pseudo-pointer referencing the original list's first node
+	# and is stored in the new list's first node.
+	my $record = LinkedList::Single->new(undef);
+	my $len = 1;
+
+	# Process all nodes but the last from the original list.
+	for ($list->head; $list->has_next; $list->next) {
+
+		# Record the position and skip over the new node.
+		$record->add($list->node)->next;
+
+		# Discard the first recorded position if the maximum length
+		# is exceeded.
+		$record->shift if ++$len > $n;
+	}
+
+	# Retrieve the cut-node position from the first node of the record
+	# list, reposition the original list and cut the next node or
+	# remove the first node.
+	# Note: "cut" removes the next node after the current and thus
+	# cannot be used to remove the first node, where a "shift" is
+	# required.
+	my $node = $record->head->node_data->[0];
+	if ($node) {
+		$list->node($node);
+		$list->cut;
+	} else {
+		$list->shift;
+	}
+
+	$list;
+}
+
+my $L = 5;
+
+for my $N (1 .. 6) {
+	my $list = LinkedList::Single->new(1 .. $L);
+	if ($N == 1) {
+		print "List:\n";
+		list_print $list;
+	}
+	print "N=$N\n";
+	list_print remove_from_end $list, $N;
+}