new file: challenge-236/mattneleigh/perl/ch-1.pl

	new file:   challenge-236/mattneleigh/perl/ch-2.pl

2 files changed, 191 insertions, 0 deletions

diff --git a/challenge-236/mattneleigh/perl/ch-1.pl b/challenge-236/mattneleigh/perl/ch-1.pl
new file mode 100755
index 0000000000..33be84381b
--- /dev/null
+++ b/challenge-236/mattneleigh/perl/ch-1.pl
@@ -0,0 +1,103 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use English;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my @denominations = (20, 10, 5);
+my @bill_sequences = (
+    [ 5, 5, 5, 10, 20 ],
+    [ 5, 5, 10, 10, 20 ],
+    [ 5, 5, 5, 20 ]
+);
+my $price = 5;
+
+print("\n");
+foreach my $bills (@bill_sequences){
+    printf(
+        "Input: \@bills = (%s)\nOutput: %s\n\n",
+        join(", ", @{$bills}),
+        exact_change_possible($price, \@denominations, @{$bills}) ?
+            "true"
+            :
+            "false"
+    );
+}
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+
+################################################################################
+# Determine whether exact change can be made from a given sequence of
+# transactions, starting with an empty till
+# Takes three arguments:
+# * The price of the item being sold (e.g. 5)
+# * A ref to an array of the denominations available for payment and change-
+#   making (e.g. [ 20, 10, 5 ] )
+# * A list of single-bill amounts indicating the payments made in a sequence of
+#   transactions
+# Returns:
+# * 1 if exact change could be made for the entire sequence of transactions
+# * 0 if exact change could NOT be made for the entire sequence of transactions
+################################################################################
+sub exact_change_possible{
+    my $price = shift();
+
+    # Sort denominations in descending order so we
+    # can take a "greedy" approach to making change
+    # (see below)
+    my @denoms = sort({ $b <=> $a } @{shift()});
+
+    my %till;
+
+    # Set up an empty till
+    foreach my $denom (@denoms){
+        $till{$denom} = 0;
+    }
+
+    # Loop over each transaction
+    foreach my $payment (@ARG){
+        # Put this payment in the till
+        $till{$payment}++;
+
+        # Skip ahead if the customer paid with
+        # exact change
+        next
+            if($payment == $price);
+
+        # We owe change back...
+        $payment -= $price;
+        
+        # Loop over each denomination- using larger
+        # denominations first (see above)
+        foreach my $denom (@denoms){
+            while($till{$denom} && ($denom <= $payment)){
+                # We have this denomination and it's
+                # greater than the change owed- use one
+                $till{$denom}--;
+                $payment -= $denom;
+            }
+        }
+
+        # If we still owe money, we couldn't make
+        # exact change for this transaction
+        return(0)
+            if($payment);
+    }
+
+    # We were able to make exact change for
+    # all transactions
+    return(1);
+
+}
+
+
+
diff --git a/challenge-236/mattneleigh/perl/ch-2.pl b/challenge-236/mattneleigh/perl/ch-2.pl
new file mode 100755
index 0000000000..bd8e5d1e11
--- /dev/null
+++ b/challenge-236/mattneleigh/perl/ch-2.pl
@@ -0,0 +1,88 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use English;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my @integer_lists = (
+    # Given cases
+    [ 4, 6, 3, 8, 15, 0, 13, 18, 7, 16, 14, 19, 17, 5, 11, 1, 12, 2, 9, 10 ],
+    [ 0, 1, 13, 7, 6, 8, 10, 11, 2, 14, 16, 4, 12, 9, 17, 5, 3, 18, 15, 19 ],
+    [ 9, 8, 3, 11, 5, 7, 13, 19, 12, 4, 14, 10, 18, 2, 16, 1, 0, 15, 6, 17 ],
+
+    # Additional test case(s)
+    [ 0, 1, 2, 3, 4, 5, 6, 22, 8 ]
+);
+
+print("\n");
+foreach my $integer_list (@integer_lists){
+    printf(
+        "Input: \@ints = (%s)\nOutput: %d\n\n",
+        join(", ", @{$integer_list}),
+        count_index_loops(@{$integer_list})
+    );
+}
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+
+################################################################################
+# Count the index loops within an array of unique integers- that is to say, the
+# number of instances in which treating each value at a given index as the next
+# index in the sequence produces a loop
+# Takes one argument:
+# * An array of unique integers to examine (e.g. ( 0, 1, 13, 7, 6, 8, 10, 11,
+#   2, 14, 16, 4, 12, 9, 17, 5, 3, 18, 15, 19 ) )
+# Returns:
+# * The count of index loops (e.g. 6 )
+################################################################################
+sub count_index_loops{
+
+    my %seen;
+    my $loopct = 0;
+
+    # Loop over @ARG
+    for my $i (0 .. $#ARG){
+        # Skip this $i if we've already seen it
+        next
+            if($seen{$i});
+
+        my $j = $i;
+
+        while(1){
+            # Mark this $j as seen
+            $seen{$j} = 1;
+
+            # Jump to the next $j
+            $j = $ARG[$j];
+
+            unless(defined($j)){
+                # $ARG[$j] was not in the array?  Break out
+                # of this iteration but do NOT count this
+                # as a loop
+                last;
+            }
+
+            if($seen{$j}){
+                # This $j has been seen; increment index loop
+                # count and break out of this iteration
+                $loopct++;
+                last;
+            }
+        }        
+    }
+
+    return($loopct);
+
+}
+
+
+