Merge pull request #1316 from saiftynet/branch-049

Challenge 049 response by saiftynet

2 files changed, 197 insertions, 0 deletions

diff --git a/challenge-049/saiftynet/perl/ch-1.pl b/challenge-049/saiftynet/perl/ch-1.pl
new file mode 100644
index 0000000000..956d951ef3
--- /dev/null
+++ b/challenge-049/saiftynet/perl/ch-1.pl
@@ -0,0 +1,59 @@
+#!/usr/env/perl
+# Task 1 Challenge 049 Solution by saiftynet
+# Smallest Multiple
+# Write a script to accept a positive number as command line argument 
+# and print the smallest multiple of the given number consists of 
+# digits 0 and 1.
+# For example:
+# For given number 55, the smallest multiple is 110 consisting of 
+# digits 0 and 1.
+#
+# This solution offers two methods of finding the answer. One is simple
+# naive answer just incrementing multipliers until a suitable target found.
+# It is offered just for illustration. method2() is significantly faster.
+
+$input=$ARGV[0];   # if input offered, returns result as specified in task
+if ($input){
+   method2($input)  
+}
+else{              # interactive operation starts if no commandline parameter 
+    while (1){
+      print "Enter a number to process, or a non-number to quit >>";
+      chomp( $input = <STDIN>);
+      last if not $input or $input=~/[^\d]/;
+      method2($input);
+    };
+}
+
+# naive  routine...multiples of 9 and a few other numbers take a
+# disproportionately long time.  The smallest number with 9 requires
+# a muliplier of 12345679, 99 requires a multiplier 1122334455667789
+# producing 111_111_111_111_111_111. To save that trouble, the routine
+# simply refuses to even try....
+sub method1{
+    my $input=shift;
+    return print "Computer says NO!\n",
+                 "Multiples of 9 are quicker with method2\n"
+                       unless $input % 9;
+    my $multiplier=1;
+    while ((($input*$multiplier)."")=~/[2-9]/){$multiplier++}; increment unt
+    print "Input: $input, Multiplier: $multiplier Result: ", $input*$multiplier,"\n";
+}
+
+# Method2 in contrast is comparatively lightning fast.  It builds up
+# progressively larger strings consisting of 1s and 0s stored in
+# @list and tests them for divisibility by the input
+sub method2{
+   my $input=shift;
+   my $found=0;                        # no answer yet
+   my @list=(1);                       # start with @list containing 1
+   while (!$found){                  
+      @list=map{$_."0",$_."1"} @list;  # appends "0" or "1" to each element
+      foreach (@list){
+          $found=$_ unless $_ % $input;# $result stored in $found if multiple found
+          last if $found;              # exit loop once $found
+      }
+   }
+   print "Input: $input, Multiplier: ",$found/$input, "  Result: ",  $found,"\n";
+}
+
diff --git a/challenge-049/saiftynet/perl/ch-2.pl b/challenge-049/saiftynet/perl/ch-2.pl
new file mode 100644
index 0000000000..be83c698b6
--- /dev/null
+++ b/challenge-049/saiftynet/perl/ch-2.pl
@@ -0,0 +1,138 @@
+#!/usr/env/perl
+# Task 2 Challenge 049 Solution by saiftynet
+# LRU Cache
+# Write a script to demonstrate LRU Cache feature. It should support 
+# operations get and set. Accept the capacity of the LRU Cache as 
+# command line argument.
+# Definition of LRU: An access to an item is defined as a get or 
+# a set operation of the item. “Least recently used” item is the 
+# one with the oldest access time.
+#
+# In order to demonstrate the LRU... 1) a test sequence is performed
+# that replicates example in description, and 2) an interactive shell
+# is opened that allows the user to interact with the LRU Cache
+
+use strict;use warnings;
+
+my (%cache,@recency,$capacity);
+
+# runs test subroutine to esnure matches required spec     
+test();
+
+# capacity can be set from command line argument, defaults to 3
+$capacity=$ARGV[0]//=3;  
+clear(); 
+
+# initialise a dispatch table for parsing inputs. Each command has 
+#  1) a regexp to extract parameters, $dispatch{$command}{re}
+#  2) an action to perform          , $dispatch{$command}{action}
+my %dispatch=(
+  set     =>{   # set (key,value) or set key,value: sets a key with a value
+    re      =>'\s*\(?\s*\b(.+)\b\s*,\s*\b(.+)\b\s*\)?',
+    action =>sub{my ($p1,$p2)=@_;set($p1,$p2)},
+  },
+  get     =>{   # get (key) or get key : gets key value
+    re      =>'\s*\(?\s*\b(.+)\b\s*\)?',
+    action  =>sub{my ($p1)=@_;print get($p1),"\n";},
+  },	
+  cache   =>{   # cache: prints cache in recency order
+    re      =>'cache',
+    action  =>sub{printCache()},
+  },		
+  capacity=>{   # capacity can be changed
+    re      =>'\s*=?\s*(\d+)',
+    action  =>sub{my ($p1)=@_;$capacity=$p1;},
+  },	
+  lru     =>{   # return least recently used
+    re      =>'',
+    action  =>sub{print $recency[0],"\n";},
+  },	
+  mru     =>{   # return most recently used
+    re      =>'',
+    action  =>sub{print $recency[-1],"\n";},
+  },	
+  quit    =>{   # quit shell
+    re      =>'',
+    action  =>sub{exit 0;},
+  },
+  clear   =>{   # clear the cache
+    re      =>'',
+    action  =>sub{clear();},
+  },	
+);
+
+# enter interactive mode for further manipulation of cache
+# interaction for users to manipulate and examine stack
+print "\n\nInteractive LRU cache started\n
+Valid Commands: capacity <capacity>, set(<key>,<value>), get(<key>)
+                cache, lru, mru, clear and quit\n";
+print "capacity=$capacity\n";
+
+while (1){
+   print ">>";                           # prompt
+   chomp( my $input = <STDIN>);          # get input
+   $input=~/^\s*([a-z]+)([^a-z].*)?$/i;  # extract command and parameters
+   my ($command,$params)=($1,$2);
+   if (exists $dispatch{$command}){      # if command present in dispatch table
+     $params=~/$dispatch{$command}{re}/ if $params;   # separate params
+     $dispatch{$command}{action}->($1,$2);# execute disspatach action
+   };
+};
+
+#### The following 3 routines are the core functions: - get(key),
+#### set(key,value) and access(key) 
+
+sub access{
+  my $key=shift;          # key being accessed
+  push @recency,$key;     # put the key into most recently used 
+                                          
+  # starting from next most recently used slot, search for key
+  # and remove any other occurence of key;
+  my $index=$#recency-1;                            
+  $index-- while (($index>=0) and ($recency[$index] ne $key));   
+  splice @recency, $index, 1 if ($index>=0);
+  
+  # if capacity exceeded then shift lru out and delete from cache                  
+  delete $cache{shift @recency} while ($capacity <@recency);
+ }
+
+sub get{                    # get value if key exists else -1
+	my $key=shift;
+	return -1 unless exists $cache{$key};
+	access($key);       # recency updated
+	return $cache{$key} # return stored value
+}
+
+sub set{                    # set key value pair
+	my ($key,$value)=@_;
+	$cache{$key}=$value;
+	access($key);       # recency updated
+}
+
+### The following subroutines are not part of the spec but allow testing
+
+sub test{   # follow the sequence described in the task
+	$capacity=3;
+	print "Setting 1 to 3 : \n" ;set(1,3);
+	print "Setting 2 to 5 : \n" ;set(2,5);
+	print "Setting 3 to 5 : \n" ;set(3,7);
+	print "Cache now has:-    " ;printCache();
+	print "Getting 2 returns : ",get(2),"\n";
+	print "Cache now has:-    " ;printCache();
+	print "Getting 1 returns : ",get(1),"\n";
+	print "Cache now has:-    " ;printCache();
+	print "Getting 4 returns : ",get(4),"\n";
+	print "Cache now has:-    " ;printCache();
+	print "Setting 4 to 9 : \n" ;set(4,9);
+	print "Cache now has:-    " ;printCache();
+	print "Getting 3 returns : ",get(3),"\n";
+}
+
+sub clear{                # clears the cache, and @recency
+	%cache=();
+	@recency=();
+};
+sub printCache{           # outputs the recency as in the task description
+	print "[Least recently used] ",(join ",",@recency)," [most recently used]\n";
+}
+