oops; forgot to submit this until now (finished 8am BST)

2 files changed, 241 insertions, 0 deletions

diff --git a/challenge-059/duncan-c-white/perl/ch-1.pl b/challenge-059/duncan-c-white/perl/ch-1.pl
new file mode 100755
index 0000000000..ce5d277729
--- /dev/null
+++ b/challenge-059/duncan-c-white/perl/ch-1.pl
@@ -0,0 +1,167 @@
+#!/usr/bin/perl
+#
+# Task 1: "Linked List
+#
+# You are given a linked list and a value k. Write a script to partition
+# the linked list such that all nodes less than k come before nodes greater
+# than or equal to k. Make sure you preserve the original relative order
+# of the nodes in each of the two partitions.
+# 
+# For example:
+# 
+# Linked List: 1 -> 4 -> 3 -> 2 -> 5 -> 2
+# 
+# k = 3
+# 
+# Expected Output: 1 -> 2 -> 2 -> 4 -> 3 -> 5.
+# "
+# 
+# My notes: why a linked list not an array, it would be so simple with an
+# array.  Ok, ok, a linked list: but the question is: do we want to reuse
+# the existing nodes or build fresh.  Building fresh would make it a "pure"
+# functional-style implementation.  But let's try reusing the existing
+# nodes..
+# Build two lists (reusing the existing nodes), one "before", the other "after".
+# Unlink each node, append it to whichever list is appropriate. Repeat.
+#
+
+use strict;
+use warnings;
+use feature 'say';
+use Function::Parameters;
+use Data::Dumper;
+
+
+die "Usage: list-partition k elements\n" if @ARGV==0;
+my( $k, @el ) = @ARGV;
+
+# usually I would write the list as an inline bless() class.
+# this time, just for the sake of variety, let's not bother with the gloss.
+
+# how to represent the list?  [] for nil, [h,t] for cons(h,t)
+
+fun nil() { return [] }
+fun cons($h,$t) { return [$h,$t] }
+fun single($h) { return [$h,[]] }
+fun isnil($l) { return @$l==0?1:0 }
+
+
+#
+# my $list = a2l( @el );
+#	Convert a plain Perl array @el into a nil/cons list.
+#	Return the generated list.
+#
+fun a2l( @el )
+{
+	return nil() unless @el;
+	my $first = shift @el;
+	my $l = single($first);	# create one-element list
+	my $last = $l;		# "pointer to last node"
+
+	foreach my $x (@el)
+	{
+		# append $x to list $l via $last
+		$last = $last->[1] = single($x);
+	}
+
+	return $l;
+}
+
+
+#
+# my $str = l2s($l);
+#	Generate printable (string) format of list $l.
+#
+fun l2s( $l )
+{
+	return "nil" unless @$l;
+	( my $h, $l ) = @$l;
+
+	my $s = "$h";
+
+	# foreach element h in $l
+	while( @$l )
+	{
+		( my $h, $l ) = @$l;
+		$s .= " -> $h";
+	}
+	return $s;
+}
+
+
+#
+# partition( $l, $k );
+#	Partition list $l (modifying it in place)
+#	such that all elements from $l that are < $k
+#	come first (in the same order as they were found
+#	in $l) followed by all elements from $l are >= $k
+#	(also in the same order as found in $l).
+#
+fun partition( $l, $k )
+{
+	return if isnil($l);
+
+	# before and after lists, and their last node pointer
+	my $before = nil();
+	my $lastb = $before;
+
+	my $after = nil();
+	my $lasta = $after;
+
+	# keep the original array ref to change @$origl later
+	my $origl = $l;
+
+	# loop over $l, detaching each node, and appending it
+	# to either $before or $after
+	my $nil = nil();
+	while( @$l )	# ! isnil
+	{
+		my $p = $l;
+		( my $h, $l ) = @$l;
+		$p->[1] = $nil;
+
+		if( $h < $k )
+		{
+			# add to before
+			if( @$lastb == 0 )
+			{
+				$lastb = $before = $p;
+			} else
+			{
+				$lastb = $lastb->[1] = $p;
+			}
+		} else
+		{
+			# add to after
+			if( @$lasta == 0 )
+			{
+				$lasta = $after = $p;
+			} else
+			{
+				$lasta = $lasta->[1] = $p;
+			}
+		}
+	}
+
+	# now $l is logically empty, reconstruct it
+	# from before++after
+	if( @$before == 0 )
+	{
+		@$origl = @$after;
+	} else
+	{
+		# connect after to end of before
+		$lastb->[1] = $after;
+
+		@$origl = @$before;
+	}
+}
+
+
+# first, build input list from @el
+my $list = a2l( @el );
+say "input list: ", l2s($list);
+
+# second, partition list
+partition( $list, $k );
+say "partition($k): ", l2s($list);
diff --git a/challenge-059/duncan-c-white/perl/ch-2.pl b/challenge-059/duncan-c-white/perl/ch-2.pl
new file mode 100755
index 0000000000..63a5d7051f
--- /dev/null
+++ b/challenge-059/duncan-c-white/perl/ch-2.pl
@@ -0,0 +1,74 @@
+#!/usr/bin/perl
+# 
+# Task 2: "Bit Sum
+#
+# For this task, you will most likely need a function f(a,b) which returns
+# the count of different bits of binary representation of a and b.
+# 
+# For example, f(1,3) = 1, since:
+# 
+# Binary representation of 1 = 01
+# Binary representation of 3 = 11
+# 
+# There is only 1 different bit. Therefore the subroutine should return
+# 1. Note that if one number is longer than the other in binary, the most
+# significant bits of the smaller number are padded (i.e., they are assumed
+# to be zeroes).
+# 
+# Script Output
+# 
+# Your script should accept n positive numbers. Your script should sum
+# the result of f(a,b) for every pair of numbers given:
+# 
+# For example, given 2, 3, 4, the output would be 6, since f(2,3) + f(2,4)
+# + f(3,4) = 1 + 2 + 3 = 6
+# "
+# 
+# My notes: sounds very straightforward.
+# 
+
+use strict;
+use warnings;
+use feature 'say';
+use Function::Parameters;
+#use Data::Dumper;
+
+
+die "Usage: sum-bit-diff n n+\n" if @ARGV<2;
+my( @n ) = @ARGV;
+
+
+#
+# my $nbitsdiff = diffbits( $a, $b );
+#	Compute and return the numbers of bits of $a and $b
+#	that are different.
+#
+fun diffbits( $a, $b )
+{
+	my $n = 0;
+	while( $a > 0 || $b > 0 )
+	{
+		$n++ if ($a&1)!=($b&1);
+		$a >>= 1;
+		$b >>= 1;
+	}
+	return $n;
+}
+
+
+#my $nbitsdiff = diffbits( 3, 4 );
+#say "diffbits(3,4)=$nbitsdiff";
+
+my $sum = 0;
+foreach my $i (0..$#n-1)
+{
+	my $x = $n[$i];
+	foreach my $j ($i+1..$#n)
+	{
+		my $y = $n[$j];
+		my $b = diffbits( $x, $y );
+		#say "debug: x=$x, y=$y, b=$b";
+		$sum += $b;
+	}
+}
+say "at end: sum=$sum";