unless ( ($p1 == $p2) || $found->{$p2}->{$p1} ) {
####
$found->{$p2}->{$p1} = 1;
####
$found->{$p1}->{$p2} = 1;
####
my %found; ## instead of my $found = {};
...
unless ( ($p1 == $p2) || $found{ "$p2|$p1" } ) {
...
$found->{ "$p1|$p2" } = 1;
####
#!/usr/bin/perl
use YAML qw(Load);
use Data::Dumper;
use Carp;
use Benchmark;
use strict;
my $precision = 7;
my $delta = 10 ** (-$precision);
my $points; # hash ref holding the raw data {'1' => [X,Y], '2' => [X,Y], ...}
{
local $/;
open(my $fh, "dump_301.dat") or die "Unable to open file: $!\n";
$points = Load( <$fh> );
croak($@) if $@;
close($fh);
}
my $start_pairs = Benchmark->new;
my $edges = find_unique_edges($points);
print "Unique edges ", scalar(@{$edges}), "\n";
print "Pairs parsed in :", timestr(timediff(Benchmark->new, $start_pairs)), "\n";
my $start_intersects = Benchmark->new;
my $neighborEdges = find_unintersected_edges($edges);
print "Unintersected edges ", scalar(keys %{$neighborEdges}), "\n";
print "Intersects parsed in :", timestr(timediff(Benchmark->new, $start_intersects)), "\n";
sub find_unique_edges {
my $MAP = shift;
my @edges; # returnable data structure
my $start_distance = Benchmark->new;
my %found;
# p1 is starting or anchor point of the line segment
foreach my $p1 ( @{ $points } ) {
# p2 is end point of the line segment
foreach my $p2 ( @{ $points } ) {
# We don't need to caculate if anchor and end are the same
# or we have already seen these two pairs [reversed] before
unless( $p1 == $p2 or $found{ "$p2|$p1" } ) {
my $edge = sqrt(
( $p1->[0] - $p2->[0] ) **2 +
( $p1->[1] - $p2->[1] ) **2
);
push @edges, [ $edge, $p1->[0], $p1->[1], $p2->[0], $p2->[1] ];
$found{ "$p1|$p2" } = 1;
}
}
}
return \@edges;
}
sub find_unintersected_edges {
my $PAIRS = shift;
my $neighborEdges; # returnable data structure
my $neighboorCNT = 1;
foreach my $aref ( sort {$a->[0] <=> $b->[0] } @{$PAIRS}) {
my $neighbor = 1;
my @line_1_ref;
push @line_1_ref, [ $aref->[ 1 ],$aref->[ 2 ] ]; # line 1 point A X,Y
push @line_1_ref, [ $aref->[ 3 ],$aref->[ 4 ] ]; # line 1 point B X,Y
for( my $n=1; $n <= $neighboorCNT; $n++ ) {
if( $neighborEdges->{ $n } ) {
my @points;
push @points, @line_1_ref; # line 1 points
push @points, [ $neighborEdges->{ $n }[ 1 ], $neighborEdges->{ $n }[ 2 ] ]; # line 2 point A X,Y
push @points, [ $neighborEdges->{ $n }[ 3 ], $neighborEdges->{ $n }[ 4 ] ]; # line 2 point B X,Y
# If a intersect is found, set false and quit checking
if( SegmentIntersection( @points ) ) {
$neighbor = 0;
last;
}
}
}
if( $neighbor ) {
$neighborEdges->{ $neighboorCNT } = $aref;
$neighboorCNT++;
}
}
return $neighborEdges ;
}
sub SegmentIntersection {
my @p1 = @{ $_[0] }; # p1,p2 = segment 1
my @p2 = @{ $_[1] };
my @p3 = @{ $_[2] }; # p3,p4 = segment 2
my @p4 = @{ $_[3] };
my $d = Determinant( $p2[0] - $p1[0], $p3[0] - $p4[0], $p2[1] - $p1[1], $p3[1] - $p4[1] );
if( abs( $d ) < $delta ) {
return 0; # parallel
}
my $n1 = Determinant( $p3[0] - $p1[0], $p3[0] - $p4[0], $p3[1] - $p1[1], $p3[1] - $p4[1] );
my $n2 = Determinant( $p2[0] - $p1[0], $p3[0] - $p1[0], $p2[1] - $p1[1], $p3[1] - $p1[1] );
if( !( $n1/$d < 1 and $n2/$d < 1 and $n1/$d > 0 and $n2/$d > 0 ) ) {
return 0;
}
return 1;
}
sub Determinant {
use integer;
return $_[0] * $_[1] - $_[2] * $_[3];
}
__END__
P:\test>480481.pl
"my" variable $edges masks earlier declaration in same scope at P:\test\480481.pl line 25.
"my" variable $neighborEdges masks earlier declaration in same scope at P:\test\480481.pl line 30.
Unique edges 90300
Pairs parsed in : 1 wallclock secs ( 1.72 usr + 0.02 sys = 1.73 CPU)
Unintersected edges 1778
Intersects parsed in :786 wallclock secs (763.19 usr + 0.55 sys = 763.74 CPU)
__second__
P:\test>480481.pl
Unique edges 90300
Pairs parsed in : 2 wallclock secs ( 1.77 usr + 0.02 sys = 1.78 CPU)
Unintersected edges 3299
Intersects parsed in :729 wallclock secs (711.84 usr + 0.86 sys = 712.70 CPU)
__third__
P:\test>480481.pl
Unique edges 45150
Pairs parsed in : 1 wallclock secs ( 1.28 usr + 0.03 sys = 1.31 CPU)
Unintersected edges 1699
Intersects parsed in :223 wallclock secs (217.66 usr + 0.22 sys = 217.87 CPU)
__fourth__
P:\test>480481.pl
Unique edges 45150
Pairs parsed in : 2 wallclock secs ( 1.27 usr + 0.03 sys = 1.30 CPU)
Unintersected edges 1699
Intersects parsed in :191 wallclock secs (186.78 usr + 0.22 sys = 187.00 CPU)
__fifth__
P:\test>480481.pl
Unique edges 45150
Pairs parsed in : 1 wallclock secs ( 1.25 usr + 0.05 sys = 1.30 CPU)
Unintersected edges 1699
Intersects parsed in :191 wallclock secs (186.95 usr + 0.11 sys = 187.06 CPU)
__sixth__
P:\test>480481.pl
Unique edges 45150
Pairs parsed in : 2 wallclock secs ( 1.30 usr + 0.03 sys = 1.33 CPU)
Unintersected edges 1699
Intersects parsed in :177 wallclock secs (173.06 usr + 0.23 sys = 173.30 CPU)