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

Examine what is said, not who speaks.
1) When a distinguished but elderly scientist states that something is possible, he is almost certainly right. When he states that something is impossible, he is very probably wrong.
2) The only way of discovering the limits of the possible is to venture a little way past them into the impossible
3) Any sufficiently advanced technology is indistinguishable from magic.
Arthur C. Clarke.

In reply to Re: AoA data merging by BrowserUk
in thread AoA data merging by jasonk

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.