Solutions to challenge 027 problem 1 and 2 in Perl 6 by Noud

3 files changed, 99 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..1d1ad3232e
--- /dev/null
+++ b/challenge-027/noud/perl6/ch-2.p6
@@ -0,0 +1,41 @@
+# 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.
+
+# I hope I don't get banned from the Perl Weekly Challenge club for using EVAL
+# in this problem. ;)
+use MONKEY-SEE-NO-EVAL;
+
+my @variables = ();
+my $pattern = /my\s*\$(\w+)/;
+
+my $exec_prog = "";
+for 'exm.p6'.IO.lines -> $line {
+    my @line_var = ($line ~~ $pattern).values;
+    if (@line_var.elems > 0) {
+        @variables = (|(@line_var), |(@variables));
+    }
+    $exec_prog = "$exec_prog $line";
+    # After every line update %var_hash_ with the current variable values.
+    for @variables -> $x {
+        $exec_prog = "$exec_prog \%var_hash_\.push: ($x => \$$x)\;";
+    }
+}
+
+my %var_hash_;
+EVAL $exec_prog;  # https://xkcd.com/292/
+for %var_hash_.kv -> $var, @hist {
+    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..caef08a250
--- /dev/null
+++ b/challenge-027/noud/perl6/exm.p6
@@ -0,0 +1,6 @@
+my $x = 10;
+$x += 5;
+my $y = 20;
+$x -= 10;
+$y = $x + $y;
+$x /= 5;