Triangle2
Triangles in 2D space
PhilipRBrenan@yahoo.com, 2004, Perl License
Synopsis
Example t/triangle2.t
#_ Triangle ___________________________________________________________
# Test 2d triangles
# philiprbrenan@yahoo.com, 2004, Perl License
#______________________________________________________________________
use Math::Zap::Triangle2;
use Math::Zap::Vector2;
use Test::Simple tests=>27;
$a = triangle2
(vector2(0, 0),
vector2(2, 0),
vector2(0, 2),
);
$b = triangle2
(vector2( 0, 0),
vector2( 4, 0),
vector2( 0, 4),
);
$c = triangle2
(vector2( 0, 0),
vector2(-4, 0),
vector2( 0, -4),
);
$d = $b - vector2(1,1);
$e = $c + vector2(1,1);
#print "a=$a\nb=$b\nc=$c\nd=$d\ne=$e\n";
ok($a->containsPoint(vector2( 1, 1)));
ok($a->containsPoint(vector2( 1, 1)));
ok($b->containsPoint(vector2( 2, 0)));
ok($b->containsPoint(vector2( 1, 0)));
ok($c->containsPoint(vector2(-1, 0)));
ok($c->containsPoint(vector2(-2, 0)));
ok($d->containsPoint(vector2( 1, -1)));
ok(!$a->containsPoint(vector2( 9, 1)));
ok(!$a->containsPoint(vector2( 1, 9)));
ok(!$b->containsPoint(vector2( 2, 9)));
ok(!$b->containsPoint(vector2( 9, 0)));
ok(!$c->containsPoint(vector2(-9, 0)));
ok(!$c->containsPoint(vector2(-2, 9)));
ok(!$d->containsPoint(vector2( 9, -1)));
ok( $a->containsPoint(vector2(0.5, 0.5)));
ok(!$a->containsPoint(vector2( -1, -1)));
ok(vector2(1,2)->rightAngle == vector2(-2, 1));
ok(vector2(1,0)->rightAngle == vector2( 0, 1));
ok($a->area == 2);
ok($c->area == 8);
eval { triangle2(vector2(0, 0), vector2(3, -6), vector2(-3, 6))};
ok($@ =~ /^Narrow triangle2/, 'Narrow triangle');
$t = triangle2(vector2(0,0),vector2(0,10),vector2( 10,0));
$T = triangle2(vector2(0,0),vector2(0,10),vector2(-10,10))+vector2(5, -2);
@p = $t->ring($T);
#print "$_\n" for(@p);
ok($p[0] == vector2(0, 8), 'Ring 0');
ok($p[1] == vector2(2, 8), 'Ring 1');
ok($p[2] == vector2(5, 5), 'Ring 2');
ok($p[3] == vector2(5, 0), 'Ring 3');
ok($p[4] == vector2(3, 0), 'Ring 4');
ok($p[5] == vector2(0, 3), 'Ring 5');Description
Triangles in 2d space
package Math::Zap::Triangle2;
$VERSION=1.07;
use Math::Zap::Line2;
use Math::Zap::Matrix2 new2v=>'matrix2New2v';
use Math::Zap::Vector2 check=>'vector2Check';
use Math::Zap::Vector check=>'vectorCheck';
use Math::Trig;
use Carp qw(cluck confess);
use constant debug => 0; # Debugging level
Constructors
new
Create a triangle from 3 vectors specifying the coordinates of each corner in space coordinates.
sub new($$$)
{vector2Check(@_) if debug;
my $t = bless {a=>$_[0], b=>$_[1], c=>$_[2]};
narrow($t, 1);
$t;
}
triangle2
Create a triangle from 3 vectors specifying the coordinates of each corner in space coordinates - synonym for "new".
sub triangle2($$$) {new($_[0],$_[1],$_[2])};
newnnc
New without narrowness check
sub newnnc($$$)
{vector2Check(@_) if debug;
bless {a=>$_[0], b=>$_[1], c=>$_[2]};
}
newV
Create a triangle from the x,y components of 3 3d vectors.
sub newV($$$)
{vectorCheck(@_) if debug;
my $t = bless
{a=>vector2($_[0]->{x}, $_[0]->{y}),
b=>vector2($_[1]->{x}, $_[1]->{y}),
c=>vector2($_[2]->{x}, $_[2]->{y})};
narrow($t, 1);
$t;
}
newVnnc
Create a triangle from the x,y components of 3 3d vectors without narrowness checking - assumes caller will do thir own.
sub newVnnc($$$)
{vectorCheck(@_) if debug;
bless
{a=>vector2($_[0]->{x}, $_[0]->{y}),
b=>vector2($_[1]->{x}, $_[1]->{y}),
c=>vector2($_[2]->{x}, $_[2]->{y})};
}
Methods
accuracy
Get/Set accuracy for comparisons
my $accuracy = 1e-10;
sub accuracy
{return $accuracy unless scalar(@_);
$accuracy = shift();
}
narrow
Narrow (colinear) colinear?
sub narrow($$)
{my $t = shift; # Triangle
my $a = 1e-2; # Accuracy
my $A = shift; # Action 0: return indicator, 1: confess
my $b = vector($t->{b}{x}-$t->{a}{x}, $t->{b}{y}-$t->{a}{y}, 0);
my $c = vector($t->{c}{x}-$t->{a}{x}, $t->{c}{y}-$t->{a}{y}, 0);
my $n = ($b x $c)->length < $a;
confess "Narrow triangle2" if $n and $A;
$n;
}
check
Check its a triangle
sub check(@)
{if (debug)
{for my $t(@_)
{confess "$t is not a triangle2" unless ref($t) eq __PACKAGE__;
}
}
@_;
}
is
Test its a triangle
sub is(@)
{for my $t(@_)
{return 0 unless ref($t) eq __PACKAGE__;
}
'triangle2';
}
components
Components of a triangle
sub a($) {check(@_) if debug; $_[0]->{a}}
sub b($) {check(@_) if debug; $_[0]->{b}}
sub c($) {check(@_) if debug; $_[0]->{c}}
sub ab($) {check(@_) if debug; ($_[0]->{b}-$_[0]->{a})}
sub ac($) {check(@_) if debug; ($_[0]->{c}-$_[0]->{a})}
sub ba($) {check(@_) if debug; ($_[0]->{a}-$_[0]->{b})}
sub bc($) {check(@_) if debug; ($_[0]->{c}-$_[0]->{b})}
sub ca($) {check(@_) if debug; ($_[0]->{a}-$_[0]->{c})}
sub cb($) {check(@_) if debug; ($_[0]->{b}-$_[0]->{c})}
sub abc($) {check(@_) if debug; ($_[0]->{a}, $_[0]->{b}, $_[0]->{c})}
sub lab($) {check(@_) if debug; line2($_[0]->{b}, $_[0]->{a})}
sub lac($) {check(@_) if debug; line2($_[0]->{c}, $_[0]->{a})}
sub lba($) {check(@_) if debug; line2($_[0]->{a}, $_[0]->{b})}
sub lbc($) {check(@_) if debug; line2($_[0]->{c}, $_[0]->{b})}
sub lca($) {check(@_) if debug; line2($_[0]->{a}, $_[0]->{c})}
sub lcb($) {check(@_) if debug; line2($_[0]->{b}, $_[0]->{c})}
clone
Create a triangle from another triangle
sub clone($)
{my ($t) = check(@_); # Triangle
bless {a=>$t->a, b=>$t->b, c=>$t->c};
}
permute
Cyclically permute the points of a triangle
sub permute($)
{my ($t) = check(@_); # Triangle
bless {a=>$t->b, b=>$t->c, c=>$t->a};
}
center
Center
sub center($)
{my ($t) = check(@_); # Triangle
($t->a + $t->b + $t->c) / 3;
}
area
Area
sub area($)
{my ($t) = check(@_); # Triangle
sqrt((($t->ab*$t->ab) * ($t->ac*$t->ac)) - ($t->ab * $t->ac))/2;
}
add
Add a vector to a triangle
sub add($$)
{my ($t) = check(@_[0..0]); # Triangle
my ($v) = vector2Check(@_[1..1]); # Vector
new($t->a+$v, $t->b+$v, $t->c+$v);
}
subtract
Subtract a vector from a triangle
sub subtract($$)
{my ($t) = check(@_[0..0]); # Triangle
my ($v) = vector2Check(@_[1..1]); # Vector
new($t->a-$v, $t->b-$v, $t->c-$v);
}
multiply
Multiply a triangle by a scalar
sub multiply($$)
{my ($t) = check(@_[0..0]); # Triangle
my ($s) = @_[1..1] ; # Scalar
new($t->a * $s, $t->b * $s, $t->c * $s);
}
divideBy
Divide a triangle by a scalar
sub divideBy($$)
{my ($t) = check(@_[0..0]); # Triangle
my ($s) = @_[1..1] ; # Scalar
$s != 0 or confess "Attempt to divide by zero";
new($t->a / $s, $t->b / $s, $t->c / $s);
}
Print triangle
sub print($)
{my ($t) = @_; # Triangle
check(@_) if debug;
my ($a, $b, $c) = ($t->a, $t->b, $t->c);
"triangle2($a, $b, $c)";
}
convertSpaceToPlane
Convert space to plane coordinates
sub convertSpaceToPlane($$)
{my ($t, $p) = @_;
check(@_[0..0]) if debug; # Triangle
vector2Check(@_[1..1]) if debug; # Vector
my $q = $p-$t->a;
vector2
($q * $t->ab / ($t->ab * $t->ab),
$q * $t->ac / ($t->ac * $t->ac),
);
}
containsPoint
Check whether point p is completely contained within triangle t.
sub containsPoint($$)
{my ($t, $p) = @_;
check(@_[0..0]) if debug; # Triangle
vector2Check(@_[1..1]) if debug; # Vector
my $s = matrix2New2v($t->ab, $t->ac) / ($p - $t->a);
return 1 if 0 <= $s->x and $s->x <= 1
and 0 <= $s->y and $s->y <= 1
and $s->x + $s->y <= 1;
0;
}
contains
Check whether triangle T is completely contained within triangle t.
sub contains($$)
{my ($t, $T) = @_;
check(@_) if debug; # Triangles
return 1 if $t->containsPoint($T->a) and
$t->containsPoint($T->b) and
$t->containsPoint($T->c);
0;
}
pointsInCommon
Find points in common to two triangles. A point in common is a point on the border of one triangle touched by the border of the other triangle.
sub pointsInCommon($$)
{my ($t, $T) = @_;
check(@_) if debug; # Triangles
return ($T->a, $T->b, $T->c) if $t->contains($T);
return ($t->a, $t->b, $t->c) if $T->contains($t);
my @p = ();
push @p, $t->a if $T->containsPoint($t->a);
push @p, $t->b if $T->containsPoint($t->b);
push @p, $t->c if $T->containsPoint($t->c);
push @p, $T->a if $t->containsPoint($T->a);
push @p, $T->b if $t->containsPoint($T->b);
push @p, $T->c if $t->containsPoint($T->c);
push @p, $t->lab->intersect($T->lab) if $t->lab->crossOver($T->lab);
push @p, $t->lab->intersect($T->lac) if $t->lab->crossOver($T->lac);
push @p, $t->lab->intersect($T->lbc) if $t->lab->crossOver($T->lbc);
push @p, $t->lac->intersect($T->lab) if $t->lac->crossOver($T->lab);
push @p, $t->lac->intersect($T->lac) if $t->lac->crossOver($T->lac);
push @p, $t->lac->intersect($T->lbc) if $t->lac->crossOver($T->lbc);
push @p, $t->lbc->intersect($T->lab) if $t->lbc->crossOver($T->lab);
push @p, $t->lbc->intersect($T->lac) if $t->lbc->crossOver($T->lac);
push @p, $t->lbc->intersect($T->lbc) if $t->lbc->crossOver($T->lbc);
# Remove duplicate points caused by splitting the vertices - inefficient and unreliable
my %p;
$p{"$_"}=$_ for(@p);
values(%p);
}
ring
Ring of points formed by overlaying triangle t and T
sub ring($$)
{my ($t, $T) = @_;
check(@_) if debug; # Triangles
my @p = $t->pointsInCommon($T);
# scalar(@p) == 1 and warn "Only one point in common";
# scalar(@p) == 2 and warn "Only two points in common";
return () unless scalar(@p) > 2;
# Find center
my $c = vector2(0,0);
$c += $_ for(@p);
$c /= scalar(@p);
# Split by y coord
my (@yp, @yn);
for my $p(0..@p-1)
{return () if ($p[$p]-$c)->length < $accuracy;
if (($p[$p]-$c)->y >= 0)
{push @yp, $p;
}
else
{push @yn, $p;
}
}
@yp = sort {($p[$a]-$c)->norm->x <=> ($p[$b]-$c)->norm->x} @yp;
@yn = sort {($p[$b]-$c)->norm->x <=> ($p[$a]-$c)->norm->x} @yn;
my @a;
push @a, $p[$_] for(@yp);
push @a, $p[$_] for(@yn);
@a;
}
convertPlaneToSpace
Convert plane to space coordinates
sub convertPlaneToSpace($$)
{my ($t, $p) = @_;
check(@_[0..0]) if debug; # Triangle
vector2Check(@_[1..1]) if debug; # Vector in plane
$t->a + ($p->x * $t->ab) + ($p->y * $t->ac);
}
split
Split a triangle into 4 sub triangles unless the sub triangles would be too small
sub split($$)
{my ($t) = check(@_[0..0]); # Triangles
my ($s) = (@_[1..1]); # Minimum size
return () unless
$t->ab->length > $s and
$t->ac->length > $s and
$t->bc->length > $s;
(new($t->a, ($t->a+$t->b)/2, ($t->a+$t->c)/2),
new($t->b, ($t->b+$t->a)/2, ($t->b+$t->c)/2),
new($t->c, ($t->c+$t->a)/2, ($t->c+$t->b)/2),
new(($t->a+$t->b)/2, ($t->a+$t->b)/2, ($t->b+$t->c)/2)
)
}
equals
Compare two triangles for equality
sub equals($$)
{my ($a, $b) = check(@_); # Triangles
my ($aa, $ab, $ac) = ($a->a, $a->b, $a->c);
my ($ba, $bb, $bc) = ($b->a, $b->b, $b->c);
my $d = $accuracy;
return 1 if
abs(($aa-$ba)->length) < $d and abs(($ab-$bb)->length) < $d and abs(($ac-$bc)->length) < $d or
abs(($aa-$ba)->length) < $d and abs(($ab-$bc)->length) < $d and abs(($ac-$bb)->length) < $d or
abs(($aa-$bb)->length) < $d and abs(($ab-$bc)->length) < $d and abs(($ac-$ba)->length) < $d or
abs(($aa-$bb)->length) < $d and abs(($ab-$ba)->length) < $d and abs(($ac-$bc)->length) < $d or
abs(($aa-$bc)->length) < $d and abs(($ab-$ba)->length) < $d and abs(($ac-$bb)->length) < $d or
abs(($aa-$bc)->length) < $d and abs(($ab-$bb)->length) < $d and abs(($ac-$ba)->length) < $d;
0;
}
Operators
Operator overloads
use overload
'+', => \&add3, # Add a vector
'-', => \&sub3, # Subtract a vector
'*', => \&multiply3, # Multiply by a scalar
'/', => \÷3, # Divide by a scalar
'==' => \&equals3, # Equals
'""' => \&print3, # Print
'fallback' => FALSE;
add
Add operator.
sub add3
{my ($a, $b, $c) = @_;
return $a->add($b);
}
subtract
Subtract operator.
sub sub3
{my ($a, $b, $c) = @_;
return $a->subtract($b);
}
multiply
Multiply operator.
sub multiply3
{my ($a, $b) = @_;
return $a->multiply($b);
}
divide
Divide operator.
sub divide3
{my ($a, $b, $c) = @_;
return $a->divideBy($b);
}
equals
Equals operator.
sub equals3
{my ($a, $b, $c) = @_;
return $a->equals($b);
}
Print a triangle
sub print3
{my ($a) = @_;
return $a->print;
}
Exports
Export "triangle2", "new", "newnnc", "newV", "newVnnc"
use Math::Zap::Exports qw(
triangle2 ($$$)
new ($$$)
newnnc ($$$)
newV ($$$)
newVnnc ($$$)
);
#_ Triangle2 ___________________________________________________________
# Package loaded successfully
#_______________________________________________________________________
1;
Credits
Author
philiprbrenan@yahoo.com
Copyright
philiprbrenan@yahoo.com, 2004
License
Perl License.