source: subversion/applications/utils/coastcheck/merge-coastlines.pl @ 30195

Last change on this file since 30195 was 29237, checked in by pnorman, 7 years ago

Increase the maximum node in merge-coastlines.pl to 3b

  • Property svn:executable set to *
File size: 10.5 KB
Line 
1#!/usr/bin/perl -w
2
3use strict;
4use warnings;
5
6use Tree::R;
7use Bit::Vector;
8use Pod::Usage;
9
10use constant EPSILON => 0.001;
11use constant TRACE => 0;
12
13# Grab the filename
14my $xml = shift||'';
15pod2usage(1) unless $xml;
16
17# Check we can load the file
18if($xml eq "-") {
19        die("Sorry, reading from stdin is not supported, as we have to make several passes\n");
20}
21unless( -f $xml) {
22        die("Osm file '$xml' could not be found\n");
23}
24
25unless( -s $xml ) {
26    die " $xml has 0 size\n";
27}
28
29# Sub to open xml
30sub openXML {
31        if( $xml =~ /\.bz2$/ )
32        {
33          open(XML, "bzcat $xml |") or die($!);
34        }
35        elsif( $xml =~ /\.gz$/ )
36        {
37          open(XML, "zcat $xml |") or die($!);
38        }
39        else
40        {
41          open(XML, "<$xml") or die("$!");
42        }
43        #open(XML, "<:utf8","$xml") or die("$!");
44}
45# Sub to close xml
46sub closeXML {
47        close XML;
48}
49
50sub processXML {
51        my ($nodeH, $wayH, $relH) = @_;
52        openXML();
53#       $pass++;
54
55        # Process the file, giving tags to the helpers that like them
56
57        # Hold the main line, tags and segs of the tag
58        my $main_line;
59        my $main_type;
60        my $wanted;
61        my @tags;
62        my @nodes;
63        my @rel_ways;
64        my @rel_nodes;
65
66        my $startNewTag = sub{
67                $wanted = 0;
68                @tags = ();
69                @nodes = ();
70                @rel_ways = ();
71                @rel_nodes = ();
72        };
73
74        while(my $line = <XML>) {
75                if($line =~ /^\s*<node/) {
76                        $main_line = $line;
77                        $main_type = "node";
78                        &$startNewTag();
79                        unless($line =~ /\/>\s*$/) { next; }
80                }
81                elsif($line =~ /^\s*\<way/) {
82                        $main_line = $line;
83                        $main_type = "way";
84                        &$startNewTag();
85                        unless($line =~ /\/>\s*$/) { next; }
86                }
87                elsif($line =~ /^\s*<relation/) {
88                        $main_line = $line;
89                        $main_type = "relation";
90                        &$startNewTag();
91                        unless($line =~ /\/>\s*$/) { next; }
92                }
93
94                if($line =~ /^\s*\<tag/) {
95                        my ($name,$value) = ($line =~ /^\s*\<tag k=[\'\"](.*?)[\'\"] v=[\'\"](.*?)[\'\"]/);
96                        unless($name) { 
97                                unless($line =~ /k="\s*" v="\s*"/) {
98                                        warn "Invalid line '$line'"; 
99                                }
100                                next; 
101                        }
102                        my @tag = ($name,$value);
103                        push @tags, \@tag;
104                }
105                elsif($line =~ /^\s*\<nd /) {
106                        my ($ref) = ($line =~ /^\s*\<nd ref=[\'\"](\d+)[\'\"]/);
107                        unless($main_type eq "way") { warn "Got nd when in $main_type\n"; next; }
108                        unless($ref) { warn "Invalid line '$line'"; next; }
109                        push @nodes, $ref;
110                }
111                elsif($line =~ /^\s*\<member /) {
112                        my ($type,$ref,$role) = ($line =~ /^\s*\<member type=[\'\"](.*?)[\'\"] ref=[\'\"](\d+)[\'\"] role=[\'\"](.*)[\'\"]/);
113                        unless($main_type eq "relation") { warn "Got member when in $main_type\n"; next; }
114                        unless($type && $ref) { warn "Invalid line '$line'"; next; }
115
116                        my %m;
117                        $m{'type'} = $type;
118                        $m{'ref'} = $ref;
119                        $m{'role'} = $role;
120                        if($type eq "node") {
121                                push @rel_nodes, \%m;
122                        } elsif($type eq "way") {
123                                push @rel_ways, \%m;
124                        } else {
125                                warn("Got unknown member type '$type' in '$line'"); next;
126                        }
127                }
128
129                # Do the decisions when closing tags - can be self closing
130                elsif($line =~ /^\s*<\/?node/) {
131                        my ($id,$lat,$long) = ($main_line =~ /^\s*<node id=['"](\d+)['"].* lat=['"]?(\-?[\d\.]+)['"]? lon=['"]?(\-?[\d\.]+e?\-?\d*)['"]?/);
132
133                        unless($id) { warn "Invalid node line '$main_line'"; next; }
134                        unless($main_type eq "node") { warn "$main_type ended with $line"; next; }
135                        if($nodeH) {
136                                &$nodeH($id,$lat,$long,\@tags,$main_line,$line);
137                        }
138                }
139                elsif($line =~ /^\s*\<\/?way/) {
140                        my ($id) = ($main_line =~ /^\s*\<way id=[\'\"](\d+)[\'\"]/);
141
142                        unless($id) { warn "Invalid way line '$main_line'"; next; }
143                        unless($main_type eq "way") { warn "$main_type ended with $line"; next; }
144                        if($wayH) {
145                                &$wayH($id,\@tags,\@nodes,$main_line,$line);
146                        }
147                }
148                elsif($line =~ /^\s*<\/?relation/) {
149                        my ($id) = ($main_line =~ /^\s*\<relation id=[\'\"](\d+)[\'\"]/);
150
151                        unless($id) { warn "Invalid relation line '$main_line'"; next; }
152                        unless($main_type eq "relation") { warn "$main_type ended with $line"; next; }
153                        if($relH) {
154                                &$relH($id,\@tags,\@rel_nodes,\@rel_ways,$main_line,$line);
155                        }
156                }
157                elsif($line =~ /^\s*\<\?xml/) {
158#                       if($pass == 1) {
159#                               print $line;
160#                       }
161                }
162                elsif($line =~ /^\s*\<osm /) {
163#                       if($pass == 1) {
164#                               print $line;
165#                       }
166                }
167                elsif($line =~ /^\s*\<\/osm\>/ ) {
168#                       if($pass == 3) {
169#                               print $line;
170#                       }
171                }
172                else {
173                        print STDERR "Unknown line $line\n";
174                        exit 1;
175                };
176        }
177
178        # All done
179        closeXML();
180}
181
182sub MarkPoint
183{
184  my $x = shift;
185  my $y = shift;
186  my $type = shift;
187  print "P$type $x $y\n";
188}
189
190my $wanted_nodes = Bit::Vector->new( 3000 * 1000 * 1000 );
191my(%nodes,%ways);
192my $totalways = 0;
193my $closed = 0;
194my $zero_length = 0;
195
196sub nodeProcessor
197{
198  my ($id,$lat,$long,$tagsRef,$main_line,$line) = @_;
199  if($wanted_nodes->contains($id)) {
200    $nodes{$id} = [$lat,$long];
201  }
202}
203
204sub wayProcessor
205{
206  my ($id,$tagsRef,$nodesRef,$main_line,$line) = @_;
207#  return unless scalar(grep{defined $tags{natural} and $tags{natural} eq "coastline";
208  if( scalar(@$nodesRef) <= 1)
209  { $zero_length++; return }
210  if( $nodesRef->[0] == $nodesRef->[-1] )
211  {
212    $closed++;
213    print "C1 $id\n";
214  }
215  else
216  {
217    $wanted_nodes->Bit_On( $nodesRef->[0] );
218    $wanted_nodes->Bit_On( $nodesRef->[-1] );
219    $ways{$id} = [$nodesRef->[0],$nodesRef->[-1]];
220    $totalways++;
221    if( $id == TRACE )
222    { print STDERR "Found way $id [$nodesRef->[0],$nodesRef->[-1]]\n" }
223  }
224}
225
226print STDERR "Pass 1: Collecting ways\n";
227# This assumes the ways come first, which may not always be the case
228processXML( \&nodeProcessor, \&wayProcessor, undef );
229print STDERR "$totalways collected, $closed closed, $zero_length zero-length\n";
230my $pass = 2;
231my $epsilon = EPSILON;
232my $ways_remain = $totalways;
233my $completed = 0;
234my $ways_output = 0;
235
236open TEMP, ">to-merge.txt" or die;
237
238for my $pass (2..4)
239{
240  print STDERR "Pass ${pass}: Starting with ",scalar(keys %ways)," ways (epsilon=$epsilon)\n";
241  print STDERR "Pass ${pass}a: Adding to R-Tree\n";
242
243  my $tree = new Tree::R();
244  # Add all begin points to the tree
245  for my $way (keys %ways)
246  {
247    if( not defined $nodes{$ways{$way}[0]} )
248    {
249      print STDERR "Missing node: $ways{$way}[0](way=$way)\n";
250      delete $ways{$way};
251      $ways_remain--;
252      next;
253    }
254    if( not defined $nodes{$ways{$way}[1]} )
255    {
256      print STDERR "Missing node: $ways{$way}[1](way=$way)\n";
257      delete $ways{$way};
258      $ways_remain--;
259      next;
260    }
261    my @coords = @{$nodes{$ways{$way}[0]}};
262    $tree->insert( $way, @coords, @coords );
263    if( $way == TRACE )
264    { print STDERR "Inserted into r-tree: id $way ($coords[0],$coords[1])\n" }
265  }
266
267  my $ways_used = new Bit::Vector( 300_000_000 );
268  print STDERR "Pass ${pass}b: Joining ways\n";
269  WAY: for my $way (keys %ways)
270  {
271    if( $way == TRACE )
272    { print STDERR "Joining $way used=", $ways_used->contains($way), "\n" }
273    next if $ways_used->contains($way);
274    for(;;)
275    {
276      my @coords = @{$nodes{$ways{$way}[1]}};
277      my @nearby;
278      $tree->query_completely_within_rect( $coords[0] - $epsilon, $coords[1] - $epsilon, $coords[0] + $epsilon, $coords[1] + $epsilon, \@nearby );
279
280      # This is a list of way_ids that start near the end of this way
281      my $match = undef;
282      my $mindist = 999;
283  #    print "Searching near [$coords[0],$coords[1]]\n";
284      for my $w (@nearby)
285      {
286  #      print "Way $way: testing '$w'\n";
287        if( $w == TRACE or $way == TRACE )
288        { print STDERR "Found way $w used=",$ways_used->contains($w)," way=$way\n" }
289        next if $ways_used->contains($w);
290        if( $ways{$w}[0] == $ways{$way}[1] )
291        { $match = $w; $mindist = 0; last }
292        my @coords2 = @{$nodes{$ways{$w}[0]}};
293        my $dist = ($coords[0]-$coords2[0])**2 + ($coords[1]-$coords2[1])**2;
294        if( $dist < $mindist )
295        {
296          $mindist = $dist;
297          $match = $w;
298        }
299      }
300      # If we loop around to ourselves and we link to no other nodes we bail. We want unclosed single ways to display
301      next WAY unless $mindist < 3 * $epsilon * $epsilon;
302      next WAY unless defined $match;
303      next WAY if $match == $way and scalar(@{$ways{$way}}) == 2 and $ways{$way}[0] != $ways{$way}[1];
304      if( $ways{$match}[0] != $ways{$way}[1]  and $mindist < 1e-8 )
305      {
306        print TEMP "$ways{$way}[1] $ways{$match}[0]\n";
307      }
308      if( $mindist > 0 )
309      {
310        MarkPoint( @coords, 2 );
311      }
312      if( $mindist > 0.05 )
313      {
314        MarkPoint( @{$nodes{$ways{$mindist}[0]}}, 2 );
315      }
316      if( $match == $way )
317      {
318        if( $match == TRACE )
319        { print STDERR "Closed way $way" }
320        OutputWay( $way, 1 );
321        $completed++;
322        $ways_remain--;
323        $ways_used->Bit_On($way);
324        last;
325      }
326      if( $way == TRACE or $match == TRACE )
327      { print STDERR "Appending to $way: $match, now $ways{$way}[0] -> $ways{$match}[1]\n" }
328      $ways_used->Bit_On($match);
329      $ways_remain--;
330      push @{ $ways{$way} }, $match;
331      $ways{$way}[1] = $ways{$match}[1];
332    }
333  }
334
335  print STDERR "Remain: $ways_remain / $totalways (complete $completed)\n";
336  print STDERR "Pass ${pass}c: Consolidate remaining\n";
337  my %new_ways;
338  my $consolidated = 0;
339  for my $way (keys %ways)
340  {
341    if( $way == TRACE )
342    { print STDERR "Consolidating $way: ",$ways_used->contains($way),"\n" }
343    next if $ways_used->contains($way);
344    my @list = Consolidate( \%ways, $way );
345    splice @list, 0, 1, $ways{$way}[0], $ways{$way}[1];
346    $new_ways{$way} = \@list;
347   
348  #  print "Consolidated $way: ($list[0] -> $list[1]) $way ",join(" ",@list[2..$#list]),"\n";
349    $consolidated++;
350  }
351  print STDERR "Consolidated: $consolidated\n";
352  %ways = %new_ways;
353  $epsilon *= 10;
354}
355print STDERR "Dumping remaining\n";
356for my $way (keys %ways)
357{
358  MarkPoint( @{$nodes{$ways{$way}[0]}}, 1 );
359  MarkPoint( @{$nodes{$ways{$way}[1]}}, 1 );
360  OutputWay($way, 0);
361}
362print STDERR "Total ways output: $ways_output\n";
363exit 0;
364
365sub Consolidate
366{
367  my $ways = shift;
368  my $way = shift;
369
370  if( $way == TRACE )
371  { print STDERR "Consolidate($way)\n" }
372  my @res = ($way);
373  if( not defined $ways{$way} )
374  {
375    if( $way == TRACE )
376    { print STDERR "Skippping\n" }
377    # This can happen after the first pass, then we don't remember the full details of each way anymore
378    return @res;
379  }
380  my @tmp = @{ $ways{$way} };
381  if( $way == TRACE )
382  { print STDERR "Subways: ", join(" ", @tmp[2..$#tmp]), "\n" }
383  for my $i (2..$#tmp)
384  {
385    push @res, Consolidate($ways, $tmp[$i]);
386  }
387  if( scalar(grep{$_ == TRACE} @res) )
388  { print STDERR "Found ",TRACE," as subway of $way\n" }
389  return @res;
390}
391
392sub OutputWay
393{
394  my $way = shift;
395  my $complete = shift;
396  my @list = Consolidate(\%ways, $way);
397  $ways_output += scalar(@list);
398  print "",($complete?"C":"I"),scalar(@list)," ",join(" ",@list),"\n" or die "Output error ($!)\n";
399}
400
Note: See TracBrowser for help on using the repository browser.