Re: Combine line segments to form a single line

The trick is you can connect to x1, y1 or to x2, y2. Depending on which one you choose, you also have to push the right coordinates to the resulting array:

#!/usr/bin/perl
use warnings;
use strict;

my @AoA = (
    [11,29, 10,25],
    [15,35, 11,29],
    [15,15, 11,21],
    [10,25, 11,21],
    [15,35, 21,39],
    [25,40, 21,39],
    [21,11, 25,10],
    [15,15, 21,11],
    [35,35, 29,39],
    [29,39, 25,40],
    [35,15, 29,11],
    [25,10, 29,11],
    [40,25, 39,29],
    [35,35, 39,29],
    [39,21, 40,25],
    [35,15, 39,21],
);

my @line = @{ shift @AoA };
while (@AoA) {
    my ($index) = grep {
            $AoA[$_][0] == $line[-2] && $AoA[$_][1] == $line[-1]
         or $AoA[$_][2] == $line[-2] && $AoA[$_][3] == $line[-1]
      } 0 .. $#AoA;
    if (defined $index) {
        my $new = splice @AoA, $index, 1;
        my $first = $new->[0] == $line[-2] ? 2 : 0;
        push @line, @{ $new }[$first, $first + 1];
    } else {
        die "No solution for @line[-2, -1]. (@line)\n";
    }
}

print "@line\n";
[download]

لսႽ† ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ

Comment on Re: Combine line segments to form a single line Download Code

Replies are listed 'Best First'.
Re^2: Combine line segments to form a single line by bangor (Monk) on Jan 13, 2014 at 13:58 UTC
Thanks choroba, that works on the sample data. Of course when I moved on to the next step (i.e. with variants of the data) I ran into another problem, see my comment below.	[reply]
Re^3: Combine line segments to form a single line by choroba (Cardinal) on Jan 13, 2014 at 14:48 UTC
In that case, you also need to be able to add new points to the beginning of the line: #!/usr/bin/perl use warnings; use strict; my @AoA = ( # [11,29, 10,25], [15,35, 11,29], [15,15, 11,21], [10,25, 11,21], [15,35, 21,39], [25,40, 21,39], [21,11, 25,10], [15,15, 21,11], [35,35, 29,39], [29,39, 25,40], [35,15, 29,11], [25,10, 29,11], [40,25, 39,29], [35,35, 39,29], [39,21, 40,25], [35,15, 39,21], ); my @line = @{ shift @AoA }; LINE: while (@AoA) { for my $index (0 .. $#AoA) { for my $indices ( [0, 1, -2, -1, 0, 0 + @line], [2, 3, -2, -1, 2, 0 + @line], [0, 1, 0, 1, 0, 0], [2, 3, 0, 1, 2, 0], ) { if ($AoA[$index][$indices->[0]] == $line[$indices->[2]] && $AoA[$index][$indices->[1]] == $line[$indices->[3]]) { my $new = splice @AoA, $index, 1; splice @$new, $indices->[4], 2; splice @line, $indices->[5], 0, @$new; next LINE } } } die "No solution for @line.\n"; } print "@line\n"; [download] لսႽ† ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ	[reply] [d/l]
Re^4: Combine line segments to form a single line by bangor (Monk) on Jan 13, 2014 at 15:23 UTC
Thanks choroba, I'm amazed how quickly you worked that. I will try to understand your code to solve my next problem but in the meantime I'll tell you what it is: when there is more than one line the code seems to go into an infinite loop - how to break out of the loop in that situation? (and sorry for being a pest) `my @AoA = ( [11,29, 10,25], [15,35, 11,29], [15,15, 11,21], [10,25, 11,21], [15,35, 21,39], [25,40, 21,39], [21,11, 25,10], [15,15, 21,11], [35,35, 29,39], [29,39, 25,40], [35,15, 29,11], [25,10, 29,11], [40,25, 39,29], [35,35, 39,29], [39,21, 40,25], [35,15, 39,21], [61,29, 60,25], [60,25, 61,21], );` [download]	[reply] [d/l]
Re^5: Combine line segments to form a single line by choroba (Cardinal) on Jan 13, 2014 at 15:44 UTC