source: subversion/applications/utils/gary68/boundaries.pl @ 26424

Last change on this file since 26424 was 26172, checked in by gary68, 8 years ago

boundaries.pl v3.3 -ignoremissing

  • Property svn:keywords set to Date Author Revision
File size: 44.8 KB
Line 
1#!/usr/bin/perl
2#
3#  $Revision: 26172 $ by $Author: gary68 $, $Date: 2011-06-24 18:33:33 +0000 (Fri, 24 Jun 2011) $
4#
5# boundaries.pl by gary68
6#
7#
8#
9# Copyright (C) 2009/2010, Gerhard Schwanz
10#
11# This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the
12# Free Software Foundation; either version 3 of the License, or (at your option) any later version.
13#
14# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
15# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16#
17# You should have received a copy of the GNU General Public License along with this program; if not, see <http://www.gnu.org/licenses/>
18#
19#
20#
21# IN:  file.osm
22#
23# OUT: file.htm (list)
24# OUT: file.csv (list)
25# OUT: file.hierarchy.htm (list)
26# OUT: file.hierarchy.csv (list)
27# OUT: file.XXXXX.poly (borders original)
28# OUT: file.Simplified.XXXXX.poly (borders simplified)
29# OUT: file.Resized.XXXXX.poly (borders resized and potentially simplified)
30# OUT: file.XXXXX.png (map of border)
31#
32# relation member roles used: outer and none
33#
34# parameters and options see below
35#
36# Version 2
37# - find hierarchies and report
38# - use simplified polygons for hierarchy if specified
39# - time calc
40# - error handling for relations caontaining themselves as member
41# - check for max nesting level when parsing relation members being relations (prevent loops eating memory and terminate program)
42# - resize option (-resize, -factor (float > 1.0)
43# - pics with resized polygons
44# - distinguish between invalid and selected
45# - qualify invalid relation list with causes of errors
46#
47# Version 3
48# - support multipolygons, multiple border segments
49#
50# Version 3.1
51# - command line error handling
52#
53# Version 3.2
54# - handle rels without node properly
55#
56# Version 3.3
57# - ignoreMissingWaysAndNodes
58#
59
60use strict ;
61use warnings ;
62
63use File::stat ;
64use Time::localtime ; 
65use Getopt::Long ;
66use Math::Polygon ;
67
68use OSM::osm 4.4 ;
69use OSM::osmgraph ;
70
71
72my $program = "boundaries.pl" ;
73my $version = "3.3" ;
74my $usage = $program . <<"END1" ;
75-help print this text
76-in= osm file name (input file, mandatory) 
77-html= output file name (defaults to boundaries.htm) 
78-csv= output file name (defaults to boundaries.csv) 
79-poly create polygons
80-polybase= poly base file name (like germany or tmp/germany) used to create output file names for relations. id is appended. (defaults to polygon)
81-pics create pictures of polygons (valid and selected) 
82-picsize=integer size in pixels for the longitude of the maps. latitude will be automatically calculated. 
83-allpics create pictures of all polygons (-pics must be given, >=V3) 
84-bigpic create picture of all (selected) boundaries (>=V3) 
85-bigpicsize=integer size in pixels for the longitude of the big map. latitude will be automatically calculated. 
86-simplify -slope -same -npk build simplified polygons (-poly and -polybase must be given). A minimum of 10 nodes is implemented in the code to prevent errors in Math::Polygon. 
87-hierarchy build hierarchy. output as html and csv. html and csv names must be given and will be adapted. -poly and -polybase= must be given. 
88-resize -factor=float build a resized (factor > 1 means bigger polygon, maybe 1.2) polygon. -poly and -polybase must be given. -simplify can be given. 
89-adminlevel=integer selects one admin_level as selection criteria. So only country borders can be selected i.e. 
90-ignoremissing ignores missing nodes or invalid ways.
91-verbose program talks even more... 
92END1
93
94
95my $maxNestingLevel = 10 ; # for relations
96
97my $nodeId ;            # variables for reading nodes
98my $nodeUser ;
99my $nodeLat ;
100my $nodeLon ;
101my @nodeTags ;
102my $aRef1 ;
103my $aRef2 ;
104
105my $wayId ;             # variables for reading ways
106my $wayUser ;
107my @wayNodes ;
108my @wayTags ;
109
110my $relationId ;        # variables for reading relations
111my $relationUser ;
112my @relationMembers ;
113my @relationTags ;
114
115my %lon = () ; my %lat = () ;   # all node positions
116
117my %neededNodesHash = () ;      # will be used to load only needed data
118my %neededWaysHash = () ;       # will be used to load only needed data
119
120my %wayNodesHash = () ; # nodes forming a way
121my %relationWays = () ; # ways contained (first directly, later also indirect by relation reference) in relation
122my %relationRelations = () ;    # relations contained in relation (referenced)
123my %validRelation = () ;        # checked and valid
124my %selectedRelation = () ;     # can be used for evaluation, selected
125my %relationName = () ;         # relation data
126my %relationType = () ;         # relation data
127my %relationBoundary = () ;     # relation data
128my %relationLength = () ;       # relation data, original
129my %relationAdminLevel = () ;   # relation data
130my %relationOpenWays = () ;
131my %relationClosedWays = () ;
132
133my %relationPolygonsClosed = () ;       # relation polygons CLOSED
134my %relationPolygonsOpen = () ;         # relation original polygons open
135my %relationPolygonSimplified = () ;    # relation simplified polygon
136my %relationPolygonResized = () ;       # relation resized polygon
137
138my %relationIsIn = () ;         # lists boundaries this relation is inside
139my %relationSize = () ;         # area as returned by math::polygon->area (no projection applied, so no real value! used only to sort is_ins)
140my %relationSegments = () ;     #
141my %relationOpen = () ; #
142my %relationWaysValid = () ;    #
143
144my $relationCount = 0 ;         # total
145my $wayCount = 0 ; 
146my $invalidWayCount = 0 ; 
147my %invalidWays ;               # node count < 2, osmcut, osmosis, error...
148my $adminInvalidCount = 0 ;     # how many relations are not used due to admin restriction
149
150# command line things
151my $optResult ;
152my $help = 0 ;
153my $verbose = "" ;
154my $adminLevelOpt = "" ;
155my $polyOpt = "" ;
156my $hierarchyOpt = 0 ;
157my $simplifyOpt = "" ;
158my $debugOpt = "" ;
159my $picOpt = "" ;
160my $bigPicOpt = "" ;
161my $allPicsOpt = "" ;
162my $picSize = 1024 ; # default pic size longitude in pixels
163my $bigPicSize = 2048 ; # default big pic size longitude in pixels
164my $resizeOpt = "" ;
165my $resizeFactor = 1.05 ; # 5% bigger default
166my $osmName = "" ; 
167my $htmlName = "" ; my $htmlFile ;
168my $csvName = "" ; my $csvFile ;
169my $polyBaseName = "" ;
170my $polyName = "" ; my $polyFile ;
171my $ignoreMissingNodesAndWays = 0;
172
173# defaults for simplify
174my $simplifySlope = 0.001 ; # IN DEGREES, ~100m
175my $simplifySame = 0.002 ; # IN DEGREES, ~200m
176my $simplifyNpk = 2 ;    # max nodes per kilometer for simplified polygon
177
178
179$optResult = GetOptions (       "in=s"          => \$osmName,           # the in file, mandatory
180                                "html=s"        => \$htmlName,          # output file html, defaults to boundaries.htm ([dir/]*.htm)
181                                "csv=s"         => \$csvName,           # output file csv, defaults to boundaries.csv ([dir/]*.csv)
182                                "poly"          => \$polyOpt,           # option to create poly files, then give polyBaseName
183                                "polybase:s"    => \$polyBaseName,      # base filename for poly files. relId is appended. also used for pic names. defaults to polygon [dir/]name
184                                "simplify"      => \$simplifyOpt,       # should simplified polygons be used?
185                                "slope:f"       => \$simplifySlope,     # simplify (Math::Polygon). distance in DEGREES. With three points X(n),X(n+1),X(n+2), the point X(n+1) will be removed if the length of the path over all three points is less than slope longer than the direct path between X(n) and X(n+2)
186                                "same:f"        => \$simplifySame,      # distance (IN DEGREES) for nodes to be considered the same
187                                "npk:f"         => \$simplifyNpk,       # max nodes per km when simplifying
188                                "debug"         => \$debugOpt,         
189                                "pics"          => \$picOpt,            # specifies if pictures of polygons are drawn. polybasename must be given.
190                                "bigpic"        => \$bigPicOpt,         # specifies if big pictures of all polygons are drawn. polybasename must be given.
191                                "allpics"       => \$allPicsOpt,        # also invalid and unselected will be drawn (don't use adminlevel selection then)
192                                "hierarchy"     => \$hierarchyOpt,      # specifies if hierarchies of boundaries are calculated. don't together use with adminlevel. can/should be used with -simplify, then simplified polygons are used for building the hierarchy - much faster
193                                "resize"        => \$resizeOpt, # specifies if new resized polygon will be produced (-polygon must be specified, maybe use -factor, if -simplify is given, simplified polygon will be resized)
194                                "factor:f"      => \$resizeFactor,      # specifies how much bigger the resized polygon will be
195                                "picsize:i"     => \$picSize,           # specifies pic size longitude in pixels
196                                "bigpicsize:i"  => \$bigPicSize,        # specifies big pic size longitude in pixels
197                                "adminlevel:s"  => \$adminLevelOpt,     # specifies which boundaries to look at
198                                "help"  => \$help,                      # print help
199                                "verbose"       => \$verbose,           # turns twitter on
200                                "ignoremissing" => \$ignoreMissingNodesAndWays ) ; #ignore missing nodes
201
202
203
204my $time0 = time() ;
205my $time1 ;
206
207print "\n$program $version \nfor file $osmName\n" ;
208
209if ($help) { print $usage ; die ("program terminated.") ; }
210
211if ($osmName eq "") { die ("ERROR: no infile given.\n") ; }
212if ($htmlName eq "") {
213        $htmlName = "boundaries.htm" ;
214        print "WARNING: htmlName (output) set to $htmlName.\n" ;
215}
216if ($csvName eq "") {
217        $csvName = $htmlName ;
218        $csvName =~  s/.htm/.csv/ ;
219        print "WARNING: csvName (output) set to $csvName.\n" ;
220}
221if ($polyBaseName eq "") {
222        $polyBaseName = "polygon" ;
223        print "WARNING: polyBaseName (output) set to $polyBaseName\n" ;
224}
225
226print "\n" ;
227
228#
229# PARSING RELATIONS
230# after this step rudimentary data of relations is present.
231# however relation members are not yet evaluated
232#
233print "parsing relations...\n" ;
234openOsmFile ($osmName) ;
235print "- skipping nodes...\n" ;
236skipNodes() ;
237print "- skipping ways...\n" ;
238skipWays() ;
239print "- checking...\n" ;
240
241($relationId, $relationUser, $aRef1, $aRef2) = getRelation () ;
242if ($relationId != -1) {
243        @relationMembers = @$aRef1 ;
244        @relationTags = @$aRef2 ;
245}
246
247while ($relationId != -1) {
248
249        my $name = "" ; 
250        my $type = "" ; 
251        my $boundary = "" ; 
252        my $landArea = "" ; 
253        my $adminLevel = "" ;
254
255        my $i ;
256        # process tags
257        if (scalar (@relationTags) > 0) {
258                for ($i=0; $i<scalar (@relationTags); $i++) {
259                        if ( ${$relationTags[$i]}[0] eq "name") { $name =  ${$relationTags[$i]}[1] ; }
260                        if ( ${$relationTags[$i]}[0] eq "type") { $type =  ${$relationTags[$i]}[1] ; }
261                        if ( ${$relationTags[$i]}[0] eq "boundary") { $boundary =  ${$relationTags[$i]}[1] ; }
262                        if ( ${$relationTags[$i]}[0] eq "admin_level") { $adminLevel =  ${$relationTags[$i]}[1] ; }
263                        if ( ${$relationTags[$i]}[0] eq "land_area") { $landArea =  ${$relationTags[$i]}[1] ; }
264                }
265        }
266        # process interesting tags. evaluate relation at all?   
267        my $eval = 0 ;
268        if (  ( ($boundary ne "") or ($landArea ne "") or ($adminLevel ne "") ) and 
269                ( ($type eq "multipolygon") or ($type eq "boundary")  )  ) { 
270                $eval = 1 ; 
271        }
272        # process members if relation is needed and has members
273        if ( ($eval == 1) and (scalar (@relationMembers) > 0) ) {
274                $relationName{$relationId} = $name ;
275                $relationType{$relationId} = $type ;
276                $relationBoundary{$relationId} = $boundary ;
277                $relationAdminLevel{$relationId} = $adminLevel ;
278                @{$relationWays{$relationId}} = () ;
279                @{$relationRelations{$relationId}} = () ;
280                @{$relationIsIn{$relationId}} = () ;
281                $validRelation{$relationId} = 1 ;
282                $selectedRelation{$relationId} = 1 ;
283                $relationSegments{$relationId} = 0 ;
284                $relationOpen{$relationId} = 0 ;
285                $relationSize{$relationId} = 0 ;
286                $relationWaysValid{$relationId} = 1 ;
287                if ($verbose) { print "\nfound relation id=$relationId\nname=$name\ntype=$type\nboundary=$boundary\nadminLevel=$adminLevel\nlandArea=$landArea\n" ; }
288                for ($i=0; $i<scalar (@relationMembers); $i++) {
289                        # way?
290                        if ( (${$relationMembers[$i]}[0] eq "way") and 
291                                ((${$relationMembers[$i]}[2] eq "none") or (${$relationMembers[$i]}[2] eq "outer") or (${$relationMembers[$i]}[2] eq "exclave") ) ){ 
292                                $neededWaysHash{${$relationMembers[$i]}[1]} = 1 ;
293                                push @{$relationWays{$relationId}}, ${$relationMembers[$i]}[1] ; 
294                        }
295                        # relation?
296                        if ( (${$relationMembers[$i]}[0] eq "relation") and 
297                                ((${$relationMembers[$i]}[2] eq "none") or (${$relationMembers[$i]}[2] eq "outer") or (${$relationMembers[$i]}[2] eq "exclave") ) ){ 
298                                if (${$relationMembers[$i]}[1] == $relationId) {
299                                        print "ERROR: relation $relationId contains itself as a member. entry discarded.\n" ;
300                                }
301                                else {
302                                        push @{$relationRelations{$relationId}}, ${$relationMembers[$i]}[1]  ;
303                                }
304                        }
305                }
306        }
307
308        #next relation
309        ($relationId, $relationUser, $aRef1, $aRef2) = getRelation () ;
310        if ($relationId != -1) {
311                @relationMembers = @$aRef1 ;
312                @relationTags = @$aRef2 ;
313        }
314}
315
316closeOsmFile () ;
317
318#
319# GET MORE WAYS out of referenced relations (recursive)
320#
321my $rel ;
322foreach $rel (keys %relationWays) {
323        if (scalar (@{$relationRelations{$rel}}) > 1) {
324                if ($verbose) { print "get relations for relation $rel\n" ; }
325                my (@newWays) = getWays ($rel, 0, @{$relationRelations{$rel}}) ;
326                push @{$relationWays{$rel}}, @newWays ;
327        }
328}
329# now %relationWays contain all needed (recursive) ways of a boundary
330
331#
332# PARSE WAYS FOR NODES
333#
334print "\nparsing ways...\n" ;
335openOsmFile ($osmName) ;
336print "- skipping nodes...\n" ;
337skipNodes() ;
338print "- reading ways...\n" ;
339
340($wayId, $wayUser, $aRef1, $aRef2) = getWay () ;
341if ($wayId != -1) {
342        @wayNodes = @$aRef1 ;
343        @wayTags = @$aRef2 ;
344}
345while ($wayId != -1) { 
346        if (scalar (@wayNodes) >= 2) {
347                if (defined ($neededWaysHash{$wayId} ) ) {
348                        $wayCount++ ;
349                        @{$wayNodesHash{$wayId}} = @wayNodes ;
350                        foreach (@wayNodes) { $neededNodesHash{$_} = 1 ; }
351                        $invalidWays{$wayId} = 0 ;
352                }
353        }
354        else {
355                # an invalid way itself is no problem first. it will lead to a gap in a boundary if used however...
356                #if ($verbose) { print "ERROR: invalid way (one node only): ", $wayId, "\n" ; }
357                $invalidWayCount++ ;
358                $invalidWays{$wayId} = 1 ;
359        }
360
361        # next way
362        ($wayId, $wayUser, $aRef1, $aRef2) = getWay () ;
363        if ($wayId != -1) {
364                @wayNodes = @$aRef1 ;
365                @wayTags = @$aRef2 ;
366        }
367}
368
369closeOsmFile () ;
370
371if ($verbose) { print "\nthere are $invalidWayCount invalid ways\n\n" ; }
372
373#
374# PARSE NODES FOR POSITIONS
375#
376print "\nparsing nodes...\n" ;
377openOsmFile ($osmName) ;
378
379#foreach (@neededNodes) { $neededNodesHash{$_} = 1 ; }
380
381($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1) = getNode () ;
382if ($nodeId != -1) {
383        @nodeTags = @$aRef1 ;
384}
385
386while ($nodeId != -1) {
387        if (defined ($neededNodesHash{$nodeId})) { 
388                $lon{$nodeId} = $nodeLon ; 
389                $lat{$nodeId} = $nodeLat ;
390        }
391
392        # next
393        ($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1) = getNode () ;
394        if ($nodeId != -1) {
395                @nodeTags = @$aRef1 ;
396        }
397}
398print "done.\n" ;
399
400#
401# STATS
402#
403print "\n", scalar (keys %relationName), " relations read into memory.\n" ;
404print scalar (keys %wayNodesHash), " ways read into memory.\n" ;
405print scalar (keys %lon), " nodes read into memory.\n\n" ;
406
407#
408# CHECK FOR VALID BOUNDARIES
409#
410print "check for valid boundaries...\n" ;
411my $valid = 0 ; my $invalid = 0 ; 
412foreach $rel (keys %relationWays) {
413
414        my $way ;
415        my $waysValid = 1 ;
416
417        # if the relation ain't got a single way...
418        if (scalar (@{$relationWays{$rel}}) == 0)  { 
419                $waysValid = 0 ;
420                $relationWaysValid{$rel} = 0 ;
421                if ($verbose eq "1") { print "INVALID relation $rel due to no ways\n" ; }
422        }
423
424        # if the boundary contains an invalid way. chances for success are low :-)
425        foreach $way (@{$relationWays{$rel}}) {
426                if ($invalidWays{$way} == 1) { 
427                        $waysValid = 0 ; 
428                        $relationWaysValid{$rel} = 0 ;
429                        if ($verbose eq "1") { print "INVALID RELATION id=$rel, name=$relationName{$rel} due to invalid way $way\n" ; }
430                }
431        }
432
433        # check for multiple usage of ways. checkSegments doesn't like that.
434        my (@temp) = sort (@{$relationWays{$rel}}) ; my $i ;
435        for ($i=0; $i<$#temp; $i++) {
436                if ($temp[$i] == $temp[$i+1]) {
437                        print "ERROR RELATION id=$rel name=$relationName{$rel} contains way $temp[$i] twice\n" ;
438                        $waysValid = 0 ;
439                        $relationWaysValid{$rel} = 0 ;
440                } 
441        }
442
443        # if we do have ways...
444        if (scalar @{$relationWays{$rel}} > 0) {
445                my $segments = 0 ; my $open = 0 ; my @waysClosed = () ; my @waysOpen = () ;
446                if ($waysValid == 1) {
447                        if ($verbose) { print "call checksegments rel = $rel --- ways = @{$relationWays{$rel}}\n" ; } 
448                        # now let's see if we can build closed ways out of all these ways...
449                        my $refClosed ; my $refOpen ;
450                        ($segments, $open, $refClosed, $refOpen) = checkSegments4 ( @{$relationWays{$rel}} ) ; 
451                        @{$relationOpenWays{$rel}} = @$refOpen ;
452                        @{$relationClosedWays{$rel}} = @$refClosed ;
453                }
454
455                if ( ($open == 0) and ($waysValid == 1) ) {
456                        $valid ++ ;
457                        $validRelation {$rel} = 1 ;
458                        $relationSegments{$rel} = $segments ;
459                        $relationOpen{$rel} = $open ;
460                        if ($verbose) { print "complete and all segments closed: relation $rel, name=$relationName{$rel}\n" ; }
461                }
462                else {
463                        $invalid ++ ;
464                        $validRelation {$rel} = 0 ; 
465                        $relationSegments{$rel} = $segments ;
466                        $relationOpen{$rel} = $open ;
467                        if ($verbose eq "1") { print "INVALID RELATION id=$rel, name=$relationName{$rel}, segments=$segments, open=$open, waysValid=$waysValid\n" ; }
468                }
469        }
470        else {
471                $invalid ++ ;
472                $validRelation {$rel} = 0 ;
473                print "INVALID RELATION id=$rel, no ways given.\n" ;
474                $relationWaysValid{$rel} = 0 ;
475        }
476
477        # check for admin level given as option
478        if (($adminLevelOpt ne "") and ($adminLevelOpt ne $relationAdminLevel{$rel})) {
479                $selectedRelation {$rel} = 0 ;
480                $adminInvalidCount++ ;
481        }
482}
483print "done.\n" ;
484print "\nTOTAL $valid valid relations, $invalid invalid relations.\n" ;
485print "$adminInvalidCount relations selected by admin level.\n" ;
486print "REMAINING for evaluation: ", $valid - $adminInvalidCount, " relations\n\n" ;
487
488#
489# CHECK IF NEEDED NODES COULD BE FOUND
490#
491print "checking if all needed nodes could be found in osm file...\n" ;
492my $nodesMissing = 0 ; my $node ;
493foreach $node (keys %neededNodesHash) {
494        if ( (! (defined ($lon{$node}))) or (!(defined ($lat{$node}))) ) {
495                print "ERROR: lon/lat for node $node missing. node not found or not valid in osm file.\n" ;
496                $nodesMissing = 1 ; my $way ;
497                foreach $way (keys %wayNodesHash) {
498                        my $n2 ;
499                        foreach $n2 (@{$wayNodesHash{$way}}) {
500                                if ($node == $n2) {
501                                        print "       node used in way $way\n" ;
502                                }
503                        }
504                }
505        }
506}
507
508#
509# CHECK IF NEEDED WAYS COULD BE FOUND
510#
511print "checking if all needed ways could be found in osm file...\n" ;
512my $waysMissing = 0 ; my $way ;
513foreach $way (keys %neededWaysHash) {
514        if ( ! (defined ( @{$wayNodesHash{$way}} ) ) ) {
515                if ($invalidWays{$way}) {
516                        print "WARNING way $way invalid in osm file.\n" ;
517                }
518                else {
519                        print "ERROR: nodes for way $way missing. way not found in osm file.\n" ;
520                        $waysMissing = 1 ;
521                        foreach $rel (keys %relationName) {
522                                my $w2 ;
523                                foreach $w2 (@{$relationWays{$rel}}) {
524                                        if ($way == $w2) {
525                                                print "       way used in relation $rel (directly or indirectly).\n" ;
526                                        }
527                                }
528                        }
529                }
530        }
531}
532
533if ($nodesMissing == 1 ) { 
534        print "ERROR: at least one needed node missing in osm file.\n" ; 
535}
536else {
537        print "all needed nodes found.\n" ;
538}
539if ($waysMissing == 1 ) { 
540        print "ERROR: at least one needed way missing in osm file.\n" ; 
541}
542else {
543        print "all needed ways found.\n" ;
544}
545if ( ( ($nodesMissing == 1) or ($waysMissing == 1) ) and not $ignoreMissingNodesAndWays)  {
546        die ("ERROR: at least one needed node or way missing.\n")
547}
548print "done (node and way check).\n" ;
549
550#
551# CALC LENGTH OF RELATIONS,
552# CALC SIMPLIFIED AND RESIZED WAY IF NEEDED
553#
554print "calc length, build polygons, (simplify, resize)...\n" ; 
555foreach $rel (keys %relationWays) {
556        if ( $selectedRelation{$rel} ) {       
557
558                if ($debugOpt eq "1") { print "  - relId: $rel\n" ;}
559
560                my $wayNodes ;
561                my $length = 0 ;
562                my $i ;
563                my @way ;
564
565                foreach $wayNodes (@{$relationOpenWays{$rel}}) {
566                        @way = @{$wayNodes} ;
567                        for ($i = 0; $i<$#way; $i++) {
568                                $length += distance ($lon{$way[$i]}, $lat{$way[$i]}, $lon{$way[$i+1]}, $lat{$way[$i+1]}) ;
569                        }
570                }
571
572                foreach $wayNodes (@{$relationClosedWays{$rel}}) {
573                        @way = @{$wayNodes} ;
574                        for ($i = 0; $i<$#way; $i++) {
575                                $length += distance ($lon{$way[$i]}, $lat{$way[$i]}, $lon{$way[$i+1]}, $lat{$way[$i+1]}) ;
576                        }
577                }
578                $relationLength{$rel} = int ($length * 100) / 100 ;
579
580                if ($polyOpt eq "1" ) {
581
582                        foreach $way ( @{$relationClosedWays{$rel}} ) {
583                                my @poly = () ; my $node ;
584                                foreach $node ( @{$way} ) {
585                                        push (@poly, [$lon{$node}, $lat{$node}]) ;
586                                }
587                                my ($p) = Math::Polygon->new(@poly) ;
588                                push @{$relationPolygonsClosed{$rel}}, $p ;
589                                $relationSize{$rel} += $p->area ;
590                        }
591
592                        if ($debugOpt eq "1") { print "    - create\n" ;}
593                        foreach $way ( @{$relationOpenWays{$rel}} ) {
594                                my @poly = () ; my $node ;
595                                foreach $node ( @{$way} ) {
596                                        push (@poly, [$lon{$node}, $lat{$node}]) ;
597                                }
598                                my ($p) = Math::Polygon->new(@poly) ;
599                                push @{$relationPolygonsOpen{$rel}}, $p ;
600                        }
601
602                        if ($simplifyOpt eq "1") { 
603                                if ($debugOpt eq "1") { print "    - simplify\n" ;}
604                                foreach my $p ( @{$relationPolygonsClosed{$rel}} ) {
605
606                                        # calc poly length $pl
607                                        my $i ; my $pl = 0 ; 
608                                        my (@coords) = $p->points ;
609                                        for ($i=0; $i<$#coords; $i++) {
610                                                $pl += distance ($coords[$i]->[0], $coords[$i]->[1], $coords[$i+1]->[0], $coords[$i+1]->[1]) ;
611                                        }
612                                        my ($maxNodes) = int ($pl * $simplifyNpk ) ; 
613                                        if ($maxNodes < 10) { $maxNodes = 10 ; }
614                                        if ($debugOpt eq "1") { print "      - max nodes allowed: $maxNodes\n" ;}
615                                        if ($debugOpt eq "1") { print "      - number nodes p: ", $p->nrPoints, "\n" ;}
616                                        my ($ps) = $p->simplify (max_points => $maxNodes, same => $simplifySame, slope => $simplifySlope ) ;
617                                        push @{$relationPolygonSimplified{$rel}}, $ps ; 
618                                        my ($percent) = int ($ps->nrPoints / $p->nrPoints * 100 ) ;
619                                        if ($verbose) { print "relation $rel: new size of polygon=", $percent, "%\n" ; } 
620                                }
621                        } # simplify
622
623                        if ($resizeOpt eq "1") { 
624                                if ($debugOpt eq "1") { print "    - resize\n" ;}
625                                if ($simplifyOpt eq "1") { 
626                                        foreach my $p ( @{$relationPolygonSimplified{$rel}} ) {
627                                                my ($x, $y) = center( $p ) ;
628                                                my ($pr) = $p->resize (center => [$x, $y], scale => $resizeFactor) ;
629                                                push @{$relationPolygonResized{$rel}}, $pr ; 
630                                        }
631                                }
632                                else {
633                                        foreach my $p ( @{$relationPolygonsClosed{$rel}} ) {
634                                                my ($x, $y) = center( $p ) ;
635                                                my ($pr) = $p->resize (center => [$x, $y], scale => $resizeFactor) ;
636                                                push @{$relationPolygonResized{$rel}}, $pr ; 
637                                        }
638                                }
639                        } # resize
640
641                }
642        }
643        else {
644                $relationLength{$rel} = 0 ;
645        }
646}
647print "done.\n" ; 
648
649#
650# WRITE POLY FILES IF SPECIFIED
651#
652if ( ($polyBaseName ne "") and ($polyOpt eq "1") ) {
653        print "write poly files...\n" ; 
654        foreach $rel (keys %relationWays) {
655                if ( ($selectedRelation{$rel}) and ($validRelation{$rel}) ) {
656
657                        my @way ; my $polyFileName = "" ; my @points = () ; my $text = "" ;
658                        if ($verbose) { print "write poly file for relation $rel $relationName{$rel} (", scalar (@points) , " nodes) ...\n" ; }
659
660                        if ($simplifyOpt eq "1") { 
661                                $polyFileName = $polyBaseName . ".Simplified." . $rel . ".poly" ;
662                                $text = " (SIMPLIFIED)" ;
663                                open ($polyFile, ">", $polyFileName) or die ("can't open poly output file") ;
664                                print $polyFile $relationName{$rel}, $text, "\n" ; # name
665                                my ($num) = 0 ;
666                                foreach my $p (@{$relationPolygonSimplified{$rel}}) {
667                                        $num++ ;
668                                        print $polyFile "$num\n" ;
669                                        foreach my $pt ( $p->points ) {
670                                                printf $polyFile "   %E   %E\n", $pt->[0], $pt->[1] ;
671                                        }
672                                        print $polyFile "END\n" ;
673                                }
674                                print $polyFile "END\n" ;
675                                close ($polyFile) ;
676                        }
677
678                        if ($resizeOpt eq "1") { 
679                                $polyFileName = $polyBaseName . ".Resized." . $rel . ".poly" ;
680                                $text = " (RESIZED)" ;
681                                if ($simplifyOpt eq "1") { $text = " (SIMPLIFIED/RESIZED)" ; }
682                                open ($polyFile, ">", $polyFileName) or die ("can't open poly output file") ;
683                                print $polyFile $relationName{$rel}, $text, "\n" ; # name
684                                my ($num) = 0 ;
685                                foreach my $p (@{$relationPolygonResized{$rel}}) {
686                                        $num++ ;
687                                        print $polyFile "$num\n" ;
688                                        foreach my $pt ( $p->points ) {
689                                                printf $polyFile "   %E   %E\n", $pt->[0], $pt->[1] ;
690                                        }
691                                        print $polyFile "END\n" ;
692                                }
693                                print $polyFile "END\n" ;
694                                close ($polyFile) ;
695                        }
696
697                        $polyFileName = $polyBaseName . "." . $rel . ".poly" ;
698
699                        open ($polyFile, ">", $polyFileName) or die ("can't open poly output file") ;
700                        print $polyFile $relationName{$rel}, "\n" ; # name
701                        my ($num) = 0 ;
702                        foreach my $p (@{$relationPolygonsClosed{$rel}}) {
703                                $num++ ;
704                                print $polyFile "$num\n" ;
705                                foreach my $pt ( $p->points ) {
706                                        printf $polyFile "   %E   %E\n", $pt->[0], $pt->[1] ;
707                                }
708                                print $polyFile "END\n" ;
709                        }
710                        print $polyFile "END\n" ;
711                        close ($polyFile) ;
712                }
713        }
714        print "done.\n" ; 
715}
716
717#
718# WRITE PICS IF SPECIFIED
719#
720if ( ($polyBaseName ne "") and ($picOpt eq "1") ) {
721        print "write picture files...\n" ; 
722        foreach $rel (keys %relationWays) {
723                if ( ( ($validRelation{$rel}) or ($allPicsOpt eq "1") ) and ($selectedRelation{$rel} ) ) {
724                        drawPic ($rel) ;
725                }
726        }
727        print "done.\n" ; 
728}
729
730#
731# WRITE BIG PIC IF SPECIFIED
732#
733if ( ($polyBaseName ne "") and ($bigPicOpt eq "1") ) {
734        print "write big picture file...\n" ; 
735        drawBigPic () ;
736        print "done.\n" ; 
737}
738
739#
740# BUILD AND PRINT HIERARCHIES
741#
742if ($hierarchyOpt eq "1") {
743        print "building hierarchies...\n" ;
744        my $rel ; my $rel1 ; my $rel2 ; 
745        my $count = 0 ; my ($max) = 0 ;
746        # calc max number of checks
747        foreach $rel1 (keys %relationName) {
748                if ( ($validRelation{$rel1}) and ($selectedRelation{$rel1}) ) { $max++ ; }
749        }
750        $max = int ($max * $max / 2 ) ;
751
752        foreach $rel1 (keys %relationName) {
753                foreach $rel2 (keys %relationName) {
754                        if ( ($rel1 < $rel2) and ($validRelation{$rel1}) and ($validRelation{$rel2}) and ($selectedRelation{$rel1}) and ($selectedRelation{$rel2}) ) {
755                                $count++ ;
756                                if ( ($count % 100000) == 0 ) { 
757                                        my ($percent) = int ($count / $max * 100) ;
758                                        print "  $percent % is_in checks done...\n" ; 
759                                }
760                                my $res ;
761                                if ($simplifyOpt eq "1") {
762                                        $res = isIn ( \@{$relationPolygonSimplified{$rel1}}, \@{$relationPolygonSimplified{$rel2}} ) ;
763                                }
764                                else {
765                                        $res = isIn ( \@{$relationPolygonsClosed{$rel1}}, \@{$relationPolygonsClosed{$rel2}} ) ;
766                                }
767                                if ($res == 2) { push @{$relationIsIn{$rel2}}, $rel1 ; }
768                                if ($res == 1) { push @{$relationIsIn{$rel1}}, $rel2 ; }
769                        }
770                }
771        }
772        print "\n$count is_in checks done.\n" ; 
773
774        my ($csvNameHierarchy) = $csvName ;
775        my ($htmlNameHierarchy) = $htmlName ;
776        $csvNameHierarchy =~  s/.csv/.hierarchy.csv/ ;
777        $htmlNameHierarchy =~ s/.htm/.hierarchy.htm/ ;
778
779        open ($htmlFile, ">", $htmlNameHierarchy) or die ("can't open html output file") ;
780        open ($csvFile, ">", $csvNameHierarchy) or die ("can't open csv output file") ;
781
782        printHTMLHeader ($htmlFile, "boundaries by gary68 - hierarchy") ;
783        print $csvFile "Line;RelationId;Name;Type;Boundary;AdminLevel;is_in\n" ;
784        print $htmlFile "<h1>boundary.pl by gary68 - hierarchy</h1>" ;
785        print $htmlFile "<p>Version ", $version, "</p>\n" ;
786        print $htmlFile "<H2>Statistics</H2>\n" ;
787        print $htmlFile "<p>", stringFileInfo ($osmName), "</p>\n" ;
788        print $htmlFile "<h2>Data</h2>" ;
789        printHTMLTableHead ($htmlFile) ;
790        printHTMLTableHeadings ($htmlFile, ("Line", "RelationId", "Name", "Type", "Boundary", "AdminLevel", "is_in")) ;
791
792        my $line = 0 ;
793
794        foreach $rel (keys %relationName) {
795                if ( ($validRelation{$rel}) and ($selectedRelation{$rel}) ) {
796                       
797                        my @is_in = () ;
798                        foreach my $r2 ( @{$relationIsIn{$rel}} ) {
799                                push @is_in, [ $r2, $relationSize{$r2} ] ;
800                        }
801                        @is_in = sort { $a->[1] <=> $b->[1] } (@is_in) ;
802                       
803                        $line++ ;
804                        print $csvFile $line, ";" ;
805                        print $csvFile $rel, ";" ;
806                        print $csvFile $relationName{$rel}, ";" ;
807                        print $csvFile $relationType{$rel}, ";" ;
808                        print $csvFile $relationBoundary{$rel}, ";" ;
809                        print $csvFile $relationAdminLevel{$rel}, ";" ;
810
811                        foreach my $r2 (@is_in) {
812                                print $csvFile $r2->[0], ";" ;
813                        }
814                        print $csvFile "\n" ;
815
816                        printHTMLRowStart ($htmlFile) ;
817                        printHTMLCellRight ($htmlFile, $line) ;
818                        printHTMLCellRight ($htmlFile, historyLink ("relation", $rel) . "(osm) " . analyzerLink($rel) . "(analyzer)" ) ;
819                        printHTMLCellLeft ($htmlFile, $relationName{$rel}) ;
820                        printHTMLCellLeft ($htmlFile, $relationType{$rel}) ;
821                        printHTMLCellLeft ($htmlFile, $relationBoundary{$rel}) ;
822                        printHTMLCellLeft ($htmlFile, $relationAdminLevel{$rel}) ;
823
824                        print $htmlFile "<td align=\"left\">\n" ;
825                        foreach my $r2 (@is_in) {
826                                print $htmlFile historyLink ("relation", $r2->[0]), "(osm) ", analyzerLink ($r2->[0]), "(analyzer) " ;
827                                print $htmlFile $relationName{$r2->[0]}, "<br>\n" ;
828                        }
829                        print $htmlFile "</td>\n" ;
830                        printHTMLRowEnd ($htmlFile) ;
831                }
832        }
833
834        printHTMLTableFoot ($htmlFile) ;
835        printHTMLFoot ($htmlFile) ;
836
837        close ($htmlFile) ;
838        close ($csvFile) ;
839        print "building hierarchies done.\n" ;
840} # hierarchy
841
842
843
844
845#
846# WRITE OVERVIEW FILES, HTML and CSV
847#
848open ($htmlFile, ">", $htmlName) or die ("can't open html output file") ;
849open ($csvFile, ">", $csvName) or die ("can't open csv output file") ;
850
851printHTMLHeader ($htmlFile, "boundaries by gary68") ;
852print $csvFile "Line;RelationId;Name;Type;Boundary;AdminLevel;Length;Nodes;NodesPerKm\n" ;
853print $htmlFile "<h1>boundary.pl by gary68</h1>" ;
854print $htmlFile "<p>Version ", $version, "</p>\n" ;
855print $htmlFile "<H2>Statistics</H2>\n" ;
856print $htmlFile "<p>", stringFileInfo ($osmName), "</p>\n" ;
857print $htmlFile "<h2>Data</h2>" ;
858printHTMLTableHead ($htmlFile) ;
859printHTMLTableHeadings ($htmlFile, ("Line", "RelationId", "Name", "Type", "Boundary", "AdminLevel", "Length", "Nodes", "NodesPerKm")) ;
860
861my $line = 0 ;
862foreach $rel (keys %relationWays) {
863        if ( ( $selectedRelation{$rel} ) and ($validRelation{$rel}) ) {
864
865                $line++ ;
866                my $pts = 0 ;
867                foreach my $p ( @{$relationPolygonsClosed{$rel}}, @{$relationPolygonsOpen{$rel}}) {
868                        $pts += $p->nrPoints ;
869                }
870
871                my $nodesPerKm = int ( $pts / $relationLength{$rel} * 100 ) / 100 ;
872                print $csvFile $line, ";" ;
873                print $csvFile $rel, ";" ;
874                print $csvFile "\"", $relationName{$rel}, "\";" ;
875                print $csvFile $relationType{$rel}, ";" ;
876                print $csvFile $relationBoundary{$rel}, ";" ;
877                print $csvFile $relationAdminLevel{$rel}, ";" ;
878                print $csvFile $relationLength{$rel}, ";" ;
879                print $csvFile $pts, ";" ;
880                print $csvFile $nodesPerKm, "\n" ;
881
882                printHTMLRowStart ($htmlFile) ;
883                printHTMLCellRight ($htmlFile, $line) ;
884                printHTMLCellRight ($htmlFile, historyLink("relation", $rel) . "(osm) " .analyzerLink($rel) . "(analyzer)" ) ;
885                printHTMLCellLeft ($htmlFile, $relationName{$rel}) ;
886                printHTMLCellLeft ($htmlFile, $relationType{$rel}) ;
887                printHTMLCellLeft ($htmlFile, $relationBoundary{$rel}) ;
888                printHTMLCellRight ($htmlFile, $relationAdminLevel{$rel}) ;
889                printHTMLCellRight ($htmlFile, $relationLength{$rel}) ;
890                printHTMLCellRight ($htmlFile, $pts ) ;
891                printHTMLCellRight ($htmlFile, $nodesPerKm) ;
892                printHTMLRowEnd ($htmlFile) ;
893
894        }
895}
896printHTMLTableFoot ($htmlFile) ;
897
898print $htmlFile "<h2>Invalid Relations</h2>\n" ;
899print $htmlFile "<p>List reflects the moment the *.osm file was created and a relation may be invalid because one or more ways were clipped in the process of creating the *.osm file.</p>\n" ;
900printHTMLTableHead ($htmlFile) ;
901printHTMLTableHeadings ($htmlFile, ("Line", "RelationId", "Name", "#segments", "#open segments", "ways valid")) ;
902$line = 0 ;
903foreach $rel (keys %relationWays) {
904        if ( (! $validRelation{$rel}) and ( $selectedRelation{$rel} ) ) {
905                $line++ ;
906                printHTMLRowStart ($htmlFile) ;
907                printHTMLCellRight ($htmlFile, $line ) ;
908                printHTMLCellRight ($htmlFile, historyLink("relation", $rel) . "(osm) " .analyzerLink($rel) . "(analyzer)" ) ;
909                printHTMLCellLeft ($htmlFile, $relationName{$rel}) ;
910                printHTMLCellRight ($htmlFile, $relationSegments{$rel} ) ;
911                printHTMLCellRight ($htmlFile, $relationOpen{$rel} ) ;
912                printHTMLCellRight ($htmlFile, $relationWaysValid{$rel} ) ;
913                printHTMLRowEnd ($htmlFile) ;
914        }
915}
916printHTMLTableFoot ($htmlFile) ;
917
918printHTMLFoot ($htmlFile) ;
919close ($htmlFile) ;
920close ($csvFile) ;
921
922#print "\n$program finished.\n\n";
923print "\n", $program, " ", $osmName, " FINISHED after ", stringTimeSpent (time - $time0), "\n\n" ;
924
925
926
927
928
929sub checkSegments4 {
930        # sub builds segments for given set of ways.
931        # returns number of segments, number of open segments and closed and open segments as ways (array refs)
932        my (@ways) = @_ ;
933        my $way ; my $node ;
934        my $segments = 0 ; my $openSegments = 0 ;
935        my $found = 1 ;
936        my $way1 ; my $way2 ;
937        my $endNodeWay2 ;       my $startNodeWay2 ;
938        my %starts = () ; my %ends = () ;
939        my %wayStart = () ; my %wayEnd = () ;
940        my %wayNodes = () ;
941
942        #init
943        foreach $way (@ways) {
944                push @{$starts{$wayNodesHash{$way}[0]}}, $way ;
945                push @{$ends{$wayNodesHash{$way}[-1]}}, $way ;
946                $wayStart{$way} = $wayNodesHash{$way}[0] ;
947                $wayEnd{$way} = $wayNodesHash{$way}[-1] ;
948                @{$wayNodes{$way}} = @{$wayNodesHash{$way}} ; # complete...
949                #print "    cs way = $way --- nodes = @{$wayNodesHash{$way}}\n" ;
950        }
951
952        while ($found == 1) {
953                $found = 0 ;
954
955                # check start/start
956                loop1:
957                foreach $node (keys %starts) {
958
959                        # if node with more than 1 connecting way...
960                        if (scalar (@{$starts{$node}}) > 1) {
961                                $way1 = ${$starts{$node}}[0] ; $way2 = ${$starts{$node}}[1] ;
962                                #print "merge start/start $way1 and $way2 at node $node\n" ;
963
964                                # complete
965                                @{$wayNodes{$way1}} = ( reverse ( @{$wayNodes{$way2}}[1..$#{$wayNodes{$way2}}] ), @{$wayNodes{$way1}} ) ;
966
967                                $endNodeWay2 = $wayEnd{$way2} ;
968                                #print "end node way2 = $endNodeWay2\n" ;
969
970                                # way1 gets new start: end way2
971                                push @{$starts{ $endNodeWay2 }}, $way1 ;
972                                $wayStart{$way1} = $endNodeWay2 ;
973
974                                # remove end way2
975                                if (scalar (@{$ends{$endNodeWay2}}) == 1) {
976                                        delete $ends{$endNodeWay2} ;
977                                        #print "$endNodeWay2 removed from end hash\n" ;
978                                }
979                                else {
980                                        @{$ends{$endNodeWay2}} = removeElement ($way2, @{$ends{$endNodeWay2}}) ;
981                                        #print "way $way2 removed from node $endNodeWay2 from end hash\n" ;
982                                }
983                               
984                                # remove way2
985                                delete $wayEnd{$way2} ;
986                                delete $wayStart{$way2} ;
987                                delete $wayNodes{$way2} ;
988
989                                # remove connecting starts
990                                if (scalar @{$starts{$node}} == 2) {
991                                        delete $starts{$node} ;
992                                        #print "$node removed from start hash\n" ;
993                                }
994                                else {
995                                        @{$starts{$node}} = @{$starts{$node}}[2..$#{$starts{$node}}] ;
996                                        #print "first two elements removed from start hash node = $node\n" ;
997                                }
998                                #print "\n" ;
999                                $found = 1 ; 
1000                                last loop1 ;
1001                        }
1002                }
1003
1004                # check end/end
1005                if (!$found) {
1006                        loop2:
1007                        foreach $node (keys %ends) {
1008
1009                                # if node with more than 1 connecting way...
1010                                if (scalar @{$ends{$node}} > 1) {
1011                                        $way1 = ${$ends{$node}}[0] ; $way2 = ${$ends{$node}}[1] ;
1012                                        #print "merge end/end $way1 and $way2 at node $node\n" ;
1013       
1014                                        # complete
1015                                        @{$wayNodes{$way1}} = ( @{$wayNodes{$way1}}, reverse ( @{$wayNodes{$way2}}[0..$#{$wayNodes{$way2}}-1] ) )  ;
1016
1017                                        $startNodeWay2 = $wayStart{$way2} ;
1018                                        #print "start node way2 = $startNodeWay2\n" ;
1019       
1020                                        # way1 gets new end: start way2
1021                                        push @{$ends{ $startNodeWay2 }}, $way1 ;
1022                                        $wayEnd{$way1} = $startNodeWay2 ;
1023       
1024                                        # remove start way2
1025                                        if (scalar (@{$starts{$startNodeWay2}}) == 1) {
1026                                                delete $starts{$startNodeWay2} ;
1027                                                #print "$startNodeWay2 removed from start hash\n" ;
1028                                        }
1029                                        else {
1030                                                @{$starts{$startNodeWay2}} = removeElement ($way2, @{$starts{$startNodeWay2}}) ;
1031                                                #print "way $way2 removed from node $startNodeWay2 from start hash\n" ;
1032                                        }
1033                               
1034                                        # remove way2
1035                                        delete $wayEnd{$way2} ;
1036                                        delete $wayStart{$way2} ;
1037                                        delete $wayNodes{$way2} ;
1038
1039                                        # remove connecting ends
1040                                        if (scalar @{$ends{$node}} == 2) {
1041                                                delete $ends{$node} ;
1042                                                #print "$node removed from end hash\n" ;
1043                                        }
1044                                        else {
1045                                                @{$ends{$node}} = @{$ends{$node}}[2..$#{$ends{$node}}] ;
1046                                                #print "first two elements removed from end hash node = $node\n" ;
1047                                        }
1048                                        #print "\n" ;
1049                                        $found = 1 ; 
1050                                        last loop2 ;
1051                                }
1052                        }
1053                }
1054
1055
1056                # check start/end
1057                if (!$found) {
1058                        my $wayFound = 0 ;
1059                        loop3:
1060                        foreach $node (keys %starts) {
1061                                if (exists ($ends{$node})) {
1062                                        #look for different! ways
1063                                        my (@startingWays) = @{$starts{$node}} ;
1064                                        my (@endingWays) = @{$ends{$node}} ;
1065                                        my $w1 ; my $w2 ;
1066                                        loop4:
1067                                        foreach $w1 (@startingWays) {
1068                                                foreach $w2 (@endingWays) {
1069                                                        if ($w1 != $w2) {
1070                                                                $wayFound = 1 ;
1071                                                                $way1 = $w1 ; 
1072                                                                $way2 = $w2 ; # merge w1 and w2
1073                                                                #print "start/end: merge ways $way1 and $way2 connected at node $node\n" ;
1074                                                                last loop4 ;
1075                                                        }
1076                                                }
1077                                        } # look for ways
1078                                        if ($wayFound) {
1079                                                #print "way $way1 start $wayStart{$way1} end $wayEnd{$way1}\n" ;
1080                                                #print "way $way2 start $wayStart{$way2} end $wayEnd{$way2}\n" ;
1081
1082                                                # way1 gets new start: start way2
1083                                                $wayStart{$way1} = $wayStart{$way2} ;
1084                                                my ($way2StartNode) = $wayStart{$way2} ;
1085
1086                                                # complete
1087                                                @{$wayNodes{$way1}} = ( @{$wayNodes{$way2}}[0..$#{$wayNodes{$way2}}-1], @{$wayNodes{$way1}} ) ;
1088
1089                                                push @{$starts{$way2StartNode}}, $way1 ;
1090                                                #print "way $way1 added to starts for node $way2StartNode\n" ;
1091
1092                                                # remove start way1
1093                                                if (scalar (@{$starts{$node}}) == 1) {
1094                                                        delete $starts{$node} ;
1095                                                        #print "$way1 removed from start hash for node $node\n" ;
1096                                                }
1097                                                else {
1098                                                        @{$starts{$node}} = removeElement ($way1, @{$starts{$node}}) ;
1099                                                        #print "$way1 removed from start hash for node $node\n" ;
1100                                                }
1101
1102                                                #remove end way2
1103                                                if (scalar (@{$ends{$node}}) == 1) {
1104                                                        delete $ends{$node} ;
1105                                                        #print "$way2 removed from end hash for node $node\n" ;
1106                                                }
1107                                                else {
1108                                                        @{$ends{$node}} = removeElement ($way2, @{$ends{$node}}) ;
1109                                                        #print "$way2 removed from end hash for node $node\n" ;
1110                                                }
1111                                                #remove start way2
1112                                                if (scalar (@{$starts{$way2StartNode}}) == 1) {
1113                                                        delete $starts{$way2StartNode} ;
1114                                                        #print "$way2 removed from start hash for node $way2StartNode\n" ;
1115                                                }
1116                                                else {
1117                                                        @{$starts{$way2StartNode}} = removeElement ($way2, @{$starts{$way2StartNode}}) ;
1118                                                        #print "$way2 removed from start hash for node $way2StartNode\n" ;
1119                                                }
1120
1121                                                # remove way2
1122                                                delete $wayEnd{$way2} ;
1123                                                delete $wayStart{$way2} ;
1124                                                delete $wayNodes{$way2} ;
1125                                                #print "way $way2 removed from waystart and wayend hashes\n" ;
1126
1127                                                #print "\n" ;
1128                                                $found = 1 ; 
1129                                                last loop3 ;
1130                                        }
1131                                }
1132                        }
1133                }
1134        }
1135
1136        # evaluation
1137        foreach $way (keys %wayStart) {
1138                #print "way $way start $wayStart{$way} end $wayEnd{$way}\n" ;
1139                if ($wayStart{$way} != $wayEnd{$way}) {
1140                        $openSegments++ ;
1141                }
1142        }
1143
1144        my @openWays = () ;
1145        my @closedWays = () ;
1146        foreach $way1 (keys %wayStart) {
1147                if ( ${$wayNodes{$way1}}[0] == ${$wayNodes{$way1}}[-1] ) {
1148                        push @closedWays, [ @{$wayNodes{$way1}} ] ;
1149                }
1150                else {
1151                        push @openWays, [ @{$wayNodes{$way1}} ] ;
1152                }
1153        }
1154
1155        return (scalar (keys %wayStart), $openSegments, \@closedWays, \@openWays) ;
1156}
1157
1158sub removeElement {
1159        # sub removes a single value (once) from an array
1160        my ($element, @array) = @_ ;
1161        my @arrayNew = () ;
1162        my $pos = -1 ; my $i ;
1163        for ($i=0; $i<=$#array; $i++) { if ($array[$i] == $element) { $pos = $i ; } }
1164        if ($pos != -1) {
1165                if ($pos == 0) {
1166                        @arrayNew = @array[1..$#array] ;
1167                }
1168                if ($pos == $#array) {
1169                        @arrayNew = @array[0..$#array-1] ;
1170                }
1171                if ( ($pos > 0) and ($pos < $#array) ) {
1172                        @arrayNew = @array[0..$pos-1, $pos+1..$#array] ;
1173                }
1174        }
1175        return @arrayNew ;
1176}
1177
1178
1179sub drawPic {
1180        # draws simple picture of relation/boundary. original and possibly simplified/resized boundary.
1181        my ($rel) = shift ;
1182        my $buffer = 0.1 ;
1183        my $lonMin = 999 ; my $latMin = 999 ; my $lonMax = -999 ; my $latMax = -999 ; 
1184        my $node ;
1185        my $p ; my $pt ; 
1186
1187        # print "draw relation $rel\n" ;
1188        my $pointsGiven = 0 ;
1189        foreach $p ( @{$relationPolygonsClosed{$rel}}, @{$relationPolygonsOpen{$rel}} ) {
1190                foreach $pt ($p->points) {
1191                        $pointsGiven = 1 ;
1192                        if ($pt->[0] > $lonMax) { $lonMax = $pt->[0] ; }
1193                        if ($pt->[1] > $latMax) { $latMax = $pt->[1] ; }
1194                        if ($pt->[0] < $lonMin) { $lonMin = $pt->[0] ; }
1195                        if ($pt->[1] < $latMin) { $latMin = $pt->[1] ; }
1196                }
1197        }
1198        if ($pointsGiven) {
1199                $lonMin = $lonMin - ($buffer * ($lonMax - $lonMin)) ;
1200                $latMin = $latMin - ($buffer * ($latMax - $latMin)) ;
1201                $lonMax = $lonMax + ($buffer * ($lonMax - $lonMin)) ;
1202                $latMax = $latMax + ($buffer * ($latMax - $latMin)) ;
1203        }
1204        else {
1205                print "WARNING: relation $rel does not have points\n" ;
1206                $lonMin = -179 ;
1207                $latMin = -80 ;
1208                $lonMax = 179 ;
1209                $latMax = 80 ;
1210        }
1211
1212        # print "  $picSize, $lonMin, $latMin, $lonMax, $latMax\n" ;
1213
1214        initGraph ($picSize, $lonMin, $latMin, $lonMax, $latMax) ;
1215       
1216        foreach $p (@{$relationPolygonsClosed{$rel}}) {
1217                my @coordinates = () ; 
1218                foreach $pt ($p->points) {
1219                        push @coordinates, $pt->[0], $pt->[1] ;
1220                }
1221                drawWay ("green", 3, @coordinates) ;
1222        }
1223        foreach $p (@{$relationPolygonsOpen{$rel}}) {
1224                my @coordinates = () ; 
1225                foreach $pt ($p->points) {
1226                        push @coordinates, $pt->[0], $pt->[1] ;
1227                }
1228                drawWay ("red", 3, @coordinates) ;
1229        }
1230
1231        if ($simplifyOpt eq "1") {     
1232                foreach $p (@{$relationPolygonSimplified{$rel}}) {
1233                        my @coordinates = () ; 
1234                        foreach $pt ($p->points) {
1235                                push @coordinates, $pt->[0], $pt->[1] ;
1236                        }
1237                        drawWay ("blue", 2, @coordinates) ;
1238                }
1239        }
1240
1241        if ($resizeOpt eq "1") {       
1242                foreach $p (@{$relationPolygonResized{$rel}}) {
1243                        my @coordinates = () ; 
1244                        foreach $pt ($p->points) {
1245                                push @coordinates, $pt->[0], $pt->[1] ;
1246                        }
1247                        drawWay ("black", 2, @coordinates) ;
1248                }
1249        }
1250
1251        drawHead ($program . " ". $version . " by Gary68" . " RelId = " . $rel . " name = " . $relationName{$rel}, "black", 3) ;
1252        drawFoot ("data by openstreetmap.org" . " " . $osmName . " " .ctime(stat($osmName)->mtime), "gray", 3) ;
1253        drawLegend (3, "Resized", "black", "Open", "red", "Simplified", "blue", "Original", "green") ;
1254        drawRuler ("black") ;
1255        writeGraph ($polyBaseName . "." . $rel . ".png") ;
1256}
1257
1258sub drawBigPic {
1259        my $buffer = 0.1 ;
1260        my $lonMin = 999 ; my $latMin = 999 ; my $lonMax = -999 ; my $latMax = -999 ; 
1261        my $node ;
1262        my $p ; my $pt ; 
1263
1264        foreach my $rel (keys %relationName) {
1265                if ($selectedRelation{$rel}) {
1266                        foreach $p ( @{$relationPolygonsClosed{$rel}}, @{$relationPolygonsOpen{$rel}} ) {
1267                                foreach $pt ($p->points) {
1268                                        if ($pt->[0] > $lonMax) { $lonMax = $pt->[0] ; }
1269                                        if ($pt->[1] > $latMax) { $latMax = $pt->[1] ; }
1270                                        if ($pt->[0] < $lonMin) { $lonMin = $pt->[0] ; }
1271                                        if ($pt->[1] < $latMin) { $latMin = $pt->[1] ; }
1272                                }
1273                        }
1274                }
1275        }
1276
1277        $lonMin = $lonMin - ($buffer * ($lonMax - $lonMin)) ;
1278        $latMin = $latMin - ($buffer * ($latMax - $latMin)) ;
1279        $lonMax = $lonMax + ($buffer * ($lonMax - $lonMin)) ;
1280        $latMax = $latMax + ($buffer * ($latMax - $latMin)) ;
1281
1282        initGraph ($bigPicSize, $lonMin, $latMin, $lonMax, $latMax) ;
1283       
1284        # for all admin levels backward
1285        my $level ;
1286        for ($level = 1; $level <= 11; $level++) {
1287                foreach my $rel (keys %relationName) {
1288                        if ($relationAdminLevel{$rel} eq $level) {
1289                                my $color ;
1290                                my ($size) = (12 - $level) * 4 + 1 ;
1291                                my ($colorRef) = $level % 4 ;
1292                                if ($colorRef == 0) { $color = "blue" ; }
1293                                if ($colorRef == 1) { $color = "black" ; }
1294                                if ($colorRef == 2) { $color = "green" ; }
1295                                if ($colorRef == 3) { $color = "red" ; }
1296
1297                                foreach $p (@{$relationPolygonsClosed{$rel}}, @{$relationPolygonsOpen{$rel}}) {
1298                                        my @coordinates = () ; 
1299                                        foreach $pt ($p->points) {
1300                                                push @coordinates, $pt->[0], $pt->[1] ;
1301                                        }
1302                                        drawWay ($color, $size, @coordinates) ;
1303                                }
1304                        }
1305                }
1306        }
1307
1308        foreach my $rel (keys %relationName) {
1309                if ($relationAdminLevel{$rel} eq "") {
1310                        foreach $p (@{$relationPolygonsClosed{$rel}}, @{$relationPolygonsOpen{$rel}}) {
1311                                my @coordinates = () ; 
1312                                foreach $pt ($p->points) {
1313                                        push @coordinates, $pt->[0], $pt->[1] ;
1314                                }
1315                                drawWay ("gray", 2, @coordinates) ;
1316                        }
1317                }
1318        }
1319
1320
1321        drawHead ($program . " ". $version . " by Gary68 - big picture", "black", 3) ;
1322        drawFoot ("data by openstreetmap.org" . " " . $osmName . " " .ctime(stat($osmName)->mtime), "gray", 3) ;
1323        # drawLegend (3, "Resized", "black", "Open", "red", "Simplified", "blue", "Original", "green") ;
1324        drawRuler ("black") ;
1325        writeGraph ($polyBaseName . ".BIG" . ".png") ;
1326}
1327
1328sub getWays {
1329        # sub gets all ways of given relation and all ways of referenced relations, recursive
1330        my ($startingRelation, $level, @relations) = @_ ;
1331        my @result = () ;
1332
1333        if ($verbose) { print "getways called for starting relation $startingRelation with members: @relations\n" ; }
1334        if ($level > $maxNestingLevel) { 
1335                die ("ERROR: relations nested deeper than $maxNestingLevel levels, maybe a loop? starting relation is $startingRelation.\n") ;
1336        }
1337
1338        my $rel ;       
1339        foreach $rel (@relations) {
1340                if (defined ($relationName{$rel})) {
1341                        push @result, @{$relationWays{$rel}} ;
1342                        if (scalar (@{$relationRelations{$rel}}) > 0) {
1343                                my $rel2 ;
1344                                foreach $rel2 (@{$relationRelations{$rel}}) { # could be done without loop, pass whole array...
1345                                        push @result, getWays ($startingRelation, $level+1, $rel2) ;
1346                                }
1347                        }
1348                }
1349                else {
1350                        print "ERROR. Nested relation id=$rel not found or not tagged correctly.\n" ;
1351                }
1352        }
1353        if ($verbose) { print "  getways result: @result\n" ; }
1354        return @result ;
1355}
1356
1357sub isIn {
1358        # check if polygon(s) 1 is(are) in polygon(s) 2 or vice versa
1359        # return 0 = neither
1360        #        1 = p1 is in p2
1361        #        2 = p2 is in p1
1362        my ($p1ref, $p2ref) = @_ ;
1363
1364        my (@polygons1) = @$p1ref ;
1365        my (@polygons2) = @$p2ref ;
1366        my ($p1In2) = 0 ;
1367        my ($p2In1) = 0 ;
1368
1369        # p1 in p2 ?
1370
1371        second:
1372        foreach my $p2 (@polygons2) {
1373                my ($inside) = 1 ;
1374                first:
1375                foreach my $p1 (@polygons1) {
1376                        foreach my $pt1 ($p1->points) {
1377                                if ($p2->contains ($pt1) ) {
1378                                        # good
1379                                }
1380                                else {
1381                                        $inside = 0 ; last first ;
1382                                }
1383                        }
1384                }
1385                if ($inside == 1) {
1386                        $p1In2 = 1 ; last second ;
1387                }
1388        }
1389
1390        # p2 in p1 ?
1391
1392        fourth:
1393        foreach my $p1 (@polygons1) {
1394                my ($inside) = 1 ;
1395                third:
1396                foreach my $p2 (@polygons2) {
1397                        foreach my $pt2 ($p2->points) {
1398                                if ($p1->contains ($pt2) ) {
1399                                        # good
1400                                }
1401                                else {
1402                                        $inside = 0 ; last third ;
1403                                }
1404                        }
1405                }
1406                if ($inside == 1) {
1407                        $p2In1 = 1 ; last fourth ;
1408                }
1409        }
1410
1411
1412        if ($p1In2 == 1) {
1413                return 1 ;
1414        }
1415        elsif ($p2In1 == 1) {
1416                return 2 ;
1417        }
1418        else {
1419                return 0 ;
1420        }
1421
1422}
1423
1424sub center {
1425        my ($polygon) = shift ;
1426        my $lonSum = 0 ;
1427        my $latSum = 0 ;
1428        my $number = 0 ;
1429
1430        foreach my $pt ($polygon->points) {
1431                $lonSum += $pt->[0] ;
1432                $latSum += $pt->[1] ;
1433                $number ++ ;
1434        }
1435        return ($lonSum/$number, $latSum/$number) ;
1436}
Note: See TracBrowser for help on using the repository browser.