- Added solutions by Arne Sommer.

6 files changed, 174 insertions, 0 deletions

diff --git a/challenge-027/arne-sommer/blog.txt b/challenge-027/arne-sommer/blog.txt
new file mode 100644
index 0000000000..f8f0e84f7a
--- /dev/null
+++ b/challenge-027/arne-sommer/blog.txt
@@ -0,0 +1 @@
+https://perl6.eu/historical-intersection.html
diff --git a/challenge-027/arne-sommer/perl6/ch-1.p6 b/challenge-027/arne-sommer/perl6/ch-1.p6
new file mode 100755
index 0000000000..20f23893d5
--- /dev/null
+++ b/challenge-027/arne-sommer/perl6/ch-1.p6
@@ -0,0 +1,41 @@
+#! /usr/bin/env perl6
+
+# Wikipedia: "line segment intersection"
+# "Finding the intersection point of two line segments in R2"
+
+
+# unit sub MAIN (Numeric $a, Numeric $b, Numeric $c, Numeric $d,
+#               Numeric $p, Numeric $q, Numeric $r, Numeric $s);
+
+unit sub MAIN (Numeric \x1, Numeric \y1, Numeric \x2, Numeric \y2,
+               Numeric \x3, Numeric \y3, Numeric \x4, Numeric \y4);
+
+
+
+
+# https://www.geeksforgeeks.org/check-if-two-given-line-segments-intersect/
+# https://rosettacode.org/wiki/Find_the_intersection_of_two_lines#Perl_6
+# http://www.cs.swan.ac.uk/~cssimon/line_intersection.html
+
+my \ta1 = (y3−y4) * (x1−x3) + (x4−x3) * (y1−y3);
+my \ta2 = (x4−x3) * (y1−y2) − (x1−x2) * (y4−y3);
+
+my \tb1 = (y1−y2) * (x1−x3) + (x2−x1) * (y1−y3);
+my \tb2 = (x4−x3) * (y1−y2) − (x1−x2) * (y4−y3);
+
+my \ta = ta1 / ta2;
+my \tb = tb1 / tb2;
+
+if ta2 == 0 || tb2 == 0
+{
+  say "Colinear lines";
+}
+elsif 0 <= ta <= 1 && 0 <= tb <= 1
+{
+  say "Segment intersection at x: { x1 + ta * (x2 - x1) } y: { y1 + ta * (y2 − y1) }";
+}
+else
+{
+  say "General Intersection (outside the box)";
+}
+
diff --git a/challenge-027/arne-sommer/perl6/ch-2.p6 b/challenge-027/arne-sommer/perl6/ch-2.p6
new file mode 100755
index 0000000000..ca2037b75a
--- /dev/null
+++ b/challenge-027/arne-sommer/perl6/ch-2.p6
@@ -0,0 +1,44 @@
+#! /usr/bin/env perl6
+
+# https://docs.perl6.org/type/Proxy
+
+my %hist;
+
+sub memoryvariable($label) is rw
+{
+  my $val;
+  Proxy.new(
+        FETCH => method ()
+   	{
+	  $val
+        },
+        STORE => method ($new)
+    	{
+ 	  $val = $new;
+    	  %hist{$label}.push( Pair(now.Int => $new) );
+        },
+  );
+}
+
+sub history ($label)
+{
+  return @(%hist{$label}).map( *.value );
+}
+
+sub history-timestamp ($label)
+{
+  return @(%hist{$label}).map({ DateTime.new($_.key).local ~ ": " ~ $_.value }).join("\n");
+}
+
+my $x := memoryvariable('x');
+
+$x = 10;
+
+$x = 20;
+
+$x -= 5;
+
+say $x;
+
+say history('x');
+say history-timestamp('x');
diff --git a/challenge-027/arne-sommer/perl6/history-variable b/challenge-027/arne-sommer/perl6/history-variable
new file mode 100755
index 0000000000..7a2ff571f5
--- /dev/null
+++ b/challenge-027/arne-sommer/perl6/history-variable
@@ -0,0 +1,21 @@
+#! /usr/bin/env perl6
+
+use lib "lib";
+
+use HistoryVariable;
+
+my $x = HistoryVariable.new;
+say $x;
+
+$x.set(10);
+say $x;
+
+$x.set(20);
+say $x;
+
+$x.set(5);
+say $x.get;
+
+say $x.get;
+say $x.history;
+say $x.history('time');
diff --git a/challenge-027/arne-sommer/perl6/lib/HistoryVariable.pm6 b/challenge-027/arne-sommer/perl6/lib/HistoryVariable.pm6
new file mode 100644
index 0000000000..63152326f1
--- /dev/null
+++ b/challenge-027/arne-sommer/perl6/lib/HistoryVariable.pm6
@@ -0,0 +1,39 @@
+use v6.d;
+
+class HistoryVariable
+{
+  has $!value;
+  has @!history;
+
+  multi method new
+  {
+    self.bless;
+  }
+
+  method set ($new-value)
+  {
+    $!value = $new-value;
+    @!history.push( Pair(now.Int => $new-value) );
+  }
+
+  method gist
+  {
+    return $!value;
+  }
+  
+  method get
+  {
+    return $!value;
+  }
+
+  multi method history ('time')
+  {
+    return @!history.map({ DateTime.new($_.key).local ~ ": " ~ $_.value }).join("\n");
+}
+  
+  multi method history
+  {
+    return @!history.map( *.value );
+  }
+}
+
diff --git a/challenge-027/arne-sommer/perl6/proxy-faulty b/challenge-027/arne-sommer/perl6/proxy-faulty
new file mode 100755
index 0000000000..4fe2923cd2
--- /dev/null
+++ b/challenge-027/arne-sommer/perl6/proxy-faulty
@@ -0,0 +1,28 @@
+#! /usr/bin/env perl6
+
+sub memoryvariable is rw
+{
+  my $val;
+  my @hist;
+  Proxy.new(
+        FETCH => method ()
+   	{
+	  $val
+        },
+        STORE => method ($new)
+    	{
+ 	  $val = $new;
+    	  @hist.push( Pair(now.Int => $new) );
+        },
+  );
+}
+
+my $x := memoryvariable;
+
+$x = 10;
+
+$x = 20;
+
+$x -= 5;
+
+say $x;
\ No newline at end of file