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.06;
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

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
 '/',       => \&divide3,   # 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

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

philiprbrenan@yahoo.com, 2004

License

Perl License.