- Added solutions by Laurent Rosenfeld.

5 files changed, 225 insertions, 0 deletions

diff --git a/challenge-027/laurent-rosenfeld/blog.txt b/challenge-027/laurent-rosenfeld/blog.txt
new file mode 100644
index 0000000000..84d863d65a
--- /dev/null
+++ b/challenge-027/laurent-rosenfeld/blog.txt
@@ -0,0 +1 @@
+http://blogs.perl.org/users/laurent_r/2019/09/perl-weekly-challenge-27-intersection-point-and-historical-values.html
diff --git a/challenge-027/laurent-rosenfeld/perl5/ch-1.pl b/challenge-027/laurent-rosenfeld/perl5/ch-1.pl
new file mode 100644
index 0000000000..dabd67b0d7
--- /dev/null
+++ b/challenge-027/laurent-rosenfeld/perl5/ch-1.pl
@@ -0,0 +1,58 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use feature qw/say/;
+
+sub find_line {
+    my ($x1, $y1, $x2, $y2) = @_;
+    my $slope = ($y2 - $y1) / ($x2 - $x1);
+    # find b for y1 = slope * x1 + b
+    my $b = $y1 - $slope * $x1;
+    return $slope, $b;
+}
+
+sub find_intersect {
+    my ($a1, $b1, $a2, $b2) = @_;
+    # solve y = ax + b for a1, b1 and a2, b2
+    # i.e.: a1 x + b1 = a2 x + b2 <=> x (a1 - a2) = b2 - b1
+    die "The segments are parallel or colinear, no intersection point!" if ($a1 == $a2);
+    my $abscissa = ($b2 - $b1) / ($a1 - $a2);
+    say "x = $abscissa";
+    my $ordinate = $a1 * $abscissa + $b1;
+    return $abscissa, $ordinate;
+}
+my ($a1, $b1, $a2, $b2);
+if (@ARGV == 8) {
+    die "The two segments are vertical, no intersection point"
+        if $ARGV[0] == $ARGV[2] and $ARGV[4] == $ARGV[6];
+    if ($ARGV[0] == $ARGV[2]) {
+        #First segment is vertical
+        my $abscissa = $ARGV[0];
+        ($a2, $b2) = find_line @ARGV[4..7];
+        my $ordinate = $a2 * $abscissa + $b2;
+        say "Intersection point: $abscissa, $ordinate";
+        exit 0;
+    }
+    if ($ARGV[4] == $ARGV[6]) {
+        # Second segment is vertical
+        my $abscissa = $ARGV[4];
+        ($a1, $b1) = find_line @ARGV[0..3];
+        my $ordinate = $a1 * $abscissa + $b1;
+        say "Intersection point: $abscissa, $ordinate";
+        exit 0;
+    }
+    ($a1, $b1) = find_line @ARGV[0..3];
+    ($a2, $b2) = find_line @ARGV[4..7];
+} else {
+    # default test values if arguments are missing or insufficient
+    ($a1, $b1) = find_line 3, 1, 5, 3;
+    ($a2, $b2) = find_line 3, 3, 6, 0;
+}
+say "a1: $a1";
+say "b1: $b1";
+say "a2: $a2";
+say "b2: $b2";
+
+my ($x, $y) = find_intersect ($a1, $b1, $a2, $b2);
+say "Intersection point abscissa: $x";
+say "Intersection point ordinate: $y";
diff --git a/challenge-027/laurent-rosenfeld/perl5/ch-2.pl b/challenge-027/laurent-rosenfeld/perl5/ch-2.pl
new file mode 100644
index 0000000000..6c7b1bc252
--- /dev/null
+++ b/challenge-027/laurent-rosenfeld/perl5/ch-2.pl
@@ -0,0 +1,31 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use feature qw/say/;
+
+sub create_watched_value {
+    my $value = shift;
+    my @past_values;
+    my $assign = sub {
+        my $new_val = shift;
+        push @past_values, $value;
+        $value = $new_val;
+    };
+    my $get_past_values = sub {
+        return "@past_values";
+    };
+    my $get_current_value = sub {
+        return $value;
+    };
+    return $assign, $get_past_values, $get_current_value;
+}
+
+my ($assign, $get_past, $get_current) = create_watched_value 10;
+say "Current: ", $get_current->();
+$assign->(15);
+say "Current: ", $get_current->();
+$assign->(20);
+say "Current: ", $get_current->();
+$assign->(5);
+say "Current: ", $get_current->();
+say "Past: ", $get_past->();
diff --git a/challenge-027/laurent-rosenfeld/perl6/ch-1.p6 b/challenge-027/laurent-rosenfeld/perl6/ch-1.p6
new file mode 100644
index 0000000000..d73fa817b1
--- /dev/null
+++ b/challenge-027/laurent-rosenfeld/perl6/ch-1.p6
@@ -0,0 +1,111 @@
+use v6;
+
+role Point {
+    has $.x;
+    has $.y;
+
+    method gist {
+        return "\n- Abscissa: $.x\n- Ordinate: $.y.";
+    }
+}
+class Segment {
+    has Point $.start;
+    has Point $.end;
+
+    method slope {
+        return ($.end.y - $.start.y) / ($.end.x - $.start.x);
+    }
+    method y-intercept {
+        my $slope = self.slope;
+        return $.start.y - $slope * $.start.x;
+    }
+    method line-coordinates {
+        return self.slope, self.y-intercept;
+    }
+}
+sub compute-intersection (Segment $s1, Segment $s2) {
+    my $abscissa = ($s2.y-intercept - $s1.y-intercept) /
+                   ($s1.slope - $s2.slope);
+    my $ordinate = $s1.slope * $abscissa + $s1.y-intercept;
+    my $intersection = Point.new( x => $abscissa, y => $ordinate);
+}
+multi MAIN ( $a1, $b1, # start of line segment 1
+             $a2, $b2, # end of line segment 1
+             $a3, $b3, # start of line segment 2
+             $a4, $b4  # end of line segment 2
+         ) {
+    exit unless valid-args |@*ARGS;
+    my $segment1 = Segment.new(
+            start => Point.new(x => $a1, y => $b1),
+            end   => Point.new(x => $a2, y => $b2)
+                              );
+    my $segment2 = Segment.new(
+            start => Point.new(x => $a3, y => $b3),
+            end   => Point.new(x => $a4, y => $b4)
+                              );
+    say "Segments are parallel or colinear." and exit
+        if $segment1.slope == $segment2.slope;
+    say "Coordinates of intersection point: ",
+        compute-intersection $segment1, $segment2;
+}
+multi MAIN () {
+    say "Using default input values for testing. Should display poinr (2, 4).";
+    my $segment1 = Segment.new(
+            start => Point.new(x => 3, y => 1),
+            end   => Point.new(x => 5, y => 3)
+                              );
+    my $segment2 = Segment.new(
+            start => Point.new(x => 3, y => 3),
+            end   => Point.new(x => 6, y => 0)
+                              );
+    say  "Coordinates of intersection point: ",
+        compute-intersection $segment1, $segment2;
+}
+sub valid-args ( $a1, $b1, # start of line segment 1
+                 $a2, $b2, # end of line segment 1
+                 $a3, $b3, # start of line segment 2
+                 $a4, $b4  # end of line segment 2
+         ) {
+    unless @*ARGS.all ~~ /<[\d]>+/ {
+        say "Non numeric argument. Can't continue.";
+        return False;
+    }
+    if $a1 == $a2 and $b1 == $b2 {
+        say "The first two points are the same. Cannot draw a line.";
+        return False;
+    }
+    if $a3 == $a4 and $b3 == $b4 {
+        say "The last two points are the same. Cannot draw a line.";
+        return False;
+    }
+    if $a1 == $a2 and $a3 == $a4 {
+        say "The two segments are vertical. No intersection.";
+        return False;
+    }
+    if $a1 == $a2 {
+        # First segment is vertical but not the second one
+        my $segment2 = Segment.new(
+                start => Point.new(x => $a3, y => $b3),
+                end   => Point.new(x => $a4, y => $b4)
+            );
+        my $ordinate = $segment2.slope
+            * $a1 + $segment2.y-intercept;
+        my $interception = Point.new(x => $a1, y => $ordinate);
+        say "Coordinates of intersection point: ", $interception;
+        return False;
+    }
+    if $a3 == $a4 {
+        # Second segment is vertical but not the first one
+        my $segment1 = Segment.new(
+                start => Point.new(x => $a1, y => $b1),
+                end   => Point.new(x => $a2, y => $b2)
+            );
+        my $ordinate = $segment1.slope
+            * $a3 + $segment1.y-intercept;
+        my $interception = Point.new(x => $a3, y => $ordinate);
+        say "Coordinates of intersection point: ", $interception;
+        return False;
+    }
+    return True;
+}
+
diff --git a/challenge-027/laurent-rosenfeld/perl6/ch-2.p6 b/challenge-027/laurent-rosenfeld/perl6/ch-2.p6
new file mode 100644
index 0000000000..acc7fd97aa
--- /dev/null
+++ b/challenge-027/laurent-rosenfeld/perl6/ch-2.p6
@@ -0,0 +1,24 @@
+use v6;
+
+class WatchedValue {
+    has Int $.current-value is rw;
+    has @.past-values = ();
+
+    method get-past-values {
+        return @.past-values;
+    }
+}
+
+multi sub infix:<=:=> (WatchedValue $y, Int $z) {
+    push $y.past-values, $y.current-value;
+    $y.current-value = $z;
+}
+my $x = WatchedValue.new(current-value => 10);
+say "Current: ", $x.current-value;
+$x =:= 15;
+say "Current: ", $x.current-value;
+$x =:= 5;
+say "Current: ", $x.current-value;
+$x =:= 20;
+say "Current: ", $x.current-value;
+say "Past values: ", $x.get-past-values;