Task-1: Handles non-contiguous data Task-2: Offers 50+ RPN operations

2 files changed, 173 insertions, 0 deletions

diff --git a/challenge-039/saiftynet/perl5/ch-1.pl b/challenge-039/saiftynet/perl5/ch-1.pl
new file mode 100644
index 0000000000..3eae6d25ae
--- /dev/null
+++ b/challenge-039/saiftynet/perl5/ch-1.pl
@@ -0,0 +1,69 @@
+#!/usr/env perl
+# Perl Challenge 39 Task 1
+# hotel lights.  Code detects non-contiguous stays
+# and also allows for out-of-sequence data entry
+# The data has been modified to test these
+
+use strict;use warnings;
+
+#initialise the intervals and time sums
+my @intervals=();my $ptr=0; my $totalOn=0;    
+
+#read data from the log file provided in the challenge
+while (my $line = <DATA>) {
+    my @inout=($line =~/\d\d\:\d\d/g);          # each log line has two
+    push @intervals, \@inout if (@inout == 2);  # time elements
+}		
+
+# sort the data by IN times...not needed for the data provided,
+# but simplifies handling of out-of-sequence data in logs
+@intervals=sort {$$a[0] cmp $$b[0]} @intervals;
+
+#merge intervals which overlap or envelop each other
+while ($ptr<$#intervals){
+	my @ret=mergeOverlaps($intervals[$ptr],$intervals[$ptr+1]);
+	splice @intervals, $ptr,2,@ret;
+	$ptr++ if (@ret>1);
+}
+
+# All remaining intervals represent contiguous on periods
+foreach (@intervals){
+	my $onPeriod=time2minutes($$_[1])-time2minutes($$_[0]);
+	print "Lights on between ".$$_[0]." and ".$$_[1]." (for $onPeriod minutes)\n";
+	$totalOn+=$onPeriod
+}
+
+#print the results
+print "Total lights on period $totalOn minutes\n";
+
+# detect and merge overlaps in two time intervals
+sub mergeOverlaps{                
+	my ($a,$b)=@_;          # in two sorted time intervals, overlap means 
+	if ($$a[1] gt $$b[0]){  # one ends after the latter starts
+		return [$$a[0],($$b[1] gt $$a[1])?$$b[1]:$$a[1]];
+	}
+	return $a,$b;           # no overlap, so time intervals stay
+}
+
+#convert the time string into minutes
+sub time2minutes{
+	my $str=shift;
+	my ($hours,$minutes)=split (/:/,$str);
+	return $hours*60+$minutes;
+}		
+	
+__DATA__
+1) Alex    IN: 09:10 OUT: 09:45
+2) Arnold  IN: 09:15 OUT: 09:33
+3) Bob     IN: 09:22 OUT: 09:55
+4) Charlie IN: 09:25 OUT: 10:05
+5) Steve   IN: 09:33 OUT: 10:01
+6) Roger   IN: 09:44 OUT: 10:12
+7) David   IN: 09:57 OUT: 10:23
+8) Neil    IN: 10:01 OUT: 10:19
+9) Chris   IN: 10:10 OUT: 11:00
+# extra confounding data
+# with non-contiguous and 
+# out-of-sequence data
+10)Lauren  IN: 15:00 OUT: 15:30
+11)MoSalah IN: 14:50 OUT: 15:10
diff --git a/challenge-039/saiftynet/perl5/ch-2.pl b/challenge-039/saiftynet/perl5/ch-2.pl
new file mode 100644
index 0000000000..15d67e6a75
--- /dev/null
+++ b/challenge-039/saiftynet/perl5/ch-2.pl
@@ -0,0 +1,104 @@
+#!/usr/env perl
+# Perl Challenge 39 Task 2
+# a reverse polish notation calculator delivering over 50 operators
+# including arithmetic, trigonometric, string, and stack operations
+# in about 100 lines of Perl including comments, and is partly coded
+# using RPN. 
+
+use strict;
+use warnings;
+my (@stack,%operators,$quiet);
+
+# Perl's built-in operations allow conventional notation mathematics 
+# simply use eval to perform these operations on the stacks contents
+
+# binary built-in operators 22
+foreach my $op(qw{+ - * / % . ** == != <=> > < >= <= lt gt le ge eq ne cmp x}){
+		$operators{$op}=sub{
+			my ($v1,$v2)=map {quoteStrings($_)} @stack[0,1];
+			@stack=(eval "$v1 $op $v2", splice @stack,2);
+		};
+}
+
+#unary built-in operators 18
+foreach my $op(qw{int floor ceil sin cos log exp sqrt uc lc length chr ucfirst lcfirst hex oct ~}){
+		$operators{$op}=sub{
+			my $v1=quoteStrings($stack[0]);
+			@stack=(eval "$op($v1)", splice @stack,1);
+		};
+}
+
+# misc functions 19... Useful trigonometric functions and stack operators
+# these extend the available functions provide other trigonometric operations,
+# stack operations, random nmumbers as well as control the displayed results
+@operators{qw/asin acos tan atan atan2 deg rad pi e rand randint dup swap del clear = quiet talk test/}=(
+	  sub { parse (qw{quiet dup dup * 1 - sqrt swap atan2 talk} ) },# atan2($tmp, sqrt(1 - $tmp * $tmp))
+	  sub { parse (qw{quiet dup dup * 1 - sqrt atan2 talk} ) },     # atan2(sqrt(1 - $tmp * $tmp), $tmp) 
+	  sub { parse (qw{quiet dup cos swap sin / talk}) },
+	  sub { parse (qw{quiet 1 swap atan2 talk}) },
+	  sub { my ($tmp1,$tmp2)=(shift @stack,shift @stack);           # derives other trig functions
+		    unshift @stack, atan2($tmp1,$tmp2)  },
+	  sub { parse (qw{quiet pi 180 / * talk}) },
+	  sub { parse (qw{quiet pi * 180 swap / talk}) },
+	  sub { parse (qw{quiet -1 0 atan2 talk})},
+	  sub { parse (qw{quiet 1 exp talk}) },   
+	  sub { unshift @stack, rand()},
+	  sub { parse (qw{quiet rand * int talk})},
+	  sub { unshift @stack, $stack[0]},
+	  sub { @stack[0,1]= @stack[1,0]},
+	  sub { shift @stack},	
+	  sub { @stack=()},	
+	  sub { print "Output : $stack[0]\n" },	
+	  sub { $quiet++},
+	  sub { $quiet = $quiet <=1?0:$quiet-1;},
+	  sub { parse (qw{quiet dup dup * 1 - sqrt atan2 talk} ) }	#atan2( sqrt(1 - $tmp * $tmp), $tmp ) 	
+	);
+
+# guess whether the parameter is a string or a number
+# numbers AND ed with their two's complement produce zero
+# this quotes strings and numerifies mumbers
+sub quoteStrings{
+		my $tmp=shift;  
+		if ($tmp & ~$tmp) {return "\"".$tmp."\"";}
+		return eval {1*$tmp}
+	}
+	
+# main function that parses inputs passed from the intercative console 
+# or as an array
+sub parse{
+   my @in=@_;
+   foreach (@in){   
+	   chomp ;
+	   # multiline commands are enclosed in square braces and
+	   # separated by spaces
+	   return parse(split /\s+/,$1) if (m/^\[(.*)]$/) ; 
+	   # next line allows ÷ × and - found in Wkipedia article
+	   s/^÷$/\//;s/^×$/\*/;s/^−$/-/;           
+	   exit print "Goodbye! \n" if (/quit/i);
+	   if (exists $operators{$_}){ # matches one of known operators
+		   $operators{$_}->();
+	   }
+	   else {unshift @stack,$_};   # push data onto stack
+	   report($_); # exists to allow user visualisation of operations 
+	}
+}
+
+# exists to allow user visualisation of operations
+sub report{
+	printf("You entered: %-10s Stack is now :  %s\n", shift,(join ",",@stack) )
+	    unless $quiet || $_ =~/^talk|=$/;
+}
+
+##  Test, demonstrates how to use the calculator
+print "Running example test calculation\n";
+parse (qw{9 9 3 * 6 2 ** - * clear hello_ ucfirst world swap . = clear});
+	
+##  Main routine to start interactive rpn calculator	
+print "\nStarting interactive rpn calculator:\n
+Enter values or operations or unquoted strings or 'quit' to quit.
+DO NOT QUOTE STRINGS, the calculator will try and guess what you need.
+For Multi-statement input use square braces and separate using spaces\nRPN>" ;
+while (<>){
+	parse ($_);   # parse input
+	print "RPN>"; # prompt for next input
+	};