## Perl Weekly Challenge 027: Intersection of Straight Lines and Historical Data

## Intersection of Straight Lines

Write a script to find the intersection of two straight lines. The coordinates of the two lines should be provided as command line parameter.

I vaguely remember we did the general form of the equation of a straight line at secondary school. The formula itself is pretty simple:

Ax + By + C = 0

Now, clearly, if we have two straight lines `A`

and _{1}, B_{1}, C_{1}`A`

, their intersection are the _{2}, B_{2}, C_{2}`x`

and `y`

such that `A`

. From the general formula we know that_{1}x + B_{1}y + C = A_{2}x + B_{2}y + C_{2}

x = (-B_{1}y - C_{1}) / A_{1}

It takes a bit of pen and paper work to find out that

y = (A_{2}C_{1}- C_{2}A_{1}) / (A_{1}B_{2}- A_{2}B_{1})

And we need to pay special attention to the cases where `A`

or _{1} = 0`A`

. In the first case, we’ll use _{1}B_{2} - A_{2}B_{1} = 0`A`

, _{2}`B`

, and _{2}`C`

instead to compute _{2}`x`

(unless `A`

as well, in which case the two lines are parallel or identical); the second case is similar._{2} = 0

The last part of the puzzle is how to translate the input coordinates of two points into the `A`

, `B`

, and `C`

.

The main trick is to realise that there are infinitely many such triples `A`

, `B`

, and `C`

: we can multiply all of them by any non-zero number to get another triple that still represents the same straight line. We can therefore fix one of the numbers, let’s say `B`

, to be always 1 or 0—the latter means the line is vertical. Getting the two remaining numbers is again just a matter of a pen & paper:

A = (y_{2}- y_{1}) / (x_{1}- x_{2}) C = x_{1}* (y_{1}- y_{2}) / (x_{1}- x_{2}) - y_{1}

After translating the equations to Perl and adding some tests, we get

```
#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };
sub line {
my ($x1, $y1, $x2, $y2) = @_;
my ($A, $B, $C);
die 'Not enough points' if $x1 == $x2 && $y1 == $y2;
if ($x1 == $x2) {
if ($x1) {
($A, $B, $C) = (-1 / $x1, 0, 1);
} else {
($A, $B, $C) = (1, 0, 0);
}
} else {
($A, $B, $C) = (($y2 - $y1) / ($x1 - $x2),
1,
$x1 * ($y1 - $y2) / ($x1 - $x2) - $y1);
}
return $A, $B, $C
}
sub intersection {
my ($a1, $b1, $c1, $a2, $b2, $c2) = @_;
if ($a1 * $b2 == $a2 * $b1) {
die 'No intersection' if $c1 != $c2;
die 'Identical lines' if $c1 == $c2;
}
my $y = ($a2 * $c1 - $c2 * $a1) / ($a1 * $b2 - $a2 * $b1);
my $x = $a1 ? (-$b1 * $y - $c1) / $a1
: (-$b2 * $y - $c2) / $a2;
return $x, $y
}
use Test::More;
use Test::Exception;
sub point_on_line {
my ($x1, $y1, $x2, $y2) = @_;
my ($A, $B, $C) = line($x1, $y1, $x2, $y2);
is $A * $x1 + $B * $y1 + $C, 0;
is $A * $x2 + $B * $y2 + $C, 0;
}
point_on_line(3, 3, 5, 3);
point_on_line(3, 3, 3, 7);
point_on_line(1, 5, 3, 11);
throws_ok { line(1, 1, 1, 1) } qr/Not enough points/;
is_deeply [ intersection(
line(1, 5, 3, 11), line(0, -1, 3, 5)
) ], [-3, -7];
is_deeply [ intersection(
line(1, 2, 5, 14), line(0, 2, -1, 7)
) ], [3/8, 1/8];
is_deeply [ intersection(
line(0, 0, 0, 1), line(0, 0, 1, 0)
) ], [0, 0];
is_deeply [ intersection(
line(4.2, 19, 4.8, 22), line(4, 19, 3.5, 17.5)
) ], [4.5, 20.5];
is_deeply [ intersection(
line(1, 1, 5, 1), line(1, 1, 1, 5),
) ], [ 1, 1 ];
throws_ok { intersection(
line(0, 0, 1, 1), line(2, 2, 3, 3)
) } qr/Identical lines/;
throws_ok { intersection(
line(2, 2, 1, 1), line(0, 2, 1, 3)
) } qr/No intersection/;
done_testing(14);
```

This solution doesn’t always work correctly: if the points are very close to each other, the imprecise floating point arithmetic can even claim the points themselves don’t lie on the line. Not even bigrat and similar can fix it if you try something like

`point_on_line(map rand, 1 .. 4) for 1 .. 100;`

## Historical data

Write a script that allows you to capture/display historical data. It could be an object or a scalar. For exampleAfter the above operations, it should list the historical values of $x in order.`my $x = 10; $x = 20; $x -= 5;`

In fact, in Perl we can have a scalar that has an object behind itself. To associate a variable with an object, Perl uses the tie function.

To create a scalar that behaves almost like a normal scalar, we can inherit from Tie::StdScalar and only redefine the operations that should behave differently; in our case, we’ll need to modify the STORE method to record the previous value, and the FETCH method to retrieve the last value. The special method TIESCALAR is a constructor of the object, we’ll just bless an empty array into the class.

We can also add new methods to the class—we’ll need one to provide all the historical values. The tied function returns the tied object.

```
#!/usr/bin/perl
use warnings;
use strict;
{ package Historical;
use Tie::Scalar;
use parent -norequire => 'Tie::StdScalar';
sub TIESCALAR { bless [], shift }
sub FETCH { $_[0][-1] }
sub STORE { push @{ $_[0] }, $_[1] }
sub history { $_[0] }
}
use Test::More tests => 2;
tie my $x, 'Historical';
$x = 'initial value';
$x = 'second value';
$x = 'last value';
is_deeply tied($x)->history,
[ 'initial value', 'second value', 'last value' ];
tie my $y, 'Historical';
$y = 10;
$y = 20;
$y -= 5;
is_deeply tied($y)->history,
[ 10, 20, 15 ];
```

## Leave a comment