- Triangle2

- Synopsis
- Description
- Constructors

- new
- triangle2
- newnnc
- newV
- newVnnc

- Methods

- accuracy
- narrow
- check
- is
- components
- clone
- permute
- center
- area
- add
- subtract
- multiply
- divideBy
- print
- convertSpaceToPlane
- containsPoint
- contains
- pointsInCommon
- ring
- convertPlaneToSpace
- split
- equals
- Operators
- add
- subtract
- multiply
- divide
- equals
- print

- Exports
- Credits

- Author
- Copyright
- License

# 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.03;
     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

### Copyright

philiprbrenan@yahoo.com, 2004

### License

Perl License.