|
Re: Combine line segments to form a single line
by tobyink (Canon) on Jan 12, 2014 at 20:32 UTC
|
If we can assume that the segments always form a cycle (the ones in your example do), then the Graph module's find_a_cycle method seems to do the trick...
use Graph;
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 $graph = Graph::Undirected->new;
for my $pair (@AoA)
{
my ($x1, $y1, $x2, $y2) = @$pair;
$graph->add_edge("$x1,$y1", "$x2,$y2");
}
print "$_\n" for $graph->find_a_cycle;
If the points are not guaranteed to form a cycle, then I think Graph is still a good place to start.
use Moops; class Cow :rw { has name => (default => 'Ermintrude') }; say Cow->new->name
| [reply]
[d/l]
[select] |
|
|
Thanks tobyink. The Graph modules will certainly be of use in my project. When I was looking on CPAN I was concentrating on geometry, not graphs, so that opens up some new possibilities for me.
| [reply] |
Re: Combine line segments to form a single line
by choroba (Cardinal) on Jan 12, 2014 at 20:32 UTC
|
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";
| [reply]
[d/l] |
|
|
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] |
|
|
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";
| [reply]
[d/l] |
|
|
|
|
Re: Combine line segments to form a single line
by bangor (Monk) on Jan 13, 2014 at 16:21 UTC
|
Thanks to tobyink for pointing me in the Graph direction I have found a simple solution:
use Graph;
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],
);
my $graph = Graph::Undirected->new;
for my $pair (@AoA) {
my ($x1, $y1, $x2, $y2) = @$pair;
$graph->add_edge("$x1,$y1", "$x2,$y2");
}
my @lines = $graph->connected_components();
for my $line (@lines) {
print "@$line\n";
}
# Result
35,15 39,21 40,25 39,29 35,35 29,39 25,40 21,39 15,35 11,29 10,25 11,2
+1 15,15 21,11 25,10 29,11
61,21 60,25 61,29
| [reply]
[d/l] |
Re: Combine line segments to form a single line
by LanX (Saint) on Jan 12, 2014 at 20:13 UTC
|
update
Apparently I misunderstood the question, plz ignore this post!
Never mind! =)
like this?
DB<100> @AoA = (
[11,29, 10,25],
[15,35, 11,29],
[15,15, 11,21],
[10,25, 11,21]
)
DB<101> @flat = map { @$_ } @AoA
=> (11, 29, 10, 25, 15, 35, 11, 29, 15, 15, 11, 21, 10, 25, 11, 21)
Cheers Rolf
( addicted to the Perl Programming Language)
| [reply]
[d/l] |
|
|
next try
(not really trivial)
use warnings;
use strict;
use Data::Dump;
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 %neighbor;
for ( @AoA) {
my ($a,$b)= ("@$_[0,1]", "@$_[2,3]") ;
push @{$neighbor{$b}}, $a;
push @{$neighbor{$a}}, $b;
};
#dd \%neighbor;
#--- init
my $next;
my @path;
my ($last,$current)=("11,29","10,25"); # start
push @path, $last, $current;
delete $neighbor{$last};
while ( %neighbor) {
my $a_neighbors = delete $neighbor{$current};
die "Data corrupt: $current has no more neighbors" unless $a_neighbo
+rs;
($next) = grep { $_ ne $last } @$a_neighbors;
($last,$current)=($current,$next);
push @path, $current ;
}
#dd \@path;
my @flat= map { split ",", $_ } @path;
print join ",", @flat;
output
11,29,10,25,11,21,15,15,21,11,25,10,29,11,35,15,39,21,40,25,39,29,35,3
+5,29,39,25,40,21,39,15,35,11,29
Cheers Rolf
( addicted to the Perl Programming Language)
| [reply]
[d/l]
[select] |
|
|
Thanks Rolf, that is very similar to the approach I was attempting myself. Unfortunately it only works when the line segments represent a complete cycle - see my comment below.
| [reply] |
|
|
Re: Combine line segments to form a single line
by bangor (Monk) on Jan 13, 2014 at 13:58 UTC
|
Thanks for the replies, much appreciated. All the solutions work on the data I supplied in my original post. As tobyink says the segment samples I gave form a cycle but when I try the solutions on segments that don't form a cycle I run into a problem. For example, if I take out one of the segments and use choroba's solution I get three lines.
my @AoA = (
# removed [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],
);
# Result
(15,35, 11,29)
(15,15, 11,21, 10,25)
(15,35, 21,39, 25,40, 29,39, 35,35, 39,29, 40,25, 39,21, 35,15, 29,11,
+ 25,10, 21,11, 15,15)
It seems to depend on which point I pick to start with, so if I pick a point at the end or start of the line it will work (where the break is), but I don't know in advance what these points are. Here is the same data with the segments re-arranged so the break point is at the start:
my @AoA = (
# removed [11,29, 10,25],
[10,25, 11,21],
[15,35, 11,29],
[15,15, 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],
);
# Result
(10,25, 11,21, 15,15, 21,11, 25,10, 29,11, 35,15, 39,21, 40,25, 39,29,
+ 35,35, 29,39, 25,40, 21,39, 15,35, 11,29)
| [reply]
[d/l]
[select] |
Re: Combine line segments to form a single line
by Laurent_R (Canon) on Jan 13, 2014 at 07:48 UTC
|
This example is not sufficient, please explain how you select the points that your are using and the order in which you select them.
| [reply] |
|
|
Hi Laurent. I am using a contouring algorithm to produce the line segments. The algorithm processes a matrix four points at a time to see if the square formed by those points contains a contour line. If it does then a line segment is produced. I can provide more information on the process if you need it.
| [reply] |