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

Last change on this file since 21494 was 19705, checked in by gary68, 10 years ago

boundaries error handling and -help option

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