source: subversion/applications/utils/gary68/checkconn.pl @ 16916

Last change on this file since 16916 was 16562, checked in by gary68, 10 years ago

initial upload of several programs

  • Property svn:executable set to *
File size: 17.4 KB
Line 
1#
2#
3# checkconn.pl by gary68
4#
5# this program check for connections at start or end of a way. this is intended to check motorways, trunks, their links, primary, secondary and
6# tertiary highways. it might not be too useful for i.e. highway=residential
7#
8#
9#
10# Copyright (C) 2008, Gerhard Schwanz
11#
12# 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
13# Free Software Foundation; either version 3 of the License, or (at your option) any later version.
14#
15# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
16# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
17#
18# You should have received a copy of the GNU General Public License along with this program; if not, see <http://www.gnu.org/licenses/>
19#
20#
21# example definition file:
22# (IMPORTANT: don't enter a tag in both sections!)
23#
24#<XML>
25#  <k="check" v="highway:motorway">
26#  <k="check" v="highway:motorway_link">
27#  <k="check" v="highway:trunk">
28#  <k="check" v="highway:trunk_link">
29#  <k="against" v="highway:primary">
30#  <k="against" v="highway:primary_link">
31#  <k="against" v="highway:secondary">
32#  <k="against" v="highway:tertiary">
33#  <k="against" v="junction:roundabout">
34#</XML>
35#
36# Version 2.0
37# 001
38# - new improved algorythm
39# 002
40# - gpx format support
41# - needed nodes sorted removed
42#
43# Version 2.1
44# - add stat output
45#
46# Version 2.2
47# - add stat output 2
48#
49# Version 3.0
50# - add boundary file support
51#
52
53use strict ;
54use warnings ;
55
56use OSM::osm ;
57use File::stat;
58use Time::localtime;
59
60my $program = "checkconn.pl" ;
61my $usage = $program . " def.xml file.osm out.htm out.gpx boundary.poly" ;
62my $version = "3.0" ;
63
64my $borderThreshold = 2 ; # in km
65
66my $wayId ; my $wayId2 ;
67my $wayUser ; my @wayNodes ; my @wayTags ;
68my $nodeId ; my $nodeId2 ;
69my $nodeUser ; my $nodeLat ; my $nodeLon ; my @nodeTags ;
70my $aRef1 ; my $aRef2 ;
71my $wayCount = 0 ;
72my $againstCount = 0 ;
73my $checkWayCount = 0 ;
74my $againstWayCount = 0 ;
75my $checkedWays = 0 ;
76my $invalidWays ;
77my $borderCollisions = 0 ;
78
79my @check ;
80my @against ;
81my @borderWay = () ;
82
83my $time0 = time() ; my $time1 ; my $timeA ;
84my $i ;
85my $key ;
86my $num ;
87my $tag1 ; my $tag2 ;
88my $progress ;
89
90my $html ;
91my $def ;
92my $gpx ;
93my $osmName ;
94my $htmlName ;
95my $defName ;
96my $gpxName ;
97my $borderFileName = "" ;
98
99my @wayStat = () ; # 0= fully connected; 3= unconnected; 2= end unconnected; 1= start unconnected
100my @cat1 ; my %cat1hash ;
101my @allWayNodes ;
102my @allCat1Nodes ;
103my %cat1Connected ;
104my @cat1Nodes ; my @cat12Nodes ;
105
106my @neededNodes ;
107my %lon ; my %lat ;
108my %wayStart ; my %wayEnd ; my %wayStat ;
109
110my $maxBorderCheckTime = 0 ;
111my $totalBorderCheckTime = 0 ;
112
113###############
114# get parameter
115###############
116$defName = shift||'';
117if (!$defName)
118{
119        die (print $usage, "\n");
120}
121
122$osmName = shift||'';
123if (!$osmName)
124{
125        die (print $usage, "\n");
126}
127
128$htmlName = shift||'';
129if (!$htmlName)
130{
131        die (print $usage, "\n");
132}
133
134$gpxName = shift||'';
135if (!$gpxName)
136{
137        die (print $usage, "\n");
138}
139
140$borderFileName = shift||'';
141if (!$borderFileName)
142{
143        $borderFileName = "" ;
144}
145
146print "\n$program $version for file $osmName\n\n" ;
147
148
149if ($borderFileName ne "") {
150        readBorder ($borderFileName) ;
151}
152
153
154##################
155# read definitions
156##################
157
158print "read definitions $defName...\n" ;
159open ($def, , "<", $defName) or die "definition file $defName not found" ;
160
161while (my $line = <$def>) {
162        #print "read line: ", $line, "\n" ;
163        my ($k)   = ($line =~ /^\s*<k=[\'\"]([:\w\s\d]+)[\'\"]/); # get key
164        my ($v) = ($line =~ /^.+v=[\'\"]([:\w\s\d]+)[\'\"]/);       # get value
165       
166        if ($k and defined ($v)) {
167                #print "key: ", $k, "\n" ;
168                #print "val: ", $v, "\n" ;
169
170                if ($k eq "check") {
171                        push @check, $v ;
172                }
173                if ($k eq "against") {
174                        push @against, $v ;
175                }
176        }
177}
178
179close ($def) ;
180
181
182# TODO: remove check from against, if specified!
183
184
185print "Check ways: " ;
186foreach (@check) { print $_, " " ;} print "\n" ;
187print "Against: " ;
188foreach (@against) { print $_, " " ;} print "\n\n" ;
189
190
191
192######################
193# skip all nodes first
194######################
195openOsmFile ($osmName) ;
196print "pass1: skipping nodes...\n" ;
197skipNodes () ;
198
199
200#############################
201# identify check/against ways
202#############################
203print "pass1: identify check ways...\n" ;
204($wayId, $wayUser, $aRef1, $aRef2) = getWay () ;
205if ($wayId != -1) {
206        @wayNodes = @$aRef1 ;
207        @wayTags = @$aRef2 ;
208}
209while ($wayId != -1) { 
210        $wayCount++ ;
211        if (scalar (@wayNodes) >= 2) {
212
213                my $found = 0 ;
214                my $round = 0 ;
215                foreach $tag1 (@wayTags) {
216                        if ($tag1 eq "junction:roundabout") { $round = 1 ; }
217                        foreach $tag2 (@check) {
218                                if ($tag1 eq $tag2) { $found = 1 ; }
219                        }
220                }
221                if (($found) and ($round == 0)) { 
222                        push @cat1, $wayId ; 
223                        $checkWayCount++ ; 
224                        $wayStart{$wayId} = $wayNodes[0] ; 
225                        $wayEnd{$wayId} = $wayNodes[-1] ; 
226                        $wayStat{$wayId} = 3 ;
227                        push @allWayNodes, @wayNodes ;
228                        push @allCat1Nodes, ($wayNodes[0], $wayNodes[-1]) ;
229                }
230
231                $found = 0 ;
232                foreach $tag1 (@wayTags) {
233                        foreach $tag2 (@against) {
234                                if ($tag1 eq $tag2) { $found = 1 ; }
235                        }
236                }
237                if ($found) {
238                        $againstWayCount++ ;
239                        push @allWayNodes, @wayNodes ;
240                }
241        }
242        else {
243                #print "invalid way (one node only): ", $wayId, "\n" ;
244                $invalidWays++ ;
245        }
246
247        # next way
248        ($wayId, $wayUser, $aRef1, $aRef2) = getWay () ;
249        if ($wayId != -1) {
250                @wayNodes = @$aRef1 ;
251                @wayTags = @$aRef2 ;
252        }
253}
254
255closeOsmFile () ;
256
257print "number total ways: $wayCount\n" ;
258print "number invalid ways (1 node only): $invalidWays\n" ;
259print "number check ways: $checkWayCount\n" ;
260print "number against ways: $againstWayCount\n" ;
261
262$" = " " ;
263#print "Cat1 ways: @cat1\n" ;
264#print "Cat1 nodes: @allCat1Nodes\n" ;
265#print "All way nodes: @allWayNodes\n" ;
266
267
268
269###############################
270# pass 2; check for connections
271###############################
272print "check for connections...\n" ;
273
274$progress = 0 ;
275$timeA = time() ;
276
277# init cat1Connected
278foreach (@allCat1Nodes) { $cat1Connected{$_} = 0 ; }
279
280# sort cat 1
281print "sort cat1 nodes...\n" ;
282@allCat1Nodes = sort {$a <=> $b} @allCat1Nodes ;
283
284#print "Cat1 nodes sorted: @allCat1Nodes\n" ;
285
286
287# find doubles in allCat1Nodes and mark as connected in @cat1Connected
288# remove doubles completely, create @cat12Nodes
289
290print "find doubles in cat1 nodes...\n" ;
291
292my $actualId = $allCat1Nodes[0] ;
293my $actualNumber = 1 ;
294my $actualIndex = 0 ;
295while ($actualIndex < $#allCat1Nodes) {
296        $actualIndex++ ;
297        if ($allCat1Nodes[$actualIndex] == $actualId) { 
298                $actualNumber++ ;
299        }
300        else
301        {
302                if ($actualNumber > 1) {
303                        $cat1Connected{$actualId} = 1 ;
304                        #print "cat1/cat1 connection found on node id = $actualId\n" ;
305                }
306                else {
307                        push @cat12Nodes, $actualId ;
308                }
309                $actualNumber = 1 ;
310                $actualId = $allCat1Nodes[$actualIndex] ;
311        }
312}
313if ($actualNumber > 1) {
314        $cat1Connected{$actualId} = 1 ;
315        #print "cat1/cat1 connection found on node id = $actualId\n" ;
316}
317else {
318        push @cat12Nodes, $actualId ;
319}
320
321print "sort cat1-2 way nodes...\n" ;
322@cat12Nodes = sort {$a <=> $b} @cat12Nodes ;
323
324#print "Cat12 nodes sorted: @cat12Nodes\n" ;
325
326
327# sort allWayNodes
328print "sort all way nodes...\n" ;
329@allWayNodes = sort {$a <=> $b} @allWayNodes ;
330
331#print "All way nodes sorted: @allWayNodes\n" ;
332
333
334
335# init loop allWayNodes (index)
336# loop through cat12Nodes ascending
337        # inc indexAll until >= cat12NodeId
338        # if == then check for number occurrences
339        # if num occurrences > 1 then mark cat12NodeId as connected
340#
341
342print "big loop running...\n" ;
343
344my $cat1Index = 0 ;
345my $allIndex = 0 ;
346my $actualCat1Id = $cat12Nodes[0] ;
347my $actualAllId = $allWayNodes[0] ;
348
349while ($cat1Index <= $#cat12Nodes) {
350        while ( ($allWayNodes[$allIndex] < $cat12Nodes[$cat1Index]) and ($allIndex < $#allWayNodes) ) {$allIndex++}
351        if ($allWayNodes[$allIndex] == $cat12Nodes[$cat1Index]) {
352                if ( ($allIndex < $#allWayNodes) and ($allWayNodes[$allIndex+1] == $cat12Nodes[$cat1Index]) ) {
353                        $cat1Connected{$cat12Nodes[$cat1Index]} = 1 ;
354                        #print "cat12 node found > 1x in allWayNodes id =", $cat12Nodes[$cat1Index], "\n" ;
355                }
356        }
357        $cat1Index++ ;
358}
359
360
361# check all starts and end for connection
362# waystat filled
363
364foreach $wayId (@cat1) {
365        # check start
366        if ($cat1Connected{$wayStart{$wayId}} == 1) { 
367                if ($wayStat{$wayId} == 1) { $wayStat{$wayId} = 0 ; }
368                if ($wayStat{$wayId} == 3) { $wayStat{$wayId} = 2 ; }
369        } 
370       
371        # check end
372        if ($cat1Connected{$wayEnd{$wayId}} == 1) { 
373                if ($wayStat{$wayId} == 2) { $wayStat{$wayId} = 0 ; }
374                if ($wayStat{$wayId} == 3) { $wayStat{$wayId} = 1 ; }
375        } 
376}
377
378
379
380
381#print "status\n" ;
382#foreach (@cat1) { print "$_ $wayStat{$_}\n" ; }
383#print "\n" ;
384
385
386######################
387# collect needed nodes
388######################
389print "collect needed nodes...\n" ;
390foreach $wayId (@cat1) {
391        if (($wayStat{$wayId} && 1) == 1) {
392                push @neededNodes, $wayStart{$wayId} ;
393        }
394        if (($wayStat{$wayId} && 2) == 2) {
395                push @neededNodes, $wayEnd{$wayId} ;
396        }
397}
398
399
400######################
401# get node information
402######################
403print "pass2: get node information...\n" ;
404openOsmFile ($osmName) ;
405
406@neededNodes = sort { $a <=> $b } @neededNodes ;
407
408($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1) = getNode () ;
409if ($nodeId != -1) {
410        #@nodeTags = @$aRef1 ;
411}
412
413while ($nodeId != -1) {
414        my $needed = 0 ;
415
416        $needed = binSearch ($nodeId, \@neededNodes ) ;
417
418        if ($needed >= 0) { $lon{$nodeId} = $nodeLon ; $lat{$nodeId} = $nodeLat }
419
420        # next
421        ($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1) = getNode () ;
422        if ($nodeId != -1) {
423                #@nodeTags = @$aRef1 ;
424        }
425}
426
427closeOsmFile () ;
428
429$time1 = time () ;
430
431
432##################
433# PRINT HTML INFOS
434##################
435print "\nwrite HTML tables and GPX file...\n" ;
436
437open ($html, ">", $htmlName) || die ("Can't open html output file") ;
438open ($gpx, ">", $gpxName) || die ("Can't open gpx output file") ;
439
440
441printHTMLHeader ($html, "Connection Check by Gary68") ;
442printGPXHeader ($gpx) ;
443
444print $html "<H1>Connection Check by Gary68</H1>\n" ;
445print $html "<p>Version ", $version, "</p>\n" ;
446print $html "<H2>Statistics</H2>\n" ;
447print $html "<p>", stringFileInfo ($osmName), "<br>\n" ;
448print $html "number ways total: $wayCount<br>\n" ;
449print $html "number invalid ways (1 node only): $invalidWays<br>\n" ;
450print $html "number check ways: $checkWayCount<br>\n" ;
451print $html "number against ways: $againstWayCount</p>\n" ;
452print $html "<p>border file: $borderFileName<br>\n" ;
453print $html "min border distance: $borderThreshold</p>\n" ;
454
455
456print $html "<p>Check ways: " ;
457foreach (@check) { print $html $_, " " ;} print $html "</p>\n" ;
458print $html "<p>Against: " ;
459foreach (@against) { print $html $_, " " ;} print $html "</p>\n" ;
460
461
462print $html "<H2>Unconnected Start/End</H2>\n" ;
463print $html "<p>These ways are either unconnected at start or end (or both). " ;
464print $html " Please be aware that most osm files are excerpts of some sort with cut ways at their limits. " ;
465print $html " This causes false positives! In case of countries or other entities with boundaries they can " ;
466print $html " easily be spotted in maps or JOSM because there are borders in the vincinity.</p>" ;
467print $html "<table border=\"1\">\n";
468print $html "<tr>\n" ;
469print $html "<th>Line</th>\n" ;
470print $html "<th>WayId</th>\n" ;
471print $html "<th>Unconnected</th>\n" ;
472print $html "<th>OSM/OSB Start</th>\n" ;
473print $html "<th>JOSM Start</th>\n" ;
474print $html "<th>OSM/OSB End</th>\n" ;
475print $html "<th>JOSM End</th>\n" ;
476print $html "<th>Pic Start</th>\n" ;
477print $html "<th>Pic End</th>\n" ;
478print $html "</tr>\n" ;
479$i = 0 ;
480foreach $wayId (@cat1) {
481
482        # border check
483        if ( ($wayStat{$wayId} == 1) or ($wayStat{$wayId} == 3) ) {
484                if ( ! minDistToBorderOK ($wayStart{$wayId})   ) {
485                        $wayStat{$wayId} = $wayStat{$wayId} - 1 ;
486                        #print "dropped start node of way $wayId because low dist to border node\n" ;
487                        $borderCollisions++ ;
488                }
489        }
490        if ( ($wayStat{$wayId} == 2) or ($wayStat{$wayId} == 3) ) {
491                if ( ! minDistToBorderOK ($wayEnd{$wayId})   ) {
492                        $wayStat{$wayId} = $wayStat{$wayId} - 2 ;
493                        #print "dropped end node of way $wayId because low dist to border node\n" ;
494                        $borderCollisions++ ;
495                }
496        }
497
498
499        if ($wayStat{$wayId} > 0) {
500                $i++ ;
501
502                my $status ;
503                if ($wayStat{$wayId} == 1) { $status = "start" ; } 
504                if ($wayStat{$wayId} == 2) { $status = "end" ; } 
505                if ($wayStat{$wayId} == 3) { $status = "start/end" ; } 
506
507                # HTML
508                print $html "<tr>\n" ;
509                print $html "<td>", $i , "</td>\n" ;
510                print $html "<td>", historyLink ("way", $wayId) , "</td>\n" ;
511                print $html "<td>", $status , "</td>\n" ;
512
513                print $html "<td>start ", osmLink ($lon{$wayStart{$wayId}}, $lat{$wayStart{$wayId}}, 16) , "<br>\n" ;
514                print $html "start ", osbLink ($lon{$wayStart{$wayId}}, $lat{$wayStart{$wayId}}, 16) , "</td>\n" ;
515                print $html "<td>start ", josmLink ($lon{$wayStart{$wayId}}, $lat{$wayStart{$wayId}}, 0.01, $wayId), "</td>\n" ;
516
517                print $html "<td>end ", osmLink ($lon{$wayEnd{$wayId}}, $lat{$wayEnd{$wayId}}, 16) , "<br>\n" ;
518                print $html "end ", osbLink ($lon{$wayEnd{$wayId}}, $lat{$wayEnd{$wayId}}, 16) , "</td>\n" ;
519                print $html "<td>end ", josmLink ($lon{$wayEnd{$wayId}}, $lat{$wayEnd{$wayId}}, 0.01, $wayId), "</td>\n" ;
520
521                print $html "<td>", picLinkOsmarender ($lon{$wayStart{$wayId}}, $lat{$wayStart{$wayId}}, 16), "</td>\n" ;
522                print $html "<td>", picLinkOsmarender ($lon{$wayEnd{$wayId}}, $lat{$wayEnd{$wayId}}, 16), "</td>\n" ;
523                print $html "</tr>\n" ;
524
525                # GPX
526                if (($wayStat{$wayId} == 1) or ($wayStat{$wayId} == 3) ) { 
527                        my ($text) = "ChkCon - " . $defName . " - way start unconnected" ;
528                        printGPXWaypoint ($gpx, $lon{$wayStart{$wayId}}, $lat{$wayStart{$wayId}}, $text) ;
529                } 
530                if (($wayStat{$wayId} == 2) or ($wayStat{$wayId} == 3) ) { 
531                        my ($text) = "ChkCon - " . $defName . " - way end unconnected" ;
532                        printGPXWaypoint ($gpx, $lon{$wayEnd{$wayId}}, $lat{$wayEnd{$wayId}}, $text) ;
533                } 
534        }
535}
536print $html "</table>\n" ;
537print $html "<p>$i lines total</p>\n" ;
538
539
540
541########
542# FINISH
543########
544print $html "<p>", stringTimeSpent ($time1-$time0), "</p>\n" ;
545printHTMLFoot ($html) ;
546printGPXFoot ($gpx) ;
547
548close ($html) ;
549close ($gpx) ;
550
551statistics ( ctime(stat($osmName)->mtime),  $program,  $defName, $osmName,  $checkWayCount,  $i) ;
552
553print "\nborder collisions found: $borderCollisions\n" ;
554print "\n$program finished after ", stringTimeSpent ($time1-$time0), "\n\n" ;
555
556
557sub statistics {
558        my ($date, $program, $def, $area, $total, $errors) = @_ ;
559        my $statfile ; my ($statfileName) = "statistics.csv" ;
560
561        if (grep /\.bz2/, $area) { $area =~ s/\.bz2// ; }
562        if (grep /\.osm/, $area) { $area =~ s/\.osm// ; }
563        my ($area2) = ($area =~ /.+\/([\w\-]+)$/ ) ;
564
565        if (grep /\.xml/, $def) { $def =~ s/\.xml// ; }
566        my ($def2) = ($def =~ /([\w\d\_]+)$/ ) ;
567
568        my ($success) = open ($statfile, "<", $statfileName) ;
569
570        if ($success) {
571                print "statfile found. writing stats...\n" ;
572                close $statfile ;
573                open $statfile, ">>", $statfileName ;
574                printf $statfile "%02d.%02d.%4d;", localtime->mday(), localtime->mon()+1, localtime->year() + 1900 ;
575                printf $statfile "%02d/%02d/%4d;", localtime->mon()+1, localtime->mday(), localtime->year() + 1900 ;
576                print $statfile $date, ";" ;
577                print $statfile $program, ";" ;
578                print $statfile $def2, ";" ;
579                print $statfile $area2, ";" ;
580                print $statfile $total, ";" ;
581                print $statfile $errors ;
582                print $statfile "\n" ;
583                close $statfile ;
584        }
585        return ;
586}
587
588
589
590sub readBorder {
591        my ($borderFileName) = shift ;
592        my $borderFile ;
593        my $line ;
594        my $id = 0 ;
595        my $dist ;
596        my $lastLon = 0 ; my $lastLat = 0 ; my $maxDist = 0 ;
597       
598        open ($borderFile, "<", $borderFileName) || die ("couldn't open border file");
599        print "parsing border file...\n" ;     
600        $line = <$borderFile> ;
601        $line = <$borderFile> ;
602        $line = <$borderFile> ;
603        while (! (grep /END/, $line) ) {
604                $id-- ; # negative ids for border nodes
605                #($lo, $la) = sscanf ("%g %g", $line) ;
606                #print "line: $line\n" ;
607                my ($lo, $la)   = ($line =~ /^\s*([\-\+\d\.Ee]+)\s+([\-\+\d\.Ee]+)+/ ) ;       
608                if (!defined ($lo))  { print "id: $id line: $line\n" ; }
609                $lon{$id} = $lo ; $lat{$id} = $la ;
610                if ($lastLon == 0) {
611                        $lastLon = $lo ;
612                        $lastLat = $la ;
613                }
614                push @borderWay, $id ;
615                $line = <$borderFile> ;
616                $dist = distance ($lo, $la, $lastLon, $lastLat) ;
617                if ($dist > $maxDist) { $maxDist = $dist ; }
618                #printf "%3d \n", distance ($lo, $la, $lastLon, $lastLat) ;
619                $lastLon = $lo ;
620                $lastLat = $la ;
621        }
622        close ($borderFile) ;
623        print $id*(-1), " border nodes read.\nmax distance between border nodes: $maxDist\n\n" ;
624}
625
626sub minDistToBorderOK {
627        my (@nodes) = @_ ;
628        my $way ; my $node ; my $borderNode ;
629        my $ok = 1 ;
630        #print "checking distance...\n" ;
631
632        my ($startTime) = time() ;
633        loopA:
634        foreach $node (@nodes) {
635                foreach $borderNode (@borderWay) {
636                        my ($dist) = distance ($lon{$borderNode}, $lat{$borderNode}, $lon{$node}, $lat{$node}) ;
637                        if ($dist < $borderThreshold) { 
638                                $ok = 0 ; 
639                                last loopA ; 
640                        }
641                }
642        }
643
644        my ($secs) = time() - $startTime ;
645        #print "done extensive border check in $secs seconds...\n" ;
646        $totalBorderCheckTime += $secs ;
647        if ( $secs > $maxBorderCheckTime ) {
648                $maxBorderCheckTime = $secs ;
649                print "max border check now $maxBorderCheckTime secs\n" ;
650        }
651
652        return $ok ;
653}
Note: See TracBrowser for help on using the repository browser.