Historical Intersection with Perl 6

by Arne Sommer

Historical Intersection with Perl 6

Published 29. September 2019

This is my response to the Perl Weekly Challenge #27.

Challenge 27.1

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.

Note that the challenge specifies two line segments («The two ends ...»), and not two lines. The difference is that the line segments start and stop at the end points, whereas lines continue infinitely in both directions.

I found a nice formula on this page: www.cs.swan.ac.uk/~cssimon/line_intersection.html. Then it is simply a matter of translating it to code:

File: intersection
unit sub MAIN (Numeric \x1, Numeric \y1, Numeric \x2, Numeric \y2,  # [1]
               Numeric \x3, Numeric \y3, Numeric \x4, Numeric \y4);

my \ta1 = (y3−y4) * (x1−x3) + (x4−x3) * (y1−y3);  # [3]
my \ta2 = (x4−x3) * (y1−y2) − (x1−x2) * (y4−y3);  # [3]

my \tb1 = (y1−y2) * (x1−x3) + (x2−x1) * (y1−y3);  # [3]
my \tb2 = (x4−x3) * (y1−y2) − (x1−x2) * (y4−y3);  # [3]

my \ta = ta1 / ta2;                               # [2]
my \tb = tb1 / tb2;                               # [2]

if ta2 == 0 || tb2 == 0                           # [4]
{
  say "Colinear lines";
}
elsif 0 <= ta <= 1 && 0 <= tb <= 1                # [5]
{
  say "Segment intersection at x: { x1 + ta * (x2 - x1) } "
    ~ " y: { y1 + ta * (y2 − y1) }";
}
else                                              # [6]
{
  say "General Intersection (outside the box)";
}

[1] The challenge uses the variable names a, b, c, d, p, q, r and s, but I have chosen to use the names x1, y1, x2, y2, x3, y3, x4 and y4 as done in the formula to reduce confusion.

[2] The two formulas.

[3] The intermediate values, as we need to check for division by zero.

[4] The check for division by zero.

[5] The check for intersection.

[6] And the rest; where they intersect outside of the box.

Running it:

$ perl6 intersection 1 1 2 2 1 1 2 2
Colinear lines

$ perl6 intersection 1 1 2 2 1 1 2 212
Segment intersection at x: 1 y: 1

$ perl6 intersection 1 1111 2 2 1 1 2111 21299
Segment intersection at x: 1.9918739 y: 11.0118156

$ perl6 intersection 0 0 100 100 0 0 30 300
Segment intersection at x: 0 y: 0

$ perl6 intersection 0 0 100 100 10 20 30 300
General Intersection (outside the box)

$ perl6 intersection 0 0 100 100 0 10 100 110
Colinear lines

$ perl6 intersection 0 0 100 100 200 200 300 300
Colinear lines

It may help to visualize it:

Note that we could have done the division (potentially by zero), and used a try/catch-block to sort it out for us instead. I don't think that it is worth while here, but it would have allowed verbatim algorithm usage (without the intermediary ta1, ta2, tb1 and tb2 steps).

Challenge 27.2

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 obvious choice is the Proxy class, as it allows us to specify a custom setter and getter.

See docs.perl6.org/type/Proxy for an explanation of the Proxy class. The following program is based on the example there.

File: proxy-faulty
sub memoryvariable is rw
{
  my $val;                                      # [1]
  my @hist;                                     # [2]
  Proxy.new(
        FETCH => method ()
   	{
	  $val                                  # [1]
        },
        STORE => method ($new)
    	{
 	  $val = $new;                          # [1]
    	  @hist.push( Pair(now.Int => $new) );  # [2]
        },
  );
}

my $x := memoryvariable;                        # [3]

$x = 10;                                        # [4]
$x = 20;
$x -= 5;

say $x;

[1] One variable for the value, used by FETCH and STORE.

[2] The history is stored in an array, as Pair objects. The first value is a timestamp, and the second the actual value. (But note that I do not access these values.)

[3] We set it up like this,

[4] and uses it like a normal variable.

See docs.perl6.org/type/Pair for an explanation of the Pair type.

Running it:

$ perl6 proxy-faulty
15

I have added timestamps on the values, to make it a little more interesting. Now, all that is left is actually retrieving that history...

The problem (with the Proxy class) is that we can only have one getter (FETCH) and one setter (STORE), and it isn't possibly to add methods or procedures to an instance. So the getter can either give us the current value (as done above), or the complete history. If we choose to return the complete history (to satisfy the challenge), this line will blow up: $x -= 5;.

Conclusion; we cannot do this with a Proxy object.

It isn't possible to subclass Proxy in the current version of Rakudo (version 2019.07.1), but this challenge has pointed out the problem to the core developers so there is hope...

The interim solution is to store the history outside of the class, and let the custom setter set it, whereas the custom getter only returns the current value. Then we access the history circumventing the Proxy. The downside is that we have one common history! But we can work around that...

File: proxy-cheating
my %hist;                             # [1]

sub memoryvariable($label) is rw      # [2]
{
  my $val;
  Proxy.new(
        FETCH => method ()
   	{
	  $val
        },
        STORE => method ($new)
    	{
 	  $val = $new;
    	  %hist{$label}.push( Pair(now.Int => $new) ); # [3]
        },
  );
}

sub history ($label)                        # [4]
{
  return @(%hist{$label}).map( *.value );
}

sub history-timestamp ($label)              # [5]
{
  return @(%hist{$label}).map({ DateTime.new($_.key).local
    ~ ": " ~ $_.value }).join("\n");
}

my $x := memoryvariable('x');               # [6]

$x = 10;
$x = 20;
$x -= 5;

say $x;

say history('x');                           # [4a]

say history-timestamp('x');                 # [5a]

[1] One global variable for the history.

[2] $label is the history ID for the current variable, so that its history doesn't interfere with other variables history.

[3] Add the history to the global variable.

[4] This global procedure gives us the history, but only the values. It is called in [4a], with the correct ID.

[5] As above, but with the timestamps as well.

Running it:

$ perl6 proxy-cheating
15
(10 20 15)
2019-09-26T00:34:24+02:00: 10
2019-09-26T00:34:24+02:00: 20
2019-09-26T00:34:24+02:00: 15

If you want several variables with history, set them up with different IDs.

Note that the history functionality doesn't work as intended if we use class instances, as we store a pointer to that instance and not the actual value in the history. Copying the class instance can solve that, but may lead to other problems (which I won't go into).

A Class Dead End

We could wrap the code above in a class, making the history access available only through a class instance. This will make the global history variable go away, but will make it impossible to use normal assignment and lookup.

I'll have a go at regardlessly, but without the Proxy object (as we'd loose access to it anyway). Here it is, without comments:

File: history-variable
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');

Running it:

$ perl6 history-variable
(Any)
10
20
5
5
(10 20 5)
2019-09-26T22:09:16+02:00: 10
2019-09-26T22:09:16+02:00: 20
2019-09-26T22:09:16+02:00: 5

And then the module code:

File: lib/HistoryVariable.pm6
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 );
  }
}

The gist method gives the current value when we access the variable directly (as in say $x;). We can be explicit (and use say $x.get;) as well.

And that's it.