Merge pull request #5258 from mattneleigh/pwc139

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

2 files changed, 173 insertions, 0 deletions

diff --git a/challenge-139/mattneleigh/perl/ch-1.pl b/challenge-139/mattneleigh/perl/ch-1.pl
new file mode 100755
index 0000000000..2afa4ff1cf
--- /dev/null
+++ b/challenge-139/mattneleigh/perl/ch-1.pl
@@ -0,0 +1,57 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use English;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my @lists = (
+    [1,2,3,4,5],
+    [1,3,2,4,5]
+);
+my $list;
+
+foreach $list (@lists){
+    print("Input: \@n = (", join(",", @{$list}), ")\n");
+    print("Output: ", jort_sort(@{$list}), "\n\n");
+}
+
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+################################################################################
+# Perform the Jort Sort on an array of numbers
+# Takes one argument:
+# * A list of numbers to examine
+# Returns:
+# * 1 if the list is sorted in ascending order
+# * 0 if the list is NOT sorted in ascending order
+################################################################################
+sub jort_sort{
+
+    my $i = $#ARG;
+
+    # For n members in the list, loop
+    # n-1 times
+    while($i--){
+        # If any member of the list is larger
+        # than the following member, return
+        # zero.
+        return(0) if($ARG[$i] > $ARG[$i + 1]);
+    }
+
+    # Made it through the list- must have
+    # been sorted
+    return(1);
+
+}
+
+
+
diff --git a/challenge-139/mattneleigh/perl/ch-2.pl b/challenge-139/mattneleigh/perl/ch-2.pl
new file mode 100755
index 0000000000..ed4f5a4a88
--- /dev/null
+++ b/challenge-139/mattneleigh/perl/ch-2.pl
@@ -0,0 +1,116 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use English;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my $prime;
+my @long_primes;
+
+foreach $prime (sieve_of_eratosthenes(100)){
+    push(@long_primes, $prime) if(is_long_prime($prime));
+    last if(scalar(@long_primes) == 5);
+}
+
+print(
+    "\nThe first five Long Primes are: ",
+    join(", ", @long_primes),
+    "\n\n"
+);
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+
+################################################################################
+# Determine whether a prime number is a "long prime" (full repetend prime)
+# Takes one argument:
+# * The prime number N to examine
+# Returns:
+# * 1 if N is a long prime
+# * 0 if N is not a long prime
+# NOTE: This function runs the external dc(1) program for arbitrary precision
+# calculation
+################################################################################
+sub is_long_prime{
+    my $n = shift();
+
+    my $digits;
+
+    # Get the required number of digits; I
+    # could have installed an arbitrary
+    # precision module for this calculation,
+    # but I was lazy and dc(1) was just
+    # sitting right there, soooo...
+    $digits = ($n - 1) * 2;
+    $digits = qx(echo "$digits k 1 $n / p" |dc);
+    $digits =~ tr/.\\\n//d;
+
+    if($digits =~ m/^(.*?)\1$/){
+        # There is a patttern that repeats
+        # twice...
+        $digits = $1;
+        if($digits !~ m/^(.*?)\1+$/){
+            # ...and it does NOT have any repeating
+            # sub-patterns within
+            return(1);
+        }
+    }
+
+    # Not a long prime
+    return(0);
+
+}
+
+
+
+################################################################################
+# Use the Sieve of Eratosthenes to find a quantity of prime numbers
+# Takes one argument:
+# * A number N (e.g. 20)
+# Returns:
+# * A list of all prime numbers less than or equal to N (e.g. (2, 3, 5, 7, 11,
+#   13, 17, 19))
+################################################################################
+sub sieve_of_eratosthenes{
+    use POSIX;
+
+    my $n = shift();
+
+    my $i;
+    my $j;
+    my $k;
+    my @a = map(1, 0 .. $n);
+
+    # Loop over $i not exceeding the square
+    # root of $n
+    for $i (2 .. floor(sqrt($n))){
+        # If $a[$i] is true, we haven't
+        # examined the multiples of $i yet
+        if($a[$i]){
+            $k = 0;
+            # Assignment in expression is deliberate
+            while(($j = $i ** 2 + $k++ * $i) <= $n){
+                # $j is not prime; set its cell in @a to
+                # false
+                $a[$j] = 0;
+            }
+        }
+    }
+
+    # Return a list of indices for which
+    # the corresponding members of @a are
+    # true
+    return(map($a[$_] ? $_ : (), 2 .. $n));
+
+}
+
+
+