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

Last change on this file since 14515 was 11032, checked in by martinvoosterhout, 11 years ago

Up limits to 400 million nodes. Should really find something more flexible.

  • Property svn:executable set to *
File size: 10.4 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                };
175        }
176
177        # All done
178        closeXML();
179}
180
181sub MarkPoint
182{
183  my $x = shift;
184  my $y = shift;
185  my $type = shift;
186  print "P$type $x $y\n";
187}
188
189my $wanted_nodes = Bit::Vector->new( 400 * 1000 * 1000 );
190my(%nodes,%ways);
191my $totalways = 0;
192my $closed = 0;
193my $zero_length = 0;
194
195sub nodeProcessor
196{
197  my ($id,$lat,$long,$tagsRef,$main_line,$line) = @_;
198  if($wanted_nodes->contains($id)) {
199    $nodes{$id} = [$lat,$long];
200  }
201}
202
203sub wayProcessor
204{
205  my ($id,$tagsRef,$nodesRef,$main_line,$line) = @_;
206#  return unless scalar(grep{defined $tags{natural} and $tags{natural} eq "coastline";
207  if( scalar(@$nodesRef) <= 1)
208  { $zero_length++; return }
209  if( $nodesRef->[0] == $nodesRef->[-1] )
210  {
211    $closed++;
212    print "C1 $id\n";
213  }
214  else
215  {
216    $wanted_nodes->Bit_On( $nodesRef->[0] );
217    $wanted_nodes->Bit_On( $nodesRef->[-1] );
218    $ways{$id} = [$nodesRef->[0],$nodesRef->[-1]];
219    $totalways++;
220    if( $id == TRACE )
221    { print STDERR "Found way $id [$nodesRef->[0],$nodesRef->[-1]]\n" }
222  }
223}
224
225print STDERR "Pass 1: Collecting ways\n";
226# This assumes the ways come first, which may not always be the case
227processXML( \&nodeProcessor, \&wayProcessor, undef );
228print STDERR "$totalways collected, $closed closed, $zero_length zero-length\n";
229my $pass = 2;
230my $epsilon = EPSILON;
231my $ways_remain = $totalways;
232my $completed = 0;
233my $ways_output = 0;
234
235open TEMP, ">to-merge.txt" or die;
236
237for my $pass (2..4)
238{
239  print STDERR "Pass ${pass}: Starting with ",scalar(keys %ways)," ways (epsilon=$epsilon)\n";
240  print STDERR "Pass ${pass}a: Adding to R-Tree\n";
241
242  my $tree = new Tree::R();
243  # Add all begin points to the tree
244  for my $way (keys %ways)
245  {
246    if( not defined $nodes{$ways{$way}[0]} )
247    {
248      print STDERR "Missing node: $ways{$way}[0](way=$way)\n";
249      delete $ways{$way};
250      $ways_remain--;
251      next;
252    }
253    if( not defined $nodes{$ways{$way}[1]} )
254    {
255      print STDERR "Missing node: $ways{$way}[1](way=$way)\n";
256      delete $ways{$way};
257      $ways_remain--;
258      next;
259    }
260    my @coords = @{$nodes{$ways{$way}[0]}};
261    $tree->insert( $way, @coords, @coords );
262    if( $way == TRACE )
263    { print STDERR "Inserted into r-tree: id $way ($coords[0],$coords[1])\n" }
264  }
265
266  my $ways_used = new Bit::Vector( 300_000_000 );
267  print STDERR "Pass ${pass}b: Joining ways\n";
268  WAY: for my $way (keys %ways)
269  {
270    if( $way == TRACE )
271    { print STDERR "Joining $way used=", $ways_used->contains($way), "\n" }
272    next if $ways_used->contains($way);
273    for(;;)
274    {
275      my @coords = @{$nodes{$ways{$way}[1]}};
276      my @nearby;
277      $tree->query_completely_within_rect( $coords[0] - $epsilon, $coords[1] - $epsilon, $coords[0] + $epsilon, $coords[1] + $epsilon, \@nearby );
278
279      # This is a list of way_ids that start near the end of this way
280      my $match = undef;
281      my $mindist = 999;
282  #    print "Searching near [$coords[0],$coords[1]]\n";
283      for my $w (@nearby)
284      {
285  #      print "Way $way: testing '$w'\n";
286        if( $w == TRACE or $way == TRACE )
287        { print STDERR "Found way $w used=",$ways_used->contains($w)," way=$way\n" }
288        next if $ways_used->contains($w);
289        if( $ways{$w}[0] == $ways{$way}[1] )
290        { $match = $w; $mindist = 0; last }
291        my @coords2 = @{$nodes{$ways{$w}[0]}};
292        my $dist = ($coords[0]-$coords2[0])**2 + ($coords[1]-$coords2[1])**2;
293        if( $dist < $mindist )
294        {
295          $mindist = $dist;
296          $match = $w;
297        }
298      }
299      # If we loop around to ourselves and we link to no other nodes we bail. We want unclosed single ways to display
300      next WAY unless $mindist < 3 * $epsilon * $epsilon;
301      next WAY unless defined $match;
302      next WAY if $match == $way and scalar(@{$ways{$way}}) == 2 and $ways{$way}[0] != $ways{$way}[1];
303      if( $ways{$match}[0] != $ways{$way}[1]  and $mindist < 1e-8 )
304      {
305        print TEMP "$ways{$way}[1] $ways{$match}[0]\n";
306      }
307      if( $mindist > 0 )
308      {
309        MarkPoint( @coords, 2 );
310      }
311      if( $mindist > 0.05 )
312      {
313        MarkPoint( @{$nodes{$ways{$mindist}[0]}}, 2 );
314      }
315      if( $match == $way )
316      {
317        if( $match == TRACE )
318        { print STDERR "Closed way $way" }
319        OutputWay( $way, 1 );
320        $completed++;
321        $ways_remain--;
322        $ways_used->Bit_On($way);
323        last;
324      }
325      if( $way == TRACE or $match == TRACE )
326      { print STDERR "Appending to $way: $match, now $ways{$way}[0] -> $ways{$match}[1]\n" }
327      $ways_used->Bit_On($match);
328      $ways_remain--;
329      push @{ $ways{$way} }, $match;
330      $ways{$way}[1] = $ways{$match}[1];
331    }
332  }
333
334  print STDERR "Remain: $ways_remain / $totalways (complete $completed)\n";
335  print STDERR "Pass ${pass}c: Consolidate remaining\n";
336  my %new_ways;
337  my $consolidated = 0;
338  for my $way (keys %ways)
339  {
340    if( $way == TRACE )
341    { print STDERR "Consolidating $way: ",$ways_used->contains($way),"\n" }
342    next if $ways_used->contains($way);
343    my @list = Consolidate( \%ways, $way );
344    splice @list, 0, 1, $ways{$way}[0], $ways{$way}[1];
345    $new_ways{$way} = \@list;
346   
347  #  print "Consolidated $way: ($list[0] -> $list[1]) $way ",join(" ",@list[2..$#list]),"\n";
348    $consolidated++;
349  }
350  print STDERR "Consolidated: $consolidated\n";
351  %ways = %new_ways;
352  $epsilon *= 10;
353}
354print STDERR "Dumping remaining\n";
355for my $way (keys %ways)
356{
357  MarkPoint( @{$nodes{$ways{$way}[0]}}, 1 );
358  MarkPoint( @{$nodes{$ways{$way}[1]}}, 1 );
359  OutputWay($way, 0);
360}
361print STDERR "Total ways output: $ways_output\n";
362exit 0;
363
364sub Consolidate
365{
366  my $ways = shift;
367  my $way = shift;
368
369  if( $way == TRACE )
370  { print STDERR "Consolidate($way)\n" }
371  my @res = ($way);
372  if( not defined $ways{$way} )
373  {
374    if( $way == TRACE )
375    { print STDERR "Skippping\n" }
376    # This can happen after the first pass, then we don't remember the full details of each way anymore
377    return @res;
378  }
379  my @tmp = @{ $ways{$way} };
380  if( $way == TRACE )
381  { print STDERR "Subways: ", join(" ", @tmp[2..$#tmp]), "\n" }
382  for my $i (2..$#tmp)
383  {
384    push @res, Consolidate($ways, $tmp[$i]);
385  }
386  if( scalar(grep{$_ == TRACE} @res) )
387  { print STDERR "Found ",TRACE," as subway of $way\n" }
388  return @res;
389}
390
391sub OutputWay
392{
393  my $way = shift;
394  my $complete = shift;
395  my @list = Consolidate(\%ways, $way);
396  $ways_output += scalar(@list);
397  print "",($complete?"C":"I"),scalar(@list)," ",join(" ",@list),"\n";
398}
Note: See TracBrowser for help on using the repository browser.