3 files changed, 115 insertions, 0 deletions
diff --git a/challenge-027/noud/perl6/ch-1.p6 b/challenge-027/noud/perl6/ch-1.p6
new file mode 100644
index 0000000000..4e17f3819b
--- /dev/null
+++ b/challenge-027/noud/perl6/ch-1.p6
@@ -0,0 +1,52 @@
+# Write a script to find the intersection of two straight lines. The
+# co-ordinates of the two lines should be provided as command line parameter.
+# For example:
+#
+#   The two ends of Line 1 are represented as co-ordinates (a,b) and (c,d).
+#   The two ends of Line 2 are represented as co-ordinates (p,q) and (r,s).
+#
+# The script should print the co-ordinates of point of intersection of the
+# above two lines.
+
+# Computational geometry is always difficult, because there are so many border
+# cases you have to take into account. I hope I covered all of them.
+sub line_intersection(($x1, $y1), ($x2, $y2), ($x3, $y3), ($x4, $y4)) {
+    if (($x1 == $x2 and $y1 == $y2) or ($x3 == $x4 and $y3 == $y4)) {
+        die "Input doesn't represent two lines.";
+    }
+    my $disc = ($x1 - $x2) * ($y3 - $y4) - ($y1 - $y2) * ($x3 - $x4);
+    if ($disc == 0) {
+        if ($x1 == $x2 and $x2 == $x3 and $x3 == $x4) {
+            # Lines coincide vertically. Return one coinciding point.
+            return ($x1, $y1);
+        }
+        if ($y1 == $y2 and $y2 == $y3 and $y3 == $y4) {
+            # Lines coincide horizontally. Return one coinciding point.
+            return ($x1, $y1);
+        }
+        if (($y1 - $x1) * ($x4 - $x2) == ($y2 - $x2) * ($x3 - $x1)) {
+            # Lines coincide diagonally. Return one coinciding point.
+            return ($x1, $y1);
+        }
+        # If the discriminant is zero, the two lines are parallel to each
+        # other. Therefore, depending on your definitions the lines don't
+        # intersect, or they intersect at infinity, introducing a
+        # non-Euclidian geometry. I choose the latter.
+        return Inf;
+    }
+    # Discriminant is non-zero, hence there is one intersecting point.
+    return ((($x1 * $y2 - $y1 * $x2) * ($x3 - $x4)
+            - ($x3 * $y4 - $y3 * $x4) * ($x1 - $x2)) / $disc,
+        (($x1 * $y2 - $y1 * $x2) * ($y3 - $y4)
+            - ($x3 * $y4 - $y3 * $x4) * ($y1 - $y2)) / $disc);
+}
+
+line_intersection((-1, -1), (1, 1), (1, -1), (-1, 1)).say;
+line_intersection((0, 0), (1, 1), (1, 0), (2, 1)).say;
+line_intersection((0, 0), (1, 1), (2, 2), (3, 3)).say;
+try {
+    line_intersection((1, 1), (1, 1), (2, 2), (3, 3)).say;
+}
+if $! {
+    say "Expected error, because the input doesn't represent a line.";
+}
diff --git a/challenge-027/noud/perl6/ch-2.p6 b/challenge-027/noud/perl6/ch-2.p6
new file mode 100644
index 0000000000..9b6b316e31
--- /dev/null
+++ b/challenge-027/noud/perl6/ch-2.p6
@@ -0,0 +1,60 @@
+# Write a script that allows you to capture/display historical data. It could
+# be an object or a scalar. For example
+#
+#   my $x = 10; $x = 20; $x -= 5;
+#
+# After the above operations, it should list $x historical value in order.
+
+# The idea behind this solution is to first extract all defined variables
+# from the original script. After that we create a hash %var_hash_ that
+# updates the current values of each of the defined variables after each
+# semicolon. The new script is executed using the dangerous EVAL method.
+#
+# Usage:
+#   perl6 ch-2.p6 filename-of-script.p6
+
+# I hope I don't get banned from the Perl Weekly Challenge club for using EVAL
+# in this problem. ;)
+use MONKEY-SEE-NO-EVAL;
+
+sub MAIN(Str $filename) {
+    # Collect all variables in program.
+    my @variables = ();
+    for $filename.IO.slurp.split(";") -> $line {
+        my @line_var = ($line ~~ /my\s*\$(\w+)/).values;
+        if (@line_var.elems > 0) {
+            @variables = (|(@line_var), |(@variables));
+        }
+    }
+
+    my $exec_prog = "";
+    for $filename.IO.slurp.split(";") -> $line {
+        $exec_prog = "$exec_prog $line\;";
+        # After every line update %var_hash_ with the current variable values.
+        for @variables -> $x {
+            $exec_prog = "$exec_prog
+                if (not DYNAMIC::<\$$x> === Nil) \{
+                    \%var_hash_\.push: ($x => DYNAMIC::<\$$x>)\; \}\;";
+        }
+    }
+
+    my %var_hash_;
+    EVAL $exec_prog;  # https://xkcd.com/292/
+
+    say "Variables history:";
+    for %var_hash_.kv -> $var, @hist {
+        my @hist_ = @hist.grep({ not $_.^name === "Any" });
+        if (@hist_.elems > 0) {
+            print("$var = (");
+            my $last = @hist_[0];
+            print("$last");
+            for @hist_[1..*] -> $next {
+                if ($last != $next) {
+                    print(", $next");
+                    $last = $next;
+                }
+            }
+            print(")\n");
+        }
+    }
+}
diff --git a/challenge-027/noud/perl6/exm.p6 b/challenge-027/noud/perl6/exm.p6
new file mode 100644
index 0000000000..ba00280a6e
--- /dev/null
+++ b/challenge-027/noud/perl6/exm.p6
@@ -0,0 +1,3 @@
+my $x = 10; $x += 5;
+my $y = 20; $x -= 10; $y = $x + $y;
+$x /= 5;