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

Last change on this file since 20882 was 19561, checked in by ldp, 10 years ago

Increase max node id to 700M. Drop max nodes per way from 12k to 2k

  • 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( 700 * 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.