Merge pull request #1141 from saiftynet/branch-043

Rings and Self-Descriptive Numbers

2 files changed, 130 insertions, 0 deletions

diff --git a/challenge-043/saiftynet/perl5/ch-1.pl b/challenge-043/saiftynet/perl5/ch-1.pl
new file mode 100644
index 0000000000..8148cab661
--- /dev/null
+++ b/challenge-043/saiftynet/perl5/ch-1.pl
@@ -0,0 +1,66 @@
+#!/usr/env perl
+# Perl Challenge Script
+# Olympics 5 intersecting rings have  some numbers allocated as below:
+# Blue: 8, Yellow: 7, Green: 5, Red: 9, Back "?". Write a script to
+# place numbers in the intersections and in the black ring so that
+# the sum of numbers in each ring is exactly 11.
+
+# list of known numbers in a chain of rings.
+my @list=(9,"?",5,"?","?","?",7,"?",8);
+
+# hash contains which positions in the chain correspond to which ring colour 
+my %rings=(red=>[0,1],
+           green=>[1,2,3],
+           black=>[3,4,5],
+           yellow=>[5,6,7],
+           blue=>[7,8],
+           );
+
+print "Inital state:-\n";
+displayRings();
+
+my $fixed=0;                               
+my $pass=0;
+
+# this function solves in one pass if we fix in
+# the sequence blue red green yellow black but
+# that would be cheating
+
+while (not $fixed){
+	$fixed=1;
+	foreach my $ring (keys %rings){
+	   my $sum=0; my @missing=();
+	   # count missing, sum known numbers
+	   foreach my $pos (@{$rings{$ring}}){
+		   if ($list[$pos] eq"?"){
+			   push @missing,$pos
+			   }
+		   else {
+			   $sum+=$list[$pos]
+			   }
+	   }
+	   if (scalar @missing == 1){
+		   # if only one missing number then the missing
+		   # number is 11 - the sum of known numbers
+		   $list[$missing[0]]=11-$sum;
+	   }
+	   elsif (scalar @missing){
+		   # if still missing numbers then not yet fixed 
+		   $fixed=0   
+	   }
+	}
+	$pass++;
+	print $fixed?"Final state:-\n":"Pass $pass\n";
+    displayRings();
+}
+
+sub displayRings{
+    printf  (
+"     RED %s                 BLACK %s                     BLUE %s
+        RedGrn %s    GrnBlk %s     BlkYel %s      YelBlu %s
+               GREEN %s                  YELLOW %s\n",
+               @list[0,4,8,1,3,5,7,2,6]
+        );	
+	
+}
+
diff --git a/challenge-043/saiftynet/perl5/ch-2.pl b/challenge-043/saiftynet/perl5/ch-2.pl
new file mode 100644
index 0000000000..803bd874a5
--- /dev/null
+++ b/challenge-043/saiftynet/perl5/ch-2.pl
@@ -0,0 +1,64 @@
+#!/usr/env perl
+# Perl Challenge 043 Task 2
+# Write a script to generate Self-descriptive Numbers in a given base.
+# In mathematics, a self-descriptive number is an integer m that in a
+# given base b is b digits long in which each digit d at position n
+# (the most significant digit being at position 0 and the least
+# significant at position b - 1) counts how many instances of digit
+# n are in m.
+use strict; use warnings;
+
+# sets up array to simplify conversions of decimal to  baseN
+my @decToBase=(0..9,"A".."Z","?");
+
+printf ("%-4s %-36s %-36s\n","base", "Derived","Cheating" );
+foreach (4,5,7..36){
+    printf ("%4s %-36s %-36s\n",$_, getSelfDescriptive($_),cheatGetSelfDescriptive($_) );
+}
+
+# This method uses description that the count of instances of digit N is 
+# in position N.  It uses a test that works by placing counts of digits for 
+# a starting number in respective positions, and keeps doing so until
+# there is no more change. Assumes no prior knowledge of these numbers 
+
+sub getSelfDescriptive{
+	my $base=shift;
+	
+	#starts with a string of 0s of length $base
+	#can be any number...the algorithm converges rapidly
+	my $start= "0"x $base;  
+	my $end=""; my $count=0;
+	
+	# keep updating until stabilises with the self-descriptive number
+	while ($end ne $start){
+		# for numbers that do not converge, a little bit of nudging
+		# by inserting a random digit in a random positions may help
+		if ($count++>5){   
+		  substr($start,rand()*$base,1)=$decToBase[rand()*$base];
+		  $count=0
+	    }
+		$end=$start;
+		$start=countAndPlace($end);
+		
+	}
+    return $start;
+    
+    # a single pass that counts occurences and puts that count in
+    # the respective positions within that string
+	sub countAndPlace{
+		my ($string)=@_;
+		my @split=split  //,$string;
+		foreach my $pos (0..$#split){
+			$split[$pos]= $decToBase[ grep { $_ eq  $decToBase[$pos] } @split];
+		}
+		return join "",@split;
+	}
+}
+
+# this method recognises that there is an obvious, observable pattern of
+# self-descriptive numbers....does not work for 4 and 5
+sub cheatGetSelfDescriptive{
+	my $base=shift;
+	return  $decToBase[$base-4]."21".("0"x($base-7))."1000" if $base >6;
+	return "oops...failed!"
+}