RogerBW's Blog

I've been doing the Perl Weekly Challenges. This one dealt with finding the intersection of two lines and doing worrying things to innocent variables.

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.

The most interesting bit of this is the special and degenerate cases. The point of intersection of finite lines must lie within both lines, or it doesn't really count as an intersection.

Also the formula given on Wikipedia is subtly wrong.

I'm wasting slot 0 in each array, for convenience of transcription.

my @x;
my @y;
$x[1]=shift @ARGV;
$y[1]=shift @ARGV;
$x[2]=shift @ARGV;
$y[2]=shift @ARGV;
$x[3]=shift @ARGV;
$y[3]=shift @ARGV;
$x[4]=shift @ARGV;
$y[4]=shift @ARGV;

We can learn a bit just from the denominator, so calculate that first.

my $d=($x[1]-$x[2])*($y[3]-$y[4]) - ($y[1]-$y[2])*($x[3]-$x[4]);
if ($d==0) {
  die "Lines are parallel or coincident.\n";
}

t and u are the relative positions of the intersections along each segment (t=0 would put the intersection at (x1,y1), t=1 at (x2,y2)) so this lets us see whether the intersection falls outside the segment.

my $t=( ($x[1]-$x[3])*($y[3]-$y[4]) - ($y[1]-$y[3])*($x[3]-$x[4]) )/$d;
if ($t<0 || $t>1) {
  die "No intersection.\n";
}
my $u=( ($y[1]-$y[2])*($x[1]-$x[3]) -  ($x[1]-$x[2])*($y[1]-$y[3]) )/$d;
if ($u<0 || $u>1) {
  die "No intersection.\n";
}
$x[0]=$x[1]+$t*($x[2]-$x[1]);
$y[0]=$y[1]+$t*($y[2]-$y[1]);
print "$x[0] $y[0]\n";

The perl6 version is basically the same except for minor syntax changes.

The other challenge was a bit more surprising…

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;

It turns out there's a perl module that lets you arbitrarily tie stuff to variables. This is frankly terrifying in its potential for action at a distance, and I would think very carefully about using it in production code…

use Variable::Magic qw(wizard cast getdata);
use Storable qw(dclone);

my @history;

my $wiz=wizard(
  set => sub { if (ref ${$_[0]}) {push @history,dclone(${$_[0]})} else {push @history,${$_[0]}} },
);

cast my ($x),$wiz;
$x=10;
$x+=5;
$x=[20];
# push @{$x},25; # this doesn't work
$x={a => 30};
# $x->{b}=30; # this doesn't work either

use Data::Dumper;
print Dumper(\@history);

This almost works. Modifying a reference by means other than simply assigning a completely new value doesn't get caught. If the variable didn't have to be generic, one could apply it directly to a hash or list:

cast my (%x),$wiz;

with appropriate modifications to store into the history array, but I can't see a way to generalise this into working on an arbitrary object.