in reply to AoA data merging
Whether this is any easier I'm not sure, but it should be more efficient as the actual merge only requires one pass.
The idea is that you create a single AoA containing just the start points and end points of your road sections. You then sort the end points into reverse order. You can then process the sorted points in adjacent pairs (0&1,1&2,2&3 etc), and if the two are the same (within some definition of same given this is FP data), then you have found two sections that can be joined.
It requires that the AoA elements contain not only the x,y pair, but also a reference back to the section that they are a start or end point of, and a flag indicating which:
Given your array @data, you might use something like
my @ends = map{ [$_->[0], $_, 'S'], [$_->[-1], $_, 'E'] } @data;
to create the array of endpoints with references back to their parent sections, and a flag to differenciate between Start points and End points, chosen so that Starts will sort lexically before Ends (in reverse order).
You then sort that using something like
@ends = sort{ $b->[0]{X} <=> $a->[0]{X} || $b->[0]{Y} <=> $a->[0]{Y} || $b->[2] cmp $a->[2] } @ends;
Depending upon the accuracy of you data, you might need to introduce some fudge factor into the comparisons as is common with FP data, though this is probably best saved for later when you come to determining whether two adjacent points are the same.
Then the process of comparing and joining sections only requires a single pass. You might find this function useful for that.
sub mapAdjPairs (&@) { my $code = shift; map { local ($a, $b) = (shift, $_[0]); $code->() } 0 .. @_-2; }
Having created @ends and sorted it as above, your merge process becomes something like
my @merged = mapAdjPairs{ if ($a->[2] eq 'S') { # $a is a start point if ( $b->[2] eq 'E' and $a->[0]{X} == $b->[0]{X} # Introduce FP fudge factor if n +eeded and $a->[0]{Y} == $b->[0]{Y} ) { # $b is and end and we found a coincident end/start pair push @{ $b->[1] }, @{ $a->[1] }[1.. $#{$a->[1]} ]; return; # we merged two sections so don't add to result } else { # We have a start point and didn't merge so add to the +results return $a->[1]; } } return; } @ends, $ends[0]; # Note:Repeat first element last to complete cycle
Combine that all together produces the following output
c:\test>240810 X 11 Y 12 X 12 Y 13 X 13 Y 14 X 14 Y 15 X 15 Y 16 X 16 Y 17 X 17 + Y 18 X 18 Y 19 X 19 Y 20 X 10 Y 10 X 11 Y 11 X 12 Y 12 X 13 Y 13 X 14 Y 14 X 15 Y 15 X 16 + Y 16 X 17 Y 17 X 18 Y 18 X 19 Y 19 X 20 Y 20 X 21 Y 21 X 22 Y +22 X 23 Y 23 X 24 Y 24 X 1 Y 2 X 1 Y 3 X 1 Y 4 c:\test>
The process will work just as well for FP data, though you might need to fudge the comparisons as is quite usual.
The complete POC code and output
#! perl -slw use strict; # Steps through an array two at a time [0,1], the [1,2] etc sub mapAdjPairs (&@) { my $code = shift; map { local ($a, $b) = (shift, $_[0]); $code->() } 0 .. @_-2; } my @data = ( [ {X=>10, Y=>10}, {X=>11, Y=>11}, {X=>12, Y=>12}, ], [ {X=>11, Y=>12}, {X=>12, Y=>13}, {X=>13, Y=>14}, {X=>14, Y=>15}, +], [ {X=>20, Y=>20}, {X=>21, Y=>21}, {X=>22, Y=>22}, {X=>23, Y=>23}, +{X=>24, Y=>24}, ], [ {X=>17, Y=>17}, {X=>18, Y=>18}, {X=>19, Y=>19}, {X=>20, Y=>20}, +], [ {X=>01, Y=>02}, {X=>01, Y=>03}, {X=>01, Y=>04}, ], [ {X=>12, Y=>12}, {X=>13, Y=>13}, {X=>14, Y=>14}, {X=>15, Y=>15}, +{X=>16, Y=>16}, {X=>17, Y=>17}, ], [ {X=>14, Y=>15}, {X=>15, Y=>16}, {X=>16, Y=>17}, {X=>17, Y=>18}, +{X=>18, Y=>19}, {X=>19, Y=>20}, ], ); my @ends = sort{ $b->[0]{X} <=> $a->[0]{X} || $b->[0]{Y} <=> $a->[0]{Y} || $b->[2] cmp $a->[2] } map{ [$_->[0], $_, 'S'], [$_->[-1], $_, 'E'] } @data; my @merged = mapAdjPairs{ if ($a->[2] eq 'S') { # $a is a start point if ( $b->[2] eq 'E' and $a->[0]{X} == $b->[0]{X} # Introduce FP fudge factor if n +eeded and $a->[0]{Y} == $b->[0]{Y} ) { # $b is and end and we found a coincident end/start pair push @{ $b->[1] }, @{ $a->[1] }[1.. $#{$a->[1]} ]; return; # we merged two sections so don't add to result } else { # We have a start point and didn't merge so add to the +results return $a->[1]; } } return; } @ends, $ends[0]; # Note: repeat the first element as the last to com +plete the cycle # Display the results. print qq[ @{[ map{ qq[ @{[ %$_ ]} ] } @$_ ]} ] for @merged; __END__ c:\test>240810 X 11 Y 12 X 12 Y 13 X 13 Y 14 X 14 Y 15 X 15 Y 16 X 16 Y 1 +7 X 17 Y 18 X 18 Y 19 X 19 Y 20 X 10 Y 10 X 11 Y 11 X 12 Y 12 X 13 Y 13 X 14 Y 14 X 15 Y 1 +5 X 16 Y 16 X 17 Y 17 X 18 Y 18 X 19 Y 19 X 20 Y 20 X 21 +Y 21 X 22 Y 22 X 23 Y 23 X 24 Y 24 X 1 Y 2 X 1 Y 3 X 1 Y 4
|
|---|